delphi实现屏幕截图

 (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;

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值