Unit1.~pas
资源名称:08.zip [点击查看]
上传用户:ynjin1970
上传日期:2014-10-13
资源大小:6438k
文件大小:3k
源码类别:
中间件编程
开发平台:
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;
- try
- 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;
- except
- ShowMessage('操作错误');
- end;
- end;
- end;
- end.