unit PreviewHandlerUnt;
interface
uses
ShlObj, Classes, Messages, Controls, System.Variants,
Vcl.Dialogs;
type
THostPreviewHandler =
class(TCustomControl)
private
FFileStream: TFileStream;
FPreviewGUIDStr:
string;
FFileName:
string;
FLoaded: Boolean;
FPreviewHandler: IPreviewHandler;
procedure SetFileName(
const Value:
string);
procedure LoadPreviewHandler;
procedure WMSize(
var Message: TWMSize);
message WM_SIZE;
protected
procedure Paint;
override;
public
property FileName:
string read FFileName
write SetFileName;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
end;
implementation
uses
SysUtils, Windows, Graphics, ComObj,
ActiveX, Registry, PropSys;
constructor THostPreviewHandler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPreviewHandler :=
nil;
FPreviewGUIDStr := EmptyStr;
FFileStream :=
nil;
end;
procedure THostPreviewHandler.Paint;
const
Msg = '
Keine Vorschau verfügbar.';
var
lpRect: TRect;
begin
if (FPreviewGUIDStr <> EmptyStr)
and Assigned(FPreviewHandler)
and not FLoaded
then
begin
FLoaded := True;
FPreviewHandler.DoPreview;
FPreviewHandler.SetFocus;
end else if FPreviewGUIDStr = '
'
then begin
lpRect := Rect(0, 0, Self.Width, Self.Height);
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := clWindowText;
DrawText(Canvas.Handle, PChar(Msg), Length(Msg), lpRect, DT_VCENTER
or DT_CENTER
or DT_SINGLELINE);
end;
end;
destructor THostPreviewHandler.Destroy;
begin
if Assigned(FPreviewHandler)
then
FPreviewHandler.Unload;
inherited;
end;
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;
procedure THostPreviewHandler.LoadPreviewHandler;
const
GUID_ISHELLITEM = '
{43826d1e-e718-42ee-bc55-a1e261c37bfe}';
var
prc: TRect;
LPreviewGUID: TGUID;
LInitializeWithFile: IInitializeWithFile;
LInitializeWithStream: IInitializeWithStream;
LInitializeWithItem: IInitializeWithItem;
LIStream: IStream;
LShellItem: IShellItem;
// PreviewHandle: HWND;
begin
// PreviewHandle := 0;
FLoaded := False;
FPreviewGUIDStr := GetPreviewHandlerCLSID(FFileName);
if FPreviewGUIDStr = '
'
then
Exit;
LPreviewGUID := StringToGUID(FPreviewGUIDStr);
FPreviewHandler := CreateComObject(LPreviewGUID)
As IPreviewHandler;
if (FPreviewHandler =
nil)
then
Exit;
if FPreviewHandler.QueryInterface(IInitializeWithFile, LInitializeWithFile) = S_OK
then
LInitializeWithFile.Initialize(StringToOleStr(FFileName), STGM_READ)
else if FPreviewHandler.QueryInterface(IInitializeWithStream, LInitializeWithStream) = S_OK
then begin
FFileStream := TFileStream.Create(FFileName, fmOpenRead
or fmShareDenyNone);
LIStream := TStreamAdapter.Create(FFileStream, soOwned)
as IStream;
LInitializeWithStream.Initialize(LIStream, STGM_READ);
end else if FPreviewHandler.QueryInterface(IInitializeWithItem, LInitializeWithItem) = S_OK
then begin
SHCreateItemFromParsingName(PChar(FileName),
nil, StringToGUID(GUID_ISHELLITEM), LShellItem);
LInitializeWithItem.Initialize(LShellItem, 0);
end else begin
FPreviewHandler.Unload;
FPreviewHandler :=
nil;
exit;
end;
prc := ClientRect;
FPreviewHandler.SetWindow(Self.Handle, prc);
// FPreviewHandler.QueryFocus(PreviewHandle);
end;
procedure THostPreviewHandler.SetFileName(
const Value:
string);
begin
FFileName := Value;
// if not HandleAllocated then // Handle zum Anzeigen der Vorschau anfordern
HandleNeeded;
LoadPreviewHandler;
end;
procedure THostPreviewHandler.WMSize(
var Message: TWMSize);
var
prc: TRect;
begin
inherited;
if FPreviewHandler <>
nil then begin
prc := ClientRect;
FPreviewHandler.SetRect(prc);
end;
end;
end.