private
isDown:
Boolean
;
downX, downY:
Integer
;
public
Bild: TBitMap;
end
;
var
FORM_SCREEN: TFORM_SCREEN;
implementation
{$R *.dfm}
uses
Unit1;
function
CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap
.
Create;
Result
.
Width := aRect
.
Right - aRect
.
Left;
Result
.
Height := aRect
.
Bottom - aRect
.
Top;
ScreenDC := GetDC(
0
);
try
BitBlt(Result
.
Canvas
.
Handle,
0
,
0
, Result
.
Width, Result
.
Height, ScreenDC, aRect
.
Left, aRect
.
Top, SRCCOPY);
finally
ReleaseDC(
0
, ScreenDC);
end
;
end
;
function
GetRectByCoord(x1, y1, x2, y2:
Integer
): TRect;
begin
Result
.
Left := Min(x1, x2);
Result
.
Right := Max(x1, x2);
Result
.
Top := Min(y1, y2);
Result
.
Bottom := Max(y1, y2);
end
;
procedure
TFORM_SCREEN
.
FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
Integer
);
begin
if
Button = mbLeft
then
begin
isDown :=
True
;
downX := X;
downY := Y;
end
;
end
;
procedure
TFORM_SCREEN
.
FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
Integer
);
var
jpg: TJPEGImage;
begin
if
Button = mbLeft
then
begin
isDown :=
False
;
jpg := TJPEGImage
.
Create;
try
Bild := CaptureScreenRect(GetRectByCoord(downX, downY, X, Y));
jpg
.
Assign(Bild);
Inc(SCREEN_COUNT);
jpg
.
SaveToFile(SCREEN_PATH +
'Screen_'
+ IntToStr(SCREEN_COUNT) +
'.jpg'
);
finally
FreeAndNil(Bild);
FreeAndNil(jpg);
self
.
Close;
end
;
end
;
end
;
procedure
TFORM_SCREEN
.
FormShow(Sender: TObject);
begin
Bild := TBitMap
.
Create;
end
;