[Asm] 纯文本查看 复制代码
unit uThumbnailForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TfrmThumbnail = class(TForm)
private
FImageFile: string;
FImage: TImage;
FLblInfo: TLabel;
FLblBottom: TLabel;
FBtnOpen: TButton;
FHotkeyWnd: HWND;
FHotkeyRegistered: Boolean;
procedure BtnOpenClick(Sender: TObject);
procedure LoadThumbnail(const AFileName: string);
function GetFileSizeStr(const AFileName: string): string;
function GetBitDepthStr(Pic: TPicture): string;
procedure PositionAt(const AScreenPt: TPoint);
procedure HotkeyWndProc(var Msg: TMessage);
procedure RegisterThumbHotKey;
procedure UnregisterThumbHotKey;
procedure WMTimer(var Msg: TMessage); message WM_TIMER;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ShowAt(const AFileName: string);
end;
const
TIMER_RAISE = 1;
TIMER_CHECK = 2;
implementation
uses
Vcl.Imaging.Jpeg, Vcl.Imaging.PngImage, Vcl.Imaging.GIFImg;
const
MAX_THUMB = 256;
RAISE_DELAY = 120;
CHECK_INTERVAL = 200;
BAR_HEIGHT = 22;
HOTKEY_ID = 1001;
constructor TfrmThumbnail.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
FHotkeyRegistered := False;
{ Allocate a dedicated hidden window for receiving WM_HOTKEY.
This avoids issues with VCL form handle recreation. }
FHotkeyWnd := AllocateHWnd(HotkeyWndProc);
{ Set properties that may trigger handle recreation }
BorderStyle := bsNone;
BorderIcons := [];
FormStyle := fsStayOnTop;
Color := clBlack;
DoubleBuffered := True;
FImage := TImage.Create(Self);
FImage.Parent := Self;
FImage.Align := alClient;
FImage.Center := True;
FImage.Stretch := True;
FImage.Proportional := True;
FLblInfo := TLabel.Create(Self);
FLblInfo.Parent := Self;
FLblInfo.Align := alTop;
FLblInfo.AutoSize := False;
FLblInfo.Height := BAR_HEIGHT;
FLblInfo.Color := clBlack;
FLblInfo.Font.Color := clLime;
FLblInfo.Font.Size := 9;
FLblInfo.Alignment := taCenter;
FLblInfo.Layout := tlCenter;
FLblInfo.Caption := '';
FLblBottom := TLabel.Create(Self);
FLblBottom.Parent := Self;
FLblBottom.Align := alBottom;
FLblBottom.AutoSize := False;
FLblBottom.Height := BAR_HEIGHT;
FLblBottom.Color := clBlack;
FLblBottom.Font.Color := clLime;
FLblBottom.Font.Size := 9;
FLblBottom.Alignment := taCenter;
FLblBottom.Layout := tlCenter;
FLblBottom.Caption := '';
FBtnOpen := TButton.Create(Self);
FBtnOpen.Parent := Self;
FBtnOpen.Caption := '关闭';
FBtnOpen.Align := alBottom;
FBtnOpen.OnClick := BtnOpenClick;
ClientWidth := MAX_THUMB + 8;
ClientHeight := MAX_THUMB + 8 + BAR_HEIGHT * 2 + FBtnOpen.Height;
RegisterThumbHotKey;
end;
destructor TfrmThumbnail.Destroy;
begin
UnregisterThumbHotKey;
if FHotkeyWnd <> 0 then
begin
DeallocateHWnd(FHotkeyWnd);
FHotkeyWnd := 0;
end;
inherited;
end;
procedure TfrmThumbnail.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WndParent := GetDesktopWindow;
Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
end;
procedure TfrmThumbnail.WMKeyDown(var Msg: TWMKeyDown);
begin
if Msg.CharCode = VK_ESCAPE then
Release
else
inherited;
end;
procedure TfrmThumbnail.WMTimer(var Msg: TMessage);
var
Pt: TPoint;
begin
case Msg.WParam of
TIMER_RAISE:
begin
KillTimer(Handle, TIMER_RAISE);
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW);
SetTimer(Handle, TIMER_CHECK, CHECK_INTERVAL, nil);
end;
TIMER_CHECK:
begin
if FindWindow('#32768', nil) <> 0 then
Exit;
GetCursorPos(Pt);
if (Pt.X >= Left) and (Pt.X < Left + Width) and (Pt.Y >= Top) and (Pt.Y < Top + Height) then
Exit;
KillTimer(Handle, TIMER_CHECK);
Release;
end;
end;
end;
function TfrmThumbnail.GetFileSizeStr(const AFileName: string): string;
var
FS: TFileStream;
Size: Int64;
begin
Result := '0 B';
if not FileExists(AFileName) then
Exit;
try
FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
Size := FS.Size;
if Size < 1024 then
Result := Format('%d B', [Size])
else if Size < 1024 * 1024 then
Result := Format('%.1f KB', [Size / 1024])
else
Result := Format('%.1f MB', [Size / (1024 * 1024)]);
finally
FS.Free;
end;
except
Result := '? B';
end;
end;
function TfrmThumbnail.GetBitDepthStr(Pic: TPicture): string;
var
Bmp: TBitmap;
begin
if Pic.Graphic is TJPEGImage then
Result := '24'
else if Pic.Graphic is TPNGImage then
Result := IntToStr(TPNGImage(Pic.Graphic).Header.BitDepth)
else if Pic.Graphic is TBitmap then
begin
case TBitmap(Pic.Graphic).PixelFormat of
pf1bit:
Result := '1';
pf4bit:
Result := '4';
pf8bit:
Result := '8';
pf15bit:
Result := '15';
pf16bit:
Result := '16';
pf24bit:
Result := '24';
pf32bit:
Result := '32';
pfCustom:
Result := '?';
else
Result := '?';
end;
end
else if Pic.Graphic is TGIFImage then
Result := '8'
else
Result := '?';
Result := Result + ' 位';
end;
procedure TfrmThumbnail.LoadThumbnail(const AFileName: string);
var
Pic: TPicture;
DimStr, SizeStr, ExtStr, DepthStr: string;
begin
if not FileExists(AFileName) then
Exit;
Pic := TPicture.Create;
try
Pic.LoadFromFile(AFileName);
FImageFile := AFileName;
FImage.Picture.Assign(Pic);
DimStr := Format('%d x %d', [Pic.Width, Pic.Height]);
SizeStr := GetFileSizeStr(AFileName);
FLblInfo.Caption := DimStr + ' ' + SizeStr;
DepthStr := GetBitDepthStr(Pic);
ExtStr := UpperCase(ExtractFileExt(AFileName));
FLblBottom.Caption := DepthStr + ' ' + ExtStr;
finally
Pic.Free;
end;
end;
procedure TfrmThumbnail.ShowAt(const AFileName: string);
begin
LoadThumbnail(AFileName);
end;
procedure TfrmThumbnail.PositionAt(const AScreenPt: TPoint);
var
W, H: Integer;
begin
W := Width;
H := Height;
Left := AScreenPt.X + 20;
Top := AScreenPt.Y - H div 4;
if Left + W > Screen.DesktopWidth then
Left := AScreenPt.X - W - 10;
if Top + H > Screen.DesktopHeight then
Top := Screen.DesktopHeight - H - 10;
if Top < 0 then
Top := 0;
end;
procedure TfrmThumbnail.RegisterThumbHotKey;
begin
if FHotkeyRegistered then
Exit;
if FHotkeyWnd = 0 then
Exit;
{ Register hotkey on the dedicated window, NOT on the form's Handle }
if Winapi.Windows.RegisterHotKey(FHotkeyWnd, HOTKEY_ID, MOD_CONTROL or MOD_ALT, Ord('I')) then
begin
FHotkeyRegistered := True;
OutputDebugString('PicaView: Hotkey registered OK');
end
else
OutputDebugString(PChar(Format('PicaView: RegisterHotKey failed, err=%d', [GetLastError])));
end;
procedure TfrmThumbnail.UnregisterThumbHotKey;
begin
if not FHotkeyRegistered then
Exit;
if FHotkeyWnd <> 0 then
Winapi.Windows.UnregisterHotKey(FHotkeyWnd, HOTKEY_ID);
FHotkeyRegistered := False;
OutputDebugString('PicaView: Hotkey unregistered');
end;
procedure TfrmThumbnail.HotkeyWndProc(var Msg: TMessage);
var
Pt: TPoint;
begin
if Msg.Msg = WM_HOTKEY then
begin
if Msg.WParam = HOTKEY_ID then
begin
OutputDebugString('PicaView: WM_HOTKEY received');
GetCursorPos(Pt);
PositionAt(Pt);
ShowWindow(Handle, SW_SHOWNOACTIVATE);
SetTimer(Handle, TIMER_RAISE, RAISE_DELAY, nil);
end;
Exit;
end;
Msg.Result := DefWindowProc(FHotkeyWnd, Msg.Msg, Msg.WParam, Msg.LParam);
end;
procedure TfrmThumbnail.BtnOpenClick(Sender: TObject);
begin
Release;
end;
end.
发表于 2026-6-3 23:24
|
发表于 2026-6-4 10:11
