unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Registry;
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure LoadSize;
private
{ Private declarations }
public
{ Public declarations }
Hold, First: boolean;
Factor: Word;
ScreenImg: TBitmap;
end;
{
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
}
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Timer1Timer(Sender: TObject);
var
tempPoint: TPoint;
tempDc: hDc;
tempWnd: hWnd;
begin
if not Hold then begin
exit;
end;
if First then begin
// 隐藏窗口，保存屏幕画面，以后无论移动到哪里，都可以正确显示
tempWnd:= GetDesktopWindow;
tempDc:= GetDc(tempWnd);
BitBlt( ScreenImg.Canvas.Handle, Width, Height, ScreenImg.Width, ScreenImg.Height,
tempDc, 0, 0, SRCCOPY);
releaseDc(tempWnd, tempDc);
Visible:= true;
First:= false;
exit;
end;
if Hold then begin
GetCursorPos(tempPoint);
Left:= tempPoint.x- Width div 2;
Top:= tempPoint.y- Height div 2;
//BitBlt( Canvas.Handle, 0, 0, Width, Height,
// ScreenImg.Canvas.Handle, Left, Top, SRCCOPY);
StretchBlt( Canvas.Handle, 0, 0, Width, Height,
ScreenImg.Canvas.Handle, Width+ tempPoint.x- Width div 2 div Factor, Height+ tempPoint.y- Height div 2 div Factor, Width div Factor, Height div Factor, SRCCOPY);
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then begin
if Hold then begin
Timer1.Enabled:= false;
Hold:= false;
refresh;
end else begin
Hold:= true;
Visible:= false;
First:= true;
Timer1.Enabled:= true;
end;
end else begin
application.Terminate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Hold:= false;
LoadSize;
ScreenImg:= TBitmap.Create;
ScreenImg.Width:= Screen.Width+ Width* 2;
ScreenImg.Height:= Screen.Height+ Height* 2;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ScreenImg.Free;
end;
procedure TForm1.LoadSize;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
Factor:= 2;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('/Software/Glass/', false) then begin
Width:= Reg.ReadInteger('Width');
Height:= Reg.ReadInteger('Height');
Factor:= Reg.ReadInteger('Factor');
if Factor< 2 then begin
Factor:= 2;
end;
end else if Reg.OpenKey('/Software/Glass/', true) then begin
Reg.WriteInteger('Width', Width);
Reg.WriteInteger('Height', Height);
Reg.WriteInteger('Factor', 2);
Factor:= 2;
end;
except
end;
Reg.CloseKey;
Reg.Free;
end;
procedure TForm1.FormDeactivate(Sender: TObject);
begin
if not Hold then begin
exit;
end;
Timer1.Enabled:= false;
Hold:= false;
refresh;
end;
end.
别人的东东，你看看吧
