[delphi-users:0098] サムネイル表示について
ムーンドルド
ファイルのサムネイル表示をしようと、Mr.X-RAYさんのサンプルプログラム
■サンプルプログラム集 ファイル一覧・仮想リストビュー
http://mrxray.on.coocan.jp/Delphi/plSamples/792_ExplThumbnail.htm
を使ってみたのですが、Windows Vista・Windows 7 Betaではファイルの保存が
上下逆になってしまいます。
WindowsXP・Windows2000では問題ありませんでした。
※他の場所も調べてみたのですが、結局どのコードもこの上下逆の症状は同じで
した。
調べてみると、以下の
ABitmap.Handle := hBmp;
をしたTBitmapをSaveToFileすると、上下逆の状態で保存される様です。
このHandleプロパティーを調べてみると
＞Handle プロパティは，GDI ビットマップオブジェクトにアクセスするための Windows
GDI ビットマップハンドルへのアクセスを提供します。
となっています。
IExtractImageの仕様変更でGDIビットマップの構造が変わり、バグっているんだ
と思われます。
ちなみに、このTBitmapをTImageに表示させると問題なく表示されます。
保存の際だけ上下逆に保存される様です。
旧MLでも調べてみたのですが、以下の文章を見つけ
＞BITMAPINFOHEADER の biHeight メンバを、
＞正の値にするか負の値にするかで、
＞画像データのスキャン並びのボトムアップ、トップダウンが選べます。
＞その辺が問題になっているかも知れません。
このへんが怪しいかな？と目星を付けているのですが、ではどうすればこの
BITMAPINFOHEADERを変更できるのかがいまいち分かりませんでした。
とりあえず、現在自分なりにコードをつけたしてみました。
ABitmap.Handle := hBmp;
をコメントして
wBitmap := TBitmap.Create;
try
wBitmap.HandleType := ABitmap.HandleType;
wBitmap.PixelFormat := ABitmap.PixelFormat;
wBitmap.Width := ABitmap.Width;
wBitmap.Height := ABitmap.Height;
wBitmap.Handle := hBmp;
ABitmap.Width := wBitmap.Width;
ABitmap.Height := wBitmap.Height;
ABitmap.Canvas.CopyRect(
Rect(0,0,wBitmap.Width,wBitmap.Height),
wBitmap.Canvas,
Rect(0,0,wBitmap.Width,wBitmap.Height));
finally
wBitmap.Free;
end;
をコメントを外せば正常動作しますが、何だか力技でしっくり来ません。
みなさんであればどう対処しますでしょうか？
考えられるのは
1.BITMAPINFOHEADERを変更
2.GDIビットマップの内容を上下反転させてTBitmapに格納
なのですが…よろしくお願いします。
以下コードです。
unit ImageExtract;
interface
uses Windows, Graphics, SysUtils, ShellApi, ShlObj, ActiveX, ComObj,
Classes;
const
IEIFLAG_ASYNC = $001;
IEIFLAG_CACHE = $002;
IEIFLAG_ASPECT = $004;
IEIFLAG_OFFLINE = $008;
IEIFLAG_GLEAM = $010;
IEIFLAG_SCREEN = $020;
IEIFLAG_ORIGSIZE = $040;
IEIFLAG_NOSTAMP = $080;
IEIFLAG_NOBORDER = $100;
IEIFLAG_QUALITY = $200;
const
{$EXTERNALSYM IID_IExtractImage}
IID_IExtractImage: TGUID = '{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}'; /
/このGUIDじゃなきゃダメ
type
{$EXTERNALSYM IExtractImage}
IExtractImage = interface(IUnknown)
['{BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}']
function GetLocation(pszPathBuffer: LPWSTR; cchMax: DWORD;
pdwPriority: PDWORD; const prgSize: PSIZE; dwRecClrDepth: DWORD;
pdwFlags: PDWORD): HRESULT; stdcall;
function Extract(phBmpImage: PHandle): HRESULT; stdcall;
end;
function ExtractImage(AFileName: string; ABitmap: TBitmap; AFlags: DWORD
= 0): Boolean;
var
Malloc: IMalloc;
implementation
function ExtractImage(AFileName: string; ABitmap: TBitmap; AFlags: DWORD
= 0): Boolean;
var
WidePath: WideString;
Eaten, Attribute: Cardinal;
DesktopFolder, Folder: IShellFolder;
ItemIDList, IDList: PItemIDList;
ExtractImage: IExtractImage;
Unknown: IUnknown;
PCh : PWideChar;
Priority : DWORD;
ImageSize : SIZE;
RecClrDepth: DWORD;
Flags: DWORD;
hBmp : THandle;
wBitmap: TBitmap;
begin
Result := False;
SHGetDesktopFolder(DesktopFolder);
WidePath := ExtractFilePath(AFileName);
DesktopFolder.ParseDisplayName(0, nil, PWideChar(WidePath),
Eaten, ItemIDList, Attribute);
DesktopFolder.BindToObject(ItemIDList, nil,
IID_IShellFolder, Pointer(Folder));
WidePath := ExtractFileName(AFileName);
Folder.ParseDisplayName(0, nil, PWideChar(WidePath), Eaten, IDList,
Attribute);
if Succeeded(Folder.GetUIObjectOf(0, 1,
IDList, IID_IExtractImage, nil, Unknown)) then
begin
ExtractImage := Unknown as IExtractImage;
if ExtractImage <> nil then
begin
case ABitmap.PixelFormat of
pfDevice : RecClrDepth := 24;
pf1bit : RecClrDepth := 1;
pf4bit : RecClrDepth := 4;
pf8bit : RecClrDepth := 8;
pf15bit : RecClrDepth := 16;
pf16bit : RecClrDepth := 16;
pf24bit : RecClrDepth := 24;
pf32bit : RecClrDepth := 32;
pfCustom : RecClrDepth := 24;
else RecClrDepth := 24;
end;
Priority := 0;
ImageSize.cx := ABitmap.Width;
ImageSize.cy := ABitmap.Height;
Flags := AFlags;
PCh := AllocMem(512);
try
ExtractImage.GetLocation(PCh, 512,
@Priority, @ImageSize, RecClrDepth, @Flags);
if Succeeded(ExtractImage.Extract(@hBmp)) then
begin
{
wBitmap := TBitmap.Create;
try
wBitmap.HandleType := ABitmap.HandleType;
wBitmap.PixelFormat := ABitmap.PixelFormat;
wBitmap.Width := ABitmap.Width;
wBitmap.Height := ABitmap.Height;
wBitmap.Handle := hBmp;
ABitmap.Width := wBitmap.Width;
ABitmap.Height := wBitmap.Height;
ABitmap.Canvas.CopyRect(
Rect(0,0,wBitmap.Width,wBitmap.Height),
wBitmap.Canvas,
Rect(0,0,wBitmap.Width,wBitmap.Height));
finally
wBitmap.Free;
end;
}
ABitmap.Handle := hBmp;
Result := True;
end;
finally
FreeMem(PCh);
end;
end;
end;
Malloc.Free(ItemIDList);
Malloc.Free(IDList);
DesktopFolder := nil;
Folder := nil;
end;
initialization
OleInitialize(nil);
SHGetMalloc(Malloc);
finalization
Malloc := nil;
OleUninitialize;
end.
ムーンドルド
do1dozn￥king-postman.com
￥を@に変更してください(スパムメール対策)
【MLコミュホームページ】http://www.freeml.com/delphi-users
--[PR]------------------------------------------------------------------
◇◆◇◆ 憧れの４ＬＤＫや共用施設充実マンション ◇◆◇◆
◆◇◆◇賃貸じゃ難しい?理想の住まい探しは早めの資料請求で先手!◆◇◆◇
◇◆◇◆ これから販売予定のおNewなマンション、即チェック ◇◆◇◆
http://ad.freeml.com/cgi-bin/sa.cgi?id=dT4Gb
------------------------------------------------------------------[PR]--
■GMO INTERNET GROUP■ GMO INTERNET www.gmo.jp
ムーンドルド
すみません、環境を書くのを忘れてました
開発環境
Windows Vista Ultimate SP1
Delphi 7
実行環境
Windows Vista Ultimate SP1
Windows2000 SP4 (Virtual PC 2007 で実行)
WindowsXP SP3
Windows 7 Beta (Virtual PC 2007 で実行)
ムーンドルド
do1dozn￥king-postman.com
￥を@に変更してください(スパムメール対策)
【MLコミュホームページ】http://www.freeml.com/delphi-users
--[PR]------------------------------------------------------------------
◇◆◇◆ 憧れの４ＬＤＫや共用施設充実マンション ◇◆◇◆
◆◇◆◇賃貸じゃ難しい?理想の住まい探しは早めの資料請求で先手!◆◇◆◇
◇◆◇◆ これから販売予定のおNewなマンション、即チェック ◇◆◇◆
http://ad.freeml.com/cgi-bin/sa.cgi?id=dT5Zf
ムーンドルド
その後、調査した結果を報告します
前回、Vista上でおかしくなるのは
IExtractImage.GetLocation
IExtractImage.Extract
で取り出したGDIビットマップが原因という所まで分かっていたので、その時に
ここが怪しいと睨んでいた旧MLの文章
＞BITMAPINFOHEADER の biHeight メンバを、
＞正の値にするか負の値にするかで、
＞画像データのスキャン並びのボトムアップ、トップダウンが選べます。
を踏まえて「Vistaの場合はBITMAPINFOHEADER の biHeightがマイナスの値が帰
ってきているのでは？」と仮定して以下のコードを作成してみました。
function ExtractImage(AFileName: string; ABitmap: TBitmap; AFlags: DWORD
= 0): Boolean;
var
WidePath: WideString;
Eaten, Attribute: Cardinal;
DesktopFolder, Folder: IShellFolder;
ItemIDList, IDList: PItemIDList;
ExtractImage: IExtractImage;
Unknown: IUnknown;
PCh : PWideChar;
Priority : DWORD;
ImageSize : SIZE;
RecClrDepth: DWORD;
Flags: DWORD;
hBmp : THandle;
wDIBSection: TDIBSection;
wBitmap: TBitmap;
begin
(中略)
ExtractImage.GetLocation(PCh, 512,
@Priority, @ImageSize, RecClrDepth, @Flags);
if Succeeded(ExtractImage.Extract(@hBmp)) then
begin
// 以下修正コード
GetObject(hBmp, SizeOf(wDIBSection), @wDIBSection);
// biHeightの値がマイナスの状態で
// TBitmat.Handleで受けると、画像が保存時に
// 上下逆になってしまうので、その対策
if wDIBSection.dsBmih.biHeight < 0 then
begin
wBitmap := TBitmap.Create;
try
wBitmap.HandleType := ABitmap.HandleType;
wBitmap.PixelFormat := ABitmap.PixelFormat;
wBitmap.Width := ABitmap.Width;
wBitmap.Height := ABitmap.Height;
wBitmap.Handle := hBmp;
ABitmap.Width := wBitmap.Width;
ABitmap.Height := wBitmap.Height;
ABitmap.Canvas.CopyRect(
Rect(0,0,wBitmap.Width,wBitmap.Height),
wBitmap.Canvas,
Rect(0,0,wBitmap.Width,wBitmap.Height));
finally
wBitmap.Free;
end;
end
else begin
ABitmap.Handle := hBmp;
end;
// 修正コード終了
・・・ですが結果としてVistaでもXPでもプラスの値が帰って来るので、この
コードは正常に動作しません。
では何故、BITMAPINFOHEADER の biHeightがマイナスじゃないのに、TImageだけ
正常に表示されて、保存時だけ上下逆に保存されるのか？
さっぱり分かりません。
とりあえず、前回書いた修正の方法で何とか動くので、それで良しとする事にし
ます。
※そもそも、TBitmapで「BITMAPINFOHEADER の biHeightがマイナスじゃないの
に、TImageだけ正常に表示されて、保存時だけ上下逆に保存される」状況って内
部ではどうなっているのかな？という疑問は残ったままですが（汗）
ムーンドルド
【MLコミュホームページ】http://www.freeml.com/delphi-users
--[PR]------------------------------------------------------------------
◇◆◇◆ 憧れの４ＬＤＫや共用施設充実マンション ◇◆◇◆
◆◇◆◇賃貸じゃ難しい?理想の住まい探しは早めの資料請求で先手!◆◇◆◇
◇◆◇◆ これから販売予定のおNewなマンション、即チェック ◇◆◇◆
http://ad.freeml.com/cgi-bin/sa.cgi?id=dZR3P