اين هم يك برنامه با حال براي كسايي كه تا آخرش آمدن :
برنامه Magnifier يا ذره بين
يك فرم بسازيد و يك تايمر روش بزارين , ... :
}
Zoom
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
Zoom in portion of your desktop screen like a loope.
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
email:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
********************************************
{
unit uZoom;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ExtCtrls, Buttons;
type
TFormZoom = class(TForm)
Image1: TImage;
Timer1: TTimer;
Panel1: TPanel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Slider: TTrackBar;
cbSrediste: TCheckBox;
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
end;
var
FormZoom: TFormZoom;
implementation
{$R *.DFM}
procedure TFormZoom.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 TFormZoom.FormResize(Sender: TObject);
begin
// panel in the middle of the form
Panel1.Left:=(FormZoom.ClientWidth Div 2) - Panel1.Width div 2;
Panel1.Top:=(FormZoom.ClientHeight Div 2) - Panel1.Height div 2;
Image1.Picture:=nil;
end;
procedure TFormZoom.FormDestroy(Sender: TObject);
begin
Timer1.Interval:=0;
end;
procedure TFormZoom.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(FormZoom.Left,FormZoom.Top,FormZoom .Left+FormZoom.Width,FormZoom.Top+FormZoom.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.