IPreviewHandler mit Delphi 7 anbinden!?

[Sushibb]

Hi @all,

ich habe versucht, in einem Tool das von Windows Vista, Office 2007 bzw Windows Search 4 bereitgestellte Interface für den PreviewHandler zu nutzen. Leider zeigt das Programm nichts an, obwohl ich als Rückgabewert keine Fehler erhalte. Kennt sich jemand damit aus?

Nachfolgend der Code. Es müsste nur ein neues Projekt und ein Button1 erstellt werden, dann sollte es schon laufen.

Bin für jeden Hinweis dankbar.

Achso, ich hab das Codebeispiel der MSDN in C# heruntergeladen und das funktioniert. Liegt also nicht an fehlenden Dateien oder OS-Unterstützung!

Code:

unit FMain;

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

}

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.