Bonjour à tous,

Voilà mon dilème.
J'utilise depuis quelque temps cette procedure pour rendre mes Shapes plus esthétiques :
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
 
type
 
  TRuShape = class(TShape)
    Private
      FStartColor:Tcolor;
      FEndColor:Tcolor ;
      fCaption1:String;
      fCaption2:String;
    Protected
      Procedure Paint;override;
    Published
      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;
  end;
 
  TForm1 = class(TForm)
....
 
 
procedure TRuShape.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;
Utilisation

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
 
Shape := TruShape.Create(StringGridSemaine); // Self pour les purristes
With Shape do
  Begin
     ParentFont := False;
     Font.Size := 7;
     Font.Name := 'Tahoma';
     Name := 'Shape1';
     Caption := 'Shape1';
     Top := 0;
     left := 0;
     Height := 30;
     Width := 100;
     Parent := StringGridSemaine;
     Pen.Color := clBlack;
     StartColor := clCream;
     EndColor := clblue;
end;
Je ne sais pas où placer mon
Brush.Style := BsCross

En effet si je le mets pendant la création du Shape il me mets la couleur du shape tout noir avec le cross et on peut plus lire le caption.

Comment avoir un BsCross sans perdre l'esthétique du shape ?