Discussion :

[Djedjeridoo]

Bonjour,

Est-il possible d'avoir sous delphi un panel avec des bords arrondis ?

Ce composant existe-t-il ?

Merci d'avance pour votre réponse,

Cordialement,

Djedjeridoo

[HopeLeaves]

Non, ce composant n'existe pas de base sous delphi.

Maintenant, il n'est surement pas compliqué a crée a partir d'un TPanel, donc il y a surement quelqu'un qui l'a créé un jour.

reste soit a le trouver sur le net,
soit a esperer que quelq'un sur le forum l'ai.

bon courage.

[bjl]

Créer un panel à coins rond, n'est pas excessivement compliqué avec des régions

le plus casse pied, c'est de dessiner les bordures ces coins en fonction des options borderstyle, BevelInner, BevelOuter, et BevelWidth.

sinon, voilà déjà un début de code: il reste la partie dessin à faire

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
Uses Classes, Controls, ExtCtrls;
 
Type TRoundPanel = Class(Tpanel)
  Private
    FCorner : Integer;
    FMaxCorner : Integer;
    Procedure SetCorner( Value : Integer);
    Procedure SetRgn;
  Protected
  Public
    Constructor Create(Aowner : Tcomponent);
    Procedure SetBounds( ALeft, ATop, Awidth, AHeight : Integer); override;
    Procedure Paint; Override;
    Procedure SetParent( AParent : TWinControl); Override;
  Published
    Property Corner : Integer read FCorner Write SetCorner default 10;
  End;
 
implementation
 
Uses math, Windows, Graphics;
 
Constructor TRoundPanel.Create(Aowner : Tcomponent);
Begin
Inherited;
FMaxCorner := 10; {nitialisation à une valeur bidon mais au poins égale à FCorner}
FCorner := 10;
End;
 
 
Procedure TRoundPanel.SetCorner( Value : Integer);
Begin
FMaxCorner :=  min( Height, Width) div 2; {Corner doit être inférieur
  à la moitié du coté le plus petit}
FCorner := Value;
EnsureRange( 0, Fcorner, FMaxCorner);
SetRgn; {mise à jour de la région}
End;
 
 
Procedure TRoundPanel.SetBounds( ALeft, ATop, Awidth, AHeight : Integer);
Var
OldHeight, OldWidth : Integer;
Begin
OldHeight := Height;
OldWidth := Width;
inherited;
If (OldWidth <> Width) or (OldHeight <> Height) then
  SetCorner( Fcorner); {on vérifie que corner reste inférieur à la moitié du
  coté le plus petit : on en profites pour rafraichir la région même si
  Fcorner ne change pas}
ENd;
 
 
Procedure TRoundPanel.SetParent( AParent : TWinControl);
Begin
inherited;
SetRgn;
End;
 
Procedure TRoundPanel.SetRgn;
Var
  rgn : Hrgn;
  ACorner : Integer;
Begin
If Parent = Nil then exit; {Pour éviter une exception si pas de parent}
{on récupère une région : les valeurs de p1 à p4 sont à vérifier : on met -1 pour left et top
de manière à pouvoir dessiner les bordures}
rgn := CreateRoundRectRgn(- 1,  - 1, Width + 1, Height + 1, FCorner * 2, FCorner * 2);
SetWindowRgn(handle, rgn, True); {on assigne la région au handle du control fenètré}
DeleteObject(Rgn); {on supprime la région après usage}
Invalidate;  {appel à peinture}
End;
 
 
Procedure TRoundPanel.Paint;
Begin
inherited;
// dessin des coins à implémenter
End;

[LadyWasky]

Je complète le travail de bjl

1) Il faut rajouter l'unité Themes dans le uses :

Code :

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

Uses math, Windows, Graphics, themes;

2) et puis ça dans l'implémentation, et vous avez Un Panel aux coins arrondis (mettre la propriété BevelWith à 2 pour de meilleurs résultats quand vous utiliserez votre Panel) :

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
 
procedure RoundFrame(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor;
  Width ,TailleCoin: Integer);
 
  procedure DoRect;
  begin
    with Canvas, Rect do
    begin
      Pen.Color := TopColor;
      RoundRect(Left,Top,Right,Bottom,TailleCoin,TailleCoin);
      Pen.Color := BottomColor;
      RoundRect(Left-1,Top,Right,Bottom,TailleCoin,TailleCoin);
    end;
  end;
 
begin
  Canvas.Pen.Width := 1;
  Dec(Rect.Bottom); Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    InflateRect(Rect, -1, -1);
  end;
  Inc(Rect.Bottom); Inc(Rect.Right);
end;
 
Procedure TRoundPanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
  FontHeight: Integer;
  Flags: Longint;
 
  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;
 
begin
  Rect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    RoundFrame(Canvas, Rect, TopColor, BottomColor, BevelWidth,FCorner);
  end;
  RoundFrame(Canvas, Rect, Color, Color, BorderWidth,FCorner);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    RoundFrame(Canvas, Rect, TopColor, BottomColor, BevelWidth ,FCorner);
  end;
  with Canvas do
  begin
    if not ThemeServices.ThemesEnabled or not ParentBackground then
    begin
      Brush.Color := Color;
      FillRect(Rect);
    end;
    Brush.Style := bsClear;
    Font := Self.Font;
    FontHeight := TextHeight('W');
    with Rect do
    begin
      Top := ((Bottom + Top) - FontHeight) div 2;
      Bottom := Top + FontHeight;
    end;
    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;