（1）新建工程，设置主界面form1的BoardStyle为bsNone，FormStyle为fsStayOnTop，WindowState为wsMaximized。

（2）在form1中放置Image1，设置其AutoSize为True。

（3）在form1的OnCreate事件中截取全屏，并将截到的图片放置在image1中。

procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitMap;
begin
  bmp:= TBitMap.Create;
  GetScreen(bmp);
  image1.Picture:= TPicture(bmp);
end;
其中，截取全屏的过程GetScreen(var bmp: TBitMap)定义如下：

procedure GetScreen(var bmp: TBitMap);  //截取全屏
var
  DC: HDC;
  MyCanvas: TCanvas;
  MyRect: TRect;
begin
  DC:= GetWindowDC(0);
  MyCanvas:= TCanvas.Create;
  try
    MyCanvas.Handle:= DC;
    MyRect:= Rect(0, 0, Screen.Width, Screen.Height);
    bmp:= TBitMap.Create;
    bmp.PixelFormat:= pf24bit;
    bmp.Width:= MyRect.Right;
    bmp.Height:= MyRect.Bottom;
    bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);
  finally
    MyCanvas.Handle:= 0;
    MyCanvas.Free;
    releaseDC(0, DC);
  end;
end;
（4）在image1的OnMouseDown事件里获取区域的初始值，并分别用全局变量pt，Endpt，rect_保存初始点，终止点和区域。

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dragging_:= true;
  pt:= Point(X, Y);
  Endpt:= pt;
  rect_.left:= pt.x;
  rect_.top:= pt.y;
  rect_.right:= pt.x;
  rect_.bottom:= pt.y;
  Canvas.DrawFocusRect(rect_);
end;
（5）随着鼠标的移动，改变选定区域的大小。

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if   (Dragging_) then
  begin
    Endpt:=   Point(X, Y);
    H:= abs(pt.y - Endpt.y);
    W:= abs(pt.x - Endpt.x);
    Canvas.DrawFocusRect(rect_);
    if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
    begin
      rect_.Left:= pt.x;
      rect_.top:= pt.y;
    end
    else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
    begin
      rect_.Left:= pt.x;
      rect_.top:= Endpt.y;
    end
    else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
    begin
      rect_.Left:= Endpt.x;
      rect_.top:= Endpt.y;
    end
    else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
    begin
      rect_.Left:= Endpt.x;
      rect_.top:= pt.y;
    end;
    rect_.right:= rect_.left + W;
    rect_.bottom:= rect_.top + H;
    Canvas.DrawFocusRect(rect_);
  end;
end;
（6）松开鼠标时，将选中区域保存在bmp图片中，并将其复制到剪贴板。

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  bmp: TBitMap;
  MyRect: TRect;
begin
  if (Dragging_) then
  begin
    Dragging_:= false;
    Endpt:=   Point(X, Y);
    Canvas.DrawFocusRect(rect_);
    bmp:= TBitMap.Create;
    bmp.Width:= Rect_.Right - Rect_.Left;
    bmp.Height:= Rect_.Bottom - Rect_.Top;
    MyRect:= Rect(0, 0, bmp.Width, bmp.Height);
    bmp.Canvas.CopyRect(MyRect, Canvas, Rect_);
    ClipBoard.Assign(bmp);
  end;
end;

（7）控制只用当按下esc键时，才能退出程序（G_CanClose为全局变量）。

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #27) then
  begin
    G_CanClose:= true;
    Close;
  end
  else
    Key:= #0;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:= G_CanClose;
end;

发表于 @ 2008年07月18日 07:27:00|评论(loading...)|收藏