IExtractImage untuk menghasilkan thumbnail view

February 9, 2009 at 7:08 pm | Posted in Code Samples, Components, Tutorials | 3 Comments
Tags: delphi programming, IExtractImage, shell extension, thumbnail

Oleh Zamrony P. Juhara

(Artikel ini awalnya berasal dari posting di mailing list Delphindo, ditulis ulang untuk blog ini)

Ada saat di mana Anda butuh menampilkan thumbnail view suatu file format, namun Anda tidak tahu atau tidak mau pusing bagaimana menampilkan preview file tersebut. Jika Anda perhatikan, Windows Explorer mampu menampilkan preview suatu file ketika dalam mode thumbnail.

Artikel ini akan menjelaskan bagaimana Anda dapat menggunakan kemampuan Windows Explorer pada aplikasi Anda sendiri untuk menghasilkan tampilan thumbnail view.

Windows Explorer mampu mendapatkan preview suatu file menggunakan shell extension. Jika Anda menginstall aplikasi Adobe Acrobat Reader, aplikasi ini menyertakan shell extension yang bertanggung jawab menampilkan preview isi file PDF. Shell extension ini memungkinkan Windows Explorer mampu menampilkan preview file berformat PDF. Shell extension tersebut adalah COM server yang mengimplementasi interface IExtractImage.

Untuk membuat tampilan thumbnail seperti pada Windows Explorer kita membutuhkan instance IExtractImage interface shell folder.

Deklarasi IExtractImage

Interface ini tidak dapat Anda temukan deklarasinya di unit bawaan Delphi. Saya tidak tahu alasannya kenapa namun dari online help MSDN, deklarasi IExtractImage setelah dikonversi ke Delphi adalah seperti pada Listing 1.

Listing 1

type
IExtractImage = interface
  ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
  function GetLocation(pszPathBuffer: PWideChar;
                              cch: cardinal;
                              var pdwPriority: cardinal;
                              var prgSize: TSize;
                              dwRecClrDepth: cardinal;
                              var pdwFlags: cardinal): HResult; stdcall;
  function Extract(var phBmpThumbnail: HBITMAP): HResult; stdcall;
end;

Mendapatkan Instance IShellFolder

Interface IExtractImage dapat Anda peroleh melalui instance interface IShellFolder pada folder yang ingin dibuat tampilan thumbnailnya.

Instance IShellFolder bisa diperoleh dengan menggunakan fungsi Windows API ShGetDesktopFolder yang dideklarasi di unit shlobj.pas.

Jika kita menggunakan SHGetDestopFolder, instance IShellFolder mengacu pada folder desktop yg merupakan root dari semua folder di Windows Explorer.

Untuk mendapatkan IShellFolder dari folder lain, kita menggunakan metode ParseDisplayName milik interface IShellFolder untuk mendapatkan PIDL folder yg diinginkan. PIDL adalah pengenal yang digunakan oleh Windows Explorer untuk mengidentifikasi file atau folder. Lebih jauh tentang PIDL dapat Anda lihat di help Windows SDK.

Untuk mendapatkan instance IShellFolder untuk folder yang ditunjuk oleh PIDL, kita menggunakan metode BindToObject milik IShellFolder. BindToObject akan mengembalikan instance interface IShellFolder yang kita butuhkan. Setelah instance IShellFolder diperoleh, memori yang digunakan oleh PIDL folder dapat dinbebaskan dengan interface IMalloc (di deklarasi di unit ActiveX.pas). Untuk mendapatkan instance IMalloc kita menggunakan fungsi SHGetMalloc (unit shlobj.pas).

Mendapatkan Instance IExtractImage

Lakukan scan seluruh isi folder untuk mendapatkan semua nama file yg ada di folder misal dengan FindFirst dan FindNext. Dari instance IShellFolder yang kita peroleh sebelumnya, kita panggil ParseDisplayName untuk tiap-tiap file yang kita temukan guna mendapatkan PIDL file tersebut.

Setelah PIDL diperoleh, dengan method IShellFolder.GetUIObjectOf dan PIDL file, kita ambil instance IExtractImage. PIDL file ini tidak lagi kita perlukan setelah instance IExtractImage diperoleh, sehingga memorinya bisa kita bebaskan dengan IMalloc.

Lebih jauh tentang IExtractImage

Ada dua method pada IExtractImage yakni GetLocation dan Extract.

GetLocation berfungsi untuk mendapatkan deskripsi file dan juga untukk mengatur beberapa setting thumbnail, seperti ukuran panjang, lebar yang kita inginkan serta kedalaman warna gambar thumbnail.

Extract digunakan untuk merequest gambar thumbnail.

Implementasi

OK kita buat implementasi lengkapnya. Agar mudah, kita akan bungkus fungsionalitasi mengekstrak gambar thumbnail ke dalam kelas bernama TExtractImage dan TExtractFolderImage.

Listing 2

unit uExtractImg;

interface
uses classes,windows,graphics,activex,shlobj,comObj;
type
IExtractImage = interface
['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
  function GetLocation(pszPathBuffer: PWideChar;
                               cch: cardinal;
                               var pdwPriority: cardinal;
                               var prgSize: TSize;
                               dwRecClrDepth: cardinal;
                               var pdwFlags: cardinal): HResult; stdcall;
   function Extract(var phBmpThumbnail: HBITMAP): HResult; stdcall;
end;

TExtractImgEvent=procedure (Sender:TObject;const Filename:string;
                  const Thumbnail:TBitmap) of object;

TBaseExtractImage=class(TObject)
private
  FWidth,FHeight:integer;
  FOnExtract:TExtractImgEvent;
protected
  function GetTargetFolder(const
  aFolder:string):IShellFolder;
  procedure DoExtractImg(ImgExtractor:IExtractImage);
  procedure ExtractImg(const filename:string;
                               const Thumbnail:TBitmap);virtual;
public
   procedure Extract;virtual;abstract;
   property Width:integer read FWidth write FWidth;
   property Height:integer read FHeight write FHeight;
   property OnExtract:TExtractImgEvent read FOnExtract write FOnExtract;
end;

TExtractImage=class(TBaseExtractImage)
private
  FFilename:string;
public
  procedure Extract;override;
published
  property Filename:string read FFilename write FFilename;
  property OnExtract;
end;

TExtractFolderImage=class(TBaseExtractImage)
private
  FFolder:string;
public
  procedure Extract;override;
published
  property Folder:string read FFolder write FFolder;
  property OnExtract;
end;

implementation
uses sysutils;

function TBaseExtractImage.GetTargetFolder(const aFolder:string):IShellFolder;
                                 var MallocObj:IMalloc;
                                 DesktopFolder,TargetFolder:IShellFolder;
                                 Eaten,attr:cardinal;
                                 itemPIDL:PItemIDList;
                                 awidefolder:widestring;
begin
   aWideFolder:=aFolder;
   SHGetMalloc(mallocObj);
   SHGetDesktopFolder(DesktopFolder);

   DesktopFolder.ParseDisplayName(0,nil,
                               PWideChar(aWideFolder),
                               Eaten, ItemPIDL,attr);
   try
     DesktopFolder.BindToObject(ItemPIDL,nil,
                              IShellFolder,TargetFolder);
     result:=TargetFolder;
   finally
     mallocObj.Free(ItemPIDL);
   end;
end;

const
  IEIFLAG_ASYNC = $001;
  IEIFLAG_CACHE = $002;
  IEIFLAG_ASPECT = $004;
  IEIFLAG_OFFLINE = $008;
  IEIFLAG_GLEAM = $010;
  IEIFLAG_SCREEN = $020;
  IEIFLAG_ORIGSIZE = $040;
  IEIFLAG_NOSTAMP = $080;
  IEIFLAG_NOBORDER = $100;
  IEIFLAG_QUALITY = $200;

procedure TBaseExtractImage.DoExtractImg(imgExtractor:IExtractImage);
var Thumbnail: TBitmap;
     ThumbnailHandle: HBITMAP;
     Buf: array[0..MAX_PATH] of WideChar;
     ColorDepth, Priority, Flags: DWORD;
     size:TSize;
     res:HResult;
begin
   priority:=0; //prioritas normal
   colorDepth:=32; //kedalaman warna 32 bit
   size.cx:=FWidth; //size thumbnail
   size.cy:=FHeight;
   //tampilkan seperti dilayar dan hanya yg offline
   flags:=IEIFLAG_SCREEN or IEIFLAG_OFFLINE;

   res:=imgExtractor.GetLocation(@Buf,sizeof(Buf),priority,
                            size,colorDepth,Flags);
   if (res=NOERROR) or (res=E_PENDING) then
   begin
      ThumbnailHandle:=0;
      imgExtractor.Extract(ThumbnailHandle);
      if ThumbnailHandle0 then
      begin
         Thumbnail:=TBitmap.Create;
         try
           Thumbnail.ReleaseHandle;
           Thumbnail.Handle:=ThumbnailHandle;
           ExtractImg(buf,thumbnail);
        finally
           Thumbnail.Free;
        end;
     end;
  end;
end;

procedure TBaseExtractImage.ExtractImg;
begin
   if Assigned(FOnExtract) then
      FOnExtract(self,Filename,Thumbnail);
end;

{TExtractImage}
procedure TExtractImage.Extract;
var TargetFolder:IShellFolder;
     attr,eaten:cardinal;
     itemPIDL:PItemIDList;
     ImgExtractor:IExtractImage;
     folder:string;
     mallocObj:IMalloc;
     afilename:wideString;
begin
   folder:=ExtractFilePath(FFilename);
   delete(folder,length(folder),1);
   TargetFolder:=GetTargetFolder(folder);
   if TargetFolder=nil then exit;
   afilename:=ExtractFilename(FFilename);
   SHGetMalloc(mallocObj);

   TargetFolder.ParseDisplayName(0,nil,
                     PWideChar(aFilename),
                     eaten,ItemPIDL,attr);
   try
     TargetFolder.GetUIObjectOf(0,1,itemPIDL,IExtractImage,
                     nil,ImgExtractor);
   finally
      mallocObj.Free(itemPIDL);
   end;

   DoExtractImg(ImgExtractor);
end;

{TExtractFolderImage}
procedure TExtractFolderImage.Extract;
var TargetFolder:IShellFolder;
     attr,eaten:cardinal;
     itemPIDL:PItemIDList;
     ImgExtractor:IExtractImage;
     mallocObj:IMalloc;
     afilename:widestring;
     searchRec:TSearchRec;
begin
   TargetFolder:=GetTargetFolder(FFolder);
   if TargetFolder=nil then exit;
   if FindFirst(FFolder+'\*.*',
               faAnyFile,SearchRec)=0 then
   begin
      SHGetMalloc(mallocObj);
      repeat
          afilename:=searchRec.Name;
          if (searchRec.Name<>'.') and
             (searchRec.Name<>'..') then
          begin
             TargetFolder.ParseDisplayName(0,nil,
                                PWideChar(aFilename),
                                eaten,ItemPIDL,attr);
             try
               TargetFolder.GetUIObjectOf(0,1,itemPIDL,
                                IExtractImage,
                                nil,ImgExtractor);
             finally
                 mallocObj.Free(itemPIDL);
             end;
             DoExtractImg(ImgExtractor);
          end;
       until (FindNext(searchRec)<>0);
       FindClose(searchRec);
    end;
end;

end.

Sengaja kita pecah menjadi beberapa kelas yakni TExtractImage untuk mendapatkan thumbnail sebuah file dan TExtractFolderImage untuk mendapatkan thumbnail file-file yang terdapat dalam suatu folder. Karena terdapat fungsionalitas yang mirip pada saat mendapatkan IShellFolder suatu direktori, kedua kelas tersebut diturunkan dari kelas yang sama TBaseExtractImage. Tiap kali sebuah file diekstrak thumbnailnya,
akan dibangkitkan event OnExtract, di mana parameternya adalah nama file yang diekstrak dan bitmap berisi thumbnail file tersebut.

Lebar dan tinggi thumbnail yngg diinginkan diatur melalui properti Width dan Height kelas ini.

Berikut ini contoh penggunaannya TExtractImage. Buat project baru. Drop kontrol TListbox,TLabel,TImage dan sebuah TButton ke form. Siapkan event handler OnFormCreate,OnFormDestroy untuk menyiapkan memori TExtractImage.

Listing 2

unit ufrmTest4;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, 
       Controls, Forms, Dialogs, StdCtrls, ExtCtrls, uExtractImg;

type
TForm4 = class(TForm)
   Image1: TImage;
   ListBox1: TListBox;
   Button1: TButton;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure ListBox1Click(Sender: TObject);
private
  extract:TExtractImage;
  procedure DoExtract(Sender:TObject;
                    const filename:string; const thumb:TBitmap);
  { Private declarations }
public
  { Public declarations }
end;

var Form4: TForm4;

implementation

{$R *.DFM}

procedure TForm4.Button1Click(Sender: TObject);
var searchRec:TSearchRec;
begin
   if FindFirst('c:\my documents\*.*',faAnyFile,
                 searchRec)=0 then
   begin
       repeat
          if (searchRec.Name<>'.') and
             (searchRec.Name<>'..') then
                Listbox1.Items.Add('c:\my documents\'+searchRec.Name);
       until (Findnext(searchRec)<>0);
       FindClose(searchRec);
   end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
   extract:=TExtractImage.Create;
   extract.Width:=Image1.Width;
   extract.Height:=Image1.Height;
   extract.OnExtract:=DoExtract;
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
   extract.Free;
end;

procedure TForm4.ListBox1Click(Sender: TObject);
var i:integer;
begin
   if listbox1.items.Count>0 then
   begin
      for i:=0 to listbox1.items.Count-1 do
      begin
         if listbox1.Selected[i] then
         begin
            extract.Filename:=listbox1.items[i];
            extract.Extract;
         end;
      end;
   end;
end;

procedure TForm4.DoExtract(Sender:TObject;
              const filename:string; const thumb:TBitmap);
begin
   label1.Caption:=filename;
   image1.picture.Assign(thumb);
end;

end.

Listing 4 berisi contoh bagaimana mengekstrak thumbnail file-file pada suatu folder.

Listing 4

unit ufrmTest5;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, 
       Controls, Forms, Dialogs, StdCtrls, ComCtrls,
       uEXtractImg, ImgList;

type
TForm5 = class(TForm)
   ListView1: TListView;
   Button1: TButton;
   ImageList1: TImageList;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Button1Click(Sender: TObject);
private
  extractFolder:TExtractFolderImage;
  procedure DoExtractFolder(Sender:TObject;const
            filename:string; const thumb:TBitmap);
  { Private declarations }
public
  { Public declarations }
end;

var
Form5: TForm5;

implementation

{$R *.DFM}

procedure TForm5.FormCreate(Sender: TObject);
begin
   extractFolder:=TExtractFolderImage.Create;
   extractFolder.Width:=ImageList1.Width;
   extractFolder.Height:=ImageList1.Height;
   extractFolder.OnExtract:=DoExtractFolder;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
   extractFolder.Free;
end;

procedure TForm5.DoExtractFolder(Sender:TObject;
      const filename:string; const thumb:TBitmap);
var aItem:TListItem;
     indx:integer;
begin
   indx:=imageList1.Add(thumb,nil);
   aItem:=ListView1.items.Add;
   aItem.Caption:=filename;
   aItem.ImageIndex:=indx;
end;

procedure TForm5.Button1Click(Sender: TObject);
begin
   extractFolder.Folder:='c:\my documents\my pictures';
   extractFolder.Extract;
end;

end.

Ok itu saja tipsnya.