Is there a Preview Handler VCL for Windows 7? - delphi

Question

This article
http://msdn.microsoft.com/en-gb/library/bb776867.aspx
describes preview handlers in Windows as
Preview handlers are called when an
item is selected to show a
lightweight, rich, read-only preview
of the file's contents in the view's
reading pane. This is done without
launching the file's associated
application.
and ...
A preview handler is a hosted
application. Hosts include the
Microsoft Windows Explorer in Windows
Vista or Microsoft Outlook 2007.
Is there some Delphi VCL code which can be used as a startingpoint for such a handler?

Answer 1

#Mjn, right know I'm writing an article for my blog to implement Preview Handlers from Delphi, but due to lack of time, I do not know when this is complete, as others users mention by the moment no exist a VCL component in Delphi to implement preview handlers, in the past I implemented a couple of preview handlers for a customer but using Delphi-Prism and C#.
As starting point here I leave some tips.
You must use the IPreviewHandler, InitializeWithFile, InitializeWithStream, IPreviewHandlerFrame, IPreviewHandlerVisuals interfaces.
This is the Delphi translation of the headers of these interfaces
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;
You must create a com dll with a class which descend from these interfaces IIPreviewHandler, IIPreviewHandlerVisuals, IOleWindow, IObjectWithSite to manage the visualization and a second class to load the files to show. this class must descend from IPreviewHandler, IInitializeWithStream.
something like this
TMyPreviewHandler = class(IIPreviewHandler, IIPreviewHandlerVisuals, IOleWindow, IObjectWithSite)
TMyStream = class(IIPreviewHandler, IInitializeWithStream, IStream)
Now you must create your own implementation of the methods for the parent interfaces.
this is the list of the methods which you need implement.
IPreviewHandler -> DoPreview, SetWindow, SetRect, Unload, SetFocus, TranslateAccelerator, QueryFocus.
IObjectWithSite -> GetSite, SetSite.
IOleWindow -> GetWindow
IPreviewHandlerVisuals - > SetBackgroundColor, SetFont, SetColor
InitializeWithStream -> Initialize
finally you must register your COM in the system as well as the file extensions which will use you PrevieHandler class.
Check this project as a starting point Windows Preview Handler Pack (is written in C#) and this article View Data Your Way With Our Managed Preview Handler Framework

Answer 2

I have made this unit to handle all the preview handler stuff:
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.
A sample preview handler based on this unit is shown here:
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.
You may be interested in this article in my blog describing some more details on that framework.

Answer 3

I have never seen such a thing, but since the whole thing is build in COM, you would start by importing the type library, and implementing the required interfaces, including IPreviewHandlerFrame. [Sorry, not very helpful. But this is a pretty obscure area, so I'm not surprised that Delphi hasn't got a prebuilt component set for this.]

Answer 4

I can't find any references to using IPreviewHandlerFrame in Delphi, but did manage to come up with a C# example here - maybe it'll give you a starting point.

Answer 5

I think you have to write a COM-Server yourself, which provides the described IPreviwHandler-Interfacees. (There is no type library to import...) I am very interested in such a code as well and I am searching for quite a while now. I am not very experienced with COM-Server-writing... If you find something, let me know please! As I will share my code also, if I get some...
Andreas