Unit1.pas
上传用户:ynjin1970
上传日期:2014-10-13
资源大小:6438k
文件大小:3k
源码类别:

中间件编程

开发平台:

Visual C++

  1. unit Unit1;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5.   Dialogs,StdCtrls, ExtCtrls,Math;
  6. type
  7.   TForm1 = class(TForm)
  8.     procedure FormCreate(Sender: TObject);
  9.     procedure CMEraseBkgnd(var message:TWMEraseBKgnd);message WM_ERASEBKGND;
  10.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  11.       Shift: TShiftState; X, Y: Integer);
  12.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  13.       Y: Integer);
  14.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
  15.       Shift: TShiftState; X, Y: Integer);
  16.   private
  17.    Dragging:Boolean;
  18.    PointOrigin:TPoint;
  19.    PointOld:TPoint;
  20.    PointNew:TPoint;
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.   end;
  25. var
  26.   Form1: TForm1;
  27. implementation
  28. {$R *.dfm}
  29. procedure TForm1.FormCreate(Sender: TObject);
  30. begin
  31.  Dragging:=False;
  32.  Canvas.Pen.Color:=clBlue;
  33.  Canvas.Pen.Mode:=pmNotXor;
  34. end;
  35. procedure TForm1.CMEraseBkgnd(var message:TWMEraseBKgnd);
  36. begin
  37.  Brush.Style:=bsClear;
  38.  inherited;
  39. end;
  40. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  41.   Shift: TShiftState; X, Y: Integer);
  42. begin
  43.  Dragging:=True;
  44.  PointOrigin:=Point(X,Y);
  45.  PointOld:=Point(X,Y);
  46. end;
  47. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  48.   Y: Integer);
  49. begin
  50.  if Dragging then
  51.   begin
  52.    Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
  53.    Canvas.LineTo(PointOld.x,PointOrigin.y);
  54.    Canvas.LineTo(PointOld.x,PointOld.y);
  55.    Canvas.LineTo(PointOrigin.x,PointOld.y);
  56.    Canvas.LineTo(PointOrigin.x,PointOrigin.y);
  57.    PointNew:=Point(X,Y);
  58.    Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
  59.    Canvas.LineTo(PointNew.x,PointOrigin.y);
  60.    Canvas.LineTo(PointNew.x,PointNew.y);
  61.    Canvas.LineTo(PointOrigin.x,PointNew.y);
  62.    Canvas.LineTo(PointOrigin.x,PointOrigin.y);
  63.    PointOld:=PointNew;
  64.   end;
  65. end;
  66. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  67.   Shift: TShiftState; X, Y: Integer);
  68. var DeskTopCanvas:TCanvas;
  69.     BitMap:TBitmap;
  70.     src,dest:TRect;
  71. begin
  72. if Dragging then
  73. begin
  74.    Dragging:=False;
  75.    Canvas.MoveTo(PointOrigin.x,PointOrigin.y);
  76.    Canvas.LineTo(PointOld.x,PointOrigin.y);
  77.    Canvas.LineTo(PointOld.x,PointOld.y);
  78.    Canvas.LineTo(PointOrigin.x,PointOld.y);
  79.    Canvas.LineTo(PointOrigin.x,PointOrigin.y);
  80.    DeskTopCanvas:=TCanvas.Create;
  81.    DeskTopCanvas.Handle:=GetDC(Hwnd_Desktop);
  82.    BitMap:=TBitmap.Create;
  83.    src.Left:=Min(PointOrigin.x,X);
  84.    src.Top:=Min(PointOrigin.y,Y);
  85.    src.Right:=Max(PointOrigin.x,X);
  86.    src.Bottom:=Max(PointOrigin.y,Y);
  87.    dest:=Rect(0,0,abs(X-PointOrigin.x),abs(Y-PointOrigin.y));
  88.    BitMap.Width:=abs(X-PointOrigin.x);
  89.    BitMap.Height:=abs(Y-PointOrigin.y);
  90.    BitMap.Canvas.CopyRect(dest,DeskTopCanvas,src);
  91.    BitMap.SaveToFile('Screen.bmp');
  92.    BitMap.Free;
  93.    DeskTopCanvas.Free;
  94. end;
  95. end;
  96. end.
  97.