（1）新建工程，設(shè)置主界面form1的BoardStyle為bsNone，F(xiàn)ormStyle為fsStayOnTop，WindowState為wsMaximized。

（2）在form1中放置Image1，設(shè)置其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事件里獲取區(qū)域的初始值，并分別用全局變量pt，Endpt，rect_保存初始點，終止點和區(qū)域。

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）隨著鼠標(biāo)的移動，改變選定區(qū)域的大小。

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）松開鼠標(biāo)時，將選中區(qū)域保存在bmp圖片中，并將其復(fù)制到剪貼板。

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）控制只用當(dāng)按下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;