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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
| unit CustomLayeredForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, PNGImage;
type
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array[0..0] of TRGBQuad;
TBackgroundForm = class(TForm)
private
Image :TBitmap;
Blend :TBlendFunction;
protected
procedure Refresh;
procedure WMWindowPosChanged(var Message :TMessage); message WM_WINDOWPOSCHANGED;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
procedure SetImage(const aImage :TBitmap);
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
end;
TLayeredForm = class(TForm)
private
BkForm :TBackgroundForm;
public
procedure LoadImageFromFile(aFileName :TFileName);
constructor Create(aOwner :TComponent); override;
end;
implementation
{$R *.dfm}
function LoadPngToBmp(const aFileName :TFileName) :TBitmap;
var
Png :TPngObject;
RGBA :PRGBQuadArray;
RGB :pRGBLine;
x :integer;
y :integer;
begin
//Création de l'objet PNG
Png := TPngObject.Create;
try
//Chargement du png
Png.LoadFromFile(aFileName);
//Création du bitmap résultant
Result := TBitmap.Create;
Result.PixelFormat := pf32bit;
Result.Width := Png.Width;
Result.Height := Png.Height;
//Copie Png dans Bitmap
for y := 0 to Result.Height -1 do
begin
RGBA := Result.Scanline[y];
RGB := Png.Scanline[y];
for x := 0 to Result.Width -1 do
begin
RGBA[x].rgbRed := RGB[x].rgbtRed;
RGBA[x].rgbGreen := RGB[x].rgbtGreen;
RGBA[x].rgbBlue := RGB[x].rgbtBlue;
RGBA[x].rgbReserved := Png.AlphaScanline[y][x];
end;
end;
finally
Png.Free;
end;
end;
{ TLayeredForm }
constructor TLayeredForm.Create(aOwner: TComponent);
begin
inherited;
//Fiche transparente
BorderStyle := bsNone;
TransparentColorValue := Color;
TransparentColor := TRUE;
//Fond
BkForm := TBackgroundForm.CreateNew(Self);
end;
procedure TLayeredForm.LoadImageFromFile(aFileName: TFileName);
begin
if not FileExists(aFileName) then
Raise Exception.Create(aFileName +#13'File not found');
BkForm.SetImage(LoadPngToBmp(aFileName));
BoundsRect := BkForm.BoundsRect;
BkForm.Visible := TRUE;
end;
{ TBackgroundForm }
constructor TBackgroundForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Image := nil;
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
with Blend do
begin
BlendOp := AC_SRC_OVER;
BlendFlags := 0;
SourceConstantAlpha := 255;
AlphaFormat := AC_SRC_ALPHA;
end;
Refresh;
end;
destructor TBackgroundForm.Destroy;
begin
Image.Free;
inherited;
end;
procedure TBackgroundForm.WMWindowPosChanged(var Message: TMessage);
begin
inherited;
if not (csDestroying in ComponentState) then
TForm(Owner).BoundsRect := BoundsRect;
end;
procedure TBackgroundForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
ReleaseCapture;
PostMessage(Handle, WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
end;
procedure TBackgroundForm.Refresh;
var
i :integer;
R1, R2 :hRgn;
begin
//Découpe les zones où doivent apparaître les Controls
R1 := CreateRectRgn(0, 0, Width, Height);
with TForm(Owner) do
for i := 0 to ControlCount -1 do
with Controls[i].BoundsRect do
begin
R2 := CreateRectRgn(Left, Top, Right, Bottom);
CombineRgn(R1, R1, R2, RGN_XOR);
DeleteObject(R2);
end;
SetWindowRgn(handle, R1, TRUE);
DeleteObject(R1);
end;
procedure TBackgroundForm.SetImage(const aImage: TBitmap);
const
BmpTopLeft : TPoint = (x:0; y:0);
var
Size :TPoint;
begin
FreeAndNil(Image);
Image := aImage;
Width := Image.Width;
Height := Image.Height;
Size.X := Height;
Size.Y := Height;
UpdateLayeredWindow(Handle, 0, nil, @Size, Image.Canvas.handle, @BmpTopLeft, 0, @Blend, ULW_ALPHA);
end;
initialization
// ReportMemoryLeaksOnShutDown := TRUE;
end. |
Répondre avec citation
, on imagine des objets placés en dehors de l'image (Tbutton, Tlabel ect...) mais sur la forme et le résultat est surprenant on a l'impression que ces objets sont dans le vide. 
bon courage
Partager