是否有适用于 Windows 7 的预览处理程序 VCL？

Question

本文

http://msdn.microsoft.com/en-gb/library/bb776867 .aspx

将 Windows 中的预览处理程序描述为

预览处理程序在以下情况下被调用： 项目被选中以显示 轻量级、丰富、只读预览 视图中文件内容的 阅读窗格。这是在没有 启动文件的关联 应用程序。

和 ...

预览处理程序是托管的 应用。主机包括 Windows 中的 Microsoft Windows 资源管理器 Vista 或 Microsoft Outlook 2007。

是否有一些 Delphi VCL 代码可以用作此类处理程序的起点？

Answer 1

@Mjn，正确知道我正在为我的 博客 写一篇文章来实现 Delphi 的预览处理程序，但由于由于时间不够，我不知道什么时候完成，正如其他用户提到的那样，Delphi 中目前不存在 VCL 组件来实现预览处理程序，过去我为客户实现了几个预览处理程序，但使用 Delphi-棱镜和 C#。

作为起点，我留下了一些提示。

• 您必须使用 IPreviewHandler，InitializeWithFile，<代码>InitializeWithStream，IPreviewHandlerFrame，IPreviewHandlerVisuals 接口。

这是这些接口的标头的 Delphi 翻译。

uses
  Windows, ActiveX, AxCtrls, ShlObj, ComObj;

type


  IIPreviewHandler = interface(IUnknown)
    ['{8895b1c6-b41f-4c1c-a562-0d564250836f}']
    function SetWindow(hwnd: HWND; var RectangleRef: TRect): HRESULT; stdcall;
    function SetRect(var RectangleRef: TRect): HRESULT; stdcall;
    function DoPreview(): HRESULT; stdcall;
    function Unload(): HRESULT; stdcall;
    function SetFocus(): HRESULT; stdcall;
    function QueryFocus(phwnd: HWND): HRESULT; stdcall;
    function TranslateAccelerator(PointerToWindowMessage: MSG): 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;

  IIPreviewHandlerFrame = interface(IUnknown)
    ['{fec87aaf-35f9-447a-adb7-20234491401a}']
    function GetWindowContext(pinfo: HWND): HRESULT; stdcall;
    function TranslateAccelerator(PointerToWindowMessage: MSG): HRESULT; stdcall;
  end;

  IIPreviewHandlerVisuals = interface(IUnknown)
    ['{8327b13c-b63f-4b24-9b8a-d010dcc3f599}']
        function SetBackgroundColor(color: COLORREF ): HRESULT; stdcall;
        function SetFont(plf:LOGFONTW): HRESULT; stdcall;  
        function SetTextColor(color: COLORREF): HRESULT; stdcall;
  end;

• 您必须创建一个 com dll，其中包含一个继承自这些接口 IIPreviewHandler、IIPreviewHandlerVisuals、IOleWindow、IObjectWithSite 的类来管理可视化，并创建第二个类来加载要显示的文件。该类必须从 IPreviewHandler、IInitializeWithStream 派生。

像这样的东西

  TMyPreviewHandler = class(IIPreviewHandler, IIPreviewHandlerVisuals, IOleWindow, IObjectWithSite)

  TMyStream = class(IIPreviewHandler, IInitializeWithStream, IStream)

• 现在您必须为父接口创建自己的方法实现。
  这是您需要实现的方法列表。

  IPreviewHandler -> DoPreview、SetWindow、SetRect、Unload、SetFocus、TranslateAccelerator、QueryFocus。

  IObjectWithSite ->获取站点、设置站点。

  IOleWindow ->获取窗口

  IPreviewHandlerVisuals - >设置背景颜色、设置字体、设置颜色

  InitializeWithStream ->初始化

• 最后您必须在系统中注册您的 COM 以及将使用 PrevieHandler 类的文件扩展名。

• 检查此项目作为起点Windows Preview Handler Pack（是用 C# 编写）和本文通过我们的托管预览按您的方式查看数据处理程序框架

Answer 2

我已经制作了这个单元来处理所有预览处理程序的内容：

unit PreviewHandler;

{$WARN SYMBOL_PLATFORM OFF}
{.$DEFINE USE_CODESITE}

interface

uses
  Classes, Controls, ComObj;

type
  TPreviewHandler = class abstract
  public
    { Create all controls needed for the preview and connect them to the
      parent given. The parent follows the size, color and font of the preview
      pane. The parent will stay valid until this instance is destroyed, so if
      you make the parent also the owner of the controls you don't need to free
      them in Destroy. }
    constructor Create(AParent: TWinControl); virtual;
    class function GetComClass: TComClass; virtual; abstract;
    class procedure Register(const AClassID: TGUID; const AName, ADescription, AFileExtension: string);
    {$REGION 'Clear Content'}
    /// <summary>Clear Content</summary>
    /// <remarks>This method is called when the preview should be cleared because
    /// either another item was selected or the PreviewHandler will be
    /// closed.</remarks>
    {$ENDREGION}
    procedure Unload; virtual;
  end;

  TStreamPreviewHandler = class abstract(TPreviewHandler)
  public
    {$REGION 'Render the preview from the stream data'}
    /// <summary>Render the preview from the stream data</summary>
    /// <remarks>Here you should render the data from the stream in whatever
    /// fashion you want.</remarks>
    {$ENDREGION}
    procedure DoPreview(Stream: TStream); virtual; abstract;
    class function GetComClass: TComClass; override; final;
  end;

  TFilePreviewHandler = class abstract(TPreviewHandler)
  public
    {$REGION 'Render the preview from the file path'}
    /// <summary>Render the preview from the file path</summary>
    /// <remarks>Here you should render the data from the file path in whatever
    /// fashion you want.</remarks>
    {$ENDREGION}
    procedure DoPreview(const FilePath: String); virtual; abstract;
    class function GetComClass: TComClass; override; final;
  end;

implementation

uses
{$IFDEF USE_CODESITE}
  CodeSiteLogging,
{$ENDIF}
  Windows, ActiveX, ComServ, ShlObj, PropSys, Types, SysUtils, Graphics, ExtCtrls;

type
  TPreviewHandlerClass = class of TPreviewHandler;
  TComPreviewHandler = class(TComObject, IPreviewHandler, IPreviewHandlerVisuals, IObjectWithSite, IOleWindow)
  strict private
    function IPreviewHandler.DoPreview = IPreviewHandler_DoPreview;
    function ContextSensitiveHelp(fEnterMode: LongBool): HRESULT; stdcall;
    function GetSite(const riid: TGUID; out site: IInterface): HRESULT; stdcall;
    function GetWindow(out wnd: HWND): HRESULT; stdcall;
    function IPreviewHandler_DoPreview: HRESULT; stdcall;
    function QueryFocus(var phwnd: HWND): HRESULT; stdcall;
    function SetBackgroundColor(color: Cardinal): HRESULT; stdcall;
    function SetFocus: HRESULT; stdcall;
    function SetFont(const plf: tagLOGFONTW): HRESULT; stdcall;
    function SetRect(var prc: TRect): HRESULT; stdcall;
    function SetSite(const pUnkSite: IInterface): HRESULT; stdcall;
    function SetTextColor(color: Cardinal): HRESULT; stdcall;
    function SetWindow(hwnd: HWND; var prc: TRect): HRESULT; stdcall;
    function TranslateAccelerator(var pmsg: tagMSG): HRESULT; stdcall;
    function Unload: HRESULT; stdcall;
  private
    FBackgroundColor: Cardinal;
    FBounds: TRect;
    FContainer: TWinControl;
    FLogFont: tagLOGFONTW;
    FParentWindow: HWND;
    FPreviewHandler: TPreviewHandler;
    FPreviewHandlerClass: TPreviewHandlerClass;
    FPreviewHandlerFrame: IPreviewHandlerFrame;
    FSite: IInterface;
    FTextColor: Cardinal;
  protected
    procedure CheckContainer;
    procedure CheckPreviewHandler;
    procedure InternalUnload; virtual; abstract;
    procedure InternalDoPreview; virtual; abstract;
    property Container: TWinControl read FContainer;
    property PreviewHandler: TPreviewHandler read FPreviewHandler;
  public
    destructor Destroy; override;
    property PreviewHandlerClass: TPreviewHandlerClass read FPreviewHandlerClass write FPreviewHandlerClass;
  end;

  TComStreamPreviewHandler = class(TComPreviewHandler, IInitializeWithStream)
  strict private
    function IInitializeWithStream.Initialize = IInitializeWithStream_Initialize;
    function IInitializeWithStream_Initialize(const pstream: IStream; grfMode: Cardinal): HRESULT; stdcall;
  private
    FIStream: IStream;
    FMode: Cardinal;
    function GetPreviewHandler: TStreamPreviewHandler;
  protected
    procedure InternalUnload; override;
    procedure InternalDoPreview; override;
    property PreviewHandler: TStreamPreviewHandler read GetPreviewHandler;
  end;

  TComFilePreviewHandler = class(TComPreviewHandler, IInitializeWithFile)
  strict private
    function IInitializeWithFile.Initialize = IInitializeWithFile_Initialize;
    function IInitializeWithFile_Initialize(pszFilePath: LPCWSTR; grfMode: DWORD): HRESULT; stdcall;
  private
    FFilePath: string;
    FMode: DWORD;
    function GetPreviewHandler: TFilePreviewHandler;
  protected
    procedure InternalDoPreview; override;
    procedure InternalUnload; override;
    property PreviewHandler: TFilePreviewHandler read GetPreviewHandler;
  end;

  TComPreviewHandlerFactory = class(TComObjectFactory)
  private
    FFileExtension: string;
    FPreviewHandlerClass: TPreviewHandlerClass;
    class procedure DeleteRegValue(const Key, ValueName: string; RootKey: DWord);
    class function IsRunningOnWOW64: Boolean;
  protected
    property FileExtension: string read FFileExtension;
  public
    constructor Create(APreviewHandlerClass: TPreviewHandlerClass; const AClassID: TGUID; const AName, ADescription, AFileExtension: string);
    function CreateComObject(const Controller: IUnknown): TComObject; override;
    procedure UpdateRegistry(Register: Boolean); override;
    property PreviewHandlerClass: TPreviewHandlerClass read FPreviewHandlerClass;
  end;

  TWinControlHelper = class helper for TWinControl
  public
    procedure SetFocusTabFirst;
    procedure SetFocusTabLast;
    procedure SetBackgroundColor(AColor: Cardinal);
    procedure SetBoundsRect(const ARect: TRect);
    procedure SetTextColor(AColor: Cardinal);
    procedure SetTextFont(const Source: tagLOGFONTW);
  end;

  TIStreamAdapter = class(TStream)
  private
    FTarget: IStream;
  protected
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override;
    procedure SetSize(const NewSize: Int64); override;
  public
    constructor Create(ATarget: IStream);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    property Target: IStream read FTarget;
  end;

procedure TWinControlHelper.SetFocusTabFirst;
begin
  SelectNext(nil, true, true);
end;

procedure TWinControlHelper.SetFocusTabLast;
begin
  SelectNext(nil, false, true);
end;

procedure TWinControlHelper.SetBackgroundColor(AColor: Cardinal);
begin
  Color := AColor;
end;

procedure TWinControlHelper.SetBoundsRect(const ARect: TRect);
begin
  SetBounds(ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
end;

procedure TWinControlHelper.SetTextColor(AColor: Cardinal);
begin
  Font.Color := AColor;
end;

procedure TWinControlHelper.SetTextFont(const Source: tagLOGFONTW);
var
  fontStyle: TFontStyles;
begin
  Font.Height := Source.lfHeight;
  fontStyle := Font.Style;
  if Source.lfWeight >= FW_BOLD then
    Include(fontStyle, fsBold);
  if Source.lfItalic = 1 then
    Include(fontStyle, fsItalic);
  if Source.lfUnderline = 1 then
    Include(fontStyle, fsUnderline);
  if Source.lfStrikeOut = 1 then
    Include(fontStyle, fsStrikeOut);
  Font.Style := fontStyle;
  Font.Charset := TFontCharset(Source.lfCharSet);
  Font.Name := Source.lfFaceName;
  case Source.lfPitchAndFamily and $F of
    VARIABLE_PITCH: Font.Pitch := fpVariable;
    FIXED_PITCH: Font.Pitch := fpFixed;
  else
    Font.Pitch := fpDefault;
  end;
  Font.Orientation := Source.lfOrientation;
end;

constructor TComPreviewHandlerFactory.Create(APreviewHandlerClass: TPreviewHandlerClass; const AClassID: TGUID; const
    AName, ADescription, AFileExtension: string);
begin
  inherited Create(ComServ.ComServer, APreviewHandlerClass.GetComClass, AClassID, AName, ADescription, ciMultiInstance, tmApartment);
  FPreviewHandlerClass := APreviewHandlerClass;
  FFileExtension := AFileExtension;
end;

function TComPreviewHandlerFactory.CreateComObject(const Controller: IUnknown): TComObject;
begin
  result := inherited CreateComObject(Controller);
  TComPreviewHandler(result).PreviewHandlerClass := PreviewHandlerClass;
end;

class procedure TComPreviewHandlerFactory.DeleteRegValue(const Key, ValueName: string; RootKey: DWord);
var
  RegKey: HKEY;
begin
  if RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_ALL_ACCESS, regKey) = ERROR_SUCCESS then begin
    try
      RegDeleteValue(regKey, PChar(ValueName));
    finally
      RegCloseKey(regKey)
    end;
  end;
end;

class function TComPreviewHandlerFactory.IsRunningOnWOW64: Boolean;
{ code taken from www.delphidabbler.com "IsWow64" }
type
  // Type of IsWow64Process API fn
  TIsWow64Process = function(Handle: Windows.THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall;
var
  IsWow64Result: Windows.BOOL; // Result from IsWow64Process
  IsWow64Process: TIsWow64Process; // IsWow64Process fn reference
begin
{$IF defined(CPUX64)}
  // compiled for 64-bit: can't be running on Wow64
  result := false;
{$ELSE}
  // Try to load required function from kernel32
  IsWow64Process := Windows.GetProcAddress(Windows.GetModuleHandle('kernel32'), 'IsWow64Process');
  if Assigned(IsWow64Process) then begin
    // Function is implemented: call it
    if not IsWow64Process(Windows.GetCurrentProcess, IsWow64Result) then
      raise SysUtils.Exception.Create('IsWindows64: bad process handle');
    // Return result of function
    Result := IsWow64Result;
  end
  else
    // Function not implemented: can't be running on Wow64
    Result := False;
{$IFEND}
end;

procedure TComPreviewHandlerFactory.UpdateRegistry(Register: Boolean);
var
  plainFileName: string;
  sAppID, sClassID, ProgID, ServerKeyName, RegPrefix: string;
  RootKey: HKEY;
  RootKey2: HKEY;
begin
  if Instancing = ciInternal then
    Exit;

  ComServer.GetRegRootAndPrefix(RootKey, RegPrefix);
  if ComServer.PerUserRegistration then
    RootKey2 := HKEY_CURRENT_USER
  else
    RootKey2 := HKEY_LOCAL_MACHINE;
  sClassID := GUIDToString(ClassID);
  ProgID := GetProgID;
  ServerKeyName := RegPrefix + 'CLSID\' + sClassID + '\' + ComServer.ServerKey;
  if IsRunningOnWOW64 then
    sAppID := '{534A1E02-D58F-44f0-B58B-36CBED287C7C}' // for Win32 shell extension running on Win64
  else
    sAppID := '{6d2b5079-2f0b-48dd-ab7f-97cec514d30b}';

  if Register then begin
    inherited;
    plainFileName := ExtractFileName(ComServer.ServerFileName);
    CreateRegKey(RegPrefix + 'CLSID\' + sClassID, 'AppID', sAppID, RootKey);
    if ProgID <> '' then begin
      CreateRegKey(ServerKeyName, 'ProgID', ProgID, RootKey);
      CreateRegKey(ServerKeyName, 'VersionIndependentProgID', ProgID, RootKey);
      CreateRegKey(RegPrefix + ProgID + '\shellex\' + SID_IPreviewHandler, '', sClassID, RootKey);
      CreateRegKey(RegPrefix + FileExtension, '', ProgID, RootKey);
      CreateRegKey('SOFTWARE\Microsoft\Windows\CurrentVersion\PreviewHandlers', sClassID, Description, RootKey2);
    end;
  end
  else begin
    if ProgID <> '' then begin
      DeleteRegValue('SOFTWARE\Microsoft\Windows\CurrentVersion\PreviewHandlers', sClassID, RootKey2);
      DeleteRegKey(RegPrefix + FileExtension, RootKey);
      DeleteRegKey(RegPrefix + ProgID + '\shellex', RootKey);
    end;
    inherited;
  end;
end;

destructor TComPreviewHandler.Destroy;
begin
  FPreviewHandler.Free;
  FContainer.Free;
  inherited Destroy;
end;

procedure TComPreviewHandler.CheckContainer;
begin
  if FContainer = nil then begin
    { I sprang for a TPanel here, because it makes things so much simpler. }
    FContainer := TPanel.Create(nil);
    TPanel(FContainer).BevelOuter := bvNone;
    FContainer.SetBackgroundColor(FBackgroundColor);
    FContainer.SetTextFont(FLogFont);
    FContainer.SetTextColor(FTextColor);
    FContainer.SetBoundsRect(FBounds);
    FContainer.ParentWindow := FParentWindow;
  end;
end;

procedure TComPreviewHandler.CheckPreviewHandler;
begin
  if FPreviewHandler = nil then begin
    CheckContainer;
    FPreviewHandler := PreviewHandlerClass.Create(Container);
  end;
end;

function TComPreviewHandler.ContextSensitiveHelp(fEnterMode: LongBool): HRESULT;
begin
  result := E_NOTIMPL;
end;

function TComPreviewHandler.GetSite(const riid: TGUID; out site: IInterface): HRESULT;
begin
  site := nil;
  if FSite = nil then
    result := E_FAIL
  else if Supports(FSite, riid, site) then
    result := S_OK
  else
    result := E_NOINTERFACE;
end;

function TComPreviewHandler.GetWindow(out wnd: HWND): HRESULT;
begin
  if Container = nil then begin
    result := E_FAIL;
  end
  else begin
    wnd := Container.Handle;
    result := S_OK;
  end;
end;

function TComPreviewHandler.IPreviewHandler_DoPreview: HRESULT;
begin
  try
    CheckPreviewHandler;
    InternalDoPreview;
  except
    on E: Exception do begin
    {$IFDEF USE_CODESITE}
      CodeSite.SendException(E);
    {$ENDIF}
    end;
  end;
  result := S_OK;
end;

function TComPreviewHandler.QueryFocus(var phwnd: HWND): HRESULT;
begin
  phwnd := GetFocus;
  result := S_OK;
end;

function TComPreviewHandler.SetBackgroundColor(color: Cardinal): HRESULT;
begin
  FBackgroundColor := color;
  if Container <> nil then
    Container.SetBackgroundColor(FBackgroundColor);
  result := S_OK;
end;

function TComPreviewHandler.SetFocus: HRESULT;
begin
  if Container <> nil then begin
    if GetKeyState(VK_SHIFT) < 0 then
      Container.SetFocusTabLast
    else
      Container.SetFocusTabFirst;
  end;
  result := S_OK;
end;

function TComPreviewHandler.SetFont(const plf: tagLOGFONTW): HRESULT;
begin
  FLogFont := plf;
  if Container <> nil then
    Container.SetTextFont(FLogFont);
  result := S_OK;
end;

function TComPreviewHandler.SetRect(var prc: TRect): HRESULT;
begin
  FBounds := prc;
  if Container <> nil then
    Container.SetBoundsRect(FBounds);
  result := S_OK;
end;

function TComPreviewHandler.SetSite(const pUnkSite: IInterface): HRESULT;
begin
  FSite := PUnkSite;
  FPreviewHandlerFrame := FSite as IPreviewHandlerFrame;
  result := S_OK;
end;

function TComPreviewHandler.SetTextColor(color: Cardinal): HRESULT;
begin
  FTextColor := color;
  if Container <> nil then
    Container.SetTextColor(FTextColor);
  result := S_OK;
end;

function TComPreviewHandler.SetWindow(hwnd: HWND; var prc: TRect): HRESULT;
begin
  FParentWindow := hwnd;
  FBounds := prc;
  if Container <> nil then begin
    Container.ParentWindow := FParentWindow;
    Container.SetBoundsRect(FBounds);
  end;
  result := S_OK;
end;

function TComPreviewHandler.TranslateAccelerator(var pmsg: tagMSG): HRESULT;
begin
  if FPreviewHandlerFrame = nil then
    result := S_FALSE
  else
    result := FPreviewHandlerFrame.TranslateAccelerator(pmsg);
end;

function TComPreviewHandler.Unload: HRESULT;
begin
  if PreviewHandler <> nil then
    PreviewHandler.Unload;
  InternalUnload;
  result := S_OK;
end;

constructor TPreviewHandler.Create(AParent: TWinControl);
begin
  inherited Create;
end;

class procedure TPreviewHandler.Register(const AClassID: TGUID; const AName, ADescription, AFileExtension: string);
begin
  TComPreviewHandlerFactory.Create(Self, AClassID, AName, ADescription, AFileExtension);
end;

procedure TPreviewHandler.Unload;
begin
end;

constructor TIStreamAdapter.Create(ATarget: IStream);
begin
  inherited Create;
  FTarget := ATarget;
end;

function TIStreamAdapter.GetSize: Int64;
var
  statStg: TStatStg;
begin
  if Target.Stat(statStg, STATFLAG_NONAME) = S_OK then
    result := statStg.cbSize
  else
    result := -1;
end;

function TIStreamAdapter.Read(var Buffer; Count: Longint): Longint;
begin
  Target.Read(@Buffer, Count, @result);
end;

function TIStreamAdapter.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Target.Seek(Offset, Ord(Origin), result);
end;

procedure TIStreamAdapter.SetSize(const NewSize: Int64);
begin
  raise ENotImplemented.Create('SetSize not implemented');
//  Target.SetSize(NewSize);
end;

procedure TIStreamAdapter.SetSize(NewSize: Longint);
begin
  SetSize(Int64(NewSize));
end;

function TIStreamAdapter.Write(const Buffer; Count: Longint): Longint;
begin
  raise ENotImplemented.Create('Write not implemented');
//  Target.Write(@Buffer, Count, @result);
end;

function TComStreamPreviewHandler.GetPreviewHandler: TStreamPreviewHandler;
begin
  Result := inherited PreviewHandler as TStreamPreviewHandler;
end;

function TComStreamPreviewHandler.IInitializeWithStream_Initialize(const pstream: IStream; grfMode: Cardinal): HRESULT;
begin
  FIStream := pStream;
  FMode := grfMode;
  result := S_OK;
end;

procedure TComStreamPreviewHandler.InternalUnload;
begin
  FIStream := nil;
end;

procedure TComStreamPreviewHandler.InternalDoPreview;
var
  stream: TIStreamAdapter;
begin
  stream := TIStreamAdapter.Create(FIStream);
  try
    PreviewHandler.DoPreview(stream);
  finally
    stream.Free;
  end;
end;

function TComFilePreviewHandler.GetPreviewHandler: TFilePreviewHandler;
begin
  Result := inherited PreviewHandler as TFilePreviewHandler;
end;

function TComFilePreviewHandler.IInitializeWithFile_Initialize(pszFilePath: LPCWSTR; grfMode: DWORD): HRESULT;
begin
  FFilePath := pszFilePath;
  FMode := grfMode;
  result := S_OK;
end;

procedure TComFilePreviewHandler.InternalDoPreview;
begin
  PreviewHandler.DoPreview(FFilePath);
end;

procedure TComFilePreviewHandler.InternalUnload;
begin
  FFilePath := '';
end;

class function TFilePreviewHandler.GetComClass: TComClass;
begin
  result := TComFilePreviewHandler;
end;

class function TStreamPreviewHandler.GetComClass: TComClass;
begin
  result := TComStreamPreviewHandler;
end;

initialization
{$IFDEF USE_CODESITE}
  CodeSiteManager.ConnectUsingTcp;
{$ENDIF}
end.

此处显示了基于此单元的示例预览处理程序：

unit MyPreviewHandler;

interface

uses
  PreviewHandler, Classes, Controls, StdCtrls;

const
  {$REGION 'Unique ClassID of your PreviewHandler'}
  ///   <summary>Unique ClassID of your PreviewHandler</summary>
  ///   <remarks>Don't forget to create a new one. Best use Ctrl-G.</remarks>
  {$ENDREGION}
  CLASS_MyPreviewHandler: TGUID = '{64644512-C345-469F-B5FB-EB351E20129D}';

type
  {$REGION 'Sample PreviewHandler'}
  ///   <summary>Sample PreviewHandler</summary>
  ///   <remarks>A sample PreviewHandler. You only have to derive from
  ///   TFilePreviewHandler or TStreamPreviewHandler and override some methods.</remarks>
  {$ENDREGION}
  TMyPreviewHandler = class(TFilePreviewHandler)
  private
    FTextLabel: TLabel;
  protected
  public
    constructor Create(AParent: TWinControl); override;
    procedure Unload; override;
    procedure DoPreview(const FilePath: string); override;
    property TextLabel: TLabel read FTextLabel;
  end;

implementation

uses
  SysUtils;

constructor TMyPreviewHandler.Create(AParent: TWinControl);
begin
  inherited;
  FTextLabel := TLabel.Create(AParent);
  FTextLabel.Parent := AParent;
  FTextLabel.AutoSize := false;
  FTextLabel.Align := alClient;
  FTextLabel.Alignment := taCenter;
  FTextLabel.Layout := tlCenter;
  FTextLabel.WordWrap := true;
end;

procedure TMyPreviewHandler.DoPreview(const FilePath: string);
begin
  TextLabel.Caption := GetPackageDescription(PWideChar(FilePath));
end;

procedure TMyPreviewHandler.Unload;
begin
  TextLabel.Caption := '';
  inherited;
end;

initialization
  { Register your PreviewHandler with the ClassID, name, descripton and file extension }
  TMyPreviewHandler.Register(CLASS_MyPreviewHandler, 'bplfile', 'BPL Binary Preview Handler', '.bpl');
end.

library MyPreviewHandlerLib;

uses
  ComServ,
  PreviewHandler in 'PreviewHandler.pas' {PreviewHandler: CoClass},
  MyPreviewHandler in 'MyPreviewHandler.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer,
  DllInstall;

{$R *.RES}

begin
end.

您可能对 我的博客中的这篇文章描述了有关该框架的更多详细信息。

Answer 3

我从来没有见过这样的事情，但由于整个事情都是在 COM 中构建的，因此您首先要导入类型库，并实现所需的接口，包括 IPreviewHandlerFrame。 [抱歉，没有多大帮助。但这是一个相当模糊的领域，所以我对 Delphi 没有为此提供预构建的组件集并不感到惊讶。]

Answer 4

我找不到任何在 Delphi 中使用 IPreviewHandlerFrame 的参考，但确实设法提出了一个 C# 示例 此处 - 也许它会给您一个起点。

Answer 5

我认为你必须自己编写一个 COM 服务器，它提供所描述的 IPreviwHandler 接口。 （没有要导入的类型库...）我对这样的代码也很感兴趣，并且我现在正在搜索很长一段时间。我对 COM 服务器编写不太有经验...如果您发现了什么，请告诉我！因为我也会分享我的代码，如果我得到一些......

安德烈亚斯