Solved

Viewing a file Thumbnail

Posted on 2004-08-11
9
4,098 Views
Last Modified: 2008-01-09
When you are viewing a folder and then select View > Thumbnails
you will be able to see the file contents (if it is an image, document a etc...), and if it is not showable you will see an icon the represents that file type.
what i need is an object that could show me this thumbnail in delphi, when the user clicks on some file it will show him the file's thumbnail.
does anyone has any idea how to do that?
0
Comment
Question by:tomerlei
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
9 Comments
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 11781859
Actually, I knew a trick for this but it's actually just a registry trick. Had to do with changing the default icon from an executable name into %1 so it would just take the image as icon. It's a neat trick, but I forgot how to do this exactly, since it slowed down the explorer quite a bit whenever I selected a folder with 500 or more images...
Keep in mind that a thumbnail display requires the system to read the images and create a thumbnail from it. This can be a slow process even on a fast system...

And can't you use a thumbnail view instead? Explorer supports it and stores the thumbnails in a hidden file for faster access. The explorer component should be able to do the same.
0
 
LVL 4

Author Comment

by:tomerlei
ID: 11789083
i need to see a thumbnail of a specific file which the user choose, usally those files are located in large directories and i need to see only one of them. is it possible?
0
 
LVL 34

Expert Comment

by:Slick812
ID: 11790409
hello tomerlei, I beleive the shell get's the thumbnails that it displays in the explorer view from the  IExtractImage  interface.
This can get a thumbnail from many different image files and from movie files, , , Here is some code for a button click, that will get a single system bitmap for a single file name (if there is any image info in that file)



implementation

{$R *.DFM}

uses ShlObj, ActiveX;

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





procedure TForm1.sbut_IExtractImageClick(Sender: TObject);
const
IEIFLAG_ASPECT = 4;
IEIFLAG_OFFLINE = 8;
IEIFLAG_SCREEN = $20;
IEIFLAG_ORIGSIZE = $40;

var
FolderISF, DesktopISF: IShellFolder;
IExtractImg: IExtractImage;
Attrib, Eaten: DWORD;
pItemIDL: PItemIDList;
MemAlloc: IMalloc;
CharBuf: array[0..2047] of WideChar;
Bmp1: TBitmap;
hBmp: HBITMAP;
Size1: TSize;
Priority, Flags: Cardinal;
GLResult: HResult;

begin
if not ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5)) then
  begin
  ShowMessage('This is NOT avalible in systems older than Win 2000');
  Exit;
  end;

if (SHGetMalloc(MemAlloc) <> NOERROR) or (MemAlloc = nil) then Exit; ;
       // we need IMAlloc interface to free allocated memory of Shell
if NOERROR = SHGetDesktopFolder(DesktopISF) then
  begin
   OleCheck(DesktopISF.ParseDisplayName(0, nil, 'E:\images', Eaten,  //place your Folder name here
    pItemIDL, Attrib));
  DesktopISF.BindToObject(pItemIDL, nil, IShellFolder,
    FolderISF);
  // you must free all of the allocated shell memory of pItemIDL
  MemAlloc.Free(pItemIDL);
  OleCheck(FolderISF.ParseDisplayName(0, nil, 'face1.jpg', Eaten,  // place your file name here
    pItemIDL, Attrib));
  FolderISF.GetUIObjectOf(0, 1, pItemIDL, IExtractImage,
    nil, IExtractImg);
  MemAlloc.Free(pItemIDL);
// set the size of the thumbnail with the Size1
  Size1.cx := 100;  // thumbnail bitmap width
  Size1.cy := 100; // thumnbail bitmap height, before crop

  Flags := //IEIFLAG_SCREEN // does not crop off bitmap
           IEIFLAG_ORIGSIZE // crops extra area off. may not work in win 2000
           or
           IEIFLAG_OFFLINE; // no online search for unknown video codex

  Priority := 0; // not sure is this has any effect

  GLResult := IExtractImg.GetLocation(CharBuf, sizeof(CharBuf), Priority,
    Size1, 32{ColorDepth}, Flags);
  if (GLResult = NOERROR) or (GLResult = E_PENDING) then
    begin
    Bmp1 := TBitmap.Create;
    try
      OleCheck(IExtractImg.Extract(hBmp));
      Bmp1.Handle := hBmp;
      Image1.Picture.Assign(Bmp1);
      finally
      Bmp1.Free;
      end;
  end;
  Label2.Caption := CharBuf;
  end;
end;


 - - - - - - - - - - - - - - - - - - - - - - - - - - -  - - - - - - -  - - - - - - - -
I'm not sure what you want from your discription, maybe you can use this, ,  ask questions if you need more info
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 4

Author Comment

by:tomerlei
ID: 11802276
this is pretty good, but is there an option to get the thumbnails of exe files (i know that those are they're icons)?
 anyway, i need to actually see the thumnails like you see it in the windows explorer, even for a none picture files.
0
 
LVL 34

Expert Comment

by:Slick812
ID: 11802687
?????
I'm confused by your terminology, and your "naming" in your statments, to me a Thumbnail is a Reduced size representation of a much larger image (bitmap), and has nothng to do with an Icon,, , , anyway, system icons are a different thing than a bitmap thumnail, and depending on how you want to implement geting icons will depend on how to code for that, here is some code I already have to get a 48x48 pixel Icon from a system for an Icon file OR an executable file with an Icon resource,  the result of this Get48hIcon function is an Icon handle or Zero if there is no icon in that filename and path


function Get48hIcon(FileName: String; icoIndex: Integer = Zero): Integer;
var
DeskTopISF: IShellFolder;
IExIcon: IExtractIcon;
PathPidl: PItemIDList;
hIconL, hIconS: HIcon;

begin
{this function uses the IExtractIcon to get a 48x48 icon Handle from a file
that Has the Icon Bitmaps in it, like an Icon File (.ICO), an executable
(.EXE) and a library (.DLL) }
Result := 0;
if SHGetDesktopFolder(DeskTopISF) <> NOERROR then
  Exit;

PathPidl := nil;
if DeskTopISF.GetUIObjectOf(Zero, One, PathPidl, IID_IExtractIconA,
                            nil, IExIcon) <> NOERROR then
  Exit;

if (IExIcon.Extract(PChar(FileName), icoIndex, hIconL, hIconS,
                   48 or (n16 shl n16)) = NOERROR) and (hIconL <> Zero) then
  Result := hIconL;
DestroyIcon(hIconS);
end;
0
 
LVL 4

Author Comment

by:tomerlei
ID: 11812420
I'm sorry that i got you confused, what i ment when i asked for thumbnail view, is to get the exact view that you get in the windows explorer thumbnail view, which could be icon, image preview, or the icon that symbols the file type.

I'm sorry for the misunderstanding,
Daniel Leicht.
0
 
LVL 34

Accepted Solution

by:
Slick812 earned 100 total points
ID: 11813582
ok, so what do you need, now?
You did not ask for any explanation, or ask for something else, ? ?
 What do you expect for 50 points? ? ? ?

I guess you expect some API function or code to to do the same thing that the XP folder thumbnail view in explorer does?
I do not know of anything like that. I have given you the code for the   IExtractImage  interface, which will do the work for an actual thumbnail for a file that has an Image in it, otherwize, just get the Icon for a file and draw it on the DC or whatever, , ,
0
 
LVL 4

Author Comment

by:tomerlei
ID: 11815839
i posted the question with 50 points because i didn't know if it was possible, anyway, if you say it cannot be done then i guess that this will have to suffice(100 points).
0
 
LVL 34

Expert Comment

by:Slick812
ID: 11826567
Here is the code for  a Unit called   FileThumb.pas,   which will get an Icon or a image thumbnail into it's ThumpBmp TBitmap property. .
it only has three public properties,  

FilePath (String) - which is the FULL PATH to a system file, , , , ,
 
Size (Integer) - which sets the size of the Bitmap, it can not be below 52 or above 256, , , , , , , ,

and  ThumbBmp (TBitmap) - has the thumbnail bitmap or Icon for the file , if the file does not exist, then a blank Bitmap is made, no icon or image on it.

This only does thumbnails in win 2000 or Newer, for older systems (win 98) it will only have the Icon in the middle of a blank bitmap, so it's almost worthless in win 98.

code for the unit -

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.




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

code for button click to use the FileThumb unit

implementation

{$R *.DFM}

uses FileThumb;


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, min = 52, max = 256

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

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi component that can load a DLL in design time? 8 107
Delphi Yen format 3 76
IP without any Dots 1 100
Firemonkey Queue list 1 51
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question