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

时间：2011-03-04 15:46:10

标签： delphi windows-7

本文

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

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

  

预览处理程序在调用时调用   选择项目以显示   轻量级，丰富的只读预览   在视图中的文件内容   阅读面板。这是没有的   启动文件的关联   应用

和......

  

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

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

5 个答案:

答案 0 :(得分：13)

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

作为起点，如果你想开始自己的项目，我在这里留下一些提示。

这是这些接口的标头的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 - ＆gt; DoPreview，SetWindow，SetRect，Unload，SetFocus，TranslateAccelerator，QueryFocus。

    IObjectWithSite - ＆gt; GetSite，SetSite。

    IOleWindow - ＆gt; GetWindow

    IPreviewHandlerVisuals - ＆gt; SetBackgroundColor，SetFont，SetColor

    InitializeWithStream - ＆gt;初始化

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

  • 将此项目作为起点Windows Preview Handler Pack（以C＃编写）和本文View Data Your Way With Our Managed Preview Handler Framework

答案 1 :(得分：6)

我让这个单元处理所有预览处理程序的东西：

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.

您可能对this article in my blog描述该框架的更多细节感兴趣。

答案 2 :(得分：1)

我从未见过这样的事情，但由于整个事情都是用COM构建的，因此您可以先导入类型库，然后实现所需的接口，包括IPreviewHandlerFrame。 [抱歉，不是很有帮助。但这是一个非常模糊的领域，所以我并不感到意外的是Delphi没有为此预先构建组件。]

答案 3 :(得分：0)

我认为你必须自己编写一个COM-Server，它提供了所描述的IPreviwHandler-Interfacees。 （没有要导入的类型库...）我对这样的代码也非常感兴趣，而且我现在正在寻找相当长的一段时间。我对COM-Server写作不是很有经验......如果你找到了什么，请告诉我！我也会分享我的代码，如果我得到一些......

安德烈亚斯

答案 4 :(得分：0)

我找不到在Delphi中使用IPreviewHandlerFrame的任何引用，但确实设法提出了一个C＃示例here - 也许它会给你一个起点。

相关问题
最新问题