type
TForm1 =
class(TForm)
CAPTURE: TButton;
SaveFileDialog1: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure CAPTUREClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Magnification;
{$R *.dfm}
function HostWndProc(hWindow: HWND; Msg: UINT; wParam: wParam; lParam: lParam)
: LRESULT;
stdcall;
begin
Result := DefWindowProc(hWindow, Msg, wParam, lParam);
end;
var
MyBMP: TBitmap;
abitmap: HBitmap;
desktoprect: TRect;
hWndMag: HWND;
CallbackDone: Boolean = False;
function MagImageScalingCallback(HWND: HWND; srcdata: Pointer;
srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL;
stdcall;
var
lpbmi: TBitmapInfo;
aDC: HDC;
begin
Fillchar(lpbmi, sizeof(lpbmi), 0);
lpbmi.bmiHeader.biSize := sizeof(lpbmi.bmiHeader);
// Otherwise the image is upside down.
lpbmi.bmiHeader.biHeight := -srcheader.height;
lpbmi.bmiHeader.biWidth := srcheader.width;
lpbmi.bmiHeader.biSizeImage := srcheader.cbSize;
lpbmi.bmiHeader.biPlanes := 1;
lpbmi.bmiHeader.biBitCount := 32;
lpbmi.bmiHeader.biCompression := BI_RGB;
aDC := GetWindowDC(HWND);
MyBMP := TBitmap.Create;
abitmap := 0;
try
abitmap := CreateDIBitmap(aDC, lpbmi.bmiHeader, CBM_INIT, srcdata, lpbmi,
DIB_RGB_COLORS);
MyBMP.handle := abitmap;
CallbackDone := True;
finally
DeleteDC(aDC);
end;
Result := True;
end;
procedure TForm1.CAPTUREClick(Sender: TObject);
var
filterList: THWNDArray;
sourceRect: TRect;
begin
filterList[0] := Form1.handle;
If (MagSetWindowFilterList(hWndMag, MW_FILTERMODE_EXCLUDE, 1,
@filterList[0]))
Then
begin
sourceRect.left := 0;
sourceRect.top := 0;
sourceRect.right := desktoprect.width;
sourceRect.bottom := desktoprect.height;
CallbackDone := False;
If (MagSetWindowSource(hWndMag, sourceRect))
Then
Screen.Cursor := crHourGlass;
repeat
until CallbackDone;
Screen.Cursor := crDefault;
SaveFileDialog1.Title := '
Save Image File';
SaveFileDialog1.Filter := '
JPeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif|Png Image|*.png';
SaveFileDialog1.DefaultExt := '
bmp';
SaveFileDialog1.FilterIndex := 2;
SaveFileDialog1.InitialDir := GetCurrentDir;
if SaveFileDialog1.Execute
then
begin
MyBMP.SaveToFile(SaveFileDialog1.FileName);
MessageDlg('
File saved: ' + SaveFileDialog1.FileName, mtInformation,
[mbOK], 0);
end
else
MessageDlg('
Save file was cancelled', mtWarning, [mbOK], 0);
DeleteObject(abitmap);
MyBMP.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
const
HOST_CLASSNAME = '
MagnifierHost';
var
wc: TWndClass;
hWndHost, desktop: HWND;
begin
hWndHost := 0;
wc.lpszClassName := HOST_CLASSNAME;
wc.lpfnWndProc := @HostWndProc;
wc.Style := 0;
wc.hInstance := 0;
wc.hIcon := 0;
wc.hCursor := 0;
wc.hbrBackground := 0;
wc.lpszMenuName :=
nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
desktop := GetDesktopWindow;
GetWindowRect(desktop, desktoprect);
if (
Winapi.Windows.RegisterClass(wc) <> 0)
then
hWndHost := CreateWindowEx(WS_EX_TOPMOST
Or WS_EX_LAYERED
Or
WS_EX_TOOLWINDOW, HOST_CLASSNAME, '
Host Window',
WS_POPUP
Or WS_THICKFRAME
Or WS_CLIPCHILDREN, 0, 0, desktoprect.width,
desktoprect.height, 0, 0, hInstance,
nil);
if (hWndHost <> 0)
then
SetLayeredWindowAttributes(hWndHost, 0, 255, LWA_ALPHA);
If (MagInitialize)
Then
hWndMag := CreateWindowEx(0, WC_MAGNIFIER, '
MagnifierWindow',
WS_CHILD
Or MS_SHOWMAGNIFIEDCURSOR
Or WS_VISIBLE, 0, 0, desktoprect.width,
desktoprect.height, hWndHost, 0, 0,
nil);
If (hWndMag = 0)
Then
ShowMessage(SysErrorMessage(GetLastError));
if (MagSetImageScalingCallback(hWndMag, MagImageScalingCallback))
then
{ShowMessage('MagSetImageScalingCallback registred!'};
Left := (GetSystemMetrics(SM_CXSCREEN) - width)
div 2;
Top := (GetSystemMetrics(SM_CYSCREEN) - height)
div 2;
end;
end.