Cherche un TColorListBox ressemblant plus à un TCheckListBox

**yoghisan** · 24/02/2005, 23h32

Bonjour,

J'ai besoin d'un composant spécifique... Pas facile à expliquer...

Personnellement, j'appellerais ça une TColorListBox mais ca existe déjà et ce n'est pas du tout de ca dont j'ai besoin.

Ca ressemblerait à une TCheckListBox mais au lieu d'etre un check, ca serait une couleur.

Bref, ca ressemblerait a ça.

Pourriez-vous me dire où je peux trouver ca ?
sinon
Comment je peux créer un tel composant ?

Merci,

David.

**edam** · 25/02/2005, 00h13

dessine le toi meme dasnl'evenement ondraw
n'oubli pas de changer son style

**yoghisan** · 25/02/2005, 01h18

Tu peux m'en dire plus stp, je ne connais rien dans ce domaine....

**Pierre Castelain** · 25/02/2005, 08h01

Voici un exemple. Change la propriété Style du TListBox à lbOwnerDrawFixed et insère le code suivant dans l'événement OnDrawItem :

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
 
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  carre: TRect;
  bcolor: TColor;
begin
  with (Control as TListBox) do
	begin
    Canvas.FillRect(Rect);
 
    bColor:= Canvas.Brush.Color;
    case Index of
      0 : Canvas.Brush.Color:= clRed;
      1 : Canvas.Brush.Color:= clYellow;
      2 : Canvas.Brush.Color:= clGreen;
      3 : Canvas.Brush.Color:= clBlue;
      else
        Canvas.Brush.Color:= clBlack;
    end;
    carre:= Rect;
    carre.Left:= carre.Left + 1;
    carre.Top:= carre.Top + 1;
    carre.Bottom:= carre.Bottom - 1;
    carre.Right:= carre.Left + carre.Bottom - carre.Top;
    Canvas. FillRect(carre);
 
    Canvas.Brush.Color:= bcolor;
    Rect.Left:= carre.Right + 2;
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
  end;
end;

**yoghisan** · 25/02/2005, 17h47

Merci Pierre,

Ca, c'est ok, je pense avoir compris le principe

Je voudrais essayer de créer ce composant dont j'ai besoin mais j'aimerai entrer les couleurs comme ceci

Code :

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

ListBox1.Color[0] := ClRed

et avoir un evenement "OnClickColor".

Tu peux m'aider stp ?

Merci

**Pierre Castelain** · 25/02/2005, 17h51

Dans ce cas, il faut que tu maintienne une liste de TColor dans le composant et que tu la synchonise avec la liste de chaines. Sers-toi de la méthode DoClick pour intercepter le clic sur la couleur.

**yoghisan** · 25/02/2005, 17h56

DoClick ?

**yoghisan** · 25/02/2005, 21h49

Bon j'ai ecrit ca laborieusement...

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
unit CouleurListBox;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Types, Graphics;
 
type
  TCouleurListBox = class(TListBox)
  private
    FOnDrawItem: TNotifyEvent;
    procedure OnDrawItemSurcharger(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  protected
  public
    Couleur: array[0..1000] of TColor;
    constructor Create(AOwner: TComponent); override;
  published
    property OnDrawItem: TNotifyEvent read FOnDrawItem  write FOnDrawItem;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Mes composants', [TCouleurListBox]);
end;
 
constructor TCouleurListBox.Create(AOwner: TComponent);
var i: integer;
begin
  InHerited Create(AOwner);
 
  Style := lbOwnerDrawFixed;
  ItemHeight := 13;
 
  for i:=0 to 1000 do Couleur[i] := ClWhite;
 
  FOnDrawItem := nil;
  Inherited OnDrawItem := OnDrawItemSurcharger;
end;
 
procedure TCouleurListBox.OnDrawItemSurcharger(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var carre: TRect;
    BackColor: Tcolor;
Const Ecart: integer= 2;
      Epaisseur: integer= 1;
begin
  with (Control as TListBox) do
    begin
      BackColor := Canvas.Brush.Color;
 
      Canvas.FillRect(Rect);
 
      Canvas.Brush.Color := ClSilver;
      carre := Rect;
      carre.Left := carre.Left + Ecart;
      carre.Top := carre.Top + Ecart;
      carre.Bottom := carre.Bottom - Ecart;
      carre.Right := carre.Left + carre.Bottom - carre.Top;
      Canvas. FillRect(carre);
 
      Canvas.Brush.Color := Couleur[Index];
      carre := Rect;
      carre.Left := carre.Left + (Ecart+Epaisseur);
      carre.Top := carre.Top + (Ecart+Epaisseur);
      carre.Bottom := carre.Bottom - (Ecart+Epaisseur);
      carre.Right := carre.Left + carre.Bottom - carre.Top;
      Canvas. FillRect(carre);
 
      Canvas.Brush.Color := BackColor;
      Rect.Left := carre.Right + 2*(Ecart+Epaisseur);
      Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
    end;
 
//  if Assigned(FOnDrawItem) then FOnDrawItem(Control, Index, Rect, State);  // <-- Ca ne marche pas
end;
 
end.

Première question
Comment je fais pour détecter que j'ai changé une couleur dans la variable "Couleur" afin de repeindre la TListBox.

Deuxieme question
Comment je crée l'evenement "OnCouleurClick" quand je clique sur une couleur ?
J'ai besoin d'un OnCouleurClick(sender: Tobject; Index: integer

;

Troisième question
Si l'utilisateur du composant a rajouté un événement OnDrawItem, je veux le déclenche.
voila le code utilisé est ca ne marche pas.

Code :

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

if Assigned(FOnDrawItem) then FOnDrawItem(Control, Index, Rect, State);

Merci

**Pierre Castelain** · 26/02/2005, 09h02

Envoyé par yoghisan

Bon j'ai ecrit ca laborieusement...

C'est comme ça qu'on apprend.

1 - Il ne te faut pas utiliser une variable de type tableau mais une propriété indexée :

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
 
private
  FCouleur: array[0..1000] of TColor;
  function GetCouleur(Index: Integer): TColor;
  procedure PutCouleur(Index: Integer; Value: TColor);
public
  property Couleur[Index: Integer] of TColor read GetCouleur write PutCouleur;
 
...
 
function TCouleurListBox.GetCouleur(Index: Integer): TColor;
begin
  // Il faudrait d'abbord tester les bornes
  result:= FCouleur[Index];
end;
 
procedure TCouleurListBox.PutCouleur(Index: Integer; Value: TColor);
begin
  // Il faudrait d'abbord tester les bornes
  if Value <> FCouleur[Index] then
  begin
    FCouleur[Index]:= Value;
    // Retracer 
  end;
end;

2 - Je me suis trompé, ce n'est pas DoClick mais Click que l'on peut surcharger :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
protected
  procedure Click; override;
 
...
 
procedure TCouleurListBox.Click;
begin
  inherited Click;
  // Ici le test pour savoir si c'est une couleur qui a été sélectionnée.
end;

Heu... Après réflexion, je pense que cela serais plus simple en utilisant DoMouseUp plutot que Click.

3 - Ton attribut FOnDrawItem masque celui de TListBox.
A ta place je surchargerais la méthode DrawItem au lieu d'utiliser OnDrawItem pour tracer les couleurs :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
protected
  procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
 
...
 
procedure TCouleurListBox.DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); 
begin
  inherited;
  // Ton code de tracé
end;

Du coup, tu n'a plus à te préoccuper de OnDrawItem (enfin, si tu te contente de cette solution).

**yoghisan** · 26/02/2005, 11h43

Merci pierre,

J'ai lu le code et j'ai compris là où je bloquais (et comme d'hab, des synthaxes que je ne connais pas... c'est très agaçant). Là, je suis au taf et je ne peux pas coder. Il me tarde d'etre à la maison pour voir ca de plus près.

Bref, je voudrais savoir un dernier truc. Comment je fais pour savoir si je clique juste sur une couleur de la listbox (si je clique sur la couleur, j'aimerai la changer. Un peu comme la TCheckistBox, quand on clique sur la case, on change le check).

Est ce que je dois, dans l'événement OnMouseDown, juste traiter l'information de la position (x uniquement, le itemIndex sera plus interessant que le y) de la souris ?
Est ce que je dois, dans l'événement OnMouseDown, regarder si le pixel sous la souris est de la meme couleur que FCouleur de la ligne ?
(la deuxième me semble plus rapide à coder mais plus contraignante à utiliser)

- Si oui, dis moi la bonne méthode et je me débrouille. Si je bloque, je reviendrais te demander (à toi de voir si tu veux répondre à un emmerdeur comme moi)
- Si non ou mieux, tu peux m'aiguiller ?

Merci encore du temps que tu veux bien me consacrer.

David.

**Pierre Castelain** · 26/02/2005, 11h51

Le mieux, à mon avis, est effectivement de tester les coordonnées de la souris.

**yoghisan** · 26/02/2005, 20h01

ouah, super...

Mais j'ai un dernier soucis avec la surcharge de la fonction "MouseActivate". Tu peux m'aider normalement une derniere fois

et si tu vois un autre truc, fais en moi profiter...

ha oui un autre truc
comment je fais pour arriver a accepter cette synthaxe

Code :

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

FCouleur: array[0..IndexMax] of TColor;

meme en declarant les "const "avant les "type"

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
unit CouleurListBox;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Types, Graphics, Dialogs;
 
type
  TCouleurListBox = class(TListBox)
  private
    FCouleur: array[0..1000] of TColor;
    FItemEnabled: array[0..1000] of Boolean;
    function  GetCouleur(Index: Integer): TColor;
    procedure PutCouleur(Index: Integer; Value: TColor);
    function  GetItemEnabled(Index: Integer): Boolean;
    procedure PutItemEnabled(Index: Integer; Value: Boolean);
  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Click; override;
    procedure DblClick; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
//    procedure MouseActivate(Button: TMouseButton; Shift: TShiftState; X, Y, HitTest: Integer; var MouseActivate: TMouseActivate); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Couleur[Index: Integer]: TColor read GetCouleur write PutCouleur;
    property ItemEnabled[Index: Integer]: Boolean read GetItemEnabled write PutItemEnabled;
  published
 
  end;
 
const
  IndexMax: integer=1000;
  Ecart: integer= 2;
  Epaisseur: integer= 1;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Mes composants', [TCouleurListBox]);
end;
 
constructor TCouleurListBox.Create(AOwner: TComponent);
var i: integer;
begin
  InHerited Create(AOwner);
 
  Style := lbOwnerDrawFixed;
  ItemHeight := 13;
 
  for i:=0 to IndexMax do begin
    Couleur[i] := ClWhite;
    FItemEnabled[i] := True;
  end;
end;
 
function TCouleurListBox.GetCouleur(Index: Integer): TColor;
begin
  if (Index<0) or (Index>IndexMax)
    then result := ClWhite;
 
  result := FCouleur[Index];
end;
 
procedure TCouleurListBox.PutCouleur(Index: Integer; Value: TColor);
begin
  if (Index<0) or (Index>IndexMax)
    then exit;
 
  if Value <> FCouleur[Index] then
  begin
    FCouleur[Index]:= Value;
    Invalidate;
  end;
end;
 
function TCouleurListBox.GetItemEnabled(Index: Integer): Boolean;
begin
  if (Index<0) or (Index>IndexMax)
    then result := true;
 
  result := FItemEnabled[Index];
end;
 
procedure TCouleurListBox.PutItemEnabled(Index: Integer; Value: Boolean);
begin
  if (Index<0) or (Index>IndexMax)
    then exit;
 
  if Value <> FItemEnabled[Index] then
  begin
    FItemEnabled[Index]:= Value;
    Invalidate;
  end;
end;
 
procedure TCouleurListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var carre: TRect;
    BackColor: Tcolor;
begin
  inherited;
 
  BackColor := Canvas.Brush.Color;
 
  Canvas.FillRect(Rect);
 
  Canvas.Brush.Color := ClSilver;
  carre := Rect;
  carre.Left := carre.Left + Ecart;
  carre.Top := carre.Top + Ecart;
  carre.Bottom := carre.Bottom - Ecart;
  carre.Right := carre.Left + carre.Bottom - carre.Top;
  Canvas. FillRect(carre);
 
  Canvas.Brush.Color := FCouleur[Index];
  carre := Rect;
  carre.Left := carre.Left + (Ecart+Epaisseur);
  carre.Top := carre.Top + (Ecart+Epaisseur);
  carre.Bottom := carre.Bottom - (Ecart+Epaisseur);
  carre.Right := carre.Left + carre.Bottom - carre.Top;
  Canvas. FillRect(carre);
 
  Canvas.Brush.Color := BackColor;
  if not FItemEnabled[Index]
    then Canvas.Font.Color := ClSilver;
  Rect.Left := carre.Right + 2*(Ecart+Epaisseur);
  Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
end;
 
procedure TCouleurListBox.Click;
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.DblClick;
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.KeyPress(var Key: Char);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
{
procedure TCouleurListBox.MouseActivate(Button: TMouseButton; Shift: TShiftState; X, Y, HitTest: Integer; var MouseActivate: TMouseActivate);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
//}
 
procedure TCouleurListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var ColorDialog: TColorDialog;
begin
  if (x>0) and (x<ItemHeight)
    then begin
      ColorDialog := TColorDialog.Create(nil);
      if ColorDialog.Execute
        then PutCouleur(ItemIndex, ColorDialog.Color);
      ColorDialog.Free;
    end;
 
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
procedure TCouleurListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FItemEnabled[ItemIndex] then inherited;
end;
 
end.

**Pierre Castelain** · 26/02/2005, 22h57

1 - D'où sors-tu la méthode MouseActivate ? Elle n'existe pas dans les classes ancêtres. C'est un message que tu veux traiter ?

2 - Il suffit de déclarer la ou les constantes avant la classe :

Code :

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

1
2
3
4
5
6
7
8
9
 
const
  INDEXMAX = 1000;
 
type
  TCouleurListBox = class(TListBox)
  private
    FCouleur: array[0..INDEXMAX] of TColor;
...

3 - Les méthodes GetCouleur et GetItemEnabled sont buggées. Je te laisse trouver pourquoi.

4 - Un dernier truc : tu déclenche l'ouverture du dialogue lors de l'appui sur le bouton de la souris (n'importe lequel d'ailleurs). En principe, sous Windows, c'est le fait de relacher le bouton qui déclenche le clic. Fais le test avec les contrôles classiques, tu verras.

**edam** · 27/02/2005, 00h13

Envoyé par Pierre Castelain

Le mieux, à mon avis, est effectivement de tester les coordonnées de la souris.

une simple question:
en testant la posion de la souri comment savoir sur quel ligne axactement si notre premié ligne vu est le 10éme par example??

**yoghisan** · 27/02/2005, 01h07

1- OnMouseActive est un evenement qui existe sur les TlistBox version delphi 2005.
Non, ce n'est pas un message que j'aurais besoin de traiter mais j'essaie de faire un composant généraliste donc je le prends en compte.

2- Moi ca ne marchait pas parce que j'ecrivais

Code :

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

1
2
const 
  IndexMax: integer = 1000;

3- Quel abruti (et j'ai du temps à trouver...)

Code :

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

1
2
3
4
5
6
function TCouleurListBox.GetCouleur(Index: Integer): TColor;
begin
  if (Index<0) or (Index>IndexMax)
    then result := ClWhite
    else result := FCouleur[Index];
end;

4- Je ne comprends pas la subtilité et surtout ce que cela implique (et donc ce que tu veux me montrer). Tu peux mettre le décodeur...

4 - Un dernier truc : tu déclenche l'ouverture du dialogue lors de l'appui sur le bouton de la souris (n'importe lequel d'ailleurs). En principe, sous Windows, c'est le fait de relacher le bouton qui déclenche le clic. Fais le test avec les contrôles classiques, tu verras.

- Le dialogue : tu parles du TColorDialog ? Comment fait-on que pour avoir le TColorDialog sans avoir tous les dialogues.
- Tu veux me dire qu'a cause de mon TColorDialog, mes evenements perd l'ordre "OnMouseDown"+"OnClick"+"OnMouseUp" pour devenir "OnClick"+"OnMouseDown".
- La solution (prise pour l'instant) tient dans le fait de mettre mon TColorDialog dans le "OnMouseUp" mais dans ce cas, je ne connais pas la vraie couleur dans les deux autres evenements...

Comment faire ?

Pour edam, on recupère la ligne avec "ItemIndex" ou avec "y div ItemHeight". le premier est mieux.