Renseignements sur SkinCrafter

**ouiouioui** · 14/09/2010, 11h18

je n'ai pas Alphacontrols, vous avez mal lu.

pour avoir une form découpé moi j'utilise la transparence sa prend 2min pour la form. Mais il faut mettre des boutons png pour un jolie rendu, et utiliser un compo de skin pour les autres éléments, mais sa prend du temps à faire

**cincap** · 14/09/2010, 11h47

@ ouiouioui, je ne sais pas tester ton application, manque d'unité certainement.

@+,

Cincap

**cincap** · 14/09/2010, 12h07

Sinon avec un Bmp sur fond fuschia, l'imagination est prioritaire quand à la forme qui doit s'afficher, j'ai testé avec un simple texte et une signature, le rendu est superbe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
procedure former(Obj:tform;img:tbitmap;couleur:tcolor);
var
x, y, reg, regtemp, debut, fin:integer;
EtaitTrans, first:boolean;
begin
obj.height:=img.height;                         //on adapte les
obj.width:=img.width;                           //dimensions de la fiche
first:=true;                                    //c'est pour savoir si on a deja créé une région : voir CombineRgn (nécessite une region non vide)
for y:=1 to img.height do begin
  debut:=1;                                     //debut=debut de la zone non- transparente
  fin:=1;                                       //fin =fin  de la zone non- transparente
  EtaitTrans:=true;                             //EtaitTrans, c'est pour savoir si le pixel examiné précédemment était transparent ou pas
  for x:=1 to img.width do begin
    if img.Canvas.Pixels[x,y]=couleur then begin//si le pixel est transparent
      if EtaitTrans=false then begin            //et que le précédent ne l'etait pas
        fin:=x-1;                               //le dernier pixel non transparent etait le precedent
        if first=true then begin                //si c'est la 1°region qu'on crée:
          reg:=CreateRectRgn(debut,y,fin+1,y+1);//on la crée
          first:=false;                         //la prochaine ne sera plus la premiere
        end else begin                          //si c'est pas la premiere region
          regtemp:=createrectrgn(debut,y,fin+1,y+1);//on en crée une temporaire
          CombineRgn(reg, reg, regtemp, rgn_or);//on l'ajoute à reg qui sera la region finale avec rgn_or (voir autres possibilités dans l'aide)
          deleteobject(regtemp);                //on supprime la region temporaire
        end;
      end;
      EtaitTrans:=true;
    end else begin                              //le pixel n'est pas transparent
      if EtaitTrans=true then debut:=x;         //ben oui rien que ca
      EtaitTrans:=false;
      if x=img.width-1 then                     //on arrive au dernier point de la ligne
      if first=true then begin                  //si c'est la 1°region qu'on crée:
        reg:=CreateRectRgn(debut,y,x,y+1);      //on la crée
        first:=false;                           //la prochaine ne sera plus la premiere
      end else begin                            //si c'est pas la premiere region
        regtemp:=createrectrgn(debut,y,x,y+1);  //on en crée une temporaire
        CombineRgn(reg, reg, regtemp, rgn_or);  //on l'ajoute à reg qui sera la region finale avec rgn_or (voir autres possibilités dans l'aide)
        deleteobject(regtemp);                  //on supprime la region temporaire pour rester propres (si on ne le fait pas, ca se fait autom. qd on ferme l'application)
      end;
    end;
  end;
end;
 
SetWindowRgn(Obj.handle, reg,true);             //on applique la region finale !
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
//Appelle la fonction pour découper Form1 en fonction de l'image de Image1
//ca rend la couleur clfuchsia transparente
Former(Form1,Image1.Picture.Bitmap,clfuchsia);
 
 
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
//Fermer
Close;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Pour déplacer la form sans la barre du titre
ReleaseCapture;
form1.Perform(WM_SYSCOMMAND, $F012, 0);
end;
 
end.

Petite question, comment joindre une photo ou un zip d'exemple aux messages ?

@+,

Cincap

**Droïde Système7** · 14/09/2010, 18h32

Envoyé par Andnotor

Bon, Bon, un petit exemple rapide !
Je ne fais rien de plus qu'implémenter les points énumérés dans le post précédent

J'utilise le fond utilisé dans le défi. A vous de définir correctement la constante PNGFileName. La taille de la fiche est adaptée à celle de l'image.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, PNGImage;
 
type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..0] of TRGBQuad;
 
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Bitmap :TBitmap;
    Blend  :TBlendFunction;
    Size   :TPoint;
  public
  end;
 
var
  Form1: TForm1;
 
const
  PNGFileName = 'Z:\Sudoku\Images\Background.png';
 
implementation
 
{$R *.dfm}
 
function CreateBmp32(const aWidth, aHeight :integer) :TBitmap;
begin
  //Création du bitmap résultant
  Result := TBitmap.Create;
 
  //Initialisation
  with Result do
  begin
    PixelFormat := pf32bit;
    Width       := aWidth;
    Height      := aHeight;
 
    //Reset (Sans cette ligne, le rendu est opaque)
    ZeroMemory(Scanline[Height -1], Width *Height *SizeOf(TRGBQuad));
  end;
end;
 
function LoadPngToBmp(const aFileName :TFileName) :TBitmap;
var
  Png  :TPngObject;
  RGBA :PRGBQuadArray;
  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
    with Png do
      Result := CreateBmp32(Width, Height);
 
    with Result do
    begin
      //Dessine le PNG sur le bitmap. Ne fonctionne qu'en 24 bits !!!
      Canvas.Draw(0, 0, Png);
 
      //Copie de la couche alpha
      for y := 0 to Height -1 do
      begin
        RGBA := Scanline[y];
 
        for x := 0 to Width -1 do
          RGBA[x].rgbReserved := Png.AlphaScanline[y][x];
      end;
    end;
 
  finally
    Png.Free;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
const
  BmpTopLeft : TPoint = (x:0; y:0);
 
begin
  //Fiche en mode layered
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
 
  //Initialisation du rendu
  with Blend do
  begin
    BlendOp             := AC_SRC_OVER;
    BlendFlags          := 0;
    SourceConstantAlpha := 255;
    AlphaFormat         := AC_SRC_ALPHA;
  end;
 
  //Charge l'image png
  Bitmap := LoadPngToBmp(PNGFileName);
 
  //Taille de la fiche à la taille de l'image
  Width  := Bitmap.Width;
  Height := Bitmap.Height;
  Size.X := Width;
  Size.Y := Height;
 
  //Mise à jour de l'affichage
  UpdateLayeredWindow(Handle, 0, nil, @Size, Bitmap.Canvas.handle, @BmpTopLeft, 0, @Blend, ULW_ALPHA);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bitmap.Free;
end;
 
end.

A noter que le contrôles (TLabel, TEdit, etc.) n'apparaissent pas si on en pose sur la fiche. Il faudrait sans doute surcharger leurs fonctions de dessins pour qu'elles soient redirigées sur le bitmap (class helper ?). Mais je ne me suis jamais penché sur le sujet

Il est cependant possible d'utiliser une deuxième fiche transparente et de la faire apparaître par dessus celle-ci.

Je viens de réaliser un copier/coller de ce code (sauf rectif du chemin du PNG et rectif de la taille de la form comme PNG).

Et rien de spécial, je dois avoir loupé une marche, ou bien un paramètre sur Form1 à ajouter, ou en source.

Qui a essayé ce code fort intéressant ?

@+

**ero-sennin** · 14/09/2010, 22h25

Hello Droïde !

Je viens d'essayer le code (super code Andnotor ... c'est pour en rajouter une tite louche

).
Ton png, il a quelle forme ? Moi j'ai essayé un truc tout con, c'est de "rogner" (comprendre gommer) les bords de mon image avec Gimp et j'ai enregistré le tout. Hé bien, lorsque je lance mon application, j'ai bien mes coins arrondis

Bon, par contre, faut gérer les redimensionnement à la mano ? Je dirai oui car lorsque je chope un coté de la form, et que je la redimensionne, ça tronque mon image... Faut donc tout gérer soit-même.

En tout cas, je rejoins les autres pour dire que l'utilisation de cette méthode pour créer des sortes de "skins", c'est pas mal. Par contre, si on veux ajouter des contrôles supplémentaires, je n'ai pas essayé la méthode d'Andnotor. Ca risque d'être contraignant si on peut ne pas gérer de façon simple les autres contrôles, non ?

**Andnotor** · 14/09/2010, 22h56

Bon, la logique serait que la fiche ne soit pas redimensionnable (BorderStyle = bsNone). Sinon, il faudrait bien sûr retailler l'image

Un 2ème point est que le dessin est positionné en 0,0 de la fiche et non de la zone cliente. (BmpTopLeft = 0,0). Avec une barre de titre, il faut tenir compte de sa hauteur.

Des contrôles, on peut en mettre, ils sont parfaitement opérationnels, mais... invisibles

Non sans rire, on doit pouvoir faire quelque chose. Par exemple les TControl peuvent être ajoutés au bitmap par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

PaintControls(Bitmap.Canvas.handle, nil);

Il faut cependant prendre soin de retoucher la couche alpha puisque toutes les fonctions de dessin ne fonctionnent qu'en 24 bits

Le dérivés de TWinControl sont plus compliqués. On arrive avec PaintTo à avoir certains résultats. Il faudrait encore gérer le texte et le caret...

Une autre approche plus globale serait de redéfinir Repaint pour y fournir le DC du bitmap.

Et comme dans le défi, si on veut une certaine dynamique, il faudra avoir une image de base qui nous serve à effacer certaines zones par recopie. (nouvelle gestion de WM_ERASEBKGND)

Bref, l'édition n'est pas si simple en mode layered. J'essayerai de me pencher dessus si j'ai un peu (beaucoup) de temps.

**cincap** · 15/09/2010, 07h04

Bonjour à toutes et à tous,

@ Droïde Système7, avec le code du défi, hier à 9H19 j'avais confirmé que sous Seven 64bits, la fiche apparaissait rectangulaire avec les 3 boutons et ce n'est qu'après le rappel depuis la barre de tache que la découpe se faisait.

Edit : après avoir lu le message de AndNotOr sur la propriété de la fiche (BorderStyle = bsNone).

Cela fonctionne correctement.

@+,

Cincap

**Droïde Système7** · 15/09/2010, 11h07

@ cincap :
J'ai essayé ton code itou, mais ça fonctionnait pôô.
Pour la circonstance, j'ai pris le PNG à Andnotor, que j'ai converti en BMP.

Mais j'avais oublié de gérer la fameuse propriété TransparentColor de Form1.

An lancé, le rendu est effectivement superbe !

En plus les compos dessus restent visibles eux

@ Droïde Système7, avec le code du défi, hier à 9H19 j'avais confirmé que sous Seven 64bits, la fiche apparaissait rectangulaire avec les 3 boutons et ce n'est qu'après le rappel depuis la barre de tache que la découpe se faisait.

Edit : après avoir lu le message de AndNotOr sur la propriété de la fiche (BorderStyle = bsNone).

Cela fonctionne correctement.

J'ai modifié cette propriété, malgré tout ça change rien. Mais j'ai certainement inclus une étourderie de ma part

@ ero-sennin :

Je viens d'essayer le code (super code Andnotor ... c'est pour en rajouter une tite louche ).
Ton png, il a quelle forme ?

Je n'avais fait que de reprendre bêtement le PNG travaillé par Andnotor.

Mais cette méthode est très efficace, un peu complexe pour moi. En plus toutes les complications avec les compos invisibles, même si son idée de placer une fiche transparente au dessus avec les compos, est très bonne.

Merci à tous, je tag ce thread en résolu, car j'ai trouvé mon bonheur (en particulier le code donné par Cincap) et appris des tas de choses, même d'autres ensuite en décortiquant.

Sans oublier un grand bravo à Andnotor

@+

**Mstreatboy** · 15/09/2010, 11h38

J'utilise alpha aussi depuis 2 ans. C'est l'un des meilleurs composants vcl. Il est superCool. Et j'ai jamais rencontré de problème par rapport aux versions de window avec.Que du bonheur!

Je vais néammoins tester le SkinCrafter voir ce que sa donne

**cincap** · 15/09/2010, 12h09

@ Droïde Système7,

Mais j'avais oublié de gérer la fameuse propriété TransparentColor de Form1.

tu pouvais aussi changer la couleur dans l'appel de la procedure "Former"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
procedure TForm1.FormCreate(Sender: TObject);
begin
//Appelle la procédure pour découper Form1 en fonction de l'image de Image1
//ca rend la couleur clfuchsia transparente
Former(Form1,Image1.Picture.Bitmap,clwhite); //clfuchsia

end;

@+,

Cincap

**Andnotor** · 15/09/2010, 13h44

Si ça vous convient, tant mieux

Mais travailler avec des régions est juste une façon différente d'appliquer une TransparentColor (qui est un mode Layered à couleur unique); ça reste du tout-ou-rien ! Il n'y a aucun lissage, aucune possibilité d'ajouter un ombré à la fiche. etc.
L'implémentation de TranparentColor se résume à ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
procedure TForm1.FormCreate(Sender: TObject);
begin
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
  SetLayeredWindowAttributes(Handle, ColorToRGB(clFuchsia), 0, LWA_COLORKEY);
end;

**cincap** · 15/09/2010, 14h44

@ Tous,

Après plusieurs essais et en reprenant l'image du copain AndNotor, voici l'application qui permet de gérer des Tbutton, Tlabel etc et en plus avec effet de fading d'ouverture de la fiche et de fermeture, gère aussi le 32bits.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
 
Unit Unit1;
 
Interface
 
Uses Windows, Messages, SysUtils, Classes, Graphics, Controls,
     Forms, Dialogs, ExtCtrls, StdCtrls, Math, PNGImage, HSLUtils;
 
Type
  TForm1 = Class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure FormMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    Procedure Button1Click(Sender: TObject);
  End;
 
Var
  Form1: TForm1;
 
 
IMPLEMENTATION
 
{$R *.DFM}
 
Var PNGForm: TForm;
    BmpForm: TBitmap;
 
 
{----------------------------------------------------------------}
{ Fusionne les controls et l'arrière-plan                        }
{----------------------------------------------------------------}
Procedure FusionForm(Var FusBitmap: TBitmap);
Var TmpBitmap: TBitmap;
    pd, pa: pByteArray;
    tcol: TRGB;
    i, j: Integer;
Begin
  TmpBitmap := TBitmap.Create;
  TmpBitmap.Width := Form1.Width;
  TmpBitmap.Height := Form1.Height;
  TmpBitmap.PixelFormat := pf24bit;
  TmpBitmap.Canvas.CopyRect(TmpBitmap.Canvas.ClipRect, Form1.Canvas, Form1.Canvas.ClipRect);
  FusBitmap := Nil;
  FusBitmap := TBitmap.Create;
  FusBitmap.Assign(BmpForm);
  FusBitmap.PixelFormat := pf32bit;
  tcol := GetRGB(Form1.TransparentColorValue);
  For j := 0 To BmpForm.Height - 1 Do Begin
    pd := FusBitmap.ScanLine[j];
    pa := TmpBitmap.ScanLine[j];
    For i := 0 To FusBitmap.Width - 1 Do Begin
      If (pa[i * 3 + 2] <> tcol.R) Or
         (pa[i * 3 + 1] <> tcol.G) Or
         (pa[i * 3 + 0] <> tcol.B) Then Begin
        pd[i * 4 + 0] := pa[i * 3 + 0];
        pd[i * 4 + 1] := pa[i * 3 + 1];
        pd[i * 4 + 2] := pa[i * 3 + 2];
        pd[i * 4 + 3] := $FF;
      End;
    End;
  End;
  TmpBitmap := Nil;
End;
 
 
{----------------------------------------------------------------}
{ Function pour obtenir l'image 32bits à la place d'une form     }
{----------------------------------------------------------------}
Function UpdateLayeredWindow(hwnd: HWND; hdcDst: HDC; pptDst: PPoint;
  psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: TColor;
  pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall; external 'user32.dll';
 
 
{----------------------------------------------------------------}
{ Procédure appellant la fonction UpdateLayeredWindow            }
{----------------------------------------------------------------}
Procedure UpDateForm(Form: TForm; Bmp: TBitmap; Opacite: Byte = $FF);
Const WS_EX_LAYERED = $80000;
Var Size: PSIZE;
    TopLeft, BmpTopLeft: TPoint;
    Blend: TBlendFunction;
Begin
  With Form Do Begin
    SetWindowLong(Handle, GWL_EXSTYLE,
      GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
    New(Size);
    Size.cx := Width;
    Size.cy := Height;
    TopLeft := BoundsRect.TopLeft;
    BmpTopLeft := Point(0, 0);
    With Blend Do Begin
      BlendOp := 0;
      BlendFlags := 0;
      SourceConstantAlpha := Opacite;
      AlphaFormat := 1;
    End;
    Bmp.PixelFormat := pf32bit;
    UpdateLayeredWindow(Handle, GetDC(0), @TopLeft, Size,
      Bmp.Canvas.handle, @BmpTopLeft, 0, @Blend, 2);
  End;
End;
 
 
{----------------------------------------------------------------}
{ Fade Out du programme                                          }
{----------------------------------------------------------------}
Procedure FadeOutForm(Delay: Integer = 800);
Const Division = 40;
Var x: Integer;
    opacite: Byte;
    FusBitmap: TBitmap;
Begin
  Form1.BringToFront;
  FusionForm(FusBitmap);
  UpDateForm(PNGForm, Fusbitmap);
  Form1.Hide;
  For x := 1 To Division Do Begin
    opacite := Abs($FF - Round(Max(Min($FF / Division * x, $FF), 0)));
    UpDateForm(PNGForm, Fusbitmap, opacite);
    Sleep(Delay Div Division);
  End;
  UpDateForm(PNGForm, BmpForm, 0);
End;
 
 
{----------------------------------------------------------------}
{ Fade In du programme                                           }
{----------------------------------------------------------------}
Procedure FadeInForm(Delay: Integer = 800);
Const Division = 20;
Var x: Integer;
    opacite: Byte;
    FusBitmap: TBitmap;
Begin
  Form1.AlphaBlend := True;
  Form1.AlphaBlendValue := 0;
  PNGForm.Show;
  Form1.Show;
  Application.ProcessMessages;
  FusionForm(FusBitmap);
  UpDateForm(PNGForm, Fusbitmap, 0);
  Form1.Hide;
  Form1.AlphaBlend := False;
  Application.ProcessMessages;
  For x := 1 To Division Do Begin
    opacite := Round(Max(Min($FF / Division * x, $FF), 0));
    UpDateForm(PNGForm, Fusbitmap, opacite);
    Sleep(Delay Div Division);
  End;
  Form1.Show;
  UpDateForm(PNGForm, BmpForm);
End;
 
 
{----------------------------------------------------------------}
{ Chargement d'une image PNG dans un TBitmap 32bits              }
{----------------------------------------------------------------}
Function MyLoadPNG(fn: String; Var FinalBitmap: TBitmap): Boolean;
Var PNG: TPNGObject;
    AlphaBitmap: TBitmap;
    pd, pa: pByteArray;
    i, j, a: Integer;
Begin
  Result := False;
  FinalBitmap := Nil;
  FinalBitmap := TBitmap.Create;
  If (FileExists(fn) = False) Then Begin
    ShowMessage('Image ' + ExtractFilename(fn) + ' introuvable.');
    Exit;
  End;
  PNG := TPNGObject.Create;
  Try PNG.LoadFromFile(fn);
  Except
    ShowMessage('Erreur format PNG (' + ExtractFilename(fn) + ')');
    PNG := Nil;
    Exit;
  End;
  AlphaBitmap := TBitmap.Create;
  AlphaBitmap.Height := PNG.Height;
  AlphaBitmap.Width := PNG.Width;
  AlphaBitmap.PixelFormat := pf24bit;
  FinalBitmap.Assign(PNG);
  FinalBitmap.PixelFormat := pf32bit;
  If (Png.Transparent) Then Begin
    For i := 0 To PNG.Height - 1 Do
      For j := 0 To PNG.Width - 1 Do
        If (PNG.AlphaScanline[i][j] >= 240) Then
          AlphaBitmap.Canvas.Pixels[j, i] := $FFFFFF Else
          AlphaBitmap.Canvas.Pixels[j, i] := HSLRangeToRGB(0, 0, PNG.AlphaScanline[i][j]);
  End Else Begin
    AlphaBitmap.Canvas.Brush.Style := bsSolid;
    AlphaBitmap.Canvas.Brush.Color := $FFFFFF;
    AlphaBitmap.Canvas.FillRect(AlphaBitmap.Canvas.ClipRect);
  End;
  For j := 0 To PNG.Height - 1 Do Begin
    pd := FinalBitmap.ScanLine[j];
    pa := AlphaBitmap.ScanLine[j];
    For i := 0 To PNG.Width - 1 Do Begin
      a := pa[i * 3];
      If (a < 240) Then Begin
        pd[i * 4 + 0] := Round(Max(Min(pd[i * 4 + 0] * a / $FF, $FF), 0));
        pd[i * 4 + 1] := Round(Max(Min(pd[i * 4 + 1] * a / $FF, $FF), 0));
        pd[i * 4 + 2] := Round(Max(Min(pd[i * 4 + 2] * a / $FF, $FF), 0));
      End;
      pd[i * 4 + 3] := a;
    End;
  End;
  AlphaBitmap := Nil;
  PNG := Nil;
  Result := True;
End;
 
 
{----------------------------------------------------------------}
{ Dessin d'un TBitmap 32bits sur un autre (fusion)               }
{----------------------------------------------------------------}
Procedure MyDrawPNG(X, Y: Integer; AlphaBitmap, FinalBitmap: TBitmap);
Var pd, pa: pByteArray;
    i, ix, j, a, b, ad: Integer;
Begin
  If (Assigned(AlphaBitmap) = False) Then Exit;
  If (Assigned(FinalBitmap) = False) Then Exit;
  FinalBitmap.PixelFormat := pf32bit;
  For j := 0 To AlphaBitmap.Height - 1 Do
    If (j + Y <= FinalBitmap.Height - 1) And (j + Y >= 0) Then Begin
      pd := FinalBitmap.ScanLine[j + Y];
      pa := AlphaBitmap.ScanLine[j];
      For i := 0 To AlphaBitmap.Width - 1 Do Begin
        a := pa[i * 4 + 3];
        b := Abs($FF - a);
        ix := Max(Min(i + X, FinalBitmap.Width - 1), 0);
        ad := pd[ix * 4 + 3];
        If (a >= 240) Then Begin
          pd[ix * 4 + 0] := pa[i * 4 + 0];
          pd[ix * 4 + 1] := pa[i * 4 + 1];
          pd[ix * 4 + 2] := pa[i * 4 + 2];
          pd[ix * 4 + 3] := $FF;
        End Else If (a >= 0) Then Begin
          If (ad < 240) Then
            b := Round(Max(Min(a + (ad * b) / $FF, $FF), 0));;
          pd[ix * 4 + 0] := Round(Max(Min(
            pa[i * 4 + 0] + b * pd[ix * 4 + 0] / $FF, $FF), 0));
          pd[ix * 4 + 1] := Round(Max(Min(
            pa[i * 4 + 1] + b * pd[ix * 4 + 1] / $FF, $FF), 0));
          pd[ix * 4 + 2] := Round(Max(Min(
            pa[i * 4 + 2] + b * pd[ix * 4 + 2] / $FF, $FF), 0));
          If (ad < 240) Then pd[ix * 4 + 3] := b;
        End;
      End;
    End;
End;
 
 
{----------------------------------------------------------------}
{ Création & initialisation des forms                            }
{----------------------------------------------------------------}
Procedure TForm1.FormCreate(Sender: TObject);
Var bmp: TBitmap;
Begin
  DoubleBuffered := True;
  Color := clFuchsia;
  TransparentColorValue := Color;
  BorderStyle := bsNone;
 
  // Chargement de l'image PNG pour l'arrière-plan, celle de AndNotOr
  If (MyLoadPNG('background.png', BmpForm)) Then Begin
    Width := BmpForm.Width;
    Height := BmpForm.Height;
  End;
 
  // Création de la form d'arrière-plan //
  PNGForm := TForm.Create(self);
  With PNGForm Do Begin
    Parent := Form1.Parent;
    Name := 'PNGForm';
    Caption := Form1.Caption;
    FormStyle := Form1.FormStyle;
    BorderStyle := Form1.BorderStyle;
    BorderIcons := [];
    Position := Form1.Position;
    Left := Form1.Left;
    Top := Form1.Top;
    Width := Form1.Width;
    Height := Form1.Height;
    OnMouseDown := FormMouseDown;
    DoubleBuffered := True;
    Visible := False;
  End;
 
  // Exemple d'ajoût d'image PNG //
  MyLoadPNG('6c.png', bmp); //Petit logo de hommer
  MyDrawPNG(0, 28, bmp, BmpForm);
  bmp := Nil;
 
  // Fusion de l'image finale sur la form & FadIn //
  UpDateForm(PNGForm, BmpForm, 0);
  FadeInForm;
End;
 
{----------------------------------------------------------------}
{ Finalisation du programme                                      }
{----------------------------------------------------------------}
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
  BmpForm := Nil;
End;
 
{----------------------------------------------------------------}
{ Déplacement de la fenêtre (image et controls fusionnés)        }
{----------------------------------------------------------------}
Procedure TForm1.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var FusBitmap: TBitmap;
Begin
  Form1.BringToFront;
  If (Button <> mbLeft) Then Exit;
 
  // Fusionne les controls et l'arrière-plan //
  FusionForm(FusBitmap);
 
  // Applique la nouvelle image et cache les controls //
  UpDateForm(PNGForm, FusBitmap);
  Form1.Hide;
  PNGForm.Show;
  FusBitmap := Nil;
 
  // Boucle de déplacement de la form  //
  Screen.Cursor := crSizeAll;
  X := PNGForm.Left - PNGForm.ScreenToClient(Mouse.CursorPos).X;
  Y := PNGForm.Top - PNGForm.ScreenToClient(Mouse.CursorPos).Y;
  Repeat
    PNGForm.Left := X + ScreenToClient(Mouse.CursorPos).X;
    PNGForm.Top := Y + ScreenToClient(Mouse.CursorPos).Y;
    Application.ProcessMessages;
    Sleep(10);
  Until ((GetAsyncKeyState(VK_LBUTTON) And $8000) = 0);
  Form1.Left := PNGForm.Left;
  Form1.Top := PNGForm.Top;
  Screen.Cursor := crDefault;
 
  // Restaure l'arrière-plan original et réaffiche les controls //
  Form1.Show;
  UpDateForm(PNGForm, BmpForm);
End;
 
 
{----------------------------------------------------------------}
{ Exemple d'objet actif -> Bouton EXIT                           }
{----------------------------------------------------------------}
Procedure TForm1.Button1Click(Sender: TObject);
Begin
  FadeOutForm;
  Application.Terminate;
End;
 
 
{----------------------------------------------------------------}
End.

@+,

Cincap

**Droïde Système7** · 15/09/2010, 14h49

@ cincap :

tu pouvais aussi changer la couleur dans l'appel de la procedure "Former"

Bien joué

.
.
.
@ Andnotor :

[...] Il n'y a aucun lissage, aucune possibilité d'ajouter un ombré à la fiche

Bahhhh une ombre ? si si

suffit de la créer en même temps que le background.

@+

Edit : après avoir posté, je découvre l'autre message de Cincap : whaouuuu non n'en rajoute pôô, j'étais content d'avoir trouvé ma solution

Mais c'est super dis-donc !

**Andnotor** · 15/09/2010, 15h23

Envoyé par Droïde Système7

Bahhhh une ombre ? si si

suffit de la créer en même temps que le background.

Et dans ton masque, quelle couleur choisiras-tu ? Fuschia avec une touche de gris, ben c'est plus du fuschia

Tu auras simplement à l'écran un joli dégradé de fushia/gris-foncé à fushia/gris-clair...

**Droïde Système7** · 15/09/2010, 16h34

En fait je peux ajouter une ombre, mais sous 2 ou trois pixels, ça ressemble plutôt à un trait grisé.

Ou bien faut que je passe déjà une première ombre/trait de 1 pixel, ensuite un autre trait un peu moins soutenu (en s'éloignant de la form), et ainsi de suite.

Me décourage pas

**ouiouioui** · 16/09/2010, 18h17

la soluce de cincap est super pour une image ombré j'avais abandonné, j'ai mis à jour mon splash screen avec son exemple sa rend mieux, je joint son exemple,

quand on clique dans la barre des tache sa bug, je laisse les bon régler sa moi j'ai mis MainFormOnTaskbar à false

impossible de faire un imprime écran de la form

intéressant ce thread

**Droïde Système7** · 16/09/2010, 18h58

Envoyé par ouiouioui

intéressant ce thread

Pour cela il existe une option en ces forums :
En haut de ce thread > "Noter la discussion" > "..."

En attendant ça me bloque sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.MainFormOnTaskbar := True;

D7 ?

**cincap** · 16/09/2010, 19h32

Bonsoir à toutes et à tous,

@ Tous, il faut enlever cette ligne "Application.MainFormOnTaskbar := True;":

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
program Project1;
 
uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  HSLUtils in 'HSLUtils.pas';
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Sinon, cela fonctionne correctement, je viens de tester le projet de ouiouioui sous Seven 64 bits et D6, cela fonctionne correctement.

La seule chôse qu'il ne faut pas oublier c'est la couleur du fond du Png !

Edit : pour le print écran, touche Alt + touche Prtsc = imprime la fenêtre active et non tout l'écran.

@+,

Cincap