IThumbnailCache - Thumbnail ermitteln

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

[KarstenK]

"Mit TBitmap.Dormant := True kann ich jetzt auf das Bild auch außerhalb der GetThumbFromCache-Funktion zugreifen".

Das nuss ausgeführt werden, solange das Handle gültig ist, also innerhalb von GetThumbFromCache

[Andreas L.]

Zitat von KarstenK:

Das nuss ausgeführt werden, solange das Handle gültig ist, also innerhalb von GetThumbFromCache

Das mache ich auch. Es wird mir von der Funktion auch ein Bild zurückgeliefert, nur steht es auf den kopf. Und wenn ich deine FlipBitmap-Funktion verwende, bekomme ich die oben genannte AV. Mein Code sieht im Moment so aus:

Delphi-Quellcode:

function TForm2.GetThumbFromCache(AFileName: string; out Bmp: TBitmap; AMaxSize: Integer = 120): HRESULT;
var
  thumbcache: IThumbnailCache;
  sharedbmp: ISharedBitmap;
  shellitem: IShellItem;
  thumbflags: PWTS_CACHEFLAGS;
  thumbid: PWTS_THUMBNAILID;
  thumbsize: TSize;
  hBmp: HBITMAP;
begin
  if not Assigned(Bmp) then
    Exit;

  Result := CoInitialize(Nil);

  Result := CoCreateInstance(
    CLSID_LocalThumbnailCache,
    nil,
    CLSCTX_INPROC,
    IThumbnailCache,
    thumbcache
  );

  if Succeeded(Result) then
  begin
    Result := SHCreateItemFromParsingName(
      PChar(AFileName),
      nil,
      IShellItem,
      shellitem
    );

    if Succeeded(Result) then
    begin
      Result := thumbcache.GetThumbnail(
        shellitem,
        AMaxSize,
        WTS_EXTRACT,
        sharedbmp,
        nil, //thumbflags,
        nil //thumbid
      );

      if Succeeded(Result) then
      begin
        sharedbmp.GetSize(thumbsize);
        Result := sharedbmp.GetSharedBitmap(hBmp);
        if Succeeded(Result) then
        begin
          bmp.SetSize(thumbsize.cx, thumbsize.cy);
          bmp.Handle := hBmp;
          bmp.Dormant;
          //FlipBmp(bmp);
          MirrorVertical(Bmp);
        end;
      end;

      CoUninitialize;
    end;
  end;
end;

Mit folgendes Funktion kann ich das Bild drehen, die soll allerdings langsam sein:

Delphi-Quellcode:

Procedure MirrorVertical(var Picture: TBitmap);
var BMP: TBitmap;
     i,j: integer;
begin
BMP := TBitmap.Create;
BMP.Assign(Picture);
for i := 0 to BMP.Height-1 do
  for j := 0 to BMP.Width-1 do
   Picture.canvas.Pixels[j, BMP.Height-i-1] := BMP.canvas.Pixels[j, i];
BMP.free;
end;

[KarstenK]

Ja, da war noch ein Fehler (X koordinate wurde doppelt hochgezählt) drin, keine Ahnung wieso der Code bei mir damals ging.
Wobei auch die Korrektur fehlschlug.

Nach setzen auf Pixelformat pf24bit, läuft er heute wieder bei mir.

Delphi-Quellcode:

procedure FlipBitmap(VAr BitmapToFlip: Tbitmap);
var
  i, j: integer;
  P1, p2: Pbytearray;
  bs: byte;
  BytesPerLine: integer;
begin
  BitmapToFlip.PixelFormat := pf24bit;
  BytesPerLine := 3 * BitmapToFlip.Width;

  for I := 0 to BitmapToFlip.Height div 2 - 1 do
    begin
      P1 := BitmapToFlip.ScanLine[i];
      P2 := BitmapToFlip.ScanLine[BitmapToFlip.Height - 1 - i];
      for j := 0 to BytesPerLine - 1 do
        begin
          bs := P1[j];
          P1[j] := P2[j];
          P2[j] := bs;
        end;
    end;
end;