unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Winapi.ShlObj, System.Win.ComObj,
Winapi.ActiveX,
Winapi.PropSys, System.Win.Registry;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
public
end;
TDefaultPreview=class
private
FFileStream: TFileStream;
FPreviewHandler: IPreviewHandler;
public
constructor Create;
destructor Destroy; override;
function LoadPreview(ParentControl: TWinControl; FileName: string): Boolean;
procedure PaintPreview(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetPreviewHandlerCLSID(const AFileName: string): string;
var
LRegistry: TRegistry;
LKey: String;
begin
LRegistry:=TRegistry.Create();
Result:=EmptyStr;
try
LRegistry.RootKey:=HKEY_CLASSES_ROOT;
LKey:=ExtractFileExt(AFileName) + '\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';
if LRegistry.OpenKeyReadOnly(LKey) then begin
Result:=LRegistry.ReadString('');
LRegistry.CloseKey;
end else begin
LKey:='SystemFileAssociations\' + ExtractFileExt(AFileName) + '\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';
if LRegistry.OpenKeyReadOnly(LKey) then begin
Result:=LRegistry.ReadString('');
LRegistry.CloseKey;
end else begin
LRegistry.RootKey:=HKEY_LOCAL_MACHINE;
LKey:='\Software\Classes\' + ExtractFileExt(AFileName) + '\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';
if LRegistry.OpenKeyReadOnly(LKey) then begin
Result:=LRegistry.ReadString('');
LRegistry.CloseKey;
end else begin
LKey:='\Software\Classes\SystemFileAssociations\' + ExtractFileExt(AFileName) +
'\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';
if LRegistry.OpenKeyReadOnly(LKey) then begin
Result:=LRegistry.ReadString('');
LRegistry.CloseKey;
end;
end;
end;
end;
finally
LRegistry.Free;
end;
end;
//
constructor TDefaultPreview.Create;
begin
inherited Create;
FFileStream:=nil;
FPreviewHandler:=nil;
end;
destructor TDefaultPreview.Destroy;
begin
if Assigned(FPreviewHandler) then
begin
FPreviewHandler.Unload;
FPreviewHandler:=nil;
end;
inherited Destroy;
end;
//
function TDefaultPreview.LoadPreview(ParentControl: TWinControl; FileName: string): Boolean;
const
GUID_ISHELLITEM='{43826d1e-e718-42ee-bc55-a1e261c37bfe}';
var
re: TRect;
GUID: TGUID;
GUIDStr: string;
InitializeWithFile: IInitializeWithFile;
InitializeWithStream: IInitializeWithStream;
InitializeWithItem: IInitializeWithItem;
PreviewHandlerVisuals: IPreviewHandlerVisuals;
Stream: IStream;
ShellItem: IShellItem;
res: HRESULT;
begin
result:=False;
//
if Assigned(FPreviewHandler) then
begin
FPreviewHandler.Unload;
FPreviewHandler:=nil;
end;
//
CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);
//
GUIDStr:=GetPreviewHandlerCLSID(FileName);
if GUIDStr='' then
Exit;
GUID:=StringToGUID(GUIDStr);
CoCreateInstance(
GUID, nil, CLSCTX_LOCAL_SERVER, IPreviewHandler, FPreviewHandler);
if FPreviewHandler=nil then
begin
CoUninitialize;
Exit;
end;
result:=True;
if FPreviewHandler.QueryInterface(IInitializeWithStream, InitializeWithStream)=S_OK then
begin
FFileStream:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
Stream:=TStreamAdapter.Create(FFileStream, soOwned) as IStream;
res:=InitializeWithStream.Initialize(Stream, STGM_READ or STGM_FAILIFTHERE or STGM_DIRECT);
if (Succeeded(res)) then
begin
re:=Form1.ClientRect;
FPreviewHandler.SetWindow(Form1.Handle, re);
FPreviewHandler.SetRect(re);
FPreviewHandler.DoPreview;
FPreviewHandler.SetFocus;
CoUninitialize;
Exit;
end;
end;
if Assigned(FPreviewHandler) then
begin
FPreviewHandler.Unload;
FPreviewHandler:=nil;
end;
CoUninitialize;
end;
//
procedure TDefaultPreview.PaintPreview(Sender: TObject);
var re: TRect;
begin
if Assigned(FPreviewHandler) then
begin
re:=Form1.ClientRect;
FPreviewHandler.SetRect(re);
FPreviewHandler.DoPreview;
FPreviewHandler.SetFocus;
end;
end;
//
var
dp: TDefaultPreview;
procedure TForm1.FormCreate(Sender: TObject);
begin
dp:=TDefaultPreview.Create;
dp.LoadPreview(Self, 'demo.pdf');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
dp.Free;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
dp.PaintPreview(Sender);
end;
end.