IThumbnailCache - Thumbnail ermitteln

[KarstenK]

Hallo,

so klappt das.

Delphi-Quellcode:

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;