⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uzoom.pas

📁 The idea is to track mouse cursor movement over the screen, and show enlarged (2x to 8x) section aro
💻 PAS
字号:
{
Zoom
http://delphi.about.com/library/weekly/aa120198.htm
Zoom in portion of your desktop screen like a loope.

********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
********************************************
}

unit uZoom;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Slider: TTrackBar;
    BitBtn1: TBitBtn;
    cbSrediste: TCheckBox;
    procedure FormResize(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
     procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  public
  end;

var
  Form1: TForm1;

implementation
uses uAbout;
{$R *.DFM}

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
   inherited;
   Msg.MinMaxInfo^.ptMinTrackSize := Point(158, 177); // min form size
   Msg.MinMaxInfo^.ptMaxTrackSize := Point(350, 350); // max form size (width, height)
end;


procedure TForm1.FormResize(Sender: TObject);
begin
		// panel in the middle of the form
  Panel1.Left:=(Form1.ClientWidth Div 2) - Panel1.Width div 2;
  Panel1.Top:=(Form1.ClientHeight Div 2) - Panel1.Height div 2;
  Image1.Picture:=nil;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Form1.FormStyle:=fsNormal;
  with TAboutBox.Create(nil) do
 	try
     Timer1.Interval:=0;
   	ShowModal;
 	finally
     Timer1.Interval:=25;
   	Free;
	end;
  Form1.FormStyle:=fsStayOnTop;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
	Timer1.Interval:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Srect,Drect,PosForme:TRect;
  iWidth,iHeight,DmX,DmY:Integer;
  iTmpX,iTmpY:Real;
  C:TCanvas;
  hDesktop: Hwnd;
  Kursor:TPoint;
begin
 If not IsIconic(Application.Handle) then begin
  hDesktop:= GetDesktopWindow;
  GetCursorPos(Kursor);
 	PosForme:=Rect(Form1.Left,Form1.Top,Form1.Left+Form1.Width,Form1.Top+Form1.Height);
  If not PtInRect(PosForme,Kursor) then begin

    If Panel1.Visible=True then Panel1.Visible:=False;
    If Image1.Visible=False then Image1.Visible:=True;

 	 iWidth:=Image1.Width;
		 iHeight:=Image1.Height;
    Drect:=Rect(0,0,iWidth,iHeight);

    iTmpX:=iWidth / (Slider.Position * 4);
    iTmpY:=iHeight / (Slider.Position * 4);

    Srect:=Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);
    InflateRect(Srect,Round(iTmpX),Round(iTmpY));
    // move Srect if outside visible area of the screen
    If Srect.Left<0 then OffsetRect(Srect,-Srect.Left,0);
    If Srect.Top<0 then OffsetRect(Srect,0,-Srect.Top);
    If Srect.Right>Screen.Width then OffsetRect(Srect,-(Srect.Right-Screen.Width),0);
    If Srect.Bottom>Screen.Height then OffsetRect(Srect,0,-(Srect.Bottom-Screen.Height));

   C:=TCanvas.Create;
   try
     C.Handle:=GetDC(GetDesktopWindow);
     Image1.Canvas.CopyRect(Drect,C,Srect);
    finally
      ReleaseDC(hDesktop, C.Handle);
      C.Free;
    end;
    If cbSrediste.Checked=True then begin // show crosshair
    	with Image1.Canvas do begin
        DmX:=Slider.Position * 2 * (Kursor.X-Srect.Left);
        DmY:=Slider.Position * 2 * (Kursor.Y-Srect.Top);  
   		 MoveTo(DmX - (iWidth div 4),DmY); // -
   		 LineTo(DmX + (iWidth div 4),DmY); // -
    		 MoveTo(DmX,DmY - (iHeight div 4)); // |
   		 LineTo(DmX,DmY + (iHeight div 4)); // |
      end; // with image1.Canvas
    end; // show crosshair
  	Application.ProcessMessages;
	end // Cursor not inside form
   else begin  // cursor inside form
   	If Panel1.Visible=False then Panel1.Visible:=True;
   	If Image1.Visible=True then Image1.Visible:=False;
  end;
 end; // IsIconic
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -