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

Question

本文

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

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

选择项目时,将调用预览处理程序,以在视图的阅读窗格中显示文件内容的轻量级,丰富的只读预览.这是在不启动文件的关联应用程序的情况下完成的.

和......

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

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

Answer 1

@Mjn,我知道我正在为我的博客撰写一篇文章来实现Delphi的预处理程序,但是由于时间不够,我不知道这是什么时候完成,因为其他用户目前还没有提到VCL组件Delphi实现预览处理程序,过去我为客户实现了几个预览处理程序,但使用的是Delphi-Prism和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 - > GetSite,SetSite.

  IOleWindow - > GetWindow

  IPreviewHandlerVisuals - > SetBackgroundColor,SetFont,SetColor

  InitializeWithStream - > Initialize

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

• 检查这个项目作为起点Windows Preview Handler Pack(用C#编写)和本文View Data Your Way With Our Managed Preview Handler Framework

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.

您可能对我的博客中的这篇文章感兴趣,该文章描述了该框架的更多细节.