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;