IThumbnailCache - Thumbnail ermitteln

[Andreas L.]

Hi,

ich möchte mit dem Interface IThumbnailCache das gecachte Thumbnail für ein Bild ermitteln. Dazu habe ich folgende Funktion geschrieben:

Delphi-Quellcode:

function GetThumbFromCache(AFileName: string; var hBmp: HBITMAP; AMaxSize: Integer = 120): HRESULT;
var
  thumbcache: IThumbnailCache;
  sharedbmp: ISharedBitmap;
  shellitem: IShellItem;
  thumbflags: PWTS_CACHEFLAGS;
  thumbid: PWTS_THUMBNAILID;
  thumbsize: TSize;
begin
  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,
        nil
      );

      if Succeeded(Result) then
      begin
        {sharedbmp.GetSize(thumbsize);
        ShowMessage(IntToStr(thumbsize.cx) + ' - ' + IntToStr(thumbsize.cy)); } // <-- gibt die richtige Größe aus
        Result := sharedbmp.GetSharedBitmap(hBmp);
      end;

      CoUninitialize;
    end;
  end;
end;

Beim Aufruf wird in hBmp ein Handle eingetragen. Das Image zeigt aber nichts an. Weiß jemand was ich falsch mache?

Delphi-Quellcode:

      GetThumbFromCache(OpenDialog1.FileName, hbmp);
      image3.Picture.Bitmap.Handle := hbmp;
      // image3.Refresh, Repaint, etc. hilft auch nichts

[Andreas L.]

Hat denn keiner eine Idee?

[KarstenK]

image3.Picture.Bitmap.Handle := hbmp;

Ich bin nicht sicher ob das reicht, ich verwende für DIB per handle eine extra funktion die aus dem Handle ein richtiges TBitmap macht.

Delphi-Quellcode:

//*****************************************************************************************
// efg, June 2000.  efg's Computer Lab, www.efg2.com/Lab
//
// Contents
//
//      Method 2.  hDIB to TBitmap resulting in bmDIB using MemoryStream (best)
//
// Summary:
//
//      Method 1.  hDIB to TBitmap resulting in bmDDB using StretchDIBits
//      Method 2.  hDIB to TBitmap resulting in bmDIB using MemoryStream
//      Method 3.  pf24bit TBitmap created using L_PaintDC Lead API call
//
// Tests:
//
//      A.  Deer.BMP, 160 by 194, 8 bits/pixel, palette mostly of browns
//
//                   256 color display     true color display (24-bit)
//                   400 MHz Pentium       166 MHz Pentium
//                   ------------------    -----------------
//      Method 1     15 ms always works    12 ms white bar (~10%) 1 of 4 times
//      Method 2      7 ms always works     4 ms always works
//      Method 3      6 ms bad color       21 ms bad color
//
//
//      B.  Balloons.BMP, 768 by 512, 24 bits/pixel, no palette
//
//                   256 color display     true color display (24-bit)
//                   400 MHz Pentium       166 MHz Pentium
//                   ------------------    -----------------
//      Method 1      82 ms bad color      189 ms always works.
//      Method 2      74 ms OK color       261 ms always works
//      Method 3     155 ms bad color      289 ms always works
//
// ============================================================================
// Method 2.  hDIB to TBitmap resulting in bmDIB using MemoryStream.
// Anatomy of a DIB written to stream :
// 1.  Bitmap File Header.  Normally 14 bytes, i.e., SizeOf(TBitmapFileHeader).
// 2.  Bitmap Info Header.  Normally 40 bytes, i.e., SizeOf(TBitmapInfoHeader)
// 3.  Color Table.  Bitmaps with > 256 colors do not have a color table.
// 4.  Bitmap Bits.
//
// Based on 12 July 1998 UseNet post "DIB to TBitmap" by Taine Gilliam in
// borland.public.delphi.vcl.components.using

function hDIBToTBitmap(const hDIB: THandle): TBitmap;

var
  BitCount: INTEGER;
  BitmapFileHeader: TBitmapFileHeader;
  BitmapInfo: pBitmapInfo;
  DIBinMemory: Pointer;
  MemoryStream: TMemoryStream;
  NumberOfColors: INTEGER;
begin
  RESULT := TBitmap.Create;

  DIBinMemory := GlobalLock(hDIB);
  try
    BitmapInfo := DIBInMemory;
    NumberOfColors := BitmapInfo.bmiHeader.biClrUsed;
    BitCount := BitmapInfo.bmiHeader.biBitCount;
    if (NumberOfColors = 0) and (BitCount <= 8) then
      NumberOfColors := 1 shl BitCount;

    with BitmapFileHeader do
      begin
        bfType := $4D42; // 'BM'
        bfReserved1 := 0;
        bfReserved2 := 0;
        bfOffBits := SizeOf(TBitmapFileHeader) +
          SizeOf(TBitmapInfoHeader) +
          NumberOfColors * SizeOf(TRGBQuad);
        bfSize := bfOffBits + BitmapInfo.bmiHeader.biSizeImage;
      end;

    MemoryStream := TMemoryStream.Create;
    try
      MemoryStream.Write(BitmapFileHeader, SizeOf(TBitmapFileHeader));
      MemoryStream.Write(DIBInMemory^,
        BitmapFileHeader.bfSize - SizeOf(TBitmapFileHeader));
      MemoryStream.Position := 0;
      RESULT.LoadFromStream(MemoryStream)
    finally
      MemoryStream.Free
    end

  finally
    GlobalUnlock(hDIB);
    GlobalFree(hDIB)
  end
end {hDIBToTBitmap};

[Andreas L.]

Danke für deine Antwort. Leider bekomme ich eine Access Violation wenn ich hBmp an deine Funktion übergebe.

Zitat:

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

Delphi-Quellcode:

    GetThumbFromCache(OpenDialog1.FileName, hbmp2, 250);
    image3.Picture.Bitmap.Assign(hDIBToTBitmap(hbmp2)); // auch ohne Assign versucht

Bei einer anderen Routine lässt sich das hBmp einfach an Bitmap.Handle zuweisen.

Delphi-Quellcode:

function GetThumb(AFilePath: string; var hBmp: HBITMAP; AMaxSize: LongInt = 120): HRESULT;
var
  fileShellItemImage: IShellItemImageFactory;
  s: TSize;
begin
  Result := CoInitializeEx(
    nil,
    COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE
  );

  if Succeeded(Result) then
  begin
    Result := SHCreateItemFromParsingName(
      PChar(AFilePath),
      nil,
      IShellItemImageFactory,
      fileShellItemImage
    );

    if Succeeded(Result) then
    begin
      s.cx := AMaxSize;
      s.cy := AMaxSize;
      Result := fileShellItemImage.GetImage(s, SIIGBF_THUMBNAILONLY, hBmp);
    end;

    CoUninitialize;
  end;
end;

...

    getThumb(opendialog1.filename, hbmp, 250);
    image1.Picture.Bitmap.Handle := hbmp;

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