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 ?