procedure FlipBitmap(Bitmap: Tbitmap);
var
i, j: integer;
P1, p2: Pbyte;
bs: byte;
BytesPerLine: integer;
begin
case Bitmap.PixelFormat
of
// pfDevice: ;
pf1bit: BytesPerLine := (Bitmap.Width - 7)
div 8 +1;
//richtig?
pf4bit: BytesPerLine := (Bitmap.Width - 1)
div 2 +1;
//richtig?
pf8bit: BytesPerLine := Bitmap.Width;
pf15bit: BytesPerLine := 2 * Bitmap.Width;
pf16bit: BytesPerLine := 2 * Bitmap.Width;
pf24bit: BytesPerLine := 3 * Bitmap.Width;
pf32bit: BytesPerLine := 4 * Bitmap.Width;
// pfCustom: ;
end;
for I := 0
to Bitmap.Height
div 2 - 1
do
begin
P1 := Bitmap.ScanLine[i];
P2 := Bitmap.ScanLine[Bitmap.Height - 1 - i];
for j := 0
to BytesPerLine - 1
do
begin
bs := P1[j];
P1[j] := P2[j];
P2[j] := bs;
inc(p1);
inc(p2);
end;
end;
end;
function GetThumbFromCache1(AFileName:
string; AMaxSize: Integer = 120): TBITMAP;
var
thumbcache: IThumbnailCache;
sharedbmp: ISharedBitmap;
shellitem: IShellItem;
// thumbflags: PWTS_CACHEFLAGS;
// thumbid: PWTS_THUMBNAILID;
// thumbsize: TSize;
hBmp: HBITMAP;
begin
CoInitialize(
nil);
result :=
nil;
try
if Succeeded(CoCreateInstance(CLSID_LocalThumbnailCache,
nil, CLSCTX_INPROC, IThumbnailCache, thumbcache))
then
if Succeeded(SHCreateItemFromParsingName(PChar(AFileName),
nil, IShellItem, shellitem))
then
if Succeeded(thumbcache.GetThumbnail(shellitem, AMaxSize, WTS_EXTRACT, sharedbmp,
nil,
nil))
then
if Succeeded(sharedbmp.GetSharedBitmap(hBmp))
then
begin
result := Tbitmap.Create;
result.Handle := hbmp;
result.Dormant;
//extrem wichtig, sonst stimmen zwar METADATEN, aber das Handle ist kaputt
//flip , sonst auf dem Kopf
FlipBitmap(result);
end;
finally
CoUninitialize;
end;
end;
procedure TForm10.Button1Click(Sender: TObject);
var TB:graphics.Tbitmap;
begin
if OpenDialog1.execute
then
Try
TB:= GetThumbFromCache1(OpenDialog1.FileName,120);
Image1.Picture.Assign(TB);
finally
TB.Free;
end;
end;