-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathfrmcontrolunit.pas
123 lines (94 loc) · 2.39 KB
/
frmcontrolunit.pas
1
2
3
4
5
6
7
8
9
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
unit frmcontrolunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
LCLIntf, LCLType, StdCtrls,
BGRABitmap, BGRABitmapTypes;
type
{ TfrmSnapControl }
TfrmSnapControl = class(TForm)
ImageList1: TImageList;
Label1: TLabel;
ToolBar1: TToolBar;
btnNew: TToolButton;
btnCancel: TToolButton;
ToolButton3: TToolButton;
procedure btnCancelClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure CaptureSnap;
end;
var
frmSnapControl: TfrmSnapControl;
//bmpSnap: TBitmap;
bmpSnap: TBGRABitmap;
bmpSnapBlended: TBGRABitmap;
bmpCropped: TBGRABitmap;
implementation
uses
frmsnapunit;
{$R *.lfm}
{ TfrmSnapControl }
procedure TfrmSnapControl.FormCreate(Sender: TObject);
begin
end;
procedure TfrmSnapControl.btnNewClick(Sender: TObject);
begin
CaptureSnap;
end;
procedure TfrmSnapControl.btnCancelClick(Sender: TObject);
begin
frmSnap.Hide;
btnCancel.Enabled:=False;
end;
procedure TfrmSnapControl.FormDestroy(Sender: TObject);
begin
bmpSnap.Free;
bmpSnapBlended.Free;
bmpCropped.Free;
end;
procedure TfrmSnapControl.FormShow(Sender: TObject);
begin
if frmSnap.Visible = False then
CaptureSnap;
end;
procedure TfrmSnapControl.CaptureSnap();
var
ScreenDC: HDC;
begin
btnCancel.Enabled:=True;
if Visible = True then begin
Visible:=False;
Sleep(500);
end;
if bmpSnap = nil then
bmpSnap := TBGRABitmap.Create;
if bmpSnapBlended = nil then
bmpSnapBlended := TBGRABitmap.Create;
if bmpCropped = nil then
bmpCropped := TBGRABitmap.Create;
ScreenDC := GetDC(0);
//bmpSnap.LoadFromDevice(ScreenDC);
bmpSnap.SetSize(Screen.Width,Screen.Height);
bmpSnap.LoadFromDevice(ScreenDC);
ReleaseDC(0, ScreenDC);
//Create faded image
bmpSnapBlended.SetSize(bmpSnap.Width,bmpSnap.Height);
bmpSnapBlended.Assign(bmpSnap);
bmpSnapBlended.FillRect(0,0,bmpSnapBlended.Width,bmpSnapBlended.Height,BGRA(255,255,255,128), dmDrawWithTransparency);
with frmSnap do begin
Show;
SetBounds(0, 0, Screen.Width, Screen.Height);
bmpSnapBlended.Draw(imgSnap.Canvas,0,0,true);
end;
Visible:=True;
FormStyle:=fsStayOnTop;
end;
end.