unit1.pas

鼠标放大器。delphi环境。可选择放大倍数。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    MenuZoom2: TMenuItem;
    MenuZoom3: TMenuItem;
    MenuZoom4: TMenuItem;
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure MenuZoom2Click(Sender: TObject);
    procedure MenuZoom3Click(Sender: TObject);
    procedure MenuZoom4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FnZoomMultiple: integer; //放大倍数
    ptNow,ptNow2: TPoint;//分别用来即时采集鼠标位置以及用来处理的位置,之所以分开来用,是防止共享冲突
    rectSrc,rectDest: TRect;//用来保存将被放大的源矩形位置和目标矩形位置
    CanvasWork: TCanvas;//工作画布对象
    procedure IdleLoop(Sender: TObject;var DoneState:boolean);//IDLE事件的处理函数
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
  ScreenCanvas: TCanvas; //保存当前整个桌面的画布对象
  dc: HDC; //dc是当前桌面的设备环境
  bmpWork: HBITMAP; //用来指定当前的工作画布使用的BITMAP对象句柄
  dcWork: HDC;//用来产生需要使用的画布的设备环境
begin
  FnZoomMultiple := 2;
  rectDest := RECT(0,0,ClientWidth,ClientHeight);
  rectSrc := RECT(0,0,ClientWidth div FnZoomMultiple,ClientHeight div FnZoomMultiple);

  ScreenCanvas := TCanvas.Create;
  CanvasWork := TCanvas.Create;

  dc := GetDC(0);
  ScreenCanvas.Handle := dc;//得到桌面设备环境的句柄

  dcWork := CreateCompatibleDC(Canvas.Handle);
  bmpWork := CreateCompatibleBitmap(Canvas.Handle,ClientWidth,ClientHeight);
  SelectObject(dcWork,bmpWork);
  SelectPalette(dcWork,0,false);
  CanvasWork.Handle := dcWork;//初始化工作环境画布
  RealizePalette(ScreenCanvas.Handle);
  CanvasWork.CopyRect(rectDest,ScreenCanvas,rectSrc);

  Canvas.CopyRect(rectDest,CanvasWork,rectDest); //初始化显示

  Application.OnIdle := IdleLoop;
  ReleaseDC(0,dc);
  ScreenCanvas.Free;
end;

procedure TForm1.IdleLoop(Sender: TObject;var DoneState:boolean);
var
  ScreenCanvas: TCanvas; //保存当前整个桌面的画布对象
  dc: HDC; //dc是当前桌面的设备环境
begin
  DoneState := false;
  ptNow2 := ptNow;//把即时采集的鼠标坐标转移给工作坐标
  ScreenCanvas := TCanvas.Create;

  rectSrc.Left := ptNow2.X - ClientWidth div (2*FnZoomMultiple);
  rectSrc.Right := ptNow2.X + ClientWidth div (2*FnZoomMultiple);
  rectSrc.Top := ptNow2.Y - ClientHeight div (2*FnZoomMultiple);
  rectSrc.Bottom := ptNow2.Y + ClientHeight div (2*FnZoomMultiple);
  //根据采集到的鼠标坐标和放大倍数,调整矩形的位置,保证鼠标所在的位置为中央
  dc := GetDC(0);
  ScreenCanvas.Handle := dc;
  RealizePalette(ScreenCanvas.Handle);
  CanvasWork.Brush.Style := bsSolid;
  CanvasWork.Brush.Color := clBlack;
  CanvasWork.FillRect(rectDest);
  CanvasWork.CopyRect(rectDest,ScreenCanvas,rectSrc);//把屏幕上相应位置的内容拷贝到工作画布上
  Canvas.CopyRect(rectDest,CanvasWork,rectDest);//显示工作画布上的内容
  ReleaseDC(0,dc);
  ScreenCanvas.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GetCursorPos(ptNow);//即时采集鼠标的位置
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  RealizePalette(Canvas.Handle);
  Canvas.CopyRect(rectDest,CanvasWork,rectDest);//刷新窗口画布上的内容
end;

procedure TForm1.MenuZoom2Click(Sender: TObject);
begin
  FnZoomMultiple := 2;     //更改放大倍数
end;

procedure TForm1.MenuZoom3Click(Sender: TObject);
begin
  FnZoomMultiple := 3;
end;

procedure TForm1.MenuZoom4Click(Sender: TObject);
begin
  FnZoomMultiple := 4;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CanvasWork.Free;
end;

end.