FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
var  
  tbs : TTabSheet;  
begin  
  //On s'assure que Self est un descendant de TComponent 
  assert(Self is TComponent, 'L''objet Self n''est pas un descendant de TComponent'); 
  // Création de la page 
  tbs := TTabSheet.Create(Self);  
  // Création du contenu de la page 
  with TFrame2.Create(self) do  
  begin  
    // Attention, chaque frame doit avoir un nom différent 
    Name := 'Frame2' + intToStr(PageControl1.PageCount);  
    Align := alClient;  
    Parent := tbs;  
  end;  
  // Ajout de la page au TPageControl 
  tbs.PageControl := PageControl1;  
  // Modification du titre de l'onglet 
  tbs.Caption := 'Frame n°' + intToStr(PageControl1.PageCount);  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
var  
  tbs : TTabSheet;  
begin  
  //On s'assure que Self est un descendant de TComponent 
  assert(Self is TComponent, 'L''objet Self n''est pas un descendant de TComponent'); 
  tbs := TTabSheet.Create(self);  
  with TMemo.Create(self) do  
  begin  
    Align := alClient;  
    Parent := tbs;  
  end;  
  tbs.PageControl := PageControl1;  
  tbs.Caption := 'n°' + intToStr(PageControl1.PageCount);  
end;

TabSheet1.TabVisible := False;

1
2
TabSheet1.TabVisible := False; 
TabSheet1.Visible := True;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
type 
  TForm1 = class(TForm) 
    PageControl1: TPageControl; 
    TabSheet1: TTabSheet; 
    TabSheet2: TTabSheet; 
    TabSheet3: TTabSheet; 
    TabSheet4: TTabSheet; 
    TabSheet5: TTabSheet; 
  private 
    { Déclarations privées } 
    function GetDroppedIndex(X, Y: Integer): Integer; 
  public 
    { Déclarations publiques } 
  end;

1
2
3
4
5
6
7
8
9
10
11
12
13
// Fonction qui permet d'identifier, en fonction des  coordonnées  
// de la souris au-dessus d'un TPageControl, l'index de l'onglet  
// qui se trouve sous le curseur de la souris. 
function TForm1.GetDroppedIndex(X, Y: Integer): Integer; 
var 
  HitTestInfo: TTCHitTestInfo; 
begin 
  HitTestInfo.pt := Point(X,Y); 
  {Utilisation de l'API Windows SendMessage, avec envoi d'un message 
  TCM_HITTEST au TPageControl. Le résultat de la fonction  
  nous donne l'index de l'onglet "visé" par la souris.} 
  result := SendMessage(PageControl1.Handle, TCM_HITTEST, 0, Longint(@HitTestInfo)); 
end;

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
//Evènement OnMouseDown de votre TPageControl  
// (début du glissé-déposé : on commence le glissement de l'onglet) 
procedure TForm1.PageControl1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  {Si c'est le bouton gauche de la souris qui est enfoncé...} 
  if Button = mbLeft then 
    {...alors on active la fonctionnalité de glissé-déposé (Drag And Drop) 
    le paramètre "False" de la fonction BeginDrag() signifie que le pointeur 
    de la souris ne change pas et que le glissement ne commence que 
    lorsque l'utilisateur déplace la souris sur une courte distance (1 pixel).} 
    TPageControl(Sender).BeginDrag(False); 
end; 
  
// Événement OnDragOver de votre TPageControl 
// (Le glissé-déposé est en train de se faire :  
// la souris passe au-dessus du TPageControl) 
procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, 
  Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
  // Ceci est le code original qui posait problème si, dans le même projet,  
  // le glissé déplacé de 2 PageContol étaient implémentés : 
  // bug lors du glissé-déplacé d'un Pagecontrol à un autre... 
  // ---------------------- 
  // {On autorise l'utilisateur à déposer "l'objet" du Drag and Drop  
  //  si la source est un TPageControl} 
  // Accept := Source is TPageControl; 
  // ---------------------- 
  
  //Ceci est le code proposé : 
  //------------------------ 
 {On autorise l'utilisateur à déposer "l'objet" du Drag and Drop  
    si la Source est la même que le  Sender --> notre TPageControl             
    s'identifie comme étant sa propre source} 
  Accept := (Source=Sender) and (Sender is TPageContol);   
  //-------------------------- 
end; 
  
// Événement OnDragDrop de votre TPageControl  
// (fin du glisser-déposer : on dépose l'onglet) 
procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, 
  Y: Integer); 
begin 
  {L'onglet déposé, celui qui est actif (ActivePage), prend comme valeur 
   d'index (PageIndex) celui de l'onglet visé par la souris  
   (utilisation de GetDroppedIndex)} 
  TPageControl(Sender).ActivePage.PageIndex := GetDroppedIndex(X, Y); 
  {Fin du glissé-déposé --> passage de True en paramètre} 
  TPageControl(Sender).EndDrag(True); 
end;

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
implementation 
uses CommCtrl; 
  
{$R *.dfm} 
(* 
Fonction qui permet, en fonction des  coordonnées de la souris 
qui se trouve au-dessus d'un TPageControl : 
- d'identifier l'index de l'onglet qui se trouve sous le curseur de la souris 
- puis de déterminer le "rectangle" de dessin de cet onglet 
- puis, à partir de la position de la souris dans ce rectangle (à gauche ou à droite du milieu) 
  de déterminer si l'onglet sera inséré avant ou après (inc(result)) 
  l'onglet "visé" par la souris. 
*) 
function GetTabIndex(APageControl:TPageControl;X, Y: Integer): Integer; 
var TabRect: TRect; 
begin 
  {Le résultat de cette fonction 
  nous donne l'index de l'onglet qui se trouve aux coordonnées X,Y 
  (le repère de référence étant la fenêtre du TPageControl)} 
  Result := APageControl.IndexOfTabAt(X,Y); 
  // Si la souris se trouve au dessus d'un onglet 
  if Result>-1 then 
  begin 
    // On récupère le rectangle de l'onglet visé 
    TabRect:=APageControl.TabRect(Result); 
    // Si on est dans la partie droite de ce rectangle 
    if x>((TabRect.Left+TabRect.Right) div 2) 
    // Alors l'index d'insertion est (Index de l'onglet visé)+1 
    then Inc(Result); 
  end; 
end; 
  
// Procedure qui dessine une petite ligne rouge permettant de visualiser 
// le point d'insertion 
procedure DrawInsertionPoint(APageControl:TPageControl;X,Y:integer); 
var TabRect: TRect; 
    TabIndex:integer; 
    X1,X2,Y1,Y2:integer; 
begin 
  // On obtient l'index où serait éventuellement inséré notre onglet 
  TabIndex:=GetTabIndex(APageControl,x,y); 
  // La petite ligne indicatrice sera rouge 
  APageControl.Canvas.Pen.Color:=clRed; 
  
  if (TabIndex<APageControl.PageCount) 
  // Si l'onglet ne serait pas déposé en dernière place 
  then begin 
         // On prend les coordonnées du "rectangle" de dessin de l'onglet qu'il 
         // peut remplacer 
         TabRect:=APageControl.TabRect(TabIndex); 
         // À partir de là, on calcule les coordonnées (X1,Y1)--(X2,Y2) de 
         // notre ligne qui sera tracée sur son bord gauche 
         X1:=TabRect.Left; 
         X2:=X1; 
         Y1:=TabRect.Top; 
         Y2:=TabRect.Bottom; 
        end 
  // Si l'onglet serait déposé en dernière place (TabIndex<APageControl.PageCount) 
   else begin 
          // On prend les coordonnées du "rectangle" de dessin du dernier onglet 
          TabRect:=APageControl.TabRect(TabIndex-1); 
          // Puis on calcule les coordonnées (X1,Y1)--(X2,Y2) de 
          // notre ligne qui sera tracée sur son bord droit 
          X1:=TabRect.Right; 
          X2:=X1; 
          Y1:=TabRect.Top; 
          Y2:=TabRect.Bottom; 
         end; 
   // On trace notre petite ligne 
    APageControl.Canvas.MoveTo(X1,Y1); 
    APageControl.Canvas.LineTo(X2,Y2); 
end; 
  
  
// Procedure chargée de déposer un onglet à la fin d'un glissé-déposé 
procedure DoTabDragDrop(Sender, Source: TPageControl; X, 
  Y: Integer); 
const TCM_GETITEMRECT = $130A; 
var i: Integer; 
    SourceIndex,TargetIndex:Integer; 
    ATabSheet:TTabSheet; 
begin 
   if Sender=Source 
   // Si le glissé-déposé concerne un TPageControl sur lui même 
   then begin 
           {On détermine la nouvelle valeur d'index de l'onglet que l'on dépose} 
           TargetIndex:=GetTabIndex(Sender,x,y); 
           {Si on ne le dépose pas "dans le vide"} 
           if (TargetIndex>-1) 
           {L'onglet déposé, celui qui est actif (ActivePage), prend sa nouvelle 
            valeur d'index (PageIndex)} 
           then begin 
                  // Si le nouvel index est supérieur à l'ancien index, 
                  // on le décrémente, sinon l'onglet est "mal déplacé" 
                  if (TargetIndex>Sender.ActivePage.PageIndex) then dec(TargetIndex); 
                  Sender.ActivePage.PageIndex:=TargetIndex; 
                end; 
        end 
   // Si le glissé-déposé s'effectue entre deux TPageControl différents... 
   else begin 
           {On détermine l'index de l'onglet que l'on dépose} 
           SourceIndex:=Source.ActivePage.PageIndex; 
           {On détermine la nouvelle valeur d'index de l'onglet que l'on dépose} 
           TargetIndex:=GetTabIndex(Sender,x,y); 
           {Si on ne le dépose pas "dans le vide"} 
           if TargetIndex>-1 then 
           begin 
              // On récupère la référence de notre onglet 
              ATabSheet:=Source.Pages[SourceIndex]; 
              // On l'affecte à son nouveau TPageControl 
              ATabSheet.PageControl:=Sender; 
              // Et on lui assigne son nouvel index 
              ATabSheet.PageIndex:=TargetIndex; 
           end; 
        end; 
end; 
  
// Événement OnMouseDown de votre TPageControl 
// (début du glissé-déposé : on commence le glissement de l'onglet) 
procedure TForm1.PageControl1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  if (Sender is TPageControl) 
  {On active la fonctionnalité de glissé-déposé (Drag And Drop) 
   le paramètre "False" de la fonction BeginDrag() signifie que le pointeur 
   de la souris ne change pas et que le glissement ne commence que 
   lorsque l'utilisateur déplace la souris sur une courte distance (1 pixel).} 
  then (Sender as TPageControl).BeginDrag(False); 
end; 
  
// Événement OnDragDrop de votre TPageControl 
// (fin du glissé-déposé : on dépose l'onglet) 
procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, 
  Y: Integer); 
begin 
   if (Sender is TPageControl) and (Source is TPageControl) then 
   begin 
     // Utilisation de notre procedure chargée de déposer 
     // un onglet à la fin d'un glissé-déposé 
     DoTabDragDrop((Sender as TPageControl), (Source as TPageControl),X,Y); 
     {Fin du glissé-déposé --> passage de True en paramètre} 
     (Source as TPageControl).EndDrag(True); 
   end; 
end; 
  
// Événement OnDragOver de votre TPageControl 
// (Le glissé-déposé est en train de se faire : 
// la souris passe au-dessus du TPageControl) 
procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, 
  Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
   if (Sender is TPageControl) then 
   begin 
     //On redessine notre TPageControl (pour effacer notre ligne d'insertion) 
     (Sender as TPageControl).Repaint; 
     //Si la souris quitte notre cible de glissé-déposé on ignore ce qui suit 
     if State<>dsDragLeave 
     then begin 
            Accept := True; 
            //On dessine le point d'insertion 
            DrawInsertionPoint((Sender as TPageControl),X,Y); 
          end; 
   end; 
end; 
end.