mainunit.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,ShellApi;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure CaptureParScr(StartPoint,EndPoint:TPoint);
    { Public declarations }
  end;

var
  Form1: TForm1;
  ClickCount:Integer;
  StartPoint,EndPoint:TPoint;
implementation

{$R *.dfm}

procedure CopyCurrentDesktop(IncludeCur:Boolean);
var 
 DesktophWnd:hWnd;
 DesktopDC:hWnd;
 CursorhWnd:hWnd;
 CurPos:Tpoint;
 Rect:TRect; 
 Bitmap:TBitmap;
begin
 DesktophWnd := GetDesktopWindow();
 DesktopDC := GetDC(DesktophWnd);
 GetWindowRect(DesktophWnd, Rect);
 if IncludeCur then
  begin
   CursorhWnd:=GetCursor();            //捕获当前鼠标指针句柄
   GetCursorPos(CurPos);
  end;                  //获取当前鼠标指针的位置坐标
 Bitmap := TBitmap.Create;//生成一个Tbitmap类型的实例对象
 Bitmap.Width := Rect.Right-Rect.Left;
 Bitmap.Height := Rect.Bottom-Rect.Top;
 BitBlt(Bitmap.Canvas.Handle, 0, 0,
 Bitmap.Width, Bitmap.Height, DesktopDC, 0, 0, SRCCOPY);

//在抓取到的位图对象上绘制鼠标
 if IncludeCur then
  DrawIcon(Bitmap.Canvas.Handle, CurPos.X, CurPos.Y, CursorhWnd);
 ReleaseDC(DesktophWnd, DesktopDC); 
 Bitmap.SaveToFile('C:\Desktop.bmp'); //使用类方法SaveToFile保存文件
 Bitmap.Free;
end;

procedure TForm1.CaptureParScr(StartPoint,EndPoint:TPoint);
var
  Bitmap:TBitmap;
begin
 Bitmap := TBitmap.Create;//生成一个Tbitmap类型的实例对象
 Bitmap.Width := Abs(StartPoint.x-EndPoint.x);
 Bitmap.Height := Abs(StartPoint.y-EndPoint.y);
 bitblt(BitMap.Canvas.Handle,0,0,Bitmap.Width, Bitmap.Height, Image1.Canvas.Handle, StartPoint.x, StartPoint.y, SRCCOPY);
 Bitmap.SaveToFile('C:\PartDesktop.bmp'); //使用类方法SaveToFile保存文件
 Bitmap.Free;
 Button2.Click;
 Form1.Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Form1.Button2.Enabled:=False;
 if MessageDlg('是否连同鼠标指针一起抓取?',mtConfirmation,
               [mbYes, mbNo], 0) = mrYes  then
  begin
   CopyCurrentDesktop(True);
  end
 else
  begin
   CopyCurrentDesktop(False);
  end;
 Button1.Visible:=False;
 Button2.Visible:=False;
 Form1.Left:=0;
 Form1.Top:=0;
 Form1.Width:=Screen.Width;
 Form1.Height:=Screen.Height;
 Form1.BorderStyle:=bsNone;
 Form1.Image1.Left:=0;
 Form1.Image1.Top:=0;
 Form1.Image1.Width:=Screen.Width;
 Form1.Image1.Height:=Screen.Height;
 ShowMessage('请您在此用鼠标选择要拷贝的屏幕区域起点和终点!');
 Form1.Image1.Picture.LoadFromFile('C:\Desktop.bmp');
 ClickCount:=0;
 Form1.Image1.Enabled:=True;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 ClickCount:=ClickCount+1;
 if ClickCount=1 then
  begin
    StartPoint.X:=X;
    StartPoint.Y:=Y;
    ShowMessage('您已经选择了区域起点坐标!请继续选择区域终点坐标.');
  end;
 if ClickCount=2 then
  begin
    EndPoint.X:=X;
    EndPoint.Y:=Y;
    if MessageDlg('您已经选择了区域终点坐标,是否抓取由这两点决定的区域?',mtConfirmation,
               [mbYes, mbNo], 0) = mrYes  then
     begin
      ClickCount:=0;
      CaptureParScr(StartPoint,EndPoint);
      Form1.Image1.Enabled:=False;
     end
     else
      ClickCount:=0; 
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ShellExecute(handle,'open','C:\PartDesktop.bmp',nil,nil,SW_Normal);
end;

end.