CheckBox in Shape ( modifié en checkBox in Panel )

Version imprimable

Voir 40 message(s) de cette discussion en une page

04/03/2010, 12h17
Archimède
Code:

1 2 Parent := AOwner as TWinControl;
pas mal, je retiens lol :ccool:

Petite remarque Buzz: Tu as l'API GradientFill pour le remplissage dégradé ;).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure Degrader;
var
  Vertex    :array[0..1] of TTriVertex;
  Rectangle :TGradientRect;
 
begin
  Vertex[0].X     := 2;
  Vertex[0].Y     := 2;
  Vertex[0].Red   := GetRValue(StartColor) *$100;
  Vertex[0].Green := GetGValue(StartColor) *$100;
  Vertex[0].Blue  := GetBValue(StartColor) *$100;
 
  Vertex[1].X     := Width -2;
  Vertex[1].Y     := Height-2;
  Vertex[1].Red   := GetRValue(EndColor) *$100;
  Vertex[1].Green := GetGValue(EndColor) *$100;
  Vertex[1].Blue  := GetBValue(EndColor) *$100;
 
  Rectangle.UpperLeft  := 0;
  Rectangle.LowerRight := 1;
 
  GradientFill(Canvas.Handle, @Vertex, 2, @Rectangle, 1, GRADIENT_FILL_RECT_V);
end;

04/03/2010, 13h52
BuzzLeclaire

@Claudius (dit le claude et sa denrée...:mouarf: )
Alors cela fonctionne désormais le checkbox est bien présent dans le TPanel.
J'ai quelque remarque :
- Je n'ai pas toutes les propriétés d'un panel normal (Bevel, etC...) est-ce normal ? dois-je les publiés ? et si oui j'ai juste à installer des prorperty où dois-je également gérer des evenements de ces propriétés ?
@Archimède : tu avait raison pour le parent, sans lui quedalle...

@AndNotOr (dit le malade du code...:mouarf:), j'ai utilisé ton dégrader mais j'ai un problème. Il utilise pas les régions total du panel il reste les bords fin autour. De plus lorsqu'on pose le composant sur un form (en conception) les start et End color ne sont pas respecté, ils se mettent qu'en exécution.

En tout cas grave à vous tous j'ai bien avancé.
04/03/2010, 14h10
Cl@udius

Citation:

Envoyé par BuzzLeclaire

J'ai quelque remarque :
- Je n'ai pas toutes les propriétés d'un panel normal (Bevel, etC...) est-ce normal ?

Oui c'est normal puisque ton compo hérite de TCustomPanel.

Citation:

Envoyé par BuzzLeclaire

dois-je les publiés ?

Oui celles dont tu as besoin. Voire toutes, c'est au choix.

Citation:

Envoyé par BuzzLeclaire

et si oui j'ai juste à installer des property où dois-je également gérer des evenements de ces propriétés ?

Simplement les property dans le published.

PS: Je ne suis pas vraiment un fan de la soupe au choux. :aie:

@+

Citation:

Envoyé par BuzzLeclaire

Il utilise pas les régions total du panel il reste les bords fin autour. De plus lorsqu'on pose le composant sur un form (en conception) les start et End color ne sont pas respecté, ils se mettent qu'en exécution.

C'est comme ça qu'était défini le rectangle de remplissage dans ton code original :roll:. Mais tu peux mettre les X/Y à 0/0 et Width/Height.

Dans tes propriétés, il faudrait remplacer fStartColor par SetStartColor et y appeler Invalidate.
Code:

1 2 3 4 5 6 7 8 9 10 11 property StartColor : Tcolor read fStartColor write SetStartColor; ... procedure TShapeX.SetStartColor(const Value: Tcolor); begin if Value <> fStartColor then begin fStartColor := Value; Invalidate; end; end;

04/03/2010, 15h02
petitprince

Salut!
Tu peux t'inspirer des composants de la librairie AntarèsVCL (lien en bas de ce message), pour étudier la structure d'un composant.
;)

@Claudius désolé pour la soupe... lol
Ok j'ai rajouter tout le Tpanel d'origine. Merci.

@AndNotor,
Oups... j'avais même pas prété attention à ce paramètre...
Merci

Il faut que je vois maintenant si je peux jouer avec mon Caption du Tpanel comme je veux avec ce dégradé.

Voilà le compo fini pour ce à qui ça intéresse (j'ai retiré mon spécifique StringridRu) :

Code:

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
unit PanelBoxRu;
 
interface
 
uses
  Windows, SysUtils, Classes, Controls, StdCtrls ,ExtCtrls, Graphics, Math, Grids, StrUtils, dialogs, Messages;
 
type
  TPanelBoxRu = class(TCustomPanel)
  private
    { Déclarations }
    fStartColor    : Tcolor;
    fEndColor      : Tcolor;
    fCheckBox      : TCheckBox;
    procedure SetCheckBox(value: TCheckBox);
    procedure SetStartColor(value: TColor);
    procedure SetEndColor(value: Tcolor);
  protected
    { Déclarations protégées }
    procedure Paint; override;
    procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
 
  public
    { Déclarations publiques }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Déclarations publiées }
    property Caption;
    property StartColor    : Tcolor read fStartColor write SetStartColor;
    property EndColor      : Tcolor read fEndColor write SetEndColor;
    property CheckBox      : TCheckBox read fCheckBox write SetCheckBox;
 
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property Padding;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowCaption;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property VerticalAlignment;
    property Visible;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
 
  end;
 
procedure Register;
 
implementation
 
 
constructor TPanelBoxRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  fStartColor := clCream;
  fEndColor   := clBtnFace;
  fCheckBox   := TCheckBox.Create(Self);
  With fcheckBox do
  begin
    Parent  := Self;
    Caption := 'Salut les loup c''est Buzz';
    Left    := 5;
    Top     := 5;
  end;
end;
 
 
destructor TPanelBoxRu.Destroy;
begin
  fCheckBox.Free;
  inherited Destroy;
end;
 
procedure TPanelBoxRu.SetCheckBox(value: TCheckBox);
begin
  fCheckBox.assign(value);
end;
 
procedure TPanelBoxRu.SetEndColor(value: Tcolor);
begin
  if Value <> fEndColor then
  begin
    fEndColor := Value;
    Invalidate;
  end;
end;
 
procedure TPanelBoxRu.SetStartColor(value: TColor);
begin
  if Value <> fStartColor then
  begin
    fStartColor := Value;
    Invalidate;
  end;
end;
 
procedure TPanelBoxRu.Paint;
  procedure Degrader;
  var
    Vertex    :array[0..1] of TTriVertex;
    Rectangle :TGradientRect;
 
  begin
    Vertex[0].X     := 0;
    Vertex[0].Y     := 0;
    Vertex[0].Red   := GetRValue(StartColor) *$100;
    Vertex[0].Green := GetGValue(StartColor) *$100;
    Vertex[0].Blue  := GetBValue(StartColor) *$100;
 
    Vertex[1].X     := Width ;
    Vertex[1].Y     := Height;
    Vertex[1].Red   := GetRValue(EndColor) *$100;
    Vertex[1].Green := GetGValue(EndColor) *$100;
    Vertex[1].Blue  := GetBValue(EndColor) *$100;
 
    Rectangle.UpperLeft  := 0;
    Rectangle.LowerRight := 1;
 
    GradientFill(Canvas.Handle, @Vertex, 2, @Rectangle, 1, GRADIENT_FILL_RECT_V);
  end;
begin
  inherited Paint;
  Degrader;
end;
 
procedure Register;
begin
  RegisterComponents('RuCompos', [TPanelBoxRu]);
end;
 
end.

:ccool:

04/03/2010, 16h25
BuzzLeclaire

Bien me revoilà.

J'ai juste encore un petit problème.

Lorsque je pose mon Compo sur une form nous souci.
mais lorsque je le créer en dynamique, le caption du CheckBox et le dégradé du TPanel ne vont pas ensemble, disont que la region du caption du checbox à la même couleur et on voit donc le contour.

J'ai tenté quelque invalidate, mais rien y fait.

Une idée ?

Faut-il encore invalider le bon objet ;).

Code:

1
2
3
4
5
6
7
8
9
procedure TPanelBoxRu.SetStartColor(value: TColor);
begin
  if Value <> fStartColor then
  begin
    fStartColor := Value;
    Invalidate;
    fCheckBox.Invalidate;
  end;
end;

Fallais le trouver celui-là.... :mrgreen:

Mais cela règle pas mon problème.
Etant donner qu'il est enfant d'un StringGridRu, lorsque je scroll dans mon stringgrid, il faudrait que je puisse aussi le invalider. Mais je ne sais pas où le fairez et comment le faire.

Voici une parti de mon stringgridRu que tu connais trés bien puisque tu m'avais aider à le faire.

Code:

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
unit StringGridRu;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids, Messages, Windows, Dialogs;
 
type
 
  TStringGridRu = class(TStringGrid)
  private
    { Déclarations privées }
    foption : Byte;
  protected
    { Déclarations protégées }
     procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
     procedure WMHSCROLL(var Message :TMessage); message WM_HSCROLL;
     procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
     procedure WMKEYDOWN(var Message :TMessage); message WM_KEYDOWN;
  public
    { Déclarations publiques }
      procedure CheckInBounds;
  published
    { Déclarations publiées }
    property Option : Byte read foption write foption;
  end;
 
procedure Register;
 
implementation
 
procedure  TStringGridRu.WMHSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure  TStringGridRu.WMVSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.WMKEYDOWN(var Message: TMessage);
begin
  inherited;
  case Message.WParam of
    33,34,35,36,37,38,39,40:
    begin
      CheckInBounds;
      Invalidate;
    end;
  end;
end;
 
 
procedure TStringGridRu.CheckInBounds;
var
  i,j   :Integer;
  RowDebut :integer;
  RowFin   :integer;
  NbLigneinvisible :integer;
 
  Row :integer;
  Col :integer;
 
begin
  case Option of
    0:
    begin
      //Liste des Shapes
      for i := 0 to ControlCount -1 do
      begin
        Row := Controls[i].Tag;
        //Cache le Shape si la ligne est masquée ou le positionne
        Controls[i].Height  := DefaultRowHeight;
        Controls[i].Visible := (CellRect(0, Row).Top > 0) And ((CellRect(0,Row).Bottom - CellRect(0,Row).Top)>0);
        Controls[i].Top     := CellRect(0, Row).Top;
      end;
    end;
    1:
    begin
//...
end;
 
procedure Register;
begin
  RegisterComponents('RuCompos', [TStringGridRu]);
end;
end.

J'ai essayeé
Controls[i].invalidate;

mais cela ne marche pas, si je scroll les Checkbox disparaissent...

Ok j'ai trouvé j'ai fais cela

Code:

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
 
Implementation
  uses 
   PanelBoxru;
 
// ...
 
procedure TStringGridRu.CheckInBounds;
var
  i,j   :Integer;
  RowDebut :integer;
  RowFin   :integer;
  NbLigneinvisible :integer;
 
  Row :integer;
  Col :integer;
 
begin
  case Option of
    0:
    begin
      //Liste des Shapes
      for i := 0 to ControlCount -1 do
      begin
        Row := Controls[i].Tag;
        //Cache le Shape si la ligne est masquée ou le positionne
        Controls[i].Height  := DefaultRowHeight;
        Controls[i].Visible := (CellRect(0, Row).Top > 0) And ((CellRect(0,Row).Bottom - CellRect(0,Row).Top)>0);
        Controls[i].Top     := CellRect(0, Row).Top;
 
        if Controls[i] is TPanelBoxRu then
           (Controls[i] as TPanelBoxRu).CheckBox.Invalidate;
      end;
    end;
 
// ...

En fait j'avais un probleme de reference circulaire au début a cause que je declarais mon PanelBoxRu avec l'implementation.

je fais quelque test et je viens cloturer.

Merci encore

04/03/2010, 17h13
BuzzLeclaire

Bien,

J'ai du rajouter dans mon autre compo StrungGridRu privée un message WM_LBUTTONUP et WM_RBUTTONUP et maintenant tout est parfait.

Merci encore à vous tous.

:ccool::ccool::ccool::ccool:

Encore mieux: Invalidate est une procédure virtuelle. Surcharge-là :mrgreen:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure Invalidate; override;
...
 
procedure TPanelBoxRu.Invalidate;
var
  i: integer;
begin
  inherited;
 
  for i := 0 to ControlCount -1 do
    Controls[i].Invalidate;
end;

04/03/2010, 17h19
BuzzLeclaire
Citation:
Envoyé par Andnotor

Faut-il encore invalider le bon objet ;).

Code:

1 2 3 4 5 6 7 8 9 procedure TPanelBoxRu.SetStartColor(value: TColor); begin if Value <> fStartColor then begin fStartColor := Value; Invalidate; fCheckBox.Invalidate; end; end;
Tu va me prendre pour un maboule....... MDR

En fait cela ne marche pas on voit toujours le baground du caption du checkbox d'un autre couleur...

(j'avais pas remis la taille du caption tout a l'heure...oupss..)
04/03/2010, 17h25
BuzzLeclaire
Code:

1 2 3 4 5 6 7 8 procedure TPanelBoxRu.Invalidate; var i: integer; begin inherited; for i := 0 to ControlCount -1 do Controls[i].Invalidate;
@AndNotOr

Bien jouée... j'avais pas pensé du tout. Evidement cela m'évite de le faire sur le parent et cela sera valable quelquesoit le moment ou je invalidate le PanelBoxRu il invalidera sont propre control... Superbe...

Par contre je cherche toujours pour le Caption....
04/03/2010, 17h36
Andnotor

Je vois pas le problème avec le caption :koi:
04/03/2010, 17h48
BuzzLeclaire

Tu verras mieux avec cela :

http://rainconnu.free.fr/screen.PNG

Le mot 'supprimer' est le caption du checkbox et il rspecte pas le degrader
04/03/2010, 17h55
Rayek

Citation:

Envoyé par BuzzLeclaire

Tu verras mieux avec cela :

Le mot 'supprimer' est le caption du checkbox et il rspecte pas le degrader

Je dirais, normal, le checkbox n'a pas la propriété de transparence donc il garde le fond basique du panel et pas celui transformé
04/03/2010, 18h02
BuzzLeclaire

Citation:

Envoyé par Rayek

Je dirais, normal, le checkbox n'a pas la propriété de transparence donc il garde le fond basique du panel et pas celui transformé

Ca j'avais pu le remarquer, mais est-il possible de passer outre ? j'ai tenter de mettree le PArentBackground à true rien a faire.

Faut-il que je créer une propriété et que je redessine le caption ? si oui...ouaaaaaaaaaaah on fait comment ?

Chose etrange, c'est que en mode conception cela ne se produit pas !!!
04/03/2010, 19h02
Andnotor

Tu utilises manifestement des composants particuliers pour la gestion des thèmes. Je me demande si c'est pas ça ton problème, parce que chez moi, aucun soucis ! (Ce qui expliquerais aussi pourquoi au design et pas au runtime)

J'essayerais temporairement de les supprimer.

Voir 40 message(s) de cette discussion en une page