IThumbnailCache - Thumbnail ermitteln

[ralfschwalbe]

Hallo,

laut dieser Seite ist der Parameter hBmp ein PHBITMAP, also ein Pointer auf ein HBITMAP...

Bei Dir ist es "nur" HBITMAP.

[Andreas L.]

So sieht die Interface-Deklaration aus:

Delphi-Quellcode:

  {$EXTERNALSYM ISharedBitmap}
  ISharedBitmap = interface(IUnknown)
    ['{091162a4-bc96-411f-aae8-c5122cd03363}']
    function GetSharedBitmap(out phbm: HBITMAP): HRESULT; stdcall;
    function GetSize(out pSize: TSize): HRESULT; stdcall;
    function GetFormat(out pat: WTS_ALPHATYPE): HRESULT; stdcall;
    function InitializeBitmap(hbm: HBITMAP; wtsAT: WTS_ALPHATYPE): HRESULT;
stdcall;
    function Detach(out phbm: HBITMAP): HRESULT; stdcall;
  end;

[ralfschwalbe]

Wo steht die Deklaration? Bei mir im Delphi 2010 gibts die nicht...

Aber ich würde mich bei solchen "speziellen" Interfaces eh lieber auf die Beschreibung von MS verlassen. Versuch es doch einfach mal

[KarstenK]

Hallo Andreas,

kannst Du mal deinen Stand des Test-Projektes mit den entsprechenden units hochladen? Ich würde es mir dann mal genauer anschauen.

Karsten

[ralfschwalbe]

Das Problem ist ein anderes:

Das Handle des Bitmaps ist nach Verlassen der Function GetThumbFromCache ungültig, da die verwendeten Interfaces ungültig sind. Also musst Du, nachdem du das Handle mit GetSharedBitmap bekommen hast, sofort das Bitmap einmal wegkopieren:

Delphi-Quellcode:

Result := sharedbmp.GetSharedBitmap(hBmp);
        if Succeeded(Result) then
        begin
          if Assigned(Bmp) then
          begin
            Bmp.SetSize(thumbsize.cx, thumbsize.cy);
            Bmp.Handle := hBmp;
          end;
        end;

Bmp ist TBitmap und nach dem Bmp.Handle := hBmp auch gültig. Bmp.SaveToFile funktioniert z.B.

Also an dieser Stelle sofort in ein anderes Bitmap kopieren und dieses dann verwenden. Dann funktionierts...

[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;

[Andreas L.]

Mit TBitmap.Dormant := True kann ich jetzt auf das Bild auch außerhalb der GetThumbFromCache-Funktion zugreifen. Leider bekomme ich eine Zugriffsverletzung in der Zeile bs := P1[j]; der procedure FlipBitmap:

Zitat:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project3.exe ist eine Exception der Klasse EAccessViolation mit der Meldung 'Zugriffsverletzung bei Adresse 004ACC76 in Modul 'Project3.exe'. Lesen von Adresse 00003F00' aufgetreten.
---------------------------
Anhalten Fortsetzen Hilfe
---------------------------

Debugger:
P1 $3F00
i 0
j 0
p2 nil
BytesPerLine 256
bs E2171 Auf Variable 'bs' kann wegen Optimierung nicht zugegriffen werden

Funktioniert FlipBitmap bei dir? Was könnte der Fehler sein?