I'm modifying an open-source Delphi magnifier application to meet my needs. It's very simple and only contains a TImage
control to show the zoomed screen.
When I run it, it looks like this:
Basically, when the user moves the cursor, the app copies the corresponding rectangle and draws it on the TImage
to give a zooming effect.
However, the problems are:
- It doesn't show the zoomed cursor (Windows Magnifier does that)
- It can't get the screen portion underneath the Main Form (Windows Magnifier does that).
How can I implement these two features? I have no clues right now.
My final goal is to make it run in full screen and still zoom, just like Windows Magnifier does.
Below is the code I have.
UNIT uZoom;
INTERFACE
USES
ShellApi, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ExtCtrls, Buttons, System.Actions, Vcl.ActnList;
TYPE
TMainForm = CLASS(TForm)
img: TImage;
timer: TTimer;
ActionList1: TActionList;
inc_factor: TAction;
dec_factor: TAction;
PROCEDURE FormResize(Sender: TObject);
PROCEDURE FormDestroy(Sender: TObject);
PROCEDURE timerTimer(Sender: TObject);
PROCEDURE inc_factorExecute(Sender: TObject);
PROCEDURE FormCreate(Sender: TObject);
PROCEDURE dec_factorExecute(Sender: TObject);
PRIVATE
PUBLIC
END;
VAR
MainForm: TMainForm;
VAR
factor: integer;
IMPLEMENTATION
{$R *.DFM}
PROCEDURE TMainForm.FormResize(Sender: TObject);
BEGIN
img.Picture := NIL;
END;
PROCEDURE TMainForm.inc_factorExecute(Sender: TObject);
BEGIN
factor := factor + 1;
OutputDebugString(PChar(inttostr(factor)));
Invalidate;
END;
PROCEDURE TMainForm.dec_factorExecute(Sender: TObject);
BEGIN
factor := factor - 1;
IF factor = 0 THEN
factor := 1;
OutputDebugString(PChar(inttostr(factor)));
Invalidate;
END;
PROCEDURE TMainForm.FormCreate(Sender: TObject);
BEGIN
factor := 1;
OutputDebugString(PChar(inttostr(factor)));
Invalidate;
END;
PROCEDURE TMainForm.FormDestroy(Sender: TObject);
BEGIN
timer.Interval := 0;
END;
PROCEDURE TMainForm.timerTimer(Sender: TObject);
VAR
srcRect, destRect, fmrRect: TRect;
iWidth, iHeight, DmX, DmY: integer;
C: TCanvas;
curPos: TPoint;
BEGIN
// Determines whether the specified window is minimized (iconic).
IF IsIconic(Application.Handle) THEN
exit;
// Retrieves a handle to the desktop window. The desktop window covers the entire screen.
// The desktop window is the area on top of which other windows are painted.
VAR
hDesktop: Hwnd := GetDesktopWindow;
// Retrieves the position of the mouse cursor, in screen coordinates.
GetCursorPos(curPos);
fmrRect := Rect(MainForm.Left, MainForm.Top, MainForm.Left + MainForm.Width, MainForm.Top + MainForm.Height);
// The PtInRect function determines whether the specified point lies within the specified rectangle.
// A point is within a rectangle if it lies on the left or top side or is within all four sides.
// A point on the right or bottom side is considered outside the rectangle.
IF NOT PtInRect(fmrRect, curPos) THEN
BEGIN
img.Visible := True;
iWidth := img.Width;
iHeight := img.Height;
destRect := Rect(0, 0, iWidth, iHeight);
VAR dx: real := iWidth / (factor * 4);
VAR dy: real := iHeight / (factor * 4);
srcRect := Rect(curPos.x, curPos.y, curPos.x, curPos.y);
InflateRect(srcRect, Round(dx), Round(dy));
IF srcRect.Left < 0 THEN
OffsetRect(srcRect, -srcRect.Left, 0);
IF srcRect.Top < 0 THEN
OffsetRect(srcRect, 0, -srcRect.Top);
IF srcRect.Right > Screen.DesktopWidth THEN
OffsetRect(srcRect, -(srcRect.Right - Screen.DesktopWidth), 0);
IF srcRect.Bottom > Screen.DesktopHeight THEN
OffsetRect(srcRect, 0, -(srcRect.Bottom - Screen.DesktopHeight));
C := TCanvas.Create;
TRY
C.Handle := GetDC(GetDesktopWindow);
img.Canvas.CopyRect(destRect, C, srcRect);
FINALLY
ReleaseDC(hDesktop, C.Handle);
C.Free;
END;
END;
END;
END.