- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
- 84
- 85
- 86
- 87
- 88
- 89
- 90
- 91
type
TForm2 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
isDown: Boolean;
downX, downY: Integer;
public
{ Public declarations }
Bild: TBitMap;
end;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
Bild := TBitMap.Create;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
Bild.Free;
end;
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
isDown := true;
downX := X;
downY := Y;
end;
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if isDown then
begin
Self.Repaint;
Self.Canvas.Pen.Color := clRed;
Self.Canvas.Pen.Width := 1;
Self.Canvas.Pen.Style := psDot;
Self.Canvas.Brush.Color := clGreen;
Self.Canvas.Rectangle(downX, downY, X, Y);
Self.Canvas.Pen.Style := psSolid;
Self.Canvas.Brush.Color := clRed;
Self.Canvas.Rectangle(downX - 6, downY - 6, downX + 6, downY + 6);
Self.Canvas.Rectangle(X - 6, Y - 6, X + 6, Y + 6);
Self.Canvas.Rectangle(X - 6, downY - 6, X + 6, downY + 6);
Self.Canvas.Rectangle(downX - 6, Y - 6, downX + 6, Y + 6);
Self.Canvas.Rectangle(downX - 6, (downY + Y) div 2 - 6, downX + 6,
(downY + Y) div 2 + 6);
Self.Canvas.Rectangle(X - 6, (downY + Y) div 2 - 6, X + 6,
(downY + Y) div 2 + 6);
Self.Canvas.Rectangle((downX + X) div 2 - 6, downY - 6,
(downX + X) div 2 + 6, downY + 6);
Self.Canvas.Rectangle((downX + X) div 2 - 6, Y - 6, (downX + X) div 2 + 6,
Y + 6);
end;
end;
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap.Create;
with Result, aRect do
begin
Width := Right - Left;
Height := Bottom - Top;
ScreenDC := GetDC(0);
try
BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
finally
ReleaseDC(0, ScreenDC);
end;
end;
end;
Прага для "снятия экранов". Дополнительная форма растягивается по экрану и с нёё снимаеться скрин.
Без комментариев.