Discussion :

[Jipété]

Bonjour,

voilà un truc qui m'a fait souffrir pas mal de temps, et comme tout est dans le titre, je vous donne directement le code pour que vous fassiez vos propres expériences.
Il vous faut un TTreeView et un TRadioGroup (pour le confort).

Ensuite, yakà cliquer sur la flèche à gauche de l'item dans le TreeView et selon que vous avez coché True ou False, ça passe (avec un ShowMessage, en haut) ou ça casse, avec un SIGSEGV, en bas.

Un clic sur la flèche, hein !, ce qui correspond à htOnButton dans HitTests, alors que le texte correspond à htOnItem.

La bonne question c'est : est-ce un bug ou juste une feature ?

Et esthétiquement parlant, ce n'est peut-être pas très heureux, cette grande barre de sélection en mode True.

Les codes :
- de la fiche (unit1.lfm) :

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
object Form1: TForm1
  Left = 307
  Height = 233
  Top = 126
  Width = 320
  Caption = 'un clic sur la flèche'
  ClientHeight = 233
  ClientWidth = 320
  OnCreate = FormCreate
  LCLVersion = '3.8.0.0'
  object tv: TTreeView
    Left = 19
    Height = 109
    Top = 104
    Width = 267
    RowSelect = True
    TabOrder = 0
    OnMouseDown = tvMouseDown
    Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoRowSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
  end
  object rdg: TRadioGroup
    Left = 19
    Height = 72
    Top = 18
    Width = 185
    AutoFill = True
    Caption = 'tvoRowSelect'
    ChildSizing.LeftRightSpacing = 6
    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    ChildSizing.EnlargeVertical = crsHomogenousChildResize
    ChildSizing.ShrinkHorizontal = crsScaleChilds
    ChildSizing.ShrinkVertical = crsScaleChilds
    ChildSizing.Layout = cclLeftToRightThenTopToBottom
    ChildSizing.ControlsPerLine = 1
    ClientHeight = 53
    ClientWidth = 181
    Items.Strings = (
      'True'
      'False'
    )
    OnClick = rdgClick
    TabOrder = 1
  end
end

- du programme (unit1.pas), où j'ai laissé qq notes, tout en bas :

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
unit unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
  ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    rdg: TRadioGroup;
    tv: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure rdgClick(Sender: TObject);
    procedure tvMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
  procedure AddTheRootNode;
  begin
     if tv.Items.Count = 0 then  {Add the root node}
       with tv.Items.AddFirst(nil, 'RootNode') do begin
         Selected := true;
         HasChildren := True;
//         Expand(True); // activé (True ou False) ou désactivé ne change rien au problème.
       end;
  end;
begin
  AddTheRootNode;
  rdg.ItemIndex := 1; // forçage du "default"
end;
 
procedure TForm1.rdgClick(Sender: TObject);
begin
  case rdg.ItemIndex of
    0: tv.RowSelect := True;
    1: tv.RowSelect := False;
  end;
end;
 
procedure TForm1.tvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  aNode: TTreeNode;
begin
  aNode := tv.GetNodeAt(X,Y);
  // GetNodeAt renvoie les nodes EXPANDED d'après l'aide mais c'est faux !
  // Activer la ligne "Expand(True);" dans FormCreate pour confirmer ce défaut...
  ShowMessage(aNode.text);
  // renvoie le texte si clic sur texte et SIGSEGV si clic sur flèche
  // en pas-à-pas les valeurs X et Y sont ok, alors quid du SIGSEGV ?
  // solution 1 :
  // if aNode = nil then ShowMessage('nil !') else ShowMessage(aNode.text);
  // ok au clic sur flèche ET sur texte
  // solution 2 :
  // passer l'option tv.RowSelect à True mais
  // esthétiquement parlant, ce n'est peut-être pas très heureux...
end;
 
end.

Enjoy !