Changement de couleur dans un bouton

**Paul TOTH** · 07/03/2020, 10h24

outre le fait qu'il est préférable d'avoir un tableau de [1..2] of TColorButton au lieu d'utiliser FindComposant

le comportement est tout à fait normal puisque le bouton étant survolé, c'est BackBeforeHoverColor qu'il faut modifier. il suffit donc de publier cette propriété et de la mettre à jour en plus de BackColor (pour l'autre bouton)

**illuch** · 10/03/2020, 10h17

Bonjour à tous et surtout merci à tous ceux qui se sont penchés sur mon problème.
Je vous rappelle la situation :

Voulant un bouton dont on peut faire changer la couleur, j'ai exhumé une unité "ColorButton.pas" qui permet de le faire (je ne sais plus qui en est l'auteur).
J'ai choisi l'option de joindre cette unité à mon projet et de créer dynamiquement 2 boutons ;
A l’exécution j'obtiens bien deux boutons dont la couleur est fixée par "BackColor".
Lorsque je survole les boutons, le bouton survolé change de couleur et prend la couleur "HoverColor".
Lorsqu'il n'est plus survolé, il reprend sa couleur "BackColor"
C'est le fonctionnement normal.
Ce que je veux faire en plus c'est que lorsque je clique sur un bouton, il devienne rouge et l'autre bouton devienne bleu et vice et versa si je clique sur le deuxième.
J'obtiens ce fonctionnement grâce au code suivant :

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm2.FormClick(Sender: TObject);
begin
  if (Sender as TColorButton).tag= 1 then begin
         MyColorButton[0].BackColor:=ClRed;
         MyColorButton[1].BackColor:=ClBlue;
       end else if (Sender as TColorButton).tag= 2 then begin
         MyColorButton[1].BackColor:=ClRed;
         MyColorButton[0].BackColor:=ClBlue;
   end;
end;

Mais dès que je relâche le bouton de la souris, la couleur du bouton cliqué redevient "HoverColor" (le bouton cliqué est rouge seulement pendant que le bouton est cliqué, dès qu'on relâche le bouton, il reprend la couleur "HoverColor". L'autre bouton, quant à lui, reste bleu)

Pour obtenir le fonctionnement souhaité, j'ai modifié "ColorButton.pas" ainsi :

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
procedure TColorButton.WndProc(var Message : TMessage);
begin
  if (Message.Msg = CM_MOUSELEAVE) then
  begin
   if backcolor <> ClRed then                // Ligne rajoutée
    BackColor := BackBeforeHoverColor;
    invalidate;
  end;
  if (Message.Msg = CM_MOUSEENTER) then
  begin
    BackBeforeHoverColor := BackColor;
    BackColor := HoverColor;
    invalidate;
  end;

  inherited;
end; (*WndProc*)

Cela a résolu mon problème et j'obtiens bien le fonctionnement souhaité.
Peut-être y-a-t-il une solution plus élégante ?

Jean-Louis

**Paul TOTH** · 10/03/2020, 11h15

Envoyé par illuch

Cela a résolu mon problème et j'obtiens bien le fonctionnement souhaité.
Peut-être y-a-t-il une solution plus élégante ?

Jean-Louis

le problème vient de cette variable BackBeforeHoverColor, il faudrait changer la logique du composant en créant une variable ActiveColor qui prend la valeur de BackColor ou HoverColor selon le cas et qui serait utilisée dans le Paint, voir un simple boolean pour indiquer dans le Paint quelle couleur il faut utiliser, hover ou back selon que la souris soit dans ou en dehors du composant...mais je me demande s'il n'existe pas déjà une propriété pour cela...j'ai un vague souvenir...

**Cirec** · 12/03/2020, 23h30

Bonsoir,

j'arrive après la bataille mais j'ai modifié légèrement le code du TColorButton
et il a maintenant le comportement attendu

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
unit ColorButton;
 
{
Article:
 
TColorButton - button with Color properties
 
http://delphi.about.com/library/weekly/aa061104a.htm
 
Full source code of the TColorButton Delphi component,
an extension to the standard TButton control,
with font color, background color and mouse over color properties.
 
}
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;
 
type
  TColorButton = class(TButton)
  private
    FBackBeforeHoverColor: TColor;
  private
    FCanvas: TCanvas;
    IsFocused: Boolean;
    FBackColor: TColor;
    FForeColor: TColor;
    FHoverColor: TColor;
    // Added 2020 Cirec
    MouseIn: Boolean;
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetHoverColor(const Value: TColor);
 
    property BackBeforeHoverColor : TColor read FBackBeforeHoverColor write FBackBeforeHoverColor;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message : TMessage); override;
 
    procedure SetButtonStyle(Value: Boolean); override;
    procedure DrawButton(Rect: TRect; State: UINT);
 
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
  published
    property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
    property ForeColor: TColor read FForeColor write SetForeColor default clBtnText;
    property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace;
  end;
 
procedure Register;
 
implementation
 
 
constructor TColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
    // Added 2020 Cirec
  MouseIn := False;
  FCanvas := TCanvas.Create;
  BackColor := clBtnFace;
  ForeColor := clBtnText;
  HoverColor := clBtnFace;
end; (*Create*)
 
destructor TColorButton.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end; (*Destroy*)
 
procedure TColorButton.WndProc(var Message : TMessage);
begin
  if (Message.Msg = CM_MOUSELEAVE) then
  begin
    // Added 2020 Cirec
    MouseIn := False;
    BackColor := BackBeforeHoverColor;
    invalidate;
  end;
  if (Message.Msg = CM_MOUSEENTER) then
  begin
    // Added 2020 Cirec
    MouseIn := True;
    BackBeforeHoverColor := BackColor;
    // Modified 2020 Cirec
    FBackColor := HoverColor;
    invalidate;
  end;
 
  inherited;
end; (*WndProc*)
 
procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end; (*CreateParams*)
 
 
 
procedure TColorButton.SetButtonStyle(Value: Boolean);
begin
  if Value <> IsFocused then
  begin
    IsFocused := Value;
    Invalidate;
  end;
end; (*SetButtonStyle*)
 
procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth  := Width;
    itemHeight := Height; 
  end;
end; (*CNMeasureItem*)
 
procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
var 
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do 
  begin 
    SaveIndex := SaveDC(hDC); 
    FCanvas.Lock;
    try 
      FCanvas.Handle := hDC;
      FCanvas.Font := Font; 
      FCanvas.Brush := Brush;
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex); 
    end;
  end; 
  Message.Result := 1;
end; (*CNDrawItem*)
 
procedure TColorButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited; 
  Invalidate;
end; (*CMEnabledChanged*)
 
procedure TColorButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end; (*CMFontChanged*)
 
 
procedure TColorButton.SetBackColor(const Value: TColor);
begin
  if FBackColor <> Value then begin
    // Added 2020 Cirec
    if MouseIn then
      FBackColor:= HoverColor
    else
      FBackColor:= Value;
    FBackBeforeHoverColor := Value;
    Invalidate;
  end;
end; (*SetButtonColor*)
 
procedure TColorButton.SetForeColor(const Value: TColor);
begin
  if FForeColor <> Value then begin
    FForeColor:= Value;
    Invalidate;
  end;
end; (*SetForeColor*)
 
procedure TColorButton.SetHoverColor(const Value: TColor);
begin
  if FHoverColor <> Value then begin
    FHoverColor:= Value;
    Invalidate;
  end;
end; (*SetHoverColor*)
 
procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
var
  Flags, OldMode: Longint;
  IsDown, IsDefault, IsDisabled: Boolean;
  OldColor: TColor;
  OrgRect: TRect;
begin
  OrgRect := Rect;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  IsDown := State and ODS_SELECTED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;
  IsDisabled := State and ODS_DISABLED <> 0;
 
  if IsDown then Flags := Flags or DFCS_PUSHED;
  if IsDisabled then Flags := Flags or DFCS_INACTIVE;
 
  if IsFocused or IsDefault then 
  begin 
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Style := bsClear; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end;
 
  if IsDown then 
  begin
    FCanvas.Pen.Color := clBtnShadow;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Color := clBtnFace; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end 
  else
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 
 
  if IsDown then OffsetRect(Rect, 1, 1); 
 
  OldColor := FCanvas.Brush.Color;
  FCanvas.Brush.Color := BackColor;
  FCanvas.FillRect(Rect); 
  FCanvas.Brush.Color := OldColor;
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
  FCanvas.Font.Color := ForeColor;
  if IsDisabled then
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
      0, 0, DST_TEXT or DSS_DISABLED)
  else
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
      DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
  SetBkMode(FCanvas.Handle, OldMode);
 
  if IsFocused and IsDefault then
  begin
    Rect := OrgRect;
    InflateRect(Rect, - 4, - 4);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, Rect);
  end;
end; (*DrawButton*)
 
procedure Register;
begin
  RegisterComponents('delphi.about.com', [TColorButton]);
end;
 
end.

Cordialement,

@+

Changement de couleur dans un bouton

Composants VCL Delphi

Discussions similaires

Partager

Partager