🚀 go-pugleaf

Hello,

I want to show a preview for files in my app. I'm using Delphi 7 and
Windows Vista.
I created a small app to test using IPreviewHandler, but it doesn't
show anything (even no error message).
Maybe anybode can help me. Just create a new project, put a Button1 on
the main form and copy the following code into the pas-file:

unit FMain;

{
http://dedjo.blogspot.com/2008/04/using-vista-preview-handlers-in-wpf.html
http://blogs.claritycon.com/blogs/ryan_powers/archive/2007/07.aspx
http://blogs.microsoft.co.il/blogs/eyal/archive/2007/07.aspx
}

interface

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

type
  TPreviewControl = class(TCustomControl)
  private
    FFileName: string;
    FLastError: string;
    procedure SetFileName(const Value: string);
    procedure PreviewFile;
  public
    property FileName: string read FFileName write SetFileName;
    property LastError: string read FLastError;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FPreview: TPreviewControl;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Registry, ComObj, ActiveX, ShlObj;

type
  IPreviewHandler = interface(IUnknown)
    ['{8895b1c6-b41f-4c1c-a562-0d564250836f}']
    function DoPreview(): HRESULT; stdcall;
    function QueryFocus(phwnd: HWND): HRESULT; stdcall;
    function SetFocus(): HRESULT; stdcall;
    function SetRect(var RectangleRef: TRect): HRESULT;   stdcall;
    function SetWindow(hwnd: HWND; var RectangleRef: TRect): HRESULT;
stdcall;
    function TranslateAccelerator(PointerToWindowMessage: MSG):
HRESULT; stdcall;
    function Unload(): HRESULT; stdcall;
  end;

   IInitializeWithFile = interface(IUnknown)
     ['{b7d14566-0509-4cce-a71f-0a554233bd9b}']
     function Initialize(pszFilePath: LPWSTR; grfMode: DWORD):HRESULT;
stdcall;
   end;

  IInitializeWithStream = interface(IUnknown)
    ['{b824b49d-22ac-4161-ac8a-9916e8fa3f7f}']
    function Initialize(pstream: IStream; grfMode: DWORD): HRESULT;
stdcall;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AFileName: string;
begin
  with TOpenDialog.Create(Self) do
  try
    if not Execute then
      Exit;
    AFileName := FileName;
  finally
    Free;
  end;

  FPreview.FileName := AFileName;
  Caption := FPreview.LastError;
end;

function GetCLSIDForFileName(AFileName: string): string;
var
  AREG: TRegistry;
  AFileExt, ARegistryPath: String;
  vNames: TStringList;
begin
  vNames := TStringList.Create();
  AREG := TRegistry.Create();
  try
    AREG.RootKey := HKEY_CLASSES_ROOT;
    AFileExt := ExtractFileExt(AFileName);
    ARegistryPath := AFileExt + '\shellex\{8895b1c6-b41f-4c1c-
a562-0d564250836f}';
    if AREG.KeyExists(ARegistryPath) then
    begin
      AREG.OpenKey(ARegistryPath, True);
      AREG.GetValueNames(vNames);
      Result := AREG.ReadString(vNames[0]);
      AREG.CloseKey;
    end
    else
      Result := '';
  finally
    FreeAndNil(vNames);
    FreeAndNil(AREG);
  end;
end;

{ TPreviewControl }

procedure TPreviewControl.PreviewFile;
var
  ACLSID: string;
  AGUID: TGUID;
  AMyPreviewHandler: IPreviewHandler;
  ARect: TRect;
  AInit: IInitializeWithFile;
  AResult: HRESULT;
  AFile: PWideChar;
begin
  FLastError := '';
  ACLSID := GetCLSIDForFileName(FFileName);
  if ACLSID = '' then
  begin
    FLastError := 'No CLSID';
    Exit;
  end;

  AGUID := StringToGUID(ACLSID);
  ARect := Rect(0, 0, Width, Height);
  AMyPreviewHandler := CreateComObject(AGUID) as IPreviewHandler;
  if (AMyPreviewHandler = nil) then
  begin
    FLastError := 'No Handler';
    Exit;
  end;

  AGUID := StringToGUID('{b7d14566-0509-4cce-a71f-0a554233bd9b}');
  if not Supports(AMyPreviewHandler, AGUID, AInit) then
  begin
    FLastError := 'Support';
    Exit;
  end;

  GetMem(AFile, 1024);
  AFile := StringToWideChar(FFileName, AFile, 1024);
  AResult := AInit.Initialize(AFile, STGM_READ);
  if AResult <> 0 then
  begin
    FLastError := 'Initialize';
    Exit;
  end;

  AResult := AMyPreviewHandler.SetWindow(Self.Handle, ARect);
  if AResult <> 0 then
  begin
    FLastError := 'SetWindow';
    Exit;
  end;

  AResult := AMyPreviewHandler.SetRect(ARect);
  if AResult <> 0 then
  begin
    FLastError := 'SetRect';
    Exit;
  end;

  AResult := AMyPreviewHandler.DoPreview;
  if AResult <> 0 then
  begin
    FLastError := 'DoPreview';
    Exit;
  end;
end;

procedure TPreviewControl.SetFileName(const Value: string);
begin
  FFileName := Value;
  PreviewFile;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FPreview := TPreviewControl.Create(Self);
  FPreview.ParentColor := False;
  FPreview.ParentBackground := False;
  FPreview.Top := 10;
  FPreview.Left := 10;
  FPreview.Width := 200;
  FPreview.Height := 200;
  FPreview.Parent := Self;
end;

end.