Homepage von Thomas Schwobe
Home Software Quelltext Impressum Datenschutzerklärung

Quelltext:

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 FindCLSID(fn: string): string;
var reg: TRegistry;
    key: string;

begin
  result:='';

  reg:=TRegistry.Create(KEY_READ);

  try
    reg.RootKey:=HKEY_CLASSES_ROOT;

    key:=ExtractFileExt(fn) + '\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';

    if reg.OpenKey(key, False) then
    begin
      result:=reg.ReadString('');

      reg.CloseKey;
    end;

  finally
    reg.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:=FindCLSID(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.

© 2025 by Thomas Schwobe