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:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
| unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ExtCtrls,GDIPAPI,GDIPOBJ, StdCtrls;
type
TForm2 = class(TForm)
Timer1: TTimer;
procedure FormPaint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
FDown:Boolean;
FStartx,FstartY ,FendX,FEndY:Integer;
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
Function ColorToTGPColor (c : Tcolor; trans : Byte = 255):TGPColor;
Type
TBarry=Array[0..3] of Byte;
Var
Barry:TBarry;
R:Byte;
begin
move(C,Barry,4);
R:=Barry[2];
Barry[2]:=Barry[0];
Barry[0]:=R;
Barry[3]:=trans;
move(Barry,Result,4);
end;
procedure TForm2.FormDblClick(Sender: TObject);
begin
Close;
end;
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FStartx := X;
FstartY := Y;
FDown := true;
end;
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssleft in shift then
begin
FEndx := X;
FEndY := Y;
Paint;
end;
end;
procedure TForm2.FormPaint(Sender: TObject);
const
C_Alpha=0;
var
DestPoint, srcPoint:TPoint;
winSize:TSize;
DC : HDC;
blendfunc : BLENDFUNCTION;
Owner : HWnd;
curWinStyle:Integer;
exStyle:Dword;
BackImage:TBitMap;
Graphics : TGPGraphics;
Brush:TGPSolidBrush;
FontFamily : TGPFontFamily;
fmt:TGPStringFormat;
aFont : TGPFont;
Pen:TGPPen;
xx,yy:Integer;
begin
DC := GetDC(0);
BackImage:=TBitMap.Create;
BackImage.PixelFormat := pf32Bit;
BackImage.Width := Width;
BackImage.Height := Height;
BackImage.Canvas.Brush.Color := clBlack;
BackImage.Canvas.FillRect(Rect(0,0,Width,Height));
Graphics := TGPGraphics.Create(BackImage.Canvas.Handle);
graphics.SetSmoothingMode(SmoothingModeHighQuality);
graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
Brush:=TGPSolidBrush.Create(ColorToTGPColor(clRed,255));
FontFamily := TGPFontFamily.Create('Arial narrow');
aFont := TGPFont.Create(FontFamily,80);
fmt:=TGPStringFormat.Create;
try
Graphics.DrawString(FormatDateTime('hh:nn:ss',now),-1,aFont,MakePoint(0.0,0),Brush);
winSize.cx := width;
winSize.cy := Height;
srcPoint.x := 0;
srcPoint.y := 0;
DestPoint := BoundsRect.TopLeft;
exStyle := GetWindowLongA(handle, GWL_EXSTYLE);
if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(handle, GWL_EXSTYLE, (exStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT) );
With blendFunc do
begin
AlphaFormat := 1;
BlendFlags := 0;
BlendOp := AC_SRC_OVER;
SourceConstantAlpha := 255 - C_Alpha;
end;
UpdateLayeredWindow(Handle, DC, @DestPoint, @winSize, BackImage.Canvas.Handle, @srcPoint,clBlack, @blendFunc, 2);
finally
ReleaseDC(0, DC);
BackImage.Free;
Graphics.Free;
Brush.Free;
FontFamily.free;
aFont.Free;
fmt.Free;
end;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE );
DoubleBuffered := true;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
FormPaint(self);
end;
end. |
Narses
