New composant: Treeview gérant l'alphablending

**Gaadek** · 22/02/2006, 12h03

Salut à tous!

Pour des besoins perso, j'ai développé un TreeView permettant la gestion de l'alphablending (effet de transparence avec + ou - d'opacité)

Le compo est en plein développement, et j'aurais besoin d'aide pour l'optimiser. Il va sans dire que ce composant est full open-source!!!

Tout d'abord, voici le code du composant (D6 edition perso):

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
unit AlphaTreeView;
 
interface
 
uses
  Windows, Forms, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, ComCtrls, StdCtrls;
 
type
  THoundred=0..100;
 
  TAlphaTreeView = class(TTreeView)
  private
    FParentForm:TForm;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: THoundred;
    FDoubleBuffer: TBitmap;
    FOnCustomDraw:TNotifyEvent;
    FOnCustomDrawItem:TNotifyEvent;
    FOnCollapsed:TNotifyEvent;
    FOnExpanded:TNotifyEvent;
    function GetParentForm(Child:TComponent):TForm;
    function CopyControlsImage(Parent:TForm):TBitmap;
    function Alpha(pixcolor,tmpcolor:Byte):Byte;
    //function Test(i:integer):integer;
    procedure CreateDoubleBuffer;
    procedure CustomPaint;
  protected
    procedure Paint;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure RefreshData;
    procedure SetAlphaBlend(IsAlphaBlend: Boolean);
    procedure CustDrawButton(ARect: TRect; Node: TTreeNode);
    procedure CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
    procedure CustRefresh(Sender: TObject; Node: TTreeNode);
  published
    property AlphaBlend:Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue:THoundred read FAlphaBlendValue write FAlphaBlendValue;
    property OnCustomDraw : TNotifyEvent read FOnCustomDraw write FOnCustomDraw;
    property OnCustomDrawItem : TNotifyEvent read FOnCustomDrawItem write FOnCustomDrawItem;
    property OnCollapsed : TNotifyEvent read FOnCollapsed write FOnCollapsed;
    property OnExpanded : TNotifyEvent read FOnExpanded write FOnExpanded;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('AlphaComponents', [TAlphaTreeView]);
end;
 
{ TAlphaTreeView }
 
// Méthode invoquée à la création du composant
constructor TAlphaTreeView.Create(AOwner: TComponent);
begin
  inherited;
  FOnCustomDraw:=nil;
  FOnCustomDrawItem:=nil;
  FOnCollapsed:=nil;
  FOnExpanded:=nil;
 
  // Les 4 lignes suivantes permettent d'appeler des méthodes déclanchées par des événements
  Inherited OnCustomDraw:=CustDraw;
  Inherited OnCustomDrawItem:=CustDrawItem;
  Inherited OnCollapsed:=CustRefresh;
  Inherited OnExpanded:=CustRefresh;
 
  // Initialise les options du controle
  FAlphaBlend:=False;
  FAlphaBlendValue:=0;
 
  // Créer un buffer graphique
  FDoubleBuffer:=TBitmap.Create;
  RefreshData;
  Repaint;
end;
 
// Méthode invoquée à la destruction du composant
destructor TAlphaTreeView.Destroy;
begin
  FreeAndNil(FDoubleBuffer);
  inherited;
end;
 
// Procédure qui charge le buffer graphique
procedure TAlphaTreeView.CreateDoubleBuffer;
begin
  FDoubleBuffer.Width:=FParentForm.Width;
  FDoubleBuffer.Height:=FParentForm.Height;
  FDoubleBuffer:=CopyControlsImage(FParentForm);
end;
 
// Procédure qui permet de mettre à jour certaines donnée (buffer...)
procedure TAlphaTreeView.RefreshData;
begin
  FParentForm:=GetParentForm(Self);
  CreateDoubleBuffer;
end;
 
// Fonction qui calcule la valeur RGB 'alphablendée' à appliquer à un pixel
function TAlphaTreeView.Alpha(pixcolor,tmpcolor : Byte) : Byte;
begin
  result := (pixcolor * AlphaBlendValue + (100 - AlphaBlendValue) * tmpcolor) div 100;
end;
 
// Fonction qui récupère dans un canvas (TBitmap) tous les controles de type TImage de la form
function TAlphaTreeView.CopyControlsImage(Parent: TForm): TBitmap;
var I:Word;
    ChildImage:TImage;
begin
  Result:=TBitmap.Create;
  Result.Height:=Parent.ClientHeight;
  Result.Width:=Parent.ClientWidth;
  Result.Canvas.Brush.Color:=Parent.Color;
  Result.Canvas.FillRect(Parent.ClientRect);
 
 // recherche tous les contrôles de type TImage qui sont dans la form
  for I:=0 to Parent.ComponentCount-1 do
  begin
    if (Parent.Components[I] is TImage) then
    begin
      // Copie le canva du TImage dans le canvas du bitmap retourné par la fontion
      ChildImage:=(Parent.Components[I] as TImage);
      Result.Canvas.Draw(ChildImage.Left,ChildImage.Top,ChildImage.Picture.Graphic);
    end;
  end;
end;
 
// Fonction qui permet de récupérer la form du control AlphaTreeview
function TAlphaTreeView.GetParentForm(Child: TComponent): TForm;
begin
  if Child.Owner is TForm then Result:=Child.Owner as TForm
  else Result:=GetParentForm(Child.Owner) as TForm;
end;
 
// Procédure perso pour désinner AlphaTreeView
procedure TAlphaTreeView.CustomPaint;
var  img:TBitmap;
     X,Y: integer;
     pixcol : tcolor;
begin
  // Si la propriété AlphaBlend du controle est vraie
  if (FAlphaBlend) then
  begin
    // Récupère le canvas de la form (juste avec les TImages)
    img:=CopyControlsImage(FParentForm);
 
    if (BorderStyle=bsSingle) then
      BitBlt(Canvas.Handle, 0, 0, Width, Height,img.Canvas.Handle, left+2, top+2, SrcCopy)
    else
      BitBlt(Canvas.Handle, 0, 0, Width, Height,img.Canvas.Handle, left, top, SrcCopy);
 
    img.free;
 
    // Effectue un parcours complet des pixels du canvas d'AlphaTreeView pour appliquer
    // un effet d'AlphaBlending
    for Y := 0 to Height - 1 do
    begin
      for X := 0 to Width - 1 do
      begin
        pixcol := Canvas.Pixels[X,Y];
        Canvas.Pixels[X,Y] := RGB(
          alpha(byte(pixcol),byte(color)),
          alpha(byte(pixcol shr 8),byte(color shr 8)),
          alpha(byte(pixcol shr 16),byte(color shr 16)));
      end;
    end;
  end;
end;
 
// Procédure pour utiliser le double buffer (non utilisé pour le moment)
procedure TAlphaTreeView.Paint;
begin
if (not FAlphaBlend) or (csDesigning in ComponentState) then
  inherited
else
  begin
    CreateDoubleBuffer;
    CustomPaint;
  end;
end;
 
// Procédure utilisée pour dessiner le contrôle
procedure TAlphaTreeView.CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
begin
  CustomPaint;
end;
 
 
procedure TAlphaTreeView.SetAlphaBlend(IsAlphaBlend: Boolean);
begin
if FAlphaBlend<>IsAlphaBlend then
  begin
    FAlphaBlend:=IsAlphaBlend;
    Invalidate;
  end;
end;
 
 
// Procédure pour dessiner les lignes/boutons de AlphaTreeView
procedure TAlphaTreeView.CustDrawButton(ARect: TRect; Node: TTreeNode);
var
  cx, cy, cx2, cy2 : Integer;
begin
//  cx := ARect.Left + Indent div 2;
//  cy := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
  // cx,cy représente le coin supérieur gauche
  cx := ARect.Left;
  cy := ARect.Top;
 
  with Canvas do
  begin
    Pen.Color := clGray;
 
    // Tout d'abord, si le noeud à des enfants, on dessine un bouton pour étendre/réduire
    if Node.HasChildren then
    begin
      // Dessine le cadre du bouton d'extension/réduction
      cx2:=cx+5;
      cy2:=cy+2;
      PenPos := Point(cx2, cy2);
      LineTo(cx2,cy2+8);
      LineTo(cx2+8,cy2+8);
      LineTo(cx2+8,cy2);
      LineTo(cx2,cy2);
 
      Pen.Color := clBlack;
      // Dessine la barre horizontale ('-')
      PenPos := Point(cx2+2, cy2+4);
      LineTo(cx2+7, cy2+4);
 
      // Dessine la barre verticale si le noeud est réduit ('+')
      if not Node.Expanded then
      begin
        PenPos := Point(cx2+4, cy2+2);
        LineTo(cx2+4, cy2+7);
      end;
      Pen.Color := clGray;
 
      if Node.Parent <> nil then
      begin
        cx2 := cx + 9;
        cy2 := cy - 2;
 
        while (cy2 < cy + 2) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end
    // Sinon (pas d'enfant), trace une barre verticale en pointillés
    else
    begin
      cx2 := cx + 9;
      if (Node.AbsoluteIndex = 0) then cy2 := cy + 6
      else cy2 := cy - 2;
 
      if (Node.getNextSibling <> nil) then
      begin
        while (cy2 < ARect.Bottom + 3) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end
      else begin
        while (cy2 < cy + 5) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end;
 
    // Pour tous les noeuds, trace une ligne horizontale en pointillés (entre le bouton et le label du noeud)
    if Node.HasChildren then cx2 := cx + 15
    else cx2 := cx + 9;
    cy2 := cy + 6;
 
    while (cx2 < cx + 18) do
    begin
      PenPos := Point(cx2,cy2);
      LineTo(cx2+1,cy2);
      cx2 := cx2 + 2;
    end;
 
    if ((Node.GetNextVisible <> nil) and (Node.GetNextVisible.Level = Node.Level))
    or (Node.GetNextSibling <> nil) then
    begin
      cx2 := cx + 9;
      cy2 := cy + 12;
      while cy2 < cy + 18 do
      begin
 
        PenPos := Point(cx2, cy2);
        LineTo(cx2,cy2+1);
        cy2 := cy2 + 2;
      end;
    end;
 
    // Connecte les sous-noeuds au noeud parent
    Node := Node.Parent;
    if Node <> nil then
    begin
      cx2 := 9;
      cy2 := ARect.Top - 2;
      while (cy2 < ARect.Bottom - 1) do
      begin
        PenPos := Point(cx2, cy2);
        LineTo(cx2, cy2 + 1);
        cy2 := cy2 + 2;
      end;
    end;
  end;
  inherited
end;
 
// Procédure pour dessiner les noeuds de AlphaTreeView
procedure TAlphaTreeView.CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  NodeRect: TRect;
begin
  DefaultDraw := false; // nécessaire pour forcer le dessin manuel des items
  with Canvas do
  begin
    if cdsSelected in State then
    begin
      NodeRect := Node.DisplayRect(True);
      FillRect(NodeRect);
    end;
    NodeRect := Node.DisplayRect(False);
 
    Brush.Style := bsClear;
 
    NodeRect.Top := NodeRect.Top+1;
    NodeRect.Left := NodeRect.Left + (Node.Level * Indent);
    // Appel à la procédure de dessin des lignes
    CustDrawButton(NodeRect, Node);
 
    NodeRect.Left := NodeRect.Left + Indent;
 
    TextOut(NodeRect.Left, NodeRect.Top, Node.Text);
  end;
  inherited
end;
 
procedure TAlphaTreeView.CustRefresh(Sender: TObject; Node: TTreeNode);
begin
  Repaint;
end;
 
end.

J'aurais besoin d'aide pour plusieurs trucs:
- Le premier, c'est qu'en cours d'exécution, ça fonctionne bien sauf que c'est lent: effet de clipping quand on étend/réduit l'arbre et autre trucs de ce genre
- Ensuite, pour le moment, je ne suis capable que d'afficher par transaprence les composants de type TImage (pas de boutons ni rien...) J'ai bien tenté de faire une copie du canvas de la form, mais sur la zone d'AlphaTreeView, ça le fait pas, et si je masque le treeview le temps de capturer la form, le fait de l'afficher après appelle la procédure de rafraichissement de la form, qui appelle le redessin du treeview etc, donc clipping pourri!

Merci pour vos commentaires et votre aide, je reste à votre disposition si vous avez besoin d'infos complémentaires!

**LadyWasky** · 22/02/2006, 13h38

Superbe, quand ce sera fini tu pourras envoyer ton composant à la rédaction de la rubrique sources

Pour l'effet de clipping, j'imagine que tu parles plutôt d'un effet de scintillement ?

Ce soir, j'essairais de te donner deux ou trois petits "trucs"

A+

**Gaadek** · 22/02/2006, 16h57

Pas de problème pour poster la source dans la rubrique correspondante quand ce sera terminé, mais pour le moment, je préfère optimiser à fond le truc, ça évitera à beacoup de monde de se prendre la tête dessus!!!

Merci pour les encouragements!

Et au fait, j'aurais pour le moment surtout besoin d'aide pour le problème de scintillement!!!!

Bye

**phplive** · 22/02/2006, 22h44

Bsr Gaadek

Hasard ou coincidence je m'écris aussi un Treeview perso multi-colonne dans le style du VirutalTreeView de Lischke (mais en moins bien

) que je ne serais trop te conseiller de télécharger sur
http://www.delphi-gems.com/VirtualTreeview/VT.php : je me suis inspiré du code en partie et le gars Lischke maîtrise bien l'AlphaBlending avec Assembleur ,MMX et tout et tout

Mon code faisant déjà plus de 8000 lignes je posterais peut-être un jour un zip

Pour le scintillement y'a pas photo du dois mettre la propriété DoubleBuffered à true plus l'interception des messages WM_ERASEBKGND et c'est magique ca scintille plus ! A se demander pourquoi Msoft n'a pas implémenté ses composants de cette façon !

le hic ton TreeView descend du TTreeView de la VCL aie aie aie je sais pas si tu vas pouvoir l'activer ...
Mon composant descend directement de TCustomControl et je gère mon arbre de A à Z car le TreeView est lent mais alors très lent !

Autrement pour l'alphablend et sans utiliser DirectX, l'assembleur ou que sais-je encore voici un ex qui va te faire comprendre à quel point la propriété Canvas.Pixels[] est lente comparée à ScanLine[] (merci encore une fois à Lischke décidemment son compo est surprenant !) :

Voici un ex : le but affiché en transparence (50%) une image dans une fiche

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
unit AlphaBlending;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  // Avec les bitmaps codés au format 32bits chaque point occupe 4 octets
  // codant respectivement le bleu (Blue), le vert (Green), le rouge (Red) +
  // le canal Alpha
  TBGRA = packed record
    case Integer of
      0 :
      (
        Blue : Byte;
        Green : Byte;
        Red : Byte;
        Alpha: Byte;
      );
 
      1 :
      (
         BGR : array[0..2] of Byte;
      );
 
  end;
 
  PBGRA = ^TBGRA;
  PBGRAArray = ^TBGRAArray;
  TBGRAArray = array[0..32767] of TBGRA;
 
 
 
  TForm3 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
procedure TForm3.Button1Click(Sender: TObject);
var
  Source, Target : PBGRA;
  Alpha : Integer;
  X,Y : Integer;
  BitMap : TBitMap;
  BitMapFond : TBitMap;
  ARect : TRect;
begin
  // Créer un nouveau BitMap pour charger l'image
  BitMap := TBitMap.Create;
 
  // Charge une image au format BMP en 16 millions de couleurs de préférence
  BitMap.LoadFromFile('c:\splash2.bmp');
  // Convertit l'image en 32 bits (même si la couche alpha ne sert pas)
  BitMap.PixelFormat := pf32Bit;
 
 
  // Stocke les dimensions de l'image dans ARect
  ARect := Bounds(0,0,BitMap.Width,BitMap.Height);
 
  // Créer un bitmap temporaire pour calculer l'alphablending
  BitMapFond := TBitMap.Create;
  // Même taille que l'image
  BitMapFond.Width := BitMap.Width;
  BitMapFond.Height := BitMap.Height;
  BitMapFond.PixelFormat := pf32Bit;  // Format 32 bits
 
  // Copy le fond de la fenêtre dans le bitmap temporaire pour
  // une surface équivalente à l'image
  BitMapFond.Canvas.CopyRect(ARect,Canvas,ARect);
 
 
  // Alpha : De 0 à 255
  // 0 l'image est totalement transparente
  // 255 l'image est opaque
  Alpha := 128; // Transparence à 50%
 
 
  // Calcul de l'alphablending dans le bitmap temporaire
 
  for Y :=0 to BitMapFond.Height-1 do
  begin
    // On récupère un pointeur sur la ligne en cours
    // dans l'image ainsi que dans le bitmap temporaire
    Source := BitMap.Scanline[Y];
    Target := BitMapFond.Scanline[Y];
 
    for X := 0 to BitMapFond.Width-1 do
    begin
      // Une boucle est superflue ici
      Target.BGR[0] := (Alpha*(Source.BGR[0]-Target.BGR[0]) shr 8)+Target.BGR[0];
      Target.BGR[1] := (Alpha*(Source.BGR[1]-Target.BGR[1]) shr 8)+Target.BGR[1];
      Target.BGR[2] := (Alpha*(Source.BGR[2]-Target.BGR[2]) shr 8)+Target.BGR[2];
 
 
      Inc(Source);  // ici on incrémente des pointeurs !
      Inc(Target);
    end;
  end;
 
  // Dessine directement le bitmap temporaire dans la fenêtre
  Canvas.Draw(ARect.Left,ARect.Top,BitMapFond);
 
  // Libère les bitmaps
  BitMap.Free;
  BitMapFond.Free;
end;
 
end.

Trouve toi une image (BMP) en 24bits et place son chemin dans

Code :

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

BitMap.LoadFromFile('c:\splash2.bmp');

Teste et tu verras le différence : bon c'est pas encore du temps réel mais c'est déjà mieux (pour le temps réel prévoir Direct X, MMX des trucs comme ca)

Tu peux remplacer pf32bit par pf24bit (car ici le canal Alpha n'est pas utilisé en fait) mais je pense que manipuler des blocs de 4 octets doit être plus rapide quelque part (bien sûr ca gaspille un peu d'espace en mémoire mais ca t'ouvre la voie vers du vrai alphablending) : dans ce cas pense à mettre en commentaire Alpha: Byte; dans le type TBGRA !!!

Nota : ta carte vidéo doit être en mode 24bits ou 32bits pour que ca fonctionne il me semble

Ha oui normalement le code devrait se trouver dans le OnPaint de la fiche
(mais pas le chargement de l'image) : à toi d'adapter si nécessaire

Voilà

@+
Php

**LadyWasky** · 23/02/2006, 01h32

Sinon, demain je te réserve une ch'tite surprise (demain soir)...

**Graffito** · 23/02/2006, 09h15

Bonjour,

Pour éviter le scintillement, tu pourrais essayer de modifier la propriété doublebuffered de la forme:

Code :

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

DoubleBuffered:=true;

**Gaadek** · 23/02/2006, 09h24

Merci merci merci!!!!

Ca fait plaisir de voir que du mode s'intéresse à mon machin!!!!

waskol -> j'attend avec impatience ce soir!!!

pour Graphplive, merci pour le lien, je vais m'y pencher tout de suite, on verra bien ce que ça va donner!!!

Graffito -> la propriété doublebuffered de la form ne semble pas modifier le fonctionnement de mon composant, ce qui semble normal à priori vu que j'utilise des fonctions perso... A moins que je me trompe???

En tout cas, je vous tiens au courant des avancées et encore merci!

**LadyWasky** · 23/02/2006, 10h26

En attendant tu peu allez jeter un oeil sur cette page :
http://www.utilmind.com/delphi2.html

Il y a un composant "Glassy Window" : télécharges le et étudie la source pour t'en inspirer.

A l'époque je m'était amusé à améliorer le composant pour qu'il soit un peu plus rapide.

En vrac :
Sinon, j'ai remarqué que dans ton code, tu reprenait trop souvent une "photo" de ta fiche parente. Il faudrait que cette "photo" ne soit prise qu'une seule fois, lors de la création de la fiche par exemple (c'est discutable si des composants changent d'aspet ou de place sous ton Treeview).
En tout cas, tu n'exploites pas FDoubleBuffer, c'est dommage.
Ton treeview peut se trouver dans un panel, dans ce cas, ce n'est pas une photo de ta fiche parente dont tu as besoin, mais de ton conteneur parent.

Pour prendre cette photo, tu peux essayer de tirer partie de la méthode PaintTo() de tous les descendants TWinControl (TForm, TPanel, etc...) qui te permet de capturer le dessin complet de ta fiche.
voilà, voilà.

Saches qu'hier soir j'ai obtenu quelque chose de plus rapide que ton code (beaucoup plus), mais par contre ce n'est pas encore au point.

donc Wait and see...

**Gaadek** · 23/02/2006, 11h51

Salut waskol, j'ai déjà récupéré le composant glassy et c'est d'ailleur lui qui m'a servi de base pour l'alphablend!

Pour FDoubleBuffer, j'ai commencé à l'implanté, mais je n'arrive pas à le mettre en place correctement... C'est pourquoi ça apparait dans les sources mais que ce n'est pas encore utilisé. Le pb, c'est que je n'arrive pas à récupérer tout le canvas du treeview alors que mon BitBlt semble OK??? Je cherche et je trouverai, mais c'est pas encore le cas.

Actuellement, je planche pour utiliser scanline au lieu de Pixel, méthode qui semble être plus véloce, et pour la capture d'image, je dois supprimer les opérations inutiles.

MAJ du premier post prévu dès que ça avance!

PS: pour ton code, tu peux toujours envoyer, même si ce n'est pas 100% finalisé, ça m'évitera peut-être de travailler sur des trucs inutiles!!!

**LadyWasky** · 24/02/2006, 02h30

Salut, j'ai eu des petits soucis familiaux ce soir (une personne malade), donc ce sera pour demain si vous ne m'en voulez pas...

**LadyWasky** · 24/02/2006, 11h44

Bon, ce matin, c'est moi aussi qui suis malade (gastro....)

Décidemment.

**Gaadek** · 24/02/2006, 11h45

Salut waskol, pas de pb!

Sinon, j'ai pas mal réfléchi au problème: je pense que dans la fonction RefreshData, il faudrait que je fasse la capture de l'image de la form (sans AlphaTreeView) et que je lui applique l'effet d'alphablending.

Plus tard, lorsque je fais appel à la fonction CustPaint d'AlphaTreeView, je n'aurai qu'à copier la zone qui m'intéresse (celle masquée par le TreeView) puis dessiner l'arbre. Cela me permet, contrairement à la méthode actuelle, de ne calculer qu'une seule fois l'alphablending sur la form et de copier avec BitBlt la partie qui m'intéresse.

Gain de performances assurée!!!

Je code tout ça et je post.

Bye!

**LadyWasky** · 24/02/2006, 23h26

Allez, hop, à utiliser sans modération

il y a une nouvelle propriété BlendType
si on met btDesktop, on affiche en transparence le bureau
si on met btParentControl, c'est tout ce qu'il y a sur la fiche.

L'idée à été de tirer partie de la méthode PainTo()
et d'utiliser repaint pour la mise à jour du treeview (voir dans le code)

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
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
unit unitAlphaTreeView;
 
interface
 
uses
  Windows, Forms, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, ComCtrls, StdCtrls;
 
type
  THoundred=0..100;
  TBlendType=(btParentControl,btDeskTop);
 
  PRGBArray = ^TRGBArray;
  TRGBArray = Array[0..1000000] of TRGBTriple;
 
  TAlphaTreeView = class(TTreeView)
  private
    FParentForm:TForm;
    FAlphaBlend: Boolean;
    FDoubleBuffer: TBitmap;
    FOnCollapsed:TNotifyEvent;
    FOnExpanded:TNotifyEvent;
    PaintLock:boolean;
    FBlendType: TBlendType;
 
    FAlphaBlendValue: THoundred;
    FCanCreateDoubleBuffer:boolean;
    OldWndProc:TFarProc;
    NewWndProc:Pointer;
    NeedRefresh,Moving:Boolean;
    FParentHooked:boolean;
    FOnCustDraw: TTVCustomDrawEvent;
    FOnCustDrawItem: TTVCustomDrawItemEvent;
    procedure CreateDoubleBuffer;
    procedure CustomPaint;
    procedure HookParentForm;
    procedure UnhookParentForm;
    procedure CallDefault(var Msg:TMessage);
 
    procedure SetBlendType(const Value: TBlendType);
    procedure SetAlphaBlendValue(const Value: THoundred);
    procedure SetAlphaBlend(IsAlphaBlend: Boolean);
  protected
    procedure NewParentWndProc(var Msg: TMessage);
    function GetParentForm: TForm;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Loaded;
    procedure CustDrawButton(ARect: TRect; Node: TTreeNode);
    procedure CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
    procedure CustRefresh(Sender: TObject; Node: TTreeNode);
  published
    property AlphaBlend:Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue:THoundred read FAlphaBlendValue write SetAlphaBlendValue;
    property BlendType:TBlendType read FBlendType write SetBlendType;
    property OnCustomDrawItem:TTVCustomDrawItemEvent read FOnCustDrawItem write FOnCustDrawItem;
    property OnCustomDraw:TTVCustomDrawEvent read FOnCustDraw write FOnCustDraw;
    property OnCollapsed : TNotifyEvent read FOnCollapsed write FOnCollapsed;
    property OnExpanded : TNotifyEvent read FOnExpanded write FOnExpanded;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('AlphaComponents', [TAlphaTreeView]);
end;
 
function TAlphaTreeView.GetParentForm: TForm;
var AWinControl:TWinControl;
begin
  AWinControl:=Self.Parent;
  if AWinControl <> nil then
     while not (AWinControl is TForm) do AWinControl := AWinControl.Parent;
  result:=(AWinControl as TForm);
end;
 
{ TAlphaTreeView }
 
// Méthode invoquée à la création du composant
constructor TAlphaTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //ControlStyle:=ControlStyle-[csOpaque];
  ParentColor:=false;
  FOnCustDraw:=nil;
  FOnCustDrawItem:=nil;
  FOnCollapsed:=nil;
  FOnExpanded:=nil;
  FParentHooked:=false;
  // Les 4 lignes suivantes permettent d'appeler des méthodes déclanchées par des événements
  Inherited OnCustomDraw:=CustDraw;
  Inherited OnCustomDrawItem:=CustDrawItem;
  Inherited OnCollapsed:=CustRefresh;
  Inherited OnExpanded:=CustRefresh;
 
  // Initialise les options du controle
  FAlphaBlend:=true;
  FAlphaBlendValue:=25;
  FBlendType:=btParentControl;
  // Créer un buffer graphique
  FDoubleBuffer:=TBitmap.Create;
  FDoubleBuffer.PixelFormat := pf24bit;
  FCanCreateDoubleBuffer := True;
  FParentForm:=nil;
  if (Owner is TForm) then FParentForm:=(Owner as TForm);
  HookParentForm;
  CreateDoubleBuffer;
  Repaint;
end;
 
// Méthode invoquée à la destruction du composant
destructor TAlphaTreeView.Destroy;
begin
  UnhookParentForm;
  Application.ProcessMessages;
  FDoubleBuffer.free;
  inherited Destroy;
end;
 
procedure DoBlend(ABitmap:TBitmap;AColor:TColor;AlphaBlendV:THoundred);
var SL: PRGBArray;
  X, Y: Integer;
  rv,gv,bv:byte;
  InvBlend:THoundred;
begin
 InvBlend:=100-AlphaBlendV;
 rv:=InvBlend*GetRValue(AColor);
 gv:=InvBlend*GetGValue(AColor);
 bv:=InvBlend*GetBValue(AColor);
 
 with ABitmap do
 for Y := 0 to Height - 1 do
 begin
  SL := ScanLine[Y];
  for X := 0 to Width - 1 do
   begin
    try
     SL[X].rgbtRed  :=(AlphaBlendV * SL[X].rgbtRed  +rv) div 100;
     SL[X].rgbtGreen:=(AlphaBlendV * SL[X].rgbtGreen+gv) div 100;
     SL[X].rgbtBlue :=(AlphaBlendV * SL[X].rgbtBlue +bv) div 100;
    except
    end;
   end
 end;
end;
// Procédure qui charge le buffer graphique
procedure TAlphaTreeView.CreateDoubleBuffer;
var
  DC: hDC;
  ScreenWidth, ScreenHeight,TicksNow: Integer;
begin
  if (csDesigning in ComponentState) or (FDoubleBuffer = nil) then Exit;
  if not Assigned(FParentForm) then exit;
  FCanCreateDoubleBuffer := False;
  case BlendType of
    btParentControl:begin
      //le dessin du treeview doit être interdit pendant le "PainTo" du parent
      //donc on désactive CustomPaint et CustDrawItem
      PaintLock:=true;
      if not Assigned(Parent) then exit;
      FDoubleBuffer.Width:=Parent.Width;
      FDoubleBuffer.Height:=Parent.Height;
      Parent.PaintTo(FDoubleBuffer.Canvas.Handle,-left,-top);
      PaintLock:=false;
      DoBlend(FDoubleBuffer,color,FAlphaBlendValue);
    end;
    btDeskTop:begin
      FDoubleBuffer.Width := GetSystemMetrics(sm_CXScreen);
      FDoubleBuffer.Height := GetSystemMetrics(sm_CYScreen);
 
      ShowWindow(FParentForm.Handle, SW_Hide);
 
      SetActiveWindow(0);
      TicksNow:=GetTickCount;
      repeat
        Application.ProcessMessages
      until GetTickCount-TicksNow>=100;
      DC := GetDC(0);
      BitBlt(FDoubleBuffer.Canvas.Handle, 0, 0, FDoubleBuffer.Width, FDoubleBuffer.Height, DC, 0, 0, SrcCopy);
      ReleaseDC(0, DC);
      DoBlend(FDoubleBuffer,color,FAlphaBlendValue);
      ShowWindow(FParentForm.Handle, sw_Show);
    end;
  end;
end;
 
// Fonction qui permet de récupérer la form du control AlphaTreeview
// Procédure perso pour désinner AlphaTreeView
procedure TAlphaTreeView.CustomPaint;
var  X,Y,XSource,YSource: integer;
     pixcol : tcolor;
     APoint:TPoint;
begin
  if ((not FAlphaBlend) or (csDesigning in ComponentState) or (FDoubleBuffer = nil) or (not Assigned(Parent))) then exit;
 
  //le dessin du treeview est interdit pendant le "PainTo" du parent
  //(voir "CreateDoubleBuffer")
  if PaintLock then exit;
  APoint.X:=0;
  APoint.Y:=0;
  // Si la propriété AlphaBlend du controle est vraie
  if (FAlphaBlend) then
  begin
    case FBlendType of
      btParentControl:begin
        //conversion des coordonnées du contrôle en coordonnées de son parent
        if Assigned(Parent) then
        APoint:=Parent.ScreenToClient(ClientToScreen(APoint));
        XSource:=APoint.X;
        YSource:=APoint.Y;
      end;
      btDeskTop:begin
        //conversion des coordonnées du contrôle en coordonnées ecran
        APoint:=ClientToScreen(APoint);
        XSource:=APoint.X;
        YSource:=APoint.Y;
      end;
    end;
    BitBlt(Canvas.Handle, 0, 0, Width, Height,FDoubleBuffer.Canvas.Handle, XSource, YSource, SrcCopy);
    end;
    FCanCreateDoubleBuffer := True;
  end;
 
procedure TAlphaTreeView.Loaded;
var p:pointer;
begin
  inherited Loaded;
  HookParentForm;
  CreateDoubleBuffer;
  Repaint;
end;
 
 
// Procédure utilisée pour dessiner le contrôle
procedure TAlphaTreeView.CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
begin
  CustomPaint;
end;
 
 
procedure TAlphaTreeView.SetAlphaBlend(IsAlphaBlend: Boolean);
begin
if FAlphaBlend<>IsAlphaBlend then
  begin
    FAlphaBlend:=IsAlphaBlend;
    CreateDoubleBuffer;
    Repaint; //appelle custdraw et custdrawitem via TWincontrol
  end;
end;
 
 
// Procédure pour dessiner les lignes/boutons de AlphaTreeView
procedure TAlphaTreeView.CustDrawButton(ARect: TRect; Node: TTreeNode);
var
  cx, cy, cx2, cy2 : Integer;
begin
//  cx := ARect.Left + Indent div 2;
//  cy := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
  // cx,cy représente le coin supérieur gauche
  cx := ARect.Left;
  cy := ARect.Top;
 
  with Canvas do
  begin
    Pen.Color := clGray;
 
    // Tout d'abord, si le noeud à des enfants, on dessine un bouton pour étendre/réduire
    if Node.HasChildren then
    begin
      // Dessine le cadre du bouton d'extension/réduction
      cx2:=cx+5;
      cy2:=cy+2;
      PenPos := Point(cx2, cy2);
      LineTo(cx2,cy2+8);
      LineTo(cx2+8,cy2+8);
      LineTo(cx2+8,cy2);
      LineTo(cx2,cy2);
 
      Pen.Color := clBlack;
      // Dessine la barre horizontale ('-')
      PenPos := Point(cx2+2, cy2+4);
      LineTo(cx2+7, cy2+4);
 
      // Dessine la barre verticale si le noeud est réduit ('+')
      if not Node.Expanded then
      begin
        PenPos := Point(cx2+4, cy2+2);
        LineTo(cx2+4, cy2+7);
      end;
      Pen.Color := clGray;
 
      if Node.Parent <> nil then
      begin
        cx2 := cx + 9;
        cy2 := cy - 2;
 
        while (cy2 < cy + 2) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end
    // Sinon (pas d'enfant), trace une barre verticale en pointillés
    else
    begin
      cx2 := cx + 9;
      if (Node.AbsoluteIndex = 0) then cy2 := cy + 6
      else cy2 := cy - 2;
 
      if (Node.getNextSibling <> nil) then
      begin
        while (cy2 < ARect.Bottom + 3) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end
      else begin
        while (cy2 < cy + 5) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end;
 
    // Pour tous les noeuds, trace une ligne horizontale en pointillés (entre le bouton et le label du noeud)
    if Node.HasChildren then cx2 := cx + 15
    else cx2 := cx + 9;
    cy2 := cy + 6;
 
    while (cx2 < cx + 18) do
    begin
      PenPos := Point(cx2,cy2);
      LineTo(cx2+1,cy2);
      cx2 := cx2 + 2;
    end;
 
    if ((Node.GetNextVisible <> nil) and (Node.GetNextVisible.Level = Node.Level))
    or (Node.GetNextSibling <> nil) then
    begin
      cx2 := cx + 9;
      cy2 := cy + 12;
      while cy2 < cy + 18 do
      begin
 
        PenPos := Point(cx2, cy2);
        LineTo(cx2,cy2+1);
        cy2 := cy2 + 2;
      end;
    end;
 
    // Connecte les sous-noeuds au noeud parent
    Node := Node.Parent;
    if Node <> nil then
    begin
      cx2 := 9;
      cy2 := ARect.Top - 2;
      while (cy2 < ARect.Bottom - 1) do
      begin
        PenPos := Point(cx2, cy2);
        LineTo(cx2, cy2 + 1);
        cy2 := cy2 + 2;
      end;
    end;
  end;
  inherited
end;
 
// Procédure pour dessiner les noeuds de AlphaTreeView
procedure TAlphaTreeView.CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  NodeRect: TRect;
begin
  //le dessin du treeview est interdit pendant le "PainTo" du parent
  //(voir "CreateDoubleBuffer")
  //if PaintLock then exit;
  DefaultDraw := false; // nécessaire pour forcer le dessin manuel des items
  with Canvas do
  begin
    if cdsSelected in State then
    begin
      NodeRect := Node.DisplayRect(True);
      FillRect(NodeRect);
    end;
    NodeRect := Node.DisplayRect(False);
 
    Brush.Style := bsClear;
 
    NodeRect.Top := NodeRect.Top+1;
    NodeRect.Left := NodeRect.Left + (Node.Level * Indent);
    // Appel à la procédure de dessin des lignes
    CustDrawButton(NodeRect, Node);
 
    NodeRect.Left := NodeRect.Left + Indent;
 
    TextOut(NodeRect.Left, NodeRect.Top, Node.Text);
  end;
  inherited
end;
 
procedure TAlphaTreeView.CustRefresh(Sender: TObject; Node: TTreeNode);
begin
  CustomPaint;
end;
 
procedure TAlphaTreeView.SetBlendType(const Value: TBlendType);
begin
  FBlendType := Value;
  CreateDoubleBuffer;
  Repaint; //appelle custdraw et custdrawitem via TWincontrol
end;
 
 
procedure TAlphaTreeView.NewParentWndProc(var Msg: TMessage);
begin
  CallDefault(Msg);
  case Msg.Msg of
    wm_Activate: if (Lo(Msg.wParam) <> wa_Inactive) and
                    FCanCreateDoubleBuffer then CreateDoubleBuffer;
    wm_Move: begin
                 //CreateDoubleBuffer;
                 Repaint; //appelle custdraw et custdrawitem via TWincontrol
             end;
   end;
end;
procedure TAlphaTreeView.SetAlphaBlendValue(const Value: THoundred);
begin
  if FAlphaBlendValue <> Value then
  begin
    FAlphaBlendValue := Value;
    CreateDoubleBuffer;
    RePaint; //appelle custdraw et custdrawitem via TWincontrol
  end;
end;
 
procedure TAlphaTreeView.CallDefault(var Msg: TMessage);
begin
  Msg.Result:=CallWindowProc(OldWndProc,FParentForm.Handle,Msg.Msg,Msg.wParam,Msg.lParam);
end;
 
procedure TAlphaTreeView.HookParentForm;
begin
  if not Assigned(FParentForm) then Exit;
  OldWndProc:=TFarProc(GetWindowLong(FParentForm.Handle,GWL_WndProc));
  NewWndProc:=MakeObjectInstance(NewParentWndProc);
  SetWindowLong(FParentForm.Handle,GWL_WndProc,LongInt(NewWndProc));
end;
 
procedure TAlphaTreeView.UnhookParentForm;
begin
//provoque un plantage...
 
   if Assigned(FParentForm) and Assigned(OldWndProc) then
   if FParentForm.HandleAllocated then
      SetWindowLong(FParentForm.Handle,GWL_WndProc,LongInt(OldWndProc));
   if Assigned(NewWndProc) then
      FreeObjectInstance(NewWndProc);
   NewWndProc:=nil;
   OldWndProc:=nil
end;
 
 
end.

Tu remarqueras que ça clignote un chouilla, mais bon

**Gaadek** · 27/02/2006, 06h32

Merci waskol, je vais regarder tout ça!!!

Je suis en déplacement professionnel toute cette semaine, donc ne vous inquiétez pas de ne pas recevoir de nouvelles de ma part!

A bientôt bye!

**Gaadek** · 08/06/2007, 12h38

Bonjour à tous!

Voila, j'ai retravaillé sur ce sujet (qui était resté quelques temps dans mes tiroirs, je dois bien l'avouer)

Le résultat aujourd'hui est plutôt satisfaisant, même si à mon avis il reste pas mal d'optimisation à faire...

Je vous propose donc aujourd'hui le projet + les sources de ce composant pour le tester.

Les points qu'il me semble nécessaires d'améliorer sont:
1) Lors de scrolling vertical, ça scintille/clignote. Impossible de trouver s'où ça vient, ce sont surement les API utilisées qui sont 'encore' trop lentes...

2) Lors de scrolling horizontal, même problème, avec en plus le carré de sélection qui se décale avec l'arrière plan (pas cool ça)

J'attends avec impatience vos commentaires, voir vos propositions d'amélioration!

Le code devrait être suffisament commenté, au cas où, je reste disponible pour apporter toute les précisions nécessaires!

New composant: Treeview gérant l'alphablending

Composants VCL Delphi

Discussions similaires

Partager

Partager