CheckBox in Shape ( modifié en checkBox in Panel )

**BuzzLeclaire** · 04/03/2010, 00h19

Bonjour à toutes

et à tous,

Comment peut-on ajouter un CheckBox sur un shape ? Sachant que le Shape est personnalisé avec un dégarder.

Vois mon ShapeRu :

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
unit ShapeRu;
 
interface
 
uses
  Windows, SysUtils, Classes, Controls, ExtCtrls, Graphics, Math, Grids,
  StrUtils, dialogs, Messages;
 
type
  TShapeRu = class(TShape)
  private
    { Déclarations }
    FStartColor    : Tcolor;
    FEndColor      : Tcolor ;
    fCaption1      : String;
    fCaption2      : String;
  protected
    { Déclarations protégées }
    procedure Paint; override;
  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 fStartColor ;
    property EndColor      : Tcolor read FEndColor write FEndColor ;
    property Caption1      : String read fCaption1 write fCaption1;
    property Caption2      : String read fCaption2 write fCaption2;
 
    property PopupMenu;
  end;
 
procedure Register;
 
implementation
 
constructor TShapeRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;
 
destructor TShapeRu.Destroy;
begin
  inherited Destroy;
end;
 
procedure TShapeRu.Paint;
  Procedure Degrader;
  Var
    TailleDuTexte : Integer;
    aBand : TRect;    { Bande rectangulaire de couleur courante }
    i : Integer;  { Compteur pour parcourir la hauteur de la fiche }
    FStartRGB  : Array[0..2] of Byte;    { RGB de la couleur de départ }
    FCurrentRGB : Array[0..2] of Byte;    { RGB de la couleur courante  }
    FDeltaRGB  : Array[0..2] of Integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
    nbtranches: integer;
    Rect:TRect;
  Begin
    Rect.Left := 2;
    Rect.Top := 2;
    Rect.Right := Self.Width-2;
    Rect.Bottom := Self.Height-2;
    self.ParentColor := false;
    { Calcul des valeurs RGB pour la couleur courante }
    FStartRGB[0] := GetRValue( ColorToRGB( StartColor ) );
    FStartRGB[1] := GetGValue( ColorToRGB( StartColor ) );
    FStartRGB[2] := GetBValue( ColorToRGB( StartColor ) );
    { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
    FDeltaRGB[0] := GetRValue( ColorToRGB( EndColor )) - FStartRGB[0] ;
    FDeltaRGB[1] := GetgValue( ColorToRGB( EndColor )) - FStartRGB[1] ;
    FDeltaRGB[2] := GetbValue( ColorToRGB( EndColor )) - FStartRGB[2] ;
 
    { Initialisation des dimensions de la bande de couleur }
    aBand.Left :=Rect.Left;
    aBand.Right:=Rect.Right;
    nbtranches:=min(256, Rect.Bottom-Rect.Top);
    { Boucle pour remplir la fiche courante en dégradé }
    With Canvas Do
    Begin
      Pen.Style:=psSolid;
      Pen.Mode:=pmCopy;
      For i:= 0 To nbtranches-1 Do
      Begin
          { Dimensions verticales de la bande }
          aBand.Left :=Rect.Left;
          aBand.Right:=Rect.Right;
          aBand.Top := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*i);
          aBand.Bottom := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*(i+1));
 
          { Calcul de la couleur courante }
          FCurrentRGB[0] := (FStartRGB[0] + MulDiv( i , FDeltaRGB[0] , nbtranches )) mod 256;
          FCurrentRGB[1] := (FStartRGB[1] + MulDiv( i , FDeltaRGB[1] , nbtranches )) mod 256;
          FCurrentRGB[2] := (FStartRGB[2] + MulDiv( i , FDeltaRGB[2] , nbtranches )) mod 256;
          { Affichage sur la fiche }
          Brush.color:=RGB(FCurrentRGB[0],FCurrentRGB[1],FCurrentRGB[2]);
          FillRect(aBand);
      End;
      Font.Name := Self.Font.Name;
      Font.Size   := self.Font.Size;
      Brush.Style := bsClear;
      if Self.Caption1 = '' then DrawText(Canvas.Handle, PChar(Self.Caption) , -1, Rect, DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      else
      Begin
        DrawText(Canvas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        TailleDuTexte := DrawText(Canvas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        Rect.Top := Rect.Top + TailleDuTexte + 2;
        Pen.Color := clBlack;
        MoveTo(Rect.Left+2,Rect.Top);
        LineTo(Rect.Right-2,Rect.top);
        Rect.Top := Rect.Top + 2;
        DrawText(Canvas.Handle, PChar(Self.Caption2) , -1, Rect, DT_NOPREFIX or DT_WORDBREAK);
      end;
    End;
  End;
begin
  inherited Paint;
  Degrader;
end;
 
procedure Register;
begin
  RegisterComponents('RuCompos', [TShapeRu]);
end;
 
end.

J'ai essayé quelque truc, mais il apparait jamais le checkbox.

Pouvez-vous m'aider ?

**BuzzLeclaire** · 04/03/2010, 11h21

Re bonjour,

Je suis partis sur un nouveau composant pour ne pas toucher à celui-ci.

Mais je ne sais pas du toiut comment faire dans ma procedure PAINT pour placer mon Check box.
Est-ce que dans le create du compo le terme SELF et approrié pour la creation du checkbox ?

Voici le composant avec un propriété CheckBox

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
unit ShapeBoxRu;
 
interface
 
uses
  Windows, SysUtils, Classes, Controls, StdCtrls ,ExtCtrls, Graphics, Math, Grids,
  StringGridRu, StrUtils, dialogs, Messages;
 
type
  TShapeBoxRu = class(TShape)
  private
    { Déclarations }
    fStartColor    : Tcolor;
    fEndColor      : Tcolor;
    fCheckBox      : TCheckBox;
    procedure SetCheckBox(value: TCheckBox);
  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 fStartColor;
    property EndColor      : Tcolor read fEndColor write FEndColor;
    property CheckBox      : TCheckBox read fCheckBox write SetCheckBox;
  end;
 
procedure Register;
 
implementation
 
constructor TShapeBoxRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fCheckBox := fCheckBox.Create(Self);
end;
 
destructor TShapeBoxRu.Destroy;
begin
  fCheckBox.Free;
  inherited Destroy;
end;
 
procedure TShapeBoxRu.SetCheckBox(value: TCheckBox);
begin
  fCheckBox.assign(value);
end;
 
procedure TShapeBoxRu.Paint;
  Procedure Degrader;
  Var
    TailleDuTexte : Integer;
    aBand : TRect;    { Bande rectangulaire de couleur courante }
    i : Integer;  { Compteur pour parcourir la hauteur de la fiche }
    FStartRGB  : Array[0..2] of Byte;    { RGB de la couleur de départ }
    FCurrentRGB : Array[0..2] of Byte;    { RGB de la couleur courante  }
    FDeltaRGB  : Array[0..2] of Integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
    nbtranches: integer;
    Rect:TRect;
  Begin
    Rect.Left := 2;
    Rect.Top := 2;
    Rect.Right := Self.Width-2;
    Rect.Bottom := Self.Height-2;
    self.ParentColor := false;
    { Calcul des valeurs RGB pour la couleur courante }
    FStartRGB[0] := GetRValue( ColorToRGB( StartColor ) );
    FStartRGB[1] := GetGValue( ColorToRGB( StartColor ) );
    FStartRGB[2] := GetBValue( ColorToRGB( StartColor ) );
    { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
    FDeltaRGB[0] := GetRValue( ColorToRGB( EndColor )) - FStartRGB[0] ;
    FDeltaRGB[1] := GetgValue( ColorToRGB( EndColor )) - FStartRGB[1] ;
    FDeltaRGB[2] := GetbValue( ColorToRGB( EndColor )) - FStartRGB[2] ;
 
    { Initialisation des dimensions de la bande de couleur }
    aBand.Left :=Rect.Left;
    aBand.Right:=Rect.Right;
    nbtranches:=min(256, Rect.Bottom-Rect.Top);
    { Boucle pour remplir la fiche courante en dégradé }
    With Canvas Do
    Begin
      Pen.Style:=psSolid;
      Pen.Mode:=pmCopy;
      For i:= 0 To nbtranches-1 Do
      Begin
          { Dimensions verticales de la bande }
          aBand.Left :=Rect.Left;
          aBand.Right:=Rect.Right;
          aBand.Top := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*i);
          aBand.Bottom := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*(i+1));
 
          { Calcul de la couleur courante }
          FCurrentRGB[0] := (FStartRGB[0] + MulDiv( i , FDeltaRGB[0] , nbtranches )) mod 256;
          FCurrentRGB[1] := (FStartRGB[1] + MulDiv( i , FDeltaRGB[1] , nbtranches )) mod 256;
          FCurrentRGB[2] := (FStartRGB[2] + MulDiv( i , FDeltaRGB[2] , nbtranches )) mod 256;
          { Affichage sur la fiche }
          Brush.color:=RGB(FCurrentRGB[0],FCurrentRGB[1],FCurrentRGB[2]);
          FillRect(aBand);
      End;
      Font.Name := Self.Font.Name;
      Font.Size := Self.Font.Size;
      Brush.Style := bsClear;
      DrawText(Canvas.Handle, PChar(Self.Caption) , -1, Rect, DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
    End;
  End;
begin
  inherited Paint;
  Degrader;
end;
 
procedure TShapeBoxRu.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  TStringGridRu(Parent).CheckInBounds;
end;
 
procedure Register;
begin
  RegisterComponents('RuCompos', [TShapeBoxRu]);
end;
 
end.

Peut-etre que ce que je fais est pas possible ?

**Archimède** · 04/03/2010, 11h29

Code :

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

1
2
3
4
5
6
7
 
constructor TShapeBoxRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fCheckBox := fCheckBox.Create(Self);
  fCheckBox.parent:=self;
end;

je crois que si tu ne définis pas son parent, tu ne le verras pas...

**BuzzLeclaire** · 04/03/2010, 11h32

Envoyé par Archimède

Code :

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

1
2
3
4
5
6
7
 
constructor TShapeBoxRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fCheckBox := fCheckBox.Create(Self);
  fCheckBox.parent:=self;
end;

je crois que si tu ne définis pas son parent, tu ne le verras pas...

Salut,

En fait en voulant poser un TShapeBoxRu sur une form vierge, j'ai droit à un super message d'erreur (je suis pas pro des compos perso) et j'ai ajouter ta proposition et là je peux carément pas compiler :

Code :

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

[DCC Erreur] ShapeBoxRu.pas(43): E2010 Types incompatibles : 'TWinControl' et 'TComponent'

Sur la ligne du parent.

**Cl@udius** · 04/03/2010, 11h37

Salut

Code :

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

 fCheckBox := fCheckBox.Create(Self);

Code :

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

 fCheckBox := TCheckBox.Create(Self);

@+

**BuzzLeclaire** · 04/03/2010, 11h45

Envoyé par Cl@udius

Salut

Code :

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

 fCheckBox := fCheckBox.Create(Self);

Code :

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

 fCheckBox := TCheckBox.Create(Self);

@+

Pfff quel idiot.. merci.

Donc là je peux poser mon compo sur une form. Mais je ne vois pas le CheckBox.

Que me reste-t-il à faire ?

Et quellle sont les choses que j'oublis ?

Merci

**Archimède** · 04/03/2010, 11h43

Code :

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

1
2
3
4
5
6
7
8
9
 
constructor TShapeBoxRu.Create(AOwner : TComponent;hote:Twincontrol));
begin
begin
inherited create(aowner);
parent:=hote;
fCheckBox := TCheckBox.Create(Self);
fCheckBox.parent:=self;
end;

non ?

avec déclaration

Code :

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

constructor create(aowner:Tcomponent;hote:Twincontrol);reintroduce;overload;

**BuzzLeclaire** · 04/03/2010, 11h52

Envoyé par Archimède

Code :

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

1
2
3
4
5
6
7
8
9
 
constructor TShapeBoxRu.Create(AOwner : TComponent;hote:Twincontrol));
begin
begin
inherited create(aowner);
parent:=hote;
fCheckBox := TCheckBox.Create(Self);
fCheckBox.parent:=self;
end;

non ?

A priori je n'ai pas besoin de parent.

J'ai tout de même ajouter ta proposition (en corrigeant Self par hote) et le probleme c'est que 1 le create n'ai plus override ce qui peut-etre fais qu'ensuite cela ne fonctionne pas du tout en conception, la prorpiété CheckBox est bien présent mais rien d'autre.

Donc j'ai remis comme cela

Code :

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

1
2
3
4
5
constructor TShapeBoxRu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fCheckBox := TCheckBox.Create(Self);
end;

Mais en conception, déjà le nom du compo (pas le name) est ShapeBoxRu1.
J'ai bien toutes les fonctions du CheckBox accessible (dans l'inspecteur d'objet) mais toujours invisible, même si je n'execute pas le Paint du ShapeBoxRu.

CheckBox in Shape ( modifié en checkBox in Panel )

Composants VCL Delphi

Vue hybride

Discussions similaires

Partager

Partager