DELPHI 截屏

unit mainunit;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  H,W: integer;
  pt,Endpt: TPoint;
  rect_: TRect;
  dragging_: boolean;

 

implementation

{$R *.dfm}
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.PixelFormat:= pf32bit;
  bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);
  finally
  MyCanvas.Handle:= 0;
  MyCanvas.Free;
  releaseDC(0, DC);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitMap;
begin
  bmp:= TBitMap.Create;
  GetScreen(bmp);
  image1.Picture:= TPicture(bmp);

end;

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;

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;

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;

end.

 

附:

 

以下是实现delphi中截指定区域的图，我截取的是image中的图片，实现了LED显示屏二次开发的一个功能，记下来

procedure TForm1.snapscreen(a, b, c, d: Integer);
var
bmpscreen:Tbitmap;
jpegscreen:Tjpegimage;
FullscreenCanvas:TCanvas;
dc:HDC;
sourceRect, destRect: TRect;
begin
try
dc:=getdc(0);
fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=dc;
bmpscreen:=Tbitmap.create;
bmpscreen.Width :=c-a;
bmpscreen.Height :=d-b;
sourcerect:=rect(0,0,c-a ,d-b );
destrect:= rect(a,b,c,d);
bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);
jpegscreen:=Tjpegimage.Create ;
jpegscreen.Assign (bmpscreen);
jpegscreen.CompressionQuality:=100;
jpegscreen.SaveToFile(ExtractFilePath(ParamStr(0))+'tmp.bmp');
FullscreenCanvas.Free;
bmpscreen.Free;
jpegscreen.Free ;
ReleaseDC(0, DC);
except
end;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
bw:integer;
tw:integer;
begin
  // snapscreen(self.Left,self.Top,Self.Left+self.Width,Self.Top+self.Height);
 bw:=self.Width-self.ClientWidth;       //边框
 tw:=self.Height-self.ClientHeight-(bw div 2);     //标题栏

 edit1.Text:=inttostr(bw div 2);
 edit2.Text:=inttostr(tw);
 snapscreen(self.Left+image1.left+(bw div 2),
            self.Top+image1.top+tw,
            Self.Left+image1.Width+image1.left+(bw div 2),
            image1.Height+image1.top+self.top+tw);
end;