Thumbnails!

Thumbnails! Et godt dansk ord til en god dansk Delphi blog ;-) Men det var nu det bedste ord jeg kunne finde.

Jeg vil i dette indlæg behandle lidt forskelligt. Dels vil jeg vise, hvordan man tilgår data i en TBitmap ved hjælp af "Scanlines", og dels vil jeg vise hvordan man får Windows til at genere thumbnails for billeder der ligger på harddisken.

Jeg vil angive nogle eksekverings tider, det er tider tager fra min egen udviklings-pc. Det er ikke nogen super hurtigt maskine, men blot en ganske almindelig pc:

Processor : AMD Athlon II x2 255. 3.1 GHz.
Ram : 4 GB.
OS: Windows 7 64 bit
HD hastighed: 5200 omdrejninger
... altså ikke noget stort og voldsomt.

For at genere nogle thumbnails, skal jeg have noget at genere dem af. Til det formål har jeg skrevet en procedure, der laver en bitmap på størrelse med skærmen, bestående af random pixels. Som det fremgår af koden, bruger jeg "Scanline-metoden" til at tilgå de enkelte pixels.

De enkelte steps er forklaret i koden.

procedure GeneratePictures(Antal: Integer);

var
  bmpWidth, bmpHeight, i, j: Integer;
  Bitmap: TBitmap;
  OutputDir: String;
  Scanline: pScanline;
begin
  bmpWidth := GetSystemMetrics(SM_CXSCREEN);
  bmpHeight := GetSystemMetrics(SM_CYSCREEN);

  //opret en 32 bits bitmap
  Bitmap := TBitmap.Create;
  Bitmap.Width := bmpWidth;
  Bitmap.Height := bmpHeight;
  Bitmap.PixelFormat := pf32bit;

  OutputDir := ExtractFilePath(ParamStr(0)) + 'Images\';
  ForceDirectories(OutputDir);

  while Antal > 0 do
  begin
    for i := 0 to bmpHeight - 1 do
    begin
      j := 0;
      //Hent adressen til den første pixel i linje "i"
      Scanline := Bitmap.Scanline[i];

      while j < bmpWidth do
      begin
        //Beregn adressen på den pixel du vil tilgå:
        //Adressen på Pixel #0 i din linje gange antal pixel gange med størrelsen på en pixel
        with pRGBQuad(Integer(@Scanline[0]) + (j * Sizeof(TRGBQuad)))^ do
        begin
          //farvelæg din pixel
          rgbBlue := Random(255);
          rgbGreen := Random(255);
          rgbRed := Random(255);
          rgbReserved := 0;
        end;

        inc(j); //næste pixel
      end;
    end;

    //Dumme billeder har dumme navne ;o)
    Bitmap.SaveToFile(OutputDir + IntToStr(Antal) + '.bmp');
    Dec(Antal);
  end;

  FreeAndNil(Bitmap);
end;

Herefter er det blot at kalde koden:

procedure TMainForm.Button1Click(Sender: TObject);
var
  Start, Stop: DWORD;
begin
  Start := GetTickCount;
  GeneratePictures(50);
  Caption := IntToStr(GetTickCount - Start)
end;

En ganske uvidenskabelig test på min computer viser, at jeg skal bruge omkring 1200-1400 millisekunder på at lave og gemme de 50 billeder.

Nu hvor billederne er genereret, skal der laves thumbnails. I stedet for at "hive dem op" i CPU'en og lade dén beregne på det, kan man få Windows til at gøre det. Det er ganske hurtigt. Eneste "ulempe" er, at sådan noget  kode der interagerer med Windows shell'en, dels ikke er ret kønt og dels ikke er ret læsevenligt. Jeg har dog gjort det nemt at bruge.

Jeg vil ikke bruge en masse plads på at forklare mig her, idet jeg har sat kommentarer i koden, og hvis det virkelig interesserer nogen hvad de enkelte Windows funktioner laver, kan jeg så afgjort anbefale at slå det op i MSDN.

unit FileThumbU;

interface

uses
  Graphics;

Type
  TFileThumb = Class
  protected
    FhImageList48: Cardinal;
    FSize, FIconSize: Integer;
    FBmp: TBitmap;
    FFilePath: String;
    procedure SetFile(const Value: String);
    procedure SetSize(Value: Integer);
    procedure GetThumb;
  public
    property Size: Integer read FSize write SetSize;
    property ThumbBmp: TBitmap read FBmp;
    property FilePath: String read FFilePath write SetFile;
    Constructor Create;
    Destructor Destroy; override;
  end;

implementation

uses
  Windows, SysUtils, ActiveX, ShellApi, commCtrl, ShlObj;

// http://msdn.microsoft.com/en-us/library/windows/desktop/bb761848(v=vs.85).aspx
// IExtractImage Interface er implementeret i Windows' Shell32.dll (fra version 4.70)
type
  IExtractImage = interface
    ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
    function GetLocation(pszwPathBuffer: PWideChar; cch: DWORD; var dwPriority: DWORD; var rgSize: TSize; dwRecClrDepth: DWORD; var dwFlags: DWORD): HResult; stdcall;
    function Extract(var hBmpThumb: HBITMAP): HResult; stdcall;
  end;

const
  MinSize = 52;
  MaxSize = 256;
  ColorFormat: DWORD = 24;
  IEIFLAG_OFFLINE = 8;
  IEIFLAG_SCREEN = $20;

Constructor TFileThumb.Create;
var
  hImagList16, hImagList32: Cardinal;
  pfsi: TShFileInfo;
  icHgt, icWid: Integer;
begin
  //Default thumbnail størrelse
  FSize := 100;
  FFilePath := '';
  {
    Henter et handle til den imagelist, som Windows internt bruger til Iconer. Yderligere information:
    http://msdn.microsoft.com/en-us/library/bb762179(VS.85).aspx
    Parameteren SHGFI_SYSICONINDEX er den centrale
  }
  hImagList32 := SHGetFileInfo('dummy.txt', FILE_ATTRIBUTE_NORMAL, pfsi, SizeOf(pfsi), SHGFI_LARGEICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  hImagList16 := SHGetFileInfo('dummy.txt', FILE_ATTRIBUTE_NORMAL, pfsi, SizeOf(pfsi), SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  FhImageList48 := hImagList16 + (hImagList16 - hImagList32);

  if ImageList_GetIconSize(FhImageList48, icHgt, icWid) and (icHgt = 48) then
    FIconSize := 48
  else
  begin
    FhImageList48 := hImagList32;
    if ImageList_GetIconSize(hImagList32, icHgt, icWid) then
      FIconSize := icHgt
    else
      FIconSize := 32;
  end;

  FBmp := Graphics.TBitmap.Create;
  FBmp.Canvas.Brush.Color := GetSysColor(COLOR_WINDOW);
  FBmp.Width := FSize;
  FBmp.Height := FSize;
  FBmp.PixelFormat := pf24Bit;
end;

destructor TFileThumb.Destroy;
begin
  FreeAndNil(FBmp);
  inherited Destroy;
end;

procedure TFileThumb.SetFile(const Value: String);
begin
  if Value = FFilePath then
    Exit;
  FFilePath := Value;
  GetThumb;
end;

procedure TFileThumb.SetSize(Value: Integer);
begin
  if Value = FSize then
    Exit;

  if Value > MaxSize then
    FSize := MaxSize
  else if Value < MinSize then
    FSize := MinSize
  else
    FSize := Value;

  FBmp.Width := FSize;
  FBmp.Height := FSize;
  GetThumb;
end;

procedure TFileThumb.GetThumb;
var
  Path, Name: String;
  FolderISF, DesktopISF: IShellFolder;
  IExtractImg: IExtractImage;
  Attrib, Eaten: DWORD;
  pItemIDL: PItemIDList;
  MemAlloc: IMalloc;
  CharBuf: array [0 .. 2047] of WideChar;
  hBmp: HBITMAP;
  Size1: TSize;
  Priority, Flags: Cardinal;
  GLResult: HResult;
  Mid: Integer;
  ShInfo1: TShFileInfo;
begin
  FBmp.Width := FSize;
  FBmp.Height := FSize;

  if (FFilePath = '') or (not FileExists(FFilePath)) then
  begin
    FBmp.Canvas.Rectangle(0, 0, FSize, FSize);
    Exit;
  end;

  Path := ExtractFilePath(FFilePath);
  Name := ExtractFileName(FFilePath);
  Mid := (FSize shr 1) - (FIconSize shr 1);
  FBmp.Canvas.Rectangle(-1, -1, FSize + 3, FSize + 3);

  //Lad Windows shell'en til at genere en thumbnail
  SHGetFileInfo(PChar(FFilePath), FILE_ATTRIBUTE_NORMAL, ShInfo1, SizeOf(ShInfo1), SHGFI_LARGEICON or SHGFI_SYSICONINDEX);

  //Tegn den på bitmap'en
  ImageList_Draw(FhImageList48, ShInfo1.iIcon, FBmp.Canvas.Handle, Mid, Mid, ILD_TRANSPARENT);

  // Krav: Mindst Windows 2000
  if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Win32MajorVersion < 6) then
    Exit;

  if (SHGetMalloc(MemAlloc) <> NOERROR) or (MemAlloc = nil) or (SHGetDesktopFolder(DesktopISF) <> NOERROR) then
    Exit;

  //Oversæt Path til PItemIDList, den skal vi bruge senere
  if DesktopISF.ParseDisplayName(0, nil, StringToOleStr(Path), Eaten, pItemIDL, Attrib) <> NOERROR then
    Exit;

  //Bind vores PItemIDList til Windows Shell
  DesktopISF.BindToObject(pItemIDL, nil, IShellFolder, FolderISF);
  MemAlloc.Free(pItemIDL);

  //Oversæt navn til PItemIDList, den skal vi bruge senere
  if FolderISF.ParseDisplayName(0, nil, StringToOleStr(Name), Eaten, pItemIDL, Attrib) <> NOERROR then
    Exit;

  //Tag fat i billedet og generer en thumbnail
  FolderISF.GetUIObjectOf(0, 1, pItemIDL, IExtractImage, nil, IExtractImg);
  MemAlloc.Free(pItemIDL);

  if IExtractImg = nil then
    Exit;

  Size1.cx := FSize;
  Size1.cy := FSize;

  Flags := IEIFLAG_SCREEN or IEIFLAG_OFFLINE;
  Priority := 0;

  //Hent path til vores billede, og vær sikker på at vores Thumbnail bitmap har det rigtige handle
  GLResult := IExtractImg.GetLocation(CharBuf, SizeOf(CharBuf), Priority, Size1, ColorFormat, Flags);

  if (GLResult = NOERROR) or (GLResult = E_PENDING) then
  begin
    if (IExtractImg.Extract(hBmp) <> NOERROR) or (hBmp = 0) then
      Exit;

    FBmp.Handle := hBmp;
  end;

end;

end.

Jeg sagde jo koden ikke var ret køn ;o) Men som det fremgår af eksemplet, har jeg lagt det i en unit for sig selv, således at det er "pakket" væk.

Tilbage er der blot at kalde koden:

uses
  FileThumbU, IOUtils;

procedure TMainForm.Button2Click(Sender: TObject);
var
  Start, Stop: DWORD;
  BitmapFile, NewFileName: String;
begin
  Start := GetTickCount;
  for BitmapFile in TDirectory.GetFiles(ExtractFilePath(ParamStr(0)) + 'Images\', '*.bmp') do
    With TFileThumb.Create do
      try
        NewFileName := ExtractFilePath(BitmapFile) + 'th_' + ExtractFileName(BitmapFile);
        FilePath := BitmapFile;
        ThumbBmp.SaveToFile(NewFileName);
      finally
        Free;
      end;

  Caption := IntToStr(GetTickCount - Start)
end;

Tests fortaget på min computer viser at det tager ca. 1400-1500 millisekunder at udføre.

Den opmærksomme læser bemærker sikkert, at jeg benytter mig af IOUtils.pas i eksempelt, som først er tilgængelig i Delphi 2009. Det er gjort fordi det er en nem måde at traversere en folder igennem efter filer. Det er så også det eneste kode, der ikke kan køre på en ældre version af Delphi. Skulle nogen få brug for det, kan man nemt selv omskrive til et "FindFirst .. FindNext .. FindClose"-loop, som man brugte før i tiden.

Så alt i alt har jeg genereret 50 billeder med random pixels, smidt dem på harddisken og lavet thumbnails ud af dem på under 3 sekunder. Ikke dumt når man tager billedernes størrelse i betragtning.

Thumbnail-generatoren kan også bruges på JPEGs og andre formater som din Windows kan lave thumbnails af. Under alle omstændigheder får man en Bitmap ud af det, som så selv må lave om til det ønskede format. I mit eksempel har jeg blot holdt mig til bitmaps for ikke at sløre billedet.

Jens Borrisholt