Discussion :

[der§en]

Bonjour,

J’ai cherché à supprimer les borders du composant TPageControl pour faire plus moderne et épuré sans la moindre réussite

Auriez-vous une idée ou un bout de code qui le permettrait ?

Merci d’avance de vos retours.

[der§en]

Désolé, j'ai oublié de préciser que j’utilise Delphi 10.2 et je suis sur un Windows 11.

[ShaiLeTroll]

Est-ce au niveau du TPageControl ou au niveau du TTabSheet, en tout cas, un truc est prévu chez MS : TCM_ADJUSTRECT

Et si tu utilises un Style, voir peut-etre l'éditer pour retirer les bordures (c'est souvent juste un trait d'une couleur différente du fond pour l'illusion 3D)
Voir fournir ton propre TTabControlStyleHook et utiliser un TTabControl au lieu d'un TPageControl, faut gérer soit même des panels (Form dockée par exemple)

[der§en]

J’utilise déjà TCM_ADJUSTREC pour le fond, mais concernant les « tabs », j’arrive déjà à les colorer individuellement mais pas à faire disparaître ces bords en pseudo 3D !

[ShaiLeTroll]

Il existe Vcl.Tabs.TTabSet.EdgeWidth ça pourrait être intéressant à regarder pour le reporter sur le TPageControl

As-tu envisagé de passer à TTabControl, il n'y a plus physiquement de containeur TTabSheet, tu auras peut-être plus de liberté.

Surtout qu'avec le thème Aero, l'effet 3D avait disparu, même le fond par défaut était blanc et non plus gris, j'avais eu des efforts de bord d'un TAnimate qui ne prenait pas la bonne couleur de fond justement à cause de ça en XE2 + Theme VCL

Je fait plus trop d'IHM, alors à force, je ne rappelle même plus à quoi ça ressemble.

EDIT : Je savais que je l'avais dans du vieux code qui doit dater de genre 2005 sous D7 qui a été régulièrement modernisé au moins jusqu'en 2019 sous XE2.

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
 
type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
  end;
 
{*------------------------------------------------------------------------------
  Bidouille pour virer les bords blancs entre les TPageControls et les TTabSheets
-------------------------------------------------------------------------------}
procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
  inherited;
  if Msg.WParam = 0 then
    InflateRect(PRect(Msg.LParam)^, 1, 2)
  else
    InflateRect(PRect(Msg.LParam)^, 0, -2);
end;

[der§en]

Alors je vais montrer visuellement ce que je n'arrive pas a faire "disparaitre", il s'agit des bords des TABS contenu dans le rectangle rouge




J'ai mis OwnerDraw a True et vider les options de StyleElements

Voici le code que j'utilise déjà pour faire "disparaitre" le contour des TAbSheet et colorer le fond du TabControl ainsi que les TABS:

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
 
type
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;
 
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
  end;
 
......
 
const
  Colors: array[0..4] of TColor = ($00FFD2B0, $00C2F0C2, $00CCE0FF, $00FFF2B0, $00E0CCE0);
 
.....
 
procedure TTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LRect  : TRect;
  LCanvas: TCanvas;
begin
  if (PageControl <> nil) and (PageControl.Style = tsTabs) and (PageControl.OwnerDraw = True) then
  begin
    //Get the bounds of the Tabsheet
    GetWindowRect(Handle, LRect);
    OffsetRect(LRect, -LRect.Left, -LRect.Top);
 
    //create a TCanvas for erase the background, using the DC of the message
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := Message.DC;
      LCanvas.Brush.Color:= clGradientInactiveCaption;
      LCanvas.FillRect(LRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;
 
    Message.Result := 1;
  end
  else
    inherited;
end;
 
procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
  inherited;
 
  if Msg.WParam = 0 then
    InflateRect(PRect(Msg.LParam)^, 4, 4)
  else
    InflateRect(PRect(Msg.LParam)^, -4, -4);
end;
 
.....
 
procedure TForm1.pcMenusDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  PageControl: TPageControl;
  TabCaption: string;
  FillColor: TColor;
  i: Integer;
  R: TRect;
  TexColor, TabColor: TColor;
begin
  PageControl := Control as TPageControl;
  TabCaption  := PageControl.Pages[TabIndex].Caption;
  R           := Rect;
  TabColor    := clGradientInactiveCaption;
  TexColor    := clGray;
 
  if Active then
  begin
    TabColor := Colors[TabIndex mod 5];
    TexColor := clBlack;
  end;
 
  PageControl.Canvas.Brush.Color := TabColor;
  PageControl.Canvas.Font.Color  := TexColor;
 
  PageControl.Canvas.FillRect(R);
 
  InflateRect(R, -2, -2);
 
  DrawText(PageControl.Canvas.Handle, PChar(TabCaption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;

[SergioMaster]

Je n'ai plus la version 10.2 d'installée.
Cependant, après consultation du Docwiki pour Tokyo la propriété OwnerDraw et son évènement OnDrawTab existent pourquoi n'est-ce pas utilisé ?

[der§en]

Heu, si je l'utilise, c'est dans le bas de la zone de code !

Sinon, j'ai aussi testé cette approche:

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
 
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    const
      Colors: array[0..4] of TColor = ($00FFD2B0, $00C2F0C2, $00CCE0FF, $00FFF2B0, $00E0CCE0);
 
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
  protected
    procedure DrawTab(Index: Integer; const Rect: TRect; Active: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
.......
 
constructor TPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StyleElements := [];  // Désactive les styles visuels
  OwnerDraw := True;    // Active le dessin personnalisé
  SetWindowTheme(Handle, '', '');  // Désactive le thème Windows
end;
 
procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
  inherited;
 
  if Msg.WParam = 0 then
    InflateRect(PRect(Msg.LParam)^, 4, 4)
  else
    InflateRect(PRect(Msg.LParam)^, -4, -4);
end;
 
procedure TPageControl.DrawTab(Index: Integer; const Rect: TRect; Active: Boolean);
var
  TabCaption: string;
  R: TRect;
  TexColor, TabColor: TColor;
begin
  TabCaption  := Pages[Index].Caption;
  R           := Rect;
  TabColor    := clGradientInactiveCaption;
  TexColor    := clGray;
 
  if Active then
  begin
    TabColor := Colors[Index mod 5];
    TexColor := clBlack;
  end;
 
  Canvas.Brush.Color := TabColor;
  Canvas.Font.Color  := TexColor;
 
  InflateRect(R, 2, 2);
 
  Canvas.FillRect(R);
 
  DrawText(Canvas.Handle, PChar(TabCaption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;

[Invité]

Si on souhaite pas perturber le gestionnaire de dessin par défaut il faut utiliser WM_PAINT

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
procedure TPageControl.WMPaint(var Message: TWMPaint);
var
 R: TRect;
begin
 inherited;
 with Tcanvas.Create do
 try
   handle:= Getdc(self.handle);
   Perform(TCM_GETITEMRECT, ActivePageIndex, WParam(@R));
   inflaterect(R,2,2);
   pen.width := 2;
   pen.Color := self.Color;
   brush.style := bsclear;
   Rectangle(R);
 finally
     free;
 end;
end;

[ShaiLeTroll]

Alors je vais montrer visuellement ce que je n'arrive pas a faire "disparaitre", il s'agit des bords des TABS contenu dans le rectangle rouge

On dirait que tu veux réinventer le TRibbon !

Ah c'est pas le conteneur mais les onglets directement, essayer un autre style genre "Flat" ou même une série de SpeedButton, à un moment donné faut penser à un code plus simple avec des controles simples que vouloir tout refaire qui risque de ne plus fonctionner avec les caprices du Style Windows.

Sinon, en mode Style VCL, faut réécrire le StyleHook, là tu as la main sur tout.

Sur quel Windows et quel Delphi tu tournes pour avoir cet aspect ?
Aspect Windows ( style ComCtrls V6 soit soit depuis XP )
Aspect Thème VCL (Amethyst par exemple)


Sur D10 et Windows 11 cela ne s'affiche pas du tout comme ce que tu montres !
L'icone DX ferait penser que tu es sur D10 ... tu n'aurais pas désactivé totalement le thème ?


C'est le style de Win2K dans ce cas donc là tu n'as même pas le XP Manifest dans ton programme, cela change TOTALEMENT les controles Windows, c'est plus les mêmes versions, leurs comportements sont différents (dont la partie que l'on peut redessiner par exemple) ... du coup tu perds le thème XP\Aero et tout la partie style VCL

Pourquoi avoir décocher cette case et vouloir un style flat qui est justement l'aspect normal du Windows qui a arrêté de mettre des effets 3D partout au profit d'un style OS plus neutre.

[der§en]

Je suis sur Delphi 10.2.3 et sur win 11, j’ai désactivé le style uniquement pour le TPageControl.

Mon appli VCL utilise le style par défauts : Windows.

Je ne veux pas refaire TRibbon, je voulais juste épurer le dessin des onglets en virant le pseudo 3D

[ShaiLeTroll]

Je ne savais pas même pas que tu pouvais remettre un style Windows 2K sur un controle en particulier alors que le reste de l'application est en style WinXP\Aero avec SetWindowTheme, on dirait qu'avec le OnwerDraw à True, cette instruction ne sert à rien en réalité, c'est le OwnerDraw qui justement provoque l'ajout de la 3D

Tu devrais remettre le style Aero par défaut, tu auras un aspect non 3D !
Par défaut, c'est XPManifest actif donc impact le style Windows, je ne sais pas ce que tu as fais mais tu devrais repartir sur une base saine car là, je pense que tu as créé plus de problème qu'autre chose !

Avec Amethyst actif pour activer le StyleHook


Faut maintenant reproduire le mode "Style VCL" dans un contrôle en Style Système et contourner justement le style OS (dans ce cas, retour au style Win2K et non Aero)

Attention, ça date de XE2, faudrait le refaire à partir du code de D10 car en 10 ans, ils sont du corriger les bugs de l'époque

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
unit Unit2;
 
interface
 
uses
  Winapi.Windows,
  Vcl.Themes, Vcl.ComCtrls, Vcl.Graphics;
 
type
  TSLTTabControlStyleHookFix = class(TTabControlStyleHook)
  protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
  end;
 
 
implementation
 
type
 TCustomTabControlHack = class(TCustomTabControl);
 
//------------------------------------------------------------------------------
procedure TSLTTabControlStyleHookFix.DrawTab(Canvas: TCanvas; Index: Integer);
const
  Colors: array[0..4] of TColor = ($00FFD2B0, $00C2F0C2, $00CCE0FF, $00FFF2B0, $00E0CCE0);
 
  // Code original privé : TTabControlStyleHook.AngleTextOut ; Fichier : Vcl.ComCtrls ; Ligne : 29912 !
  procedure AngleTextOut(Canvas: TCanvas; Angle: Integer; X, Y: Integer; const Text: string);
  var
    NewFontHandle, OldFontHandle: hFont;
    LogRec: TLogFont;
  begin
    GetObject(Canvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
    LogRec.lfEscapement := Angle * 10;
    LogRec.lfOrientation := LogRec.lfEscapement;
    NewFontHandle := CreateFontIndirect(LogRec);
    OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
    SetBkMode(Canvas.Handle, TRANSPARENT);
    Canvas.TextOut(X, Y, Text);
    NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
    DeleteObject(NewFontHandle);
  end;
 
// Code original protégé : TTabControlStyleHook.DrawTab ; Fichier : Vcl.ComCtrls ; Ligne : 29928 !
var
  R, LayoutR, GlyphR: TRect;
  TexColor, TabColor: TColor;
  ImageWidth, ImageHeight, ImageStep, TX, TY: Integer;
  DrawState: TThemedTab;
  Details: TThemedElementDetails;
  ThemeTextColor: TColor;
  FImageIndex: Integer;
begin
  // SLT : dimensions des images récupérées uniquement lorsque cela sera vraiment utile !
 
  R := TabRect[Index];
  if R.Left < 0 then Exit;
 
  if TabPosition in [tpTop, tpBottom] then
  begin
    if Index = TabIndex then
      InflateRect(R, 0, 2);
  end
  else if Index = TabIndex then
    Dec(R.Left, 2) else Dec(R.Right, 2);
 
  Canvas.Font.Assign(TCustomTabControlHack(Control).Font);
  LayoutR := R;
  DrawState := ttTabDontCare;
  case TabPosition of
    tpTop:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemHot
        else
          DrawState := ttTabItemNormal;
      end;
    tpLeft:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemLeftEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemLeftEdgeHot
        else
          DrawState := ttTabItemLeftEdgeNormal;
      end;
    tpBottom:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemBothEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemBothEdgeHot
        else
          DrawState := ttTabItemBothEdgeNormal;
      end;
    tpRight:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemRightEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemRightEdgeHot
        else
          DrawState := ttTabItemRightEdgeNormal;
      end;
  end;
 
  if StyleServices.Available then
  begin
    Details := StyleServices.GetElementDetails(DrawState);
    StyleServices.DrawElement(Canvas.Handle, Details, R);
  end;
 
  { Fond }
  TabColor    := clGradientInactiveCaption;
  TexColor    := clGray;
 
  if Index = TabIndex then
  begin
    TabColor := Colors[TabIndex mod 5];
    TexColor := clBlack;
  end;
 
  Canvas.Pen.Color := TabColor;
  Canvas.Pen.Style := psSolid; // Suffisant !
  Canvas.Brush.Color := TabColor;
  Canvas.Brush.Style := bsSolid; // Suffisant !
  Canvas.Font.Color  := TexColor;
 
  Canvas.Rectangle(R);
 
  { Image }
 
  // SLT : Il faut récupérer l'index image avant de récupérer les dimensions !
  // Surtout si la liste d'image a un nombre inférieur d'image au nombre d'onglet !
  // Sinon, la position de l'image est mal centrée tout comme le texte (impacte sur LayoutR)
  if Control is TCustomTabControl then
    FImageIndex := TCustomTabControlHack(Control).GetImageIndex(Index)
  else
    FImageIndex := Index;
 
  if (Images <> nil) and (FImageIndex >= 0) and (FImageIndex < Images.Count) then
  begin
    // SLT : dimensions récupérées au moment opportun (code original dans fichier : Vcl.ComCtrls ; ligne 29939)
    ImageWidth := Images.Width;
    ImageHeight := Images.Height;
    ImageStep := 3;
 
    GlyphR := LayoutR;
    case TabPosition of
      tpTop, tpBottom:
        begin
          GlyphR.Left := GlyphR.Left + ImageStep;
          GlyphR.Right := GlyphR.Left + ImageWidth;
          LayoutR.Left := GlyphR.Right;
          GlyphR.Top := GlyphR.Top + (GlyphR.Bottom - GlyphR.Top) div 2 - ImageHeight div 2;
          if (TabPosition = tpTop) and (Index = TabIndex) then
            OffsetRect(GlyphR, 0, -1)
          else if (TabPosition = tpBottom) and (Index = TabIndex) then
            OffsetRect(GlyphR, 0, 1);
        end;
      tpLeft:
        begin
          GlyphR.Bottom := GlyphR.Bottom - ImageStep;
          GlyphR.Top := GlyphR.Bottom - ImageHeight;
          LayoutR.Bottom := GlyphR.Top;
          GlyphR.Left := GlyphR.Left + (GlyphR.Right - GlyphR.Left) div 2 - ImageWidth div 2;
        end;
      tpRight:
        begin
          GlyphR.Top := GlyphR.Top + ImageStep;
          GlyphR.Bottom := GlyphR.Top + ImageHeight;
          LayoutR.Top := GlyphR.Bottom;
          GlyphR.Left := GlyphR.Left + (GlyphR.Right - GlyphR.Left) div 2 - ImageWidth div 2;
        end;
    end;
    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, Details, GlyphR, Images.Handle, FImageIndex);
  end;
 
  { Text }
  if StyleServices.Available then
  begin
    if (TabPosition = tpTop) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, -1)
    else if (TabPosition = tpBottom) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, 1);
 
    if TabPosition = tpLeft then
    begin
      TX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 -
        Canvas.TextHeight(Tabs[Index]) div 2;
      TY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 +
        Canvas.TextWidth(Tabs[Index]) div 2;
     if StyleServices.GetElementColor(Details, ecTextColor, ThemeTextColor) then
       Canvas.Font.Color := ThemeTextColor;
      AngleTextOut(Canvas, 90, TX, TY, Tabs[Index]);
    end
    else if TabPosition = tpRight then
    begin
      TX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 +
        Canvas.TextHeight(Tabs[Index]) div 2;
      TY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 -
        Canvas.TextWidth(Tabs[Index]) div 2;
      if StyleServices.GetElementColor(Details, ecTextColor, ThemeTextColor)
      then
        Canvas.Font.Color := ThemeTextColor;
      AngleTextOut(Canvas, -90, TX, TY, Tabs[Index]);
    end
    else
      DrawControlText(Canvas, Details, Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE  or DT_NOCLIP);
  end;
end;
 
initialization
  TStyleManager.Engine.RegisterStyleHook(TPageControl, TSLTTabControlStyleHookFix) ;
 
 
end.

Donc en VCL sans style, on va y aller en mode brutal !

Voici le résultat


Note le bord sur le dernier onglet, voir le code "Cas du dernier bord" pour affiner cela, cela résoud le problème mais je te laisse affiner le InflateRect à ton besoin

Idem pour le OwnerDraw, à toi de voir comment cela se comporte à True ou à False,
A False = Tu pourrais rarement voir un scintillement
A True = Cela affiche la bordure du conteneur !

Voici le résultat avec OnwerDraw à False + le code pour le dernier bouton
Note la bordure plus fine dans ce cas (oui elle est là mais presque invisible)



Voici le code, je me suis limité au strict nécessaire, je te laisse fusionner avec ton code existant pour d'autres parties à modifier.

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
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, Winapi.CommCtrl,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls;
 
type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    const
      Colors: array[0..4] of TColor = ($00FFD2B0, $00C2F0C2, $00CCE0FF, $00FFF2B0, $00E0CCE0);
 
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
 public
    constructor Create(AOwner: TComponent); override;
 end;
 
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
constructor TPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Je le laisserais à False à choisir pour l'aspect non 3D 
  // OwnerDraw := True;    // Désactive le dessin par défaut mais n'utilise pas le dessin personnalisé
end;
 
procedure TPageControl.WMPaint(var Message: TWMPaint);
var
  I: Integer;
  TabRect, BorderRect: TRect;
  TabCaption: string;
  TexColor, TabColor: TColor;
begin
  inherited;
 
  for I := 0 to PageCount - 1 do
  begin
    if TabCtrl_GetItemRect(Handle, I, TabRect) then
    begin
      TabCaption  := Pages[I].Caption;
      TabColor    := clGradientInactiveCaption;
      TexColor    := clGray;
 
      if I = ActivePageIndex then
      begin
        TabColor := Colors[I mod 5];
        TexColor := clBlack;
      end;
 
      BorderRect := TabRect;
      InflateRect(BorderRect, 1, 1);
      // Cas du dernier bord
      if I = PageCount - 1 then
        BorderRect.Width := BorderRect.Width + 1;
 
      Canvas.Pen.Color := TabColor;
      Canvas.Pen.Style := psSolid;
      Canvas.Brush.Color := TabColor;
      Canvas.Brush.Style := bsSolid;
      Canvas.Rectangle(BorderRect);
 
      Canvas.Font.Color  := TexColor;
      DrawText(Canvas.Handle, PChar(TabCaption), -1, TabRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    end;
  end;
end;
 
procedure TPageControl.CNNotify(var Message: TWMNotify);
begin
  inherited;
  Invalidate();
end;
 
 
 
end.

Code dfm :

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
 
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 394
  ClientWidth = 798
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 64
    Top = 40
    Width = 433
    Height = 193
    ActivePage = TabSheet5
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'TabSheet1'
      object Panel1: TPanel
        Left = 128
        Top = 80
        Width = 185
        Height = 41
        Caption = 'Panel1'
        TabOrder = 0
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'TabSheet2'
      ImageIndex = 1
      object Panel2: TPanel
        Left = 160
        Top = 80
        Width = 185
        Height = 41
        Caption = 'Panel2'
        TabOrder = 0
      end
    end
    object TabSheet3: TTabSheet
      Caption = 'TabSheet3'
      ImageIndex = 2
      object Panel3: TPanel
        Left = 192
        Top = 88
        Width = 185
        Height = 41
        Caption = 'Panel3'
        TabOrder = 0
      end
    end
    object TabSheet4: TTabSheet
      Caption = 'TabSheet4'
      ImageIndex = 3
      object Panel4: TPanel
        Left = 152
        Top = 48
        Width = 185
        Height = 41
        Caption = 'Panel4'
        TabOrder = 0
      end
    end
    object TabSheet5: TTabSheet
      Caption = 'TabSheet5'
      ImageIndex = 4
      object Panel5: TPanel
        Left = 144
        Top = 88
        Width = 185
        Height = 41
        Caption = 'Panel5'
        TabOrder = 0
      end
    end
  end
end

[der§en]

Merci pour ton explication lumineuse

Y’a juste un petit souci que ma solution avait résolu: les bords de la zone TabSheet que j’avais fait disparaître, je vais voir s’il y a un moyen de fusionner !

[ShaiLeTroll]

En théorie, c'est TCMAdjustRect qui supprime le bord du conteneur, j'ai mis le strict essentiel pour éviter les parasites / effets de bord.

EDIT : Confirmé, ajoute juste TCMAdjustRect et tu peux remettre OwnerDraw à True pour n'avoir QUE le dessin via WMPaint.

[der§en]

Merci, je mets le sujet a résolu

[der§en]

J'ai adapté la fonction DrawTab depuis ma version contenu dans la VCL ?

Il me reste juste une petite question, j'ai 2 pagecontrol dans ma form, et je souhaite que le fix ne s'applique que sur le premier, comment pourrais-je modifier mon DrawTab, as-ton avis ?

[ShaiLeTroll]

Tu es parti sur DrawTab plutôt que WMPaint ?

Fourni ton code pour que l'on reparte sur une bonne base mais si tu ne veux que modifier le Premier PageControl, tu peux te baser sur OwnerDraw peut-être, au lieu de le définir dans le constructeur, tu le défini via l'inspecteur d'objet

Si OnwerDraw est à False, cela n'appelera pas OnDrawTab
Si tu utilises l'approche WMPaint suffit de d'ajouter un if not OnwerDraw then Exit; juste après le inherited.

Tu peux aussi utiliser des propriétés Colors / ColorCount et AddColor pour définir les couleurs à utiliser, c'est comme ça très explicite
Si le array of TColorest vide, cela ne fait aucun dessin (faut mettre OwnerDraw à False évidemment)

[der§en]

[der§en]

@ShaiLeTroll dans la solution WMPaint, tu utilises ceci: TabCtrl_GetItemRect, cela provient d’où ?

PS: Oups, je vient de trouver c'est dans Winapi.CommCtrl, désolé...