Code/Resource
Windows Develop
Linux-Unix program
Internet-Socket-Network
Web Server
Browser Client
Ftp Server
Ftp Client
Browser Plugins
Proxy Server
Email Server
Email Client
WEB Mail
Firewall-Security
Telnet Server
Telnet Client
ICQ-IM-Chat
Search Engine
Sniffer Package capture
Remote Control
xml-soap-webservice
P2P
WEB(ASP,PHP,...)
TCP/IP Stack
SNMP
Grid Computing
SilverLight
DNS
Cluster Service
Network Security
Communication-Mobile
Game Program
Editor
Multimedia program
Graph program
Compiler program
Compress-Decompress algrithms
Crypt_Decrypt algrithms
Mathimatics-Numerical algorithms
MultiLanguage
Disk/Storage
Java Develop
assembly language
Applications
Other systems
Database system
Embeded-SCM Develop
FlashMX/Flex
source in ebook
Delphi VCL
OS Develop
MiddleWare
MPI
MacOS develop
LabView
ELanguage
Software/Tools
E-Books
Artical/Document
Unit1.pas
Package: 08.zip [view]
Upload User: ynjin1970
Upload Date: 2014-10-13
Package Size: 6438k
Code Size: 3k
Category:
MiddleWare
Development Platform:
Visual C++
- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs,StdCtrls, ExtCtrls,Math;
- type
- TForm1 = class(TForm)
- procedure FormCreate(Sender: TObject);
- procedure CMEraseBkgnd(var message:TWMEraseBKgnd);message WM_ERASEBKGND;
- procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- private
- Dragging:Boolean;
- PointOrigin:TPoint;
- PointOld:TPoint;
- PointNew:TPoint;
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- Dragging:=False;
- Canvas.Pen.Color:=clBlue;
- Canvas.Pen.Mode:=pmNotXor;
- end;
- procedure TForm1.CMEraseBkgnd(var message:TWMEraseBKgnd);
- begin
- Brush.Style:=bsClear;
- inherited;
- end;
- procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- Dragging:=True;
- PointOrigin:=Point(X,Y);
- PointOld:=Point(X,Y);
- end;
- procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- if Dragging then
- begin
- Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
- Canvas.LineTo(PointOld.x,PointOrigin.y);
- Canvas.LineTo(PointOld.x,PointOld.y);
- Canvas.LineTo(PointOrigin.x,PointOld.y);
- Canvas.LineTo(PointOrigin.x,PointOrigin.y);
- PointNew:=Point(X,Y);
- Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
- Canvas.LineTo(PointNew.x,PointOrigin.y);
- Canvas.LineTo(PointNew.x,PointNew.y);
- Canvas.LineTo(PointOrigin.x,PointNew.y);
- Canvas.LineTo(PointOrigin.x,PointOrigin.y);
- PointOld:=PointNew;
- end;
- end;
- procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var DeskTopCanvas:TCanvas;
- BitMap:TBitmap;
- src,dest:TRect;
- begin
- if Dragging then
- begin
- Dragging:=False;
- Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
- Canvas.LineTo(PointOld.x,PointOrigin.y);
- Canvas.LineTo(PointOld.x,PointOld.y);
- Canvas.LineTo(PointOrigin.x,PointOld.y);
- Canvas.LineTo(PointOrigin.x,PointOrigin.y);
- DeskTopCanvas:=TCanvas.Create;
- DeskTopCanvas.Handle:=GetDC(Hwnd_Desktop);
- BitMap:=TBitmap.Create;
- src.Left:=Min(PointOrigin.x,X);
- src.Top:=Min(PointOrigin.y,Y);
- src.Right:=Max(PointOrigin.x,X);
- src.Bottom:=Max(PointOrigin.y,Y);
- dest:=Rect(0,0,abs(X-PointOrigin.x),abs(Y-PointOrigin.y));
- BitMap.Width:=abs(X-PointOrigin.x);
- BitMap.Height:=abs(Y-PointOrigin.y);
- BitMap.Canvas.CopyRect(dest,DeskTopCanvas,src);
- BitMap.SaveToFile('Screen.bmp');
- BitMap.Free;
- DeskTopCanvas.Free;
- end;
- end;
- end.