Thumbnail in TListView

thanks mnasman,

this seems to be the stuff for me, the demo looks excellent. But I cannot get through the author. Do you have the code with you?

perthg

hello  perthg , , I am unsure of what you are asking for in your question, you say that your "custom file search" will have results that are not files on a disk (physical files), and you say you want Thumbnails to be displayed in a list view? I am guessing that for your NON-physical files, that there is some sort of Image (a bitmap?) that you want a thumbnail of? ? The delphi TListView can display images in a TImageList, and this Image List can have your images in it, so you could just place your bitmap thumbnail in the Image list and set the List View Item image index to that thumnail? Or if there more to what you need to do?

hello slick812,
I am writing a search program. Say, search for '*.pas' files in 'c:\delphiapps\' folder including subfolders. The results of the search are stored in a listview. I want thumbnails to work on my listview. I cannot use any Shell components because I do not point to any particular physical folder. As in the example .pas files of 'c:\delphiapps\folder1', 'c:\delphiapps\folder2' etc are displayed in the same listview. I hope it is now clear to you.

perthg

???
still not so clear to me?

I understand that these files may ALL be in different folders, that your file search will be in more than one folder. . .
But you say that you are searching for delphi  .PAS  unit file. . . as far as I know, these  .PAS files are not Image files, not Bitmap files. . . Then what do you mean by  "thumbnail", , ,  I would guess you must mean the system ICON  for a  .PAS  file

are you asking how to show the system Icons in a TListView for a file on a hard disk no matter what folder it happens to be in?

The .pas is mentioned as an example. it can be .bmp. If we search pas file it will just display the icon associated with the file, just like windows explorer. I have fetched the system icons and Large icons/small icons/view/details is working fine for me. I only need a way to display thumbnails.

OK, I will guess that you want some kind of display like the win XP and win 2000 have for their "Explorer" window list view set to Thumbnail s View type? This will get a thumb for image and movie files. . .

I have used the shell interface of IExtractImage to get the same thumbs as that explorer view type.
I could show some code
I uses a FilePath, so that any file on disk (even in many folders) can be a thumb, but will not work on systems before win 20000

here is some code for a FileThumb unit, which will get a thumbnail size bitmap from a file on disk, if it is an image or movie file you get a picture thumb bitmap, if it is not a registered image file, then you will get a bitmap of thumb size, with a system Icon for that file type, much like the display of explorer in thumbnail view. . . . . . . . . .
- - - - - - - - - - - -



unit FileThumb;

interface

uses Graphics;

Type
  TFileThumb = Class
  protected
    FhImageList48: Cardinal;
    FSize, FIconSize: Integer;
    FBmp: TBitmap;
    FFilePath: String;
    procedure SetFile(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;

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;
ShInfo1: TShFileInfo;
icHgt, icWid: Integer;
begin
FSize := 100;
FFilePath := '';
hImagList32 := SHGetFileInfo('file.txt',FILE_ATTRIBUTE_NORMAL, ShInfo1, SizeOf(ShInfo1),
           SHGFI_LARGEICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);

hImagList16 := SHGetFileInfo('file.txt',FILE_ATTRIBUTE_NORMAL, ShInfo1, SizeOf(ShInfo1),
           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(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);
SHGetFileInfo(PChar(FFilePath),FILE_ATTRIBUTE_NORMAL, ShInfo1, SizeOf(ShInfo1),
         SHGFI_LARGEICON or SHGFI_SYSICONINDEX);
ImageList_Draw(FhImageList48, ShInfo1.iIcon, FBmp.Canvas.Handle, Mid,
               Mid, ILD_TRANSPARENT);
if not ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5)) then
  Exit;

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

if DesktopISF.ParseDisplayName(0, nil, StringToOleStr(path), Eaten,
    pItemIDL, Attrib) <> NOERROR then
      Exit;

DesktopISF.BindToObject(pItemIDL, nil, IShellFolder, FolderISF);
MemAlloc.Free(pItemIDL);
if FolderISF.ParseDisplayName(0, nil, StringToOleStr(name), Eaten,
    pItemIDL, Attrib) <> NOERROR then
      Exit;

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;

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.


 = = = = = = = = = = = = = = = = = = = = = = = = =

button click to use


procedure TForm1.sbut_FileThumbClick(Sender: TObject);
var
aThumbFile: TFileThumb;
begin
if OpenDialog1.Execute then
  begin
  aThumbFile := TFileThumb.Create;
  try
    aThumbFile.Size := 128; // set Thumb Bitmap size, default to 100
    aThumbFile.FilePath := OpenDialog1.FileName;
  // whenever you set a FilePath a new ThumbBmp is made
    Image1.Picture.Assign(aThumbFile.ThumbBmp);
    finally
    FreeAndNil(aThumbFile);
    end;
  end;
end;

Thanks slick812,
but the solution is not workable for me. I want a solution with a group of files. I also need information about selected files in the thumblist. Also it does not displays the actual image of a image file in the thumbnail view.

perthg.