~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/include/treeview.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
77
77
// NodeArray must be sorted via Top
78
78
// returns index of Node with Node.Top <= y < Node[+1].Top
79
79
var
80
 
  l, m, r: integer;
 
80
  l, m, r, VisibleCount: integer;
 
81
  VisibleNodesAlloc: Boolean;
 
82
  VisibleNodes: TTreeNodeArray;
81
83
begin
82
84
  if (Count = 0) or (NodeArray = nil) then
83
85
    Exit(-1);
84
 
  l := 0;
85
 
  r := Count - 1;
86
 
  while (l <= r) do
87
 
  begin
88
 
    m := (l + r) shr 1;
89
 
    //DebugLn(':0 [IndexOfNodeAtTop] m=',m,' y=',y,' ',NodeArray[m].Text,' NodeArray[m].Top=',NodeArray[m].Top,' NodeArray[m].BottomExpanded=',NodeArray[m].BottomExpanded);
90
 
    if NodeArray[m].Top > y then
91
 
      r := m - 1
92
 
    else
93
 
    if NodeArray[m].BottomExpanded <= y then
94
 
      l := m + 1
95
 
    else
96
 
      Exit(m);
 
86
  // Count the visible nodes
 
87
  VisibleCount := 0;
 
88
  VisibleNodesAlloc := False;
 
89
  for l := 0 to Count-1 do
 
90
    if NodeArray[l].Visible then
 
91
      Inc(VisibleCount);
 
92
  try
 
93
    // Make a temporary array of visible nodes if there are hidden nodes
 
94
    if VisibleCount < Count then begin
 
95
      GetMem(VisibleNodes,SizeOf(Pointer)*VisibleCount);
 
96
      m := 0;
 
97
      for l := 0 to Count-1 do
 
98
        if NodeArray[l].Visible then begin
 
99
          VisibleNodes[m] := NodeArray[l];
 
100
          Inc(m);
 
101
        end;
 
102
      Count := VisibleCount;
 
103
      VisibleNodesAlloc := True;
 
104
    end
 
105
    else
 
106
      VisibleNodes := NodeArray;
 
107
    // Binary search for the Y coordinate
 
108
    l := 0;
 
109
    r := Count - 1;
 
110
    while (l <= r) do
 
111
    begin
 
112
      m := (l + r) shr 1;
 
113
      //DebugLn(':0 [IndexOfNodeAtTop] m=',m,' y=',y,' ',NodeArray[m].Text,' NodeArray[m].Top=',NodeArray[m].Top,' NodeArray[m].BottomExpanded=',NodeArray[m].BottomExpanded);
 
114
      if VisibleNodes[m].Top > y then
 
115
        r := m - 1
 
116
      else if VisibleNodes[m].BottomExpanded <= y then
 
117
        l := m + 1
 
118
      else
 
119
        Exit(VisibleNodes[m].Index);
 
120
    end;
 
121
    Result := -1;
 
122
  finally
 
123
    if VisibleNodesAlloc then
 
124
      Freemem(VisibleNodes);
97
125
  end;
98
 
  Result := -1;
99
126
end;
100
127
 
101
128
// procedure for sorting a TTreeNodeArray
222
249
  end;
223
250
end;
224
251
 
225
 
procedure TTreeNodeExpandedState.Apply(FirstTreeNode: TTreeNode);
 
252
procedure TTreeNodeExpandedState.Apply(FirstTreeNode: TTreeNode; CollapseToo: boolean);
226
253
var
227
254
  ChildNode: TTreeNode;
228
255
  ANode: TAvgLvlTreeNode;
233
260
  while ChildNode<>nil do begin
234
261
    ChildNodeText:=ChildNode.Text;
235
262
    ANode:=Children.FindKey(PChar(ChildNodeText),@CompareTextWithExpandedNode);
236
 
    ChildNode.Expanded:=ANode<>nil;
237
 
    if ANode<>nil then
238
 
      TTreeNodeExpandedState(ANode.Data).Apply(ChildNode.GetFirstChild);
 
263
    if ANode<>nil then
 
264
      ChildNode.Expanded:=true
 
265
    else if CollapseToo then
 
266
      ChildNode.Expanded:=false;
 
267
    if ANode<>nil then
 
268
      TTreeNodeExpandedState(ANode.Data).Apply(ChildNode.GetFirstChild,CollapseToo);
239
269
    ChildNode:=ChildNode.GetNextSibling;
240
270
  end;
241
271
end;
242
272
 
243
 
procedure TTreeNodeExpandedState.Apply(TreeView: TCustomTreeView);
 
273
procedure TTreeNodeExpandedState.Apply(TreeView: TCustomTreeView; CollapseToo: boolean);
244
274
begin
245
 
  Apply(TreeView.Items.GetFirstNode);
 
275
  Apply(TreeView.Items.GetFirstNode,CollapseToo);
246
276
end;
247
277
 
248
278
{ TTreeNode }
259
289
constructor TTreeNode.Create(AnOwner: TTreeNodes);
260
290
begin
261
291
  inherited Create;
 
292
  FNodeEffect := gdeNormal;
262
293
  FImageIndex := -1;
263
294
  FOverlayIndex := -1;
264
295
  FSelectedIndex := -1;
267
298
  FOwner := AnOwner;
268
299
  FSubTreeCount := 1;
269
300
  FIndex := -1;
 
301
  FVisible := True;
270
302
  if Owner<>nil then inc(Owner.FCount);
271
303
end;
272
304
 
273
305
destructor TTreeNode.Destroy;
 
306
var
 
307
  lOwnerAccessibleObject, lAccessibleObject: TLazAccessibleObject;
274
308
begin
275
309
  {$IFDEF TREEVIEW_DEBUG}
276
310
  DebugLn('[TTreeNode.Destroy] Self=',DbgS(Self),' Self.Text=',Text);
279
313
 
280
314
  // we must trigger TCustomTreeView.OnDeletion event before
281
315
  // unbinding.See issue #17832.
282
 
  if (Owner <> nil) and (Owner.Owner <> nil) then
 
316
  if Assigned(Owner) and Assigned(Owner.Owner) then
283
317
    Owner.Owner.Delete(Self);
284
318
 
 
319
  // Remove the accessibility object too
 
320
  if Assigned(Owner) and Assigned(Owner.Owner) then
 
321
  begin
 
322
    lOwnerAccessibleObject := Owner.Owner.GetAccessibleObject();
 
323
    if lOwnerAccessibleObject<>nil then
 
324
    begin
 
325
      lAccessibleObject := lOwnerAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
 
326
      if lAccessibleObject <> nil then
 
327
        lOwnerAccessibleObject.RemoveChildAccessibleObject(lAccessibleObject);
 
328
    end;
 
329
  end;
 
330
 
285
331
  // delete children
286
332
  HasChildren := false;
287
333
  // unbind all references
288
334
  Unbind;
289
335
 
290
 
  if Owner<>nil then
 
336
  if Assigned(Owner) then begin
291
337
    dec(Owner.FCount);
 
338
    if FStates * [nsSelected, nsMultiSelected] <> [] then
 
339
      Owner.FSelection.Remove(Self);
 
340
  end;
292
341
 
293
342
  Data := nil;
294
343
  // free data
295
 
  if FItems<>nil then begin
 
344
  if Assigned(FItems) then
 
345
  begin
296
346
    FreeMem(FItems);
297
 
    FItems:=nil;
 
347
    FItems := nil;
298
348
  end;
299
349
  inherited Destroy;
300
350
end;
358
408
end;
359
409
 
360
410
procedure TTreeNode.SetText(const S: string);
 
411
var
 
412
  lSelfAX: TLazAccessibleObject;
361
413
begin
362
414
  if S=FText then exit;
363
415
  FText := S;
369
421
    else TreeView.AlphaSort;
370
422
  end;
371
423
  Update;
 
424
  // Update accessibility information
 
425
  lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
 
426
  if lSelfAX <> nil then
 
427
    lSelfAX.AccessibleValue := S;
372
428
end;
373
429
 
374
430
procedure TTreeNode.SetData(AValue: Pointer);
402
458
  Update;
403
459
end;
404
460
 
 
461
procedure TTreeNode.SetImageEffect(AValue: TGraphicsDrawEffect);
 
462
begin
 
463
  if FNodeEffect=AValue then exit;
 
464
  FNodeEffect := AValue;
 
465
  Update;
 
466
end;
 
467
 
405
468
procedure TTreeNode.SetImageIndex(AValue: TImageIndex);
406
469
begin
407
470
  if FImageIndex=AValue then exit;
448
511
  Update;
449
512
end;
450
513
 
 
514
procedure TTreeNode.SetVisible(const AValue: Boolean);
 
515
begin
 
516
  if FVisible = AValue then exit;
 
517
  FVisible := AValue;
 
518
  Selected := False;
 
519
  if TreeView<>nil then
 
520
    TreeView.FStates:=TreeView.FStates+[tvsScrollbarChanged,tvsTopsNeedsUpdate,
 
521
                                        tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate,
 
522
                                        tvsMaxLvlNeedsUpdate,tvsMaxRightNeedsUpdate];
 
523
  Update;
 
524
end;
 
525
 
451
526
procedure TTreeNode.SetOverlayIndex(AValue: Integer);
452
527
begin
453
528
  if FOverlayIndex = AValue then exit;
462
537
  Update;
463
538
end;
464
539
 
465
 
function TTreeNode.AreParentsExpanded: Boolean;
466
 
var ANode: TTreeNode;
 
540
function TTreeNode.AreParentsExpandedAndVisible: Boolean;
 
541
var
 
542
  ANode: TTreeNode;
467
543
begin
468
544
  Result:=false;
469
545
  ANode:=Parent;
470
546
  while ANode<>nil do begin
471
 
    if not ANode.Expanded then exit;
 
547
    if not (ANode.Expanded and ANode.Visible) then exit;
472
548
    ANode:=ANode.Parent;
473
549
  end;
474
550
  Result:=true;
543
619
  
544
620
  // Set self as last selected node
545
621
  TheTreeNodes.FLastMultiSelected := Self;
546
 
 
547
622
end;
548
623
 
549
624
function TTreeNode.CompareCount(CompareMe: Integer): Boolean;
690
765
    Exclude(FStates,nsSelected);
691
766
    if (TV<>nil) and (TV.Selected=Self) then
692
767
    begin
693
 
      TV.EndEditing(true);
 
768
      {$IFDEF TREEVIEW_DEBUG}
 
769
      DebugLn('TTreeNode.SetSelected: Removing selection from Node (but it does not work): ', Text);
 
770
      {$ENDIF}
 
771
//      TV.EndEditing(true);    // Done in TV.SetSelection
694
772
      TV.Selected:=nil;
695
 
      if TV.Selected=Self then
696
 
        Include(FStates,nsSelected);
 
773
      Assert(TV.Selected<>Self, 'Should not happen');
 
774
      //if TV.Selected=Self then
 
775
      //  Include(FStates,nsSelected);
697
776
    end;
698
777
  end;
699
778
  Update;
755
834
end;
756
835
 
757
836
function TTreeNode.BottomExpanded: integer;
 
837
var
 
838
  Node: TTreeNode;
758
839
begin
759
 
  if GetNextSibling <> nil then
760
 
    Result := GetNextSibling.Top
761
 
  else
762
 
  if Expanded and (GetLastChild <> nil) then
763
 
    Result := GetLastChild.BottomExpanded
764
 
  else
765
 
    Result := Bottom;
 
840
  Node := GetNextVisibleSibling;
 
841
  if Node <> nil then
 
842
    Result := Node.Top
 
843
  else begin
 
844
    Node := GetLastVisibleChild;
 
845
    if Expanded and (Node <> nil) then
 
846
      Result := Node.BottomExpanded
 
847
    else
 
848
      Result := Bottom;
 
849
  end;
766
850
end;
767
851
 
768
852
function TTreeNode.GetFocused: Boolean;
771
855
end;
772
856
 
773
857
procedure TTreeNode.SetHasChildren(AValue: Boolean);
774
 
//var Item: TTVItem;
775
858
begin
776
859
  if AValue=HasChildren then exit;
777
860
  //DebugLn('[TTreeNode.SetHasChildren] Self=',DbgS(Self),' Self.Text=',Text,' AValue=',AValue);
782
865
      GetLastChild.Free;
783
866
    Exclude(FStates,nsHasChildren)
784
867
  end;
785
 
  { Delphi:
786
 
  with Item do
787
 
  begin
788
 
    mask := TVIF_CHILDREN;
789
 
    hItem := ItemId;
790
 
    cChildren := Ord(Value);
791
 
  end;
792
 
  TreeView_SetItem(Handle, Item);
793
 
  }
794
868
  Update;
795
869
end;
796
870
 
806
880
 
807
881
function TTreeNode.GetNextVisible: TTreeNode;
808
882
begin
809
 
  if Expanded and (GetFirstChild<>nil) then
810
 
    Result:=GetFirstChild
 
883
  if FVisible and Expanded and (GetFirstVisibleChild<>nil) then
 
884
    Result:=GetFirstVisibleChild
811
885
  else begin
812
886
    Result:=Self;
813
 
    while (Result<>nil) and (Result.GetNextSibling=nil) do
 
887
    while (Result<>nil) and (Result.GetNextVisibleSibling=nil) do
814
888
      Result:=Result.Parent;
815
 
    if Result<>nil then Result:=Result.GetNextSibling;
 
889
    if Result<>nil then
 
890
      Result:=Result.GetNextVisibleSibling;
816
891
  end;
817
 
  if (Result<>nil) and (not Result.IsVisible) then
 
892
  if (Result<>nil) and ( (not Result.FVisible) or (not AreParentsExpandedAndVisible) ) then
818
893
    Result:=nil;
819
894
end;
820
895
 
 
896
function TTreeNode.GetNextVisibleSibling: TTreeNode;
 
897
begin
 
898
  Result := Self;
 
899
  repeat
 
900
    Result := Result.GetNextSibling;
 
901
  until ((Result=nil) or (Result.FVisible));
 
902
  if (Result<>nil) and (not Result.FVisible) then // Result := nil ... will be removed
 
903
    Assert(False,'TTreeNode.GetNextVisibleSibling: (Result<>nil) and (not Result.FVisible)');
 
904
end;
 
905
 
821
906
function TTreeNode.GetPrevVisible: TTreeNode;
822
907
var
823
908
  ANode: TTreeNode;
824
909
begin
825
 
  Result:=GetPrevSibling;
 
910
  Result:=GetPrevVisibleSibling;
826
911
  if Result <> nil then begin
827
 
    while Result.Expanded do begin
828
 
      ANode:=Result.GetLastChild;
 
912
    while Result.Visible and Result.Expanded do begin
 
913
      ANode:=Result.GetLastVisibleChild;
829
914
      if ANode=nil then break;
830
915
      Result:=ANode;
831
916
    end;
832
 
  end else
 
917
  end
 
918
  else
833
919
    Result := Parent;
834
 
  if (Result<>nil) and (TreeView<>nil) and (not TreeView.IsNodeVisible(Result))
835
 
  then
 
920
  if (Result<>nil) and ( (not Result.FVisible) or (not AreParentsExpandedAndVisible) ) then
836
921
    Result:=nil;
837
922
end;
838
923
 
 
924
function TTreeNode.GetPrevVisibleSibling: TTreeNode;
 
925
begin
 
926
  Result := Self;
 
927
  repeat
 
928
    Result := Result.GetPrevSibling;
 
929
  until ((Result=nil) or (Result.FVisible));
 
930
  if (Result<>nil) and (not Result.FVisible) then  // Result := nil ... will be removed
 
931
    Assert(False,'TTreeNode.GetPrevVisibleSibling: (Result<>nil) and (not Result.FVisible)');
 
932
end;
 
933
 
839
934
function TTreeNode.GetPrevExpanded: TTreeNode;
840
935
var
841
936
  ANode: TTreeNode;
842
937
begin
843
 
  Result:=GetPrevSibling;
 
938
  Result:=GetPrevVisibleSibling;
844
939
  if Result <> nil then begin
845
 
    while Result.Expanded do begin
846
 
      ANode:=Result.GetLastChild;
 
940
    while Result.Visible and Result.Expanded do begin
 
941
      ANode:=Result.GetLastVisibleChild;
847
942
      if ANode=nil then break;
848
943
      Result:=ANode;
849
944
    end;
850
 
  end else
851
 
    Result := Parent;
 
945
  end
 
946
  else
 
947
    Result:=Parent;
852
948
end;
853
949
 
854
950
function TTreeNode.GetNextChild(AValue: TTreeNode): TTreeNode;
860
956
end;
861
957
 
862
958
function TTreeNode.GetNextExpanded: TTreeNode;
 
959
var
 
960
  ANode: TTreeNode;
863
961
begin
864
 
  if Expanded and (GetFirstChild<>nil) then
865
 
    Result:=GetFirstChild
 
962
  ANode := GetFirstVisibleChild;
 
963
  if Expanded and (ANode<>nil) then
 
964
    Result:=ANode
866
965
  else begin
867
966
    Result:=Self;
868
 
    while (Result<>nil) and (Result.GetNextSibling=nil) do
 
967
    while (Result<>nil) and (Result.GetNextVisibleSibling=nil) do
869
968
      Result:=Result.Parent;
870
 
    if Result<>nil then Result:=Result.GetNextSibling;
 
969
    if Result<>nil then
 
970
      Result:=Result.GetNextVisibleSibling;
871
971
  end;
872
972
end;
873
973
 
897
997
    Result:=nil;
898
998
end;
899
999
 
 
1000
function TTreeNode.GetFirstVisibleChild: TTreeNode;
 
1001
begin
 
1002
  Result := GetFirstChild;
 
1003
  if (Result<>nil) and (not Result.FVisible) then
 
1004
    Result := Result.GetNextVisibleSibling;
 
1005
end;
 
1006
 
900
1007
function TTreeNode.GetLastSibling: TTreeNode;
901
1008
begin
902
1009
  if Parent<>nil then
916
1023
    Result := nil;
917
1024
end;
918
1025
 
 
1026
function TTreeNode.GetLastVisibleChild: TTreeNode;
 
1027
begin
 
1028
  Result := GetLastChild;
 
1029
  if Assigned(Result) and not Result.Visible then begin
 
1030
    Result := Result.GetPrevVisible;
 
1031
    // ToDo: implement this better. Now it works only when Self is visible.
 
1032
    if Result = Self then begin                     // No visible nodes found.
 
1033
      Assert(Visible, 'TTreeNode.GetLastVisibleChild: Node is not Visible');
 
1034
      Result := Nil;
 
1035
    end;
 
1036
  end;
 
1037
end;
 
1038
 
919
1039
function TTreeNode.GetLastSubChild: TTreeNode;
920
 
var Node: TTreeNode;
 
1040
var
 
1041
  Node: TTreeNode;
921
1042
begin
922
1043
  Result:=GetLastChild;
923
1044
  if Result<>nil then begin
930
1051
function TTreeNode.GetNext: TTreeNode;
931
1052
begin
932
1053
  Result:=GetFirstChild;
933
 
  if Result=nil then begin
934
 
    // no children, search next
935
 
    Result:=Self;
936
 
    while (Result<>nil) and (Result.FNextBrother=nil) do
937
 
      Result:=Result.Parent;
938
 
    if Result<>nil then Result:=Result.FNextBrother;
939
 
  end;
 
1054
  if Result=nil then
 
1055
    Result:=GetNextSkipChildren;
 
1056
end;
 
1057
 
 
1058
function TTreeNode.GetNextSkipChildren: TTreeNode;
 
1059
begin
 
1060
  Result:=Self;
 
1061
  while (Result<>nil) and (Result.FNextBrother=nil) do
 
1062
    Result:=Result.Parent;
 
1063
  if Result<>nil then
 
1064
    Result:=Result.FNextBrother;
940
1065
end;
941
1066
 
942
1067
function TTreeNode.GetPrev: TTreeNode;
1056
1181
 
1057
1182
function TTreeNode.IndexOf(AValue: TTreeNode): Integer;
1058
1183
begin
1059
 
  if (AValue=nil) or (AValue.FParent<>Self) then begin
 
1184
  if (AValue = nil) or (AValue.FParent <> Self) then
 
1185
  begin
1060
1186
    Result:=-1;
1061
1187
    exit;
1062
1188
  end;
1063
 
  Result:=AValue.GetIndex;
 
1189
  Result := AValue.GetIndex;
1064
1190
end;
1065
1191
 
1066
1192
function TTreeNode.IndexOfText(const NodeText: string): Integer;
1067
1193
begin
1068
 
  Result:=Count-1;
1069
 
  while Result>=0 do begin
1070
 
    if FItems[Result].Text=NodeText then exit;
 
1194
  Result := Count - 1;
 
1195
  while Result >= 0 do
 
1196
  begin
 
1197
    if FItems[Result].Text = NodeText then exit;
1071
1198
    dec(Result);
1072
1199
  end;
1073
1200
end;
1083
1210
var
1084
1211
  Node: TTreeNode;
1085
1212
begin
1086
 
  Result:='';
1087
 
  Node:=Self;
1088
 
  while Node<>nil do begin
1089
 
    if Result<>'' then
1090
 
      Result:='/'+Result;
1091
 
    Result:=Node.Text+Result;
1092
 
    Node:=Node.Parent;
 
1213
  Result := '';
 
1214
  Node := Self;
 
1215
  while Assigned(Node) do
 
1216
  begin
 
1217
    if Result <> '' then
 
1218
      Result := '/' + Result;
 
1219
    Result := Node.Text + Result;
 
1220
    Node := Node.Parent;
1093
1221
  end;
1094
1222
end;
1095
1223
 
1096
1224
function TTreeNode.GetCount: Integer;
1097
1225
begin
1098
 
  Result:=FCount;
 
1226
  Result := FCount;
1099
1227
end;
1100
1228
 
1101
1229
procedure TTreeNode.EndEdit(Cancel: Boolean);
1201
1329
  FPrevMultiSelected:=nil;
1202
1330
end;
1203
1331
 
1204
 
procedure TTreeNode.InternalMove(ANode: TTreeNode;
1205
 
  AddMode: TAddMode);
 
1332
function AddModeStr(AddMode: TAddMode): string;
 
1333
begin
 
1334
  WriteStr(Result, AddMode);
 
1335
end;
 
1336
 
 
1337
procedure TTreeNode.InternalMove(ANode: TTreeNode; AddMode: TAddMode);
1206
1338
{
1207
1339
  TAddMode = (taAddFirst, taAdd, taInsert);
1208
1340
 
1217
1349
begin
1218
1350
  {$IFDEF TREEVIEW_DEBUG}
1219
1351
  DbgOut('[TTreeNode.InternalMove]  Self=',DbgS(Self),' Self.Text=',Text
1220
 
  ,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
1221
 
  if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
 
1352
         ,' ANode=',ANode<>nil,' AddMode=', AddModeStr(AddMode));
 
1353
  if ANode<>nil then
 
1354
    DbgOut(' ANode.Text=',ANode.Text);
1222
1355
  DebugLn('');
1223
1356
  {$ENDIF}
1224
1357
  if TreeView<>nil then TreeView.BeginUpdate;
1331
1464
 
1332
1465
  {$IFDEF TREEVIEW_DEBUG}
1333
1466
  DbgOut('[TTreeNode.InternalMove] END Self=',DbgS(Self),' Self.Text=',Text
1334
 
  ,' ANode=',DbgS(ANode<>nil),' AddMode=',AddModeNames[AddMode]);
1335
 
  if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
 
1467
         ,' ANode=',DbgS(ANode<>nil),' AddMode=',AddModeStr(AddMode));
 
1468
  if ANode<>nil then
 
1469
    DbgOut(' ANode.Text=',ANode.Text);
1336
1470
  DebugLn('');
1337
1471
  {$ENDIF}
1338
1472
end;
1355
1489
  OldOnChanging: TTVChangingEvent;
1356
1490
  OldOnChange: TTVChangedEvent;
1357
1491
begin
1358
 
  if (Destination=nil)
1359
 
  and (Mode in [naAddChild,naAddChildFirst,naInsert,naInsertBehind]) then
 
1492
  if (Destination=nil) and not(Mode in [naAdd,naAddFirst]) then
1360
1493
    TreeNodeError('TTreeNode.MoveTo Destination=nil');
1361
 
  if Mode=naInsertBehind then begin
1362
 
    // convert naInsertBehind
1363
 
    if Destination.GetNextSibling=nil then begin
1364
 
      Mode:=naAdd;
1365
 
    end else begin
 
1494
  if Mode=naInsertBehind then begin      // convert naInsertBehind
 
1495
    if Destination.GetNextSibling=nil then
 
1496
      Mode:=naAdd
 
1497
    else begin
1366
1498
      Mode:=naInsert;
1367
1499
      Destination:=Destination.GetNextSibling;
1368
1500
    end;
1376
1508
      if (Destination <> nil) and (Mode in [naAdd, naAddFirst]) then
1377
1509
        Destination := Destination.Parent;
1378
1510
      case Mode of
1379
 
        naAdd,
1380
 
        naAddChild: AddMode := taAdd;
1381
1511
        naAddFirst,
1382
1512
        naAddChildFirst: AddMode := taAddFirst;
1383
 
        naInsert: AddMode := taInsert;
 
1513
        naInsert:        AddMode := taInsert;
1384
1514
      else
1385
1515
        AddMode:=taAdd;
1386
1516
      end;
1397
1527
var
1398
1528
  FirstNode, LastNode, ANode: TTreeNode;
1399
1529
begin
1400
 
  if (TreeView<>nil) and (not (tvoAllowMultiselect in TreeView.Options)) then
1401
 
    exit;
1402
 
  if (TreeView<>nil) then TreeView.LockSelectionChangeEvent;
 
1530
  if Assigned(TreeView) and not (tvoAllowMultiselect in TreeView.Options) then
 
1531
    Exit;
 
1532
  if Assigned(TreeView) then TreeView.LockSelectionChangeEvent;
1403
1533
  try
1404
 
    FirstNode:=GetPrevSibling;
1405
 
    while (FirstNode<>nil) and (not FirstNode.MultiSelected) do
1406
 
      FirstNode:=FirstNode.GetPrevSibling;
1407
 
    if FirstNode=nil then FirstNode:=Self;
1408
 
    LastNode:=GetNextSibling;
1409
 
    while (LastNode<>nil) and (not LastNode.MultiSelected) do
1410
 
      LastNode:=LastNode.GetNextSibling;
1411
 
    if LastNode=nil then LastNode:=Self;
1412
 
    ANode:=FirstNode;
1413
 
    while ANode<>nil do begin
1414
 
      ANode.MultiSelected:=true;
1415
 
      if ANode=LastNode then break;
1416
 
      ANode:=ANode.GetNextSibling;
 
1534
    // We need to select the nodes between the selected node and the current node
 
1535
    FirstNode := GetPrevSibling;
 
1536
    while Assigned(FirstNode) and not FirstNode.Selected do
 
1537
      FirstNode := FirstNode.GetPrevSibling;
 
1538
    if not Assigned(FirstNode) then FirstNode := Self;
 
1539
    LastNode := GetNextSibling;
 
1540
    while Assigned(LastNode) and not LastNode.Selected do
 
1541
      LastNode := LastNode.GetNextSibling;
 
1542
    if not Assigned(LastNode) then LastNode := Self;
 
1543
    ANode := FirstNode;
 
1544
    while Assigned(ANode) do
 
1545
    begin
 
1546
      ANode.MultiSelected := True;
 
1547
      if ANode = LastNode then Break;
 
1548
      ANode := ANode.GetNextSibling;
1417
1549
    end;
1418
1550
  finally
1419
 
    if (TreeView<>nil) then TreeView.UnlockSelectionChangeEvent;
 
1551
    if Assigned(TreeView) then TreeView.UnlockSelectionChangeEvent;
1420
1552
  end;
1421
1553
end;
1422
1554
 
1423
1555
procedure TTreeNode.MakeVisible;
1424
1556
begin
1425
 
  if TreeView<>nil then
 
1557
  if Assigned(TreeView) then
1426
1558
    TreeView.EnsureNodeIsVisible(Self)
1427
1559
  else
1428
1560
    ExpandParents;
1435
1567
begin
1436
1568
  Result := 0;
1437
1569
  ANode := Parent;
1438
 
  while ANode <> nil do begin
 
1570
  while Assigned(ANode) do
 
1571
  begin
1439
1572
    Inc(Result);
1440
1573
    ANode := ANode.Parent;
1441
1574
  end;
1448
1581
 
1449
1582
function TTreeNode.IsNodeVisible: Boolean;
1450
1583
begin
1451
 
  if TreeView<>nil then
1452
 
    Result:=TreeView.IsNodeVisible(Self)
 
1584
  if Assigned(TreeView) then
 
1585
    Result := TreeView.IsNodeVisible(Self)
1453
1586
  else
1454
 
    Result:=AreParentsExpanded;
 
1587
    Result := AreParentsExpandedAndVisible;
1455
1588
end;
1456
1589
 
1457
1590
function TTreeNode.IsNodeHeightFullVisible: Boolean;
1458
1591
begin
1459
 
  if TreeView<>nil then
1460
 
    Result:=TreeView.IsNodeHeightFullVisible(Self)
 
1592
  if Assigned(TreeView) then
 
1593
    Result := TreeView.IsNodeHeightFullVisible(Self)
1461
1594
  else
1462
 
    Result:=AreParentsExpanded;
 
1595
    Result := AreParentsExpandedAndVisible;
1463
1596
end;
1464
1597
 
1465
1598
procedure TTreeNode.Update;
1466
1599
var
1467
1600
  TV: TCustomTreeView;
1468
1601
begin
1469
 
  TV:=TreeView;
1470
 
  if (TV<>nil) and (Owner.FUpdateCount=0) and (not (csLoading in TV.ComponentState)) then
 
1602
  TV := TreeView;
 
1603
  if Assigned(TV) and (Owner.FUpdateCount = 0) and (not (csLoading in TV.ComponentState)) then
1471
1604
    TV.Invalidate;
1472
1605
end;
1473
1606
 
1475
1608
var
1476
1609
  TV: TCustomTreeView;
1477
1610
begin
1478
 
  TV:=TreeView;
1479
 
  Result:=(TV<>nil) and (tvsIsEditing in TreeView.FStates);
 
1611
  TV := TreeView;
 
1612
  Result := Assigned(TV) and (tvsIsEditing in TreeView.FStates);
1480
1613
  TV.BeginEditing(Self);
1481
1614
end;
1482
1615
 
1632
1765
  OldInfo: TOldTreeNodeInfo;
1633
1766
  Info: TTreeNodeInfo;
1634
1767
  Node: TTreeNode;
 
1768
  lSelfAX: TLazAccessibleObject;
1635
1769
begin
1636
1770
  if Owner<>nil then Owner.ClearCache;
1637
1771
  if StreamVersion=TTreeNodeWithPointerStreamVersion then
1660
1794
    SetLength(FText,Info.TextLen);
1661
1795
  end;
1662
1796
  if FText<>'' then
 
1797
  begin
1663
1798
    Stream.Read(FText[1],length(FText));
 
1799
    // Update accessibility information
 
1800
    if TreeView<>nil then
 
1801
    begin
 
1802
     lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
 
1803
     if lSelfAX <> nil then
 
1804
       lSelfAX.AccessibleValue := FText;
 
1805
    end;
 
1806
  end;
1664
1807
  if Owner<>nil then begin
1665
1808
    for I := 0 to ItemCount - 1 do begin
1666
1809
      Node:=Owner.AddChild(Self, '');
1738
1881
end;
1739
1882
 
1740
1883
procedure TTreeNode.ConsistencyCheck;
1741
 
var RealSubTreeCount: integer;
 
1884
var
 
1885
  RealSubTreeCount: integer;
1742
1886
  i: integer;
1743
1887
  Node1: TTreeNode;
1744
1888
begin
1745
 
  if FOwner<>nil then begin
1746
 
  end;
1747
1889
  if FCapacity<0 then
1748
1890
    RaiseGDBException('');
1749
1891
  if FCapacity<FCount then
1870
2012
end;
1871
2013
 
1872
2014
procedure TTreeNodes.Clear;
 
2015
var
 
2016
  Node: TTreeNode;
1873
2017
begin
1874
2018
  BeginUpdate;
1875
2019
  ClearCache;
1876
 
  if GetLastNode<>nil then begin
1877
 
    while GetLastNode<>nil do
1878
 
      GetLastNode.Delete;
1879
 
    if (FUpdateCount=0) and (Owner<>nil) then
1880
 
      Owner.Invalidate;
 
2020
  Node := GetLastNode;
 
2021
  if Assigned(Node) then
 
2022
  begin
 
2023
    while Assigned(Node) do
 
2024
    begin
 
2025
      Node.Delete;
 
2026
      Node := GetLastNode;
 
2027
    end;
1881
2028
  end;
1882
2029
  FSelection.Clear;
 
2030
  if (FOwner <> nil) then
 
2031
    FOwner.GetAccessibleObject().ClearChildAccessibleObjects();
1883
2032
  EndUpdate;
1884
2033
end;
1885
2034
 
1887
2036
var
1888
2037
  ANode, OldNode: TTreeNode;
1889
2038
begin
1890
 
  if Owner<>nil then Owner.LockSelectionChangeEvent;
 
2039
  if Assigned(Owner) then Owner.LockSelectionChangeEvent;
1891
2040
  try
1892
 
    ANode:=FFirstMultiSelected;
1893
 
    while ANode<>nil do begin
1894
 
      OldNode:=ANode;
1895
 
      ANode:=ANode.GetNextMultiSelected;
1896
 
      OldNode.MultiSelected:=false;
 
2041
    ANode := FFirstMultiSelected;
 
2042
    while Assigned(ANode) do
 
2043
    begin
 
2044
      OldNode := ANode;
 
2045
      ANode := ANode.GetNextMultiSelected;
 
2046
      OldNode.MultiSelected := false;
1897
2047
    end;
1898
2048
    if ClearSelected then
1899
 
      Owner.Selected:=nil;
 
2049
      Owner.Selected := nil;
1900
2050
  finally
1901
 
    if Owner<>nil then Owner.UnlockSelectionChangeEvent;
 
2051
    if Assigned(Owner) then Owner.UnlockSelectionChangeEvent;
1902
2052
  end;
1903
2053
end;
1904
2054
 
1957
2107
  Result := InternalAddObject(ParentNode, S, Data, taAddFirst);
1958
2108
end;
1959
2109
 
 
2110
function TTreeNodes.AddNode(Node: TTreeNode; Relative: TTreeNode;
 
2111
  const S: string; Ptr: Pointer; Method: TNodeAttachMode): TTreeNode;
 
2112
var
 
2113
   AddMode: TAddMode;
 
2114
begin
 
2115
  if (Relative=nil) and not (Method in [naAdd,naAddFirst]) then
 
2116
    TreeNodeError('TTreeNode.AddNode Relative=nil');
 
2117
  if Method=naInsertBehind then begin    // convert naInsertBehind
 
2118
    if Relative.GetNextSibling=nil then
 
2119
      Method:=naAdd
 
2120
    else begin
 
2121
      Method:=naInsert;
 
2122
      Relative:=Relative.GetNextSibling;
 
2123
    end;
 
2124
  end;
 
2125
  if (Relative <> nil) and (Method in [naAdd, naAddFirst]) then
 
2126
    Relative := Relative.Parent;
 
2127
  // Convert TNodeAttachMode to TAddMode
 
2128
  case Method of
 
2129
    naAddFirst,naAddChildFirst: AddMode := taAddFirst;
 
2130
    naInsert: AddMode := taInsert;
 
2131
  else
 
2132
    AddMode:=taAdd;
 
2133
  end;
 
2134
  fNewNodeToBeAdded := Node;
 
2135
  Result := InternalAddObject(Relative, S, Ptr, AddMode);
 
2136
end;
 
2137
 
1960
2138
procedure TTreeNodes.SelectionsChanged(ANode: TTreeNode; const AIsSelected: Boolean);
1961
2139
begin
1962
2140
  if ANode <> nil then
2018
2196
  Result:=InternalAddObject(NextNode,S,Data,taInsert);
2019
2197
end;
2020
2198
 
2021
 
function TTreeNodes.InsertBehind(PrevNode: TTreeNode; const S: string
2022
 
  ): TTreeNode;
 
2199
function TTreeNodes.InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode;
2023
2200
begin
2024
2201
  Result := InsertObjectBehind(PrevNode, S, nil);
2025
2202
end;
2049
2226
  taAddFirst: add Result as first child of Node
2050
2227
  taInsert:   add Result in front of Node
2051
2228
}
2052
 
//var Item: HTreeItem;
2053
 
var ok: boolean;
 
2229
var
 
2230
  ok: boolean;
 
2231
  // Item: HTreeItem;
 
2232
  lAccessibleObject: TLazAccessibleObject;
2054
2233
begin
2055
2234
  if Owner=nil then
2056
2235
    TreeNodeError('TTreeNodes.InternalAddObject Owner=nil');
2057
2236
  {$IFDEF TREEVIEW_DEBUG}
2058
2237
  write('[TTreeNodes.InternalAddObject] Node=',Node<>nil,' S=',S,
2059
 
  ' AddMode=',AddModeNames[AddMode]);
2060
 
  if Node<>nil then DbgOut(' Node.Text=',Node.Text);
 
2238
        ' AddMode=',AddModeStr(AddMode));
 
2239
  if Node<>nil then
 
2240
    DbgOut(' Node.Text=',Node.Text);
2061
2241
  DebugLn('');
2062
2242
  {$ENDIF}
2063
 
  Result := Owner.CreateNode;
 
2243
  Result := fNewNodeToBeAdded; // Used by AddNode to pass an existing node.
 
2244
  if Result = Nil then
 
2245
    Result := Owner.CreateNode;
 
2246
  fNewNodeToBeAdded := nil;
2064
2247
  ok:=false;
2065
2248
  try
2066
2249
    Result.Data := Data;
2071
2254
      Result.Parent.Expanded:=true;
2072
2255
    if (Owner<>nil) and (not (csReading in Owner.ComponentState)) then
2073
2256
      Owner.Added(Result);
2074
 
    if (FUpdateCount=0) and (Owner<>nil) then
2075
 
      Owner.Invalidate;
2076
2257
    ok:=true;
 
2258
    if ok and (Owner<>nil) and (Owner.AccessibilityOn) then
 
2259
    begin
 
2260
      lAccessibleObject := FOwner.GetAccessibleObject().AddChildAccessibleObject();
 
2261
      lAccessibleObject.AccessibleDescription := 'Item';
 
2262
      lAccessibleObject.AccessibleValue := S;
 
2263
      lAccessibleObject.AccessibleRole := larTreeItem;
 
2264
      lAccessibleObject.DataObject := Result;
 
2265
    end;
2077
2266
  finally
2078
2267
    // this construction creates nicer exception output
2079
2268
    if not ok then
2083
2272
 
2084
2273
function TTreeNodes.GetFirstNode: TTreeNode;
2085
2274
begin
2086
 
  if FTopLvlItems<>nil then
 
2275
  if Assigned(FTopLvlItems) then
2087
2276
    Result := FTopLvlItems[0]
2088
2277
  else
2089
2278
    Result := nil;
2090
2279
  //Result := GetNode(TreeView_GetRoot(Handle));
2091
2280
end;
2092
2281
 
 
2282
function TTreeNodes.GetFirstVisibleNode: TTreeNode;
 
2283
var
 
2284
  Node: TTreeNode;
 
2285
  i: Integer;
 
2286
begin
 
2287
  Result := nil;
 
2288
  if Assigned(FTopLvlItems) then
 
2289
    for i := 0 to FTopLvlCount-1 do begin
 
2290
      Node := FTopLvlItems[i];
 
2291
      if Node.Visible then begin
 
2292
        Result := Node;
 
2293
        Break;
 
2294
      end;
 
2295
    end;
 
2296
end;
 
2297
 
2093
2298
function TTreeNodes.GetLastNode: TTreeNode;
2094
2299
begin
2095
 
  if FTopLvlItems<>nil then
2096
 
    Result := FTopLvlItems[FTopLvlCount-1]
 
2300
  if Assigned(FTopLvlItems) then
 
2301
    Result := FTopLvlItems[FTopLvlCount - 1]
2097
2302
  else
2098
2303
    Result := nil;
2099
2304
end;
2100
2305
 
 
2306
function TTreeNodes.GetLastVisibleNode: TTreeNode;
 
2307
var
 
2308
  Node: TTreeNode;
 
2309
  i: Integer;
 
2310
begin
 
2311
  Result := nil;
 
2312
  if Assigned(FTopLvlItems) then
 
2313
    for i := FTopLvlCount-1 downto 0 do begin
 
2314
      Node := FTopLvlItems[i];
 
2315
      if Node.Visible then begin
 
2316
        Result := Node;
 
2317
        Break;
 
2318
      end;
 
2319
    end;
 
2320
end;
 
2321
 
2101
2322
function TTreeNodes.GetLastSubNode: TTreeNode;
2102
2323
// absolute last node
2103
 
var Node: TTreeNode;
 
2324
var
 
2325
  Node: TTreeNode;
2104
2326
begin
2105
 
  Result:=GetLastNode;
2106
 
  if Result<>nil then begin
2107
 
    Node:=Result.GetLastSubChild;
2108
 
    if Node<>nil then Result:=Node;
 
2327
  Result := GetLastNode;
 
2328
  if Assigned(Result) then
 
2329
  begin
 
2330
    Node := Result.GetLastSubChild;
 
2331
    if Assigned(Node) then Result := Node;
2109
2332
  end;
2110
2333
end;
2111
2334
 
2112
2335
function TTreeNodes.GetLastExpandedSubNode: TTreeNode;
2113
2336
// absolute last expanded node
2114
 
var Node: TTreeNode;
 
2337
var
 
2338
  Node: TTreeNode;
2115
2339
begin
2116
 
  Result:=GetLastNode;
2117
 
  while (Result<>nil) and (Result.Expanded) do begin
2118
 
    Node:=Result.GetLastChild;
2119
 
    if Node<>nil then
2120
 
      Result:=Node
 
2340
  Result := GetLastVisibleNode;
 
2341
  while Assigned(Result) and (Result.Expanded) do
 
2342
  begin
 
2343
    Node := Result.GetLastVisibleChild;
 
2344
    if Assigned(Node) then
 
2345
      Result := Node
2121
2346
    else
2122
2347
      exit;
2123
2348
  end;
2125
2350
 
2126
2351
function TTreeNodes.FindTopLvlNode(const NodeText: string): TTreeNode;
2127
2352
begin
2128
 
  Result:=GetFirstNode;
2129
 
  while (Result<>nil) and (Result.Text<>NodeText) do
2130
 
    Result:=Result.GetNextSibling;
 
2353
  Result := GetFirstNode;
 
2354
  while Assigned(Result) and (Result.Text <> NodeText) do
 
2355
    Result := Result.GetNextSibling;
2131
2356
end;
2132
2357
 
2133
2358
function TTreeNodes.FindNodeWithText(const NodeText: string): TTreeNode;
2134
2359
begin
2135
 
  Result:=GetFirstNode;
2136
 
  while (Result<>nil) and (Result.Text<>NodeText) do
2137
 
    Result:=Result.GetNext;
 
2360
  Result := GetFirstNode;
 
2361
  while Assigned(Result) and (Result.Text <> NodeText) do
 
2362
    Result := Result.GetNext;
2138
2363
end;
2139
2364
 
2140
2365
function TTreeNodes.FindNodeWithData(const NodeData: Pointer): TTreeNode;
2141
2366
begin
2142
 
  Result:=GetFirstNode;
2143
 
  while (Result<>nil) and (Result.Data<>NodeData) do
2144
 
    Result:=Result.GetNext;
 
2367
  Result := GetFirstNode;
 
2368
  while Assigned(Result) and (Result.Data <> NodeData) do
 
2369
    Result := Result.GetNext;
2145
2370
end;
2146
2371
 
2147
2372
function TTreeNodes.GetNodeFromIndex(Index: Integer): TTreeNode;
2263
2488
    Include(Owner.FStates,tvsUpdating)
2264
2489
  else
2265
2490
    Exclude(Owner.FStates,tvsUpdating);
2266
 
  if not Updating then Owner.Refresh;
 
2491
  if not Updating then
 
2492
    Owner.Invalidate;
2267
2493
end;
2268
2494
 
2269
2495
procedure TTreeNodes.EndUpdate;
2530
2756
end;
2531
2757
 
2532
2758
procedure TTreeNodes.ConsistencyCheck;
2533
 
var Node: TTreeNode;
 
2759
var
 
2760
  Node: TTreeNode;
2534
2761
  RealCount, i: integer;
2535
2762
  OldCache: TNodeCache;
2536
2763
begin
2581
2808
end;
2582
2809
 
2583
2810
procedure TTreeNodes.WriteDebugReport(const Prefix: string; AllNodes: boolean);
2584
 
var Node: TTreeNode;
 
2811
var
 
2812
  Node: TTreeNode;
2585
2813
begin
2586
2814
  DbgOut('%s%s.WriteDebugReport Self=%p', [Prefix, ClassName, Pointer(Self)]);
2587
2815
  ConsistencyCheck;
2636
2864
  Result := '';
2637
2865
  Node := Owner.GetNodeFromIndex(Index);
2638
2866
  Level := Node.Level;
2639
 
  for I := 0 to Level - 1 do Result := Result + TabChar;
 
2867
  for I := 0 to Level - 1 do
 
2868
    Result := Result + TabChar;
2640
2869
  Result := Result + Node.Text;
2641
2870
end;
2642
2871
 
2679
2908
procedure TTreeStrings.SetUpdateState(Updating: Boolean);
2680
2909
begin
2681
2910
  //SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating), 0);
2682
 
  if not Updating then Owner.Owner.Refresh;
 
2911
  if not Updating then
 
2912
    Owner.Owner.Invalidate;
2683
2913
end;
2684
2914
 
2685
2915
function TTreeStrings.Add(const S: string): Integer;
2728
2958
  ANode, NextNode: TTreeNode;
2729
2959
  ALevel, i: Integer;
2730
2960
  CurrStr: string;
2731
 
  ok: boolean;
2732
2961
begin
2733
2962
  List := TStringList.Create;
2734
2963
  Owner.BeginUpdate;
2735
 
  ok:=false;
2736
2964
  try
2737
2965
    Clear;
2738
2966
    List.LoadFromStream(Stream);
2756
2984
      else TreeViewError('TTreeStrings.LoadTreeFromStream: Level='
2757
2985
        +IntToStr(ALevel)+' CuurStr="'+CurrStr+'"');
2758
2986
    end;
2759
 
    ok:=true;
2760
2987
  finally
2761
2988
    Owner.EndUpdate;
2762
2989
    List.Free;
2763
 
    if not ok then
2764
 
      Owner.Owner.Invalidate;  // force repaint on exception
2765
2990
  end;
2766
2991
end;
2767
2992
 
2837
3062
  FTreeLineColor := clWindowFrame;
2838
3063
  FTreeLinePenStyle := psPattern;
2839
3064
  FExpandSignColor := clWindowFrame;
 
3065
  // Accessibility
 
3066
  AccessibleDescription := rsTTreeViewAccessibilityDescription;
 
3067
  AccessibleRole := larTreeView;
 
3068
  FAccessibilityOn := WidgetSet.GetLCLCapability(lcAccessibilitySupport) = LCL_CAPABILITY_YES;
2840
3069
end;
2841
3070
 
2842
3071
destructor TCustomTreeView.Destroy;
2896
3125
begin
2897
3126
  //DebugLn(['TCustomTreeView.BeginEditing tvsIsEditing=',tvsIsEditing in FStates,' Selected=',Selected<>nil]);
2898
3127
  if (tvsIsEditing in FStates) or (ANode=nil) then exit;
2899
 
  if not CanEdit(ANode) then exit;
 
3128
  if (not CanEdit(ANode)) or (not ANode.FVisible) then exit;
2900
3129
  // if we are asked to edit another node while one is already being edited then
2901
3130
  // stop editing that node
2902
3131
  if FEditingItem <> nil then
2937
3166
  if Items.FUpdateCount=0 then begin
2938
3167
    // ToDo: only refresh if something changed
2939
3168
    UpdateScrollBars;
2940
 
    Invalidate;
2941
3169
  end;
2942
3170
end;
2943
3171
 
2951
3179
begin
2952
3180
  Result := False;
2953
3181
  if FTreeNodes.Count>0 then begin
 
3182
    BeginUpdate;
2954
3183
    if not assigned(SortProc) then SortProc := @DefaultTreeViewSort;
2955
3184
    FTreeNodes.SortTopLevelNodes(SortProc);
2956
3185
 
2957
3186
    Node := FTreeNodes.GetFirstNode;
2958
3187
    while Node <> nil do begin
2959
 
      if Node.HasChildren then Node.CustomSort(SortProc);
 
3188
      if (Node.GetFirstChild<>nil) then Node.CustomSort(SortProc);
2960
3189
      Node := Node.GetNext;
2961
3190
    end;
2962
3191
    Items.ClearCache;
2963
3192
    FStates:= FStates+[tvsTopsNeedsUpdate, tvsTopItemNeedsUpdate,
2964
 
                       tvsBottomItemNeedsUpdate,
2965
 
                       tvsScrollbarChanged,tvsMaxRightNeedsUpdate];
2966
 
    Invalidate;
 
3193
                       tvsBottomItemNeedsUpdate,tvsScrollbarChanged];
 
3194
    EndUpdate;
2967
3195
  end;
2968
3196
end;
2969
3197
 
3037
3265
  if AValue=FScrolledTop then exit;
3038
3266
  EndEditing(true);
3039
3267
  FScrolledTop:=AValue;
3040
 
  FStates:=FStates+[tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate,
3041
 
                    tvsScrollbarChanged];
 
3268
  FStates:=FStates+[tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate,tvsScrollbarChanged];
3042
3269
  Invalidate;
3043
3270
end;
3044
3271
 
3100
3327
    EndEditing;
3101
3328
  if (tvoAllowMultiselect in ChangedOptions) then begin
3102
3329
    if (tvoAllowMultiselect in FOptions) then begin
3103
 
      if Selected<>nil then Selected.MultiSelected:=true;
 
3330
      if Selected<>nil then
 
3331
        Selected.MultiSelected:=true;
3104
3332
    end else begin
3105
3333
      Items.ClearMultiSelection;
3106
3334
    end;
3125
3353
      NewDefItemHeight:=Images.Height;
3126
3354
    if (StateImages<>nil) and (StateImages.Height>NewDefItemHeight) then
3127
3355
      NewDefItemHeight:=StateImages.Height;
 
3356
    if Odd(NewDefItemHeight) then Inc(NewDefItemHeight);
3128
3357
    if NewDefItemHeight<>FDefItemHeight then begin
3129
3358
      FDefItemHeight:=NewDefItemHeight;
3130
 
      FStates:=FStates+[tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,
3131
 
                        tvsBottomItemNeedsUpdate];
 
3359
      FStates:=FStates+[tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
3132
3360
      Invalidate;
3133
3361
    end;
3134
3362
  end;
3135
3363
end;
3136
3364
 
3137
3365
procedure TCustomTreeView.UpdateAllTops;
 
3366
var
 
3367
  CurTop: integer;
3138
3368
 
3139
 
  procedure CalculateTops(FirstSibling: TTreeNode; var CurTop: integer);
 
3369
  procedure CalculateTops(Node: TTreeNode);
3140
3370
  begin
3141
 
    while FirstSibling<>nil do begin
3142
 
      FirstSibling.fTop:=CurTop;
3143
 
      inc(CurTop,FirstSibling.Height);
3144
 
      if FirstSibling.Expanded then
3145
 
        CalculateTops(FirstSibling.GetFirstChild,CurTop);
3146
 
      FirstSibling:=FirstSibling.GetNextSibling;
 
3371
    while Node<>nil do begin
 
3372
      if Node.FVisible then begin
 
3373
        Node.fTop:=CurTop;
 
3374
        inc(CurTop, Node.Height);
 
3375
        if Node.Expanded then
 
3376
          CalculateTops(Node.GetFirstChild);
 
3377
      end;
 
3378
      Node:=Node.GetNextSibling;
3147
3379
    end;
3148
3380
  end;
3149
3381
 
3150
 
var i: integer;
3151
3382
begin
3152
3383
  if not (tvsTopsNeedsUpdate in FStates) then exit;
3153
 
  i:=0;
3154
 
  CalculateTops(Items.GetFirstNode,i);
 
3384
  CurTop:=0;
 
3385
  CalculateTops(Items.GetFirstVisibleNode);
3155
3386
  Exclude(FStates,tvsTopsNeedsUpdate);
3156
3387
  Include(FStates,tvsScrollbarChanged);
3157
3388
end;
3190
3421
  Cnt := 0;
3191
3422
  while Node <> nil do
3192
3423
  begin
3193
 
    if not Node.AreParentsExpanded then
 
3424
    if not Node.AreParentsExpandedAndVisible then
3194
3425
    begin
3195
3426
      Node := Node.GetNext;
3196
3427
      Continue;
3230
3461
 
3231
3462
procedure TCustomTreeView.UpdateBottomItem;
3232
3463
begin
3233
 
  if (FStates*[tvsTopItemNeedsUpdate,tvsTopsNeedsUpdate,
3234
 
    tvsBottomItemNeedsUpdate]=[])
 
3464
  if (FStates*[tvsTopItemNeedsUpdate,tvsTopsNeedsUpdate,tvsBottomItemNeedsUpdate]=[])
3235
3465
  then exit;
3236
 
  if not (tvsBottomItemNeedsUpdate in FStates) then exit;
 
3466
//  if not (tvsBottomItemNeedsUpdate in FStates) then exit;  already above
3237
3467
  FBottomItem:=TopItem;
3238
3468
  while (FBottomItem<>nil) and (FBottomItem.GetNextVisible<>nil) do
3239
3469
    FBottomItem:=FBottomItem.GetNextVisible;
3248
3478
  end;
3249
3479
end;
3250
3480
 
 
3481
procedure TCustomTreeView.SetSeparatorColor(const AValue: TColor);
 
3482
begin
 
3483
  if fSeparatorColor=AValue then exit;
 
3484
  fSeparatorColor:=AValue;
 
3485
  if tvoShowSeparators in Options then
 
3486
    Invalidate;
 
3487
end;
 
3488
 
3251
3489
procedure TCustomTreeView.SetShowButton(Value: Boolean);
3252
3490
begin
3253
3491
  if ShowButtons <> Value then begin
3366
3604
end;
3367
3605
 
3368
3606
function TCustomTreeView.GetMaxScrollTop: integer;
3369
 
var LastVisibleNode: TTreeNode;
 
3607
var
 
3608
  LastVisibleNode: TTreeNode;
3370
3609
begin
3371
3610
  LastVisibleNode:=Items.GetLastExpandedSubNode;
3372
3611
  if LastVisibleNode=nil then
3379
3618
  end;
3380
3619
end;
3381
3620
 
3382
 
function TCustomTreeView.GetNodeAtInternalY(Y: Integer): TTreeNode;
3383
 
// search in all expanded nodes for the node at the absolute coordinate Y
3384
 
var
3385
 
  i: integer;
3386
 
begin
3387
 
  i := IndexOfNodeAtTop(Items.FTopLvlItems, Items.FTopLvlCount, Y);
3388
 
  if i >= 0 then
3389
 
  begin
3390
 
    Result := Items.FTopLvlItems[i];
3391
 
    while Result.Expanded do
3392
 
    begin
3393
 
      i := IndexOfNodeAtTop(Result.FItems, Result.FCount, Y);
3394
 
      if i >= 0 then
3395
 
        Result := Result.Items[i]
3396
 
      else
3397
 
        break;
3398
 
    end;
3399
 
  end
3400
 
  else
3401
 
    Result := nil;
3402
 
end;
3403
 
 
3404
3621
function TCustomTreeView.GetNodeAtY(Y: Integer): TTreeNode;
3405
3622
// search in all expanded nodes for the node at the screen coordinate Y
 
3623
var
 
3624
  i: integer;
3406
3625
begin
3407
3626
  Result := nil;
 
3627
  if not Assigned(Items) then
 
3628
    Exit;
3408
3629
  if (Y >= BorderWidth) and (Y < (ClientHeight - ScrollBarWidth) - BorderWidth) then
3409
3630
  begin
3410
3631
    inc(Y, FScrolledTop - BorderWidth);
3411
 
    Result := GetNodeAtInternalY(Y);
 
3632
    i := IndexOfNodeAtTop(Items.FTopLvlItems, Items.FTopLvlCount, Y);
 
3633
    if i >= 0 then
 
3634
    begin
 
3635
      Result := Items.FTopLvlItems[i];
 
3636
      while Result.Visible and Result.Expanded do
 
3637
      begin
 
3638
        i := IndexOfNodeAtTop(Result.FItems, Result.FCount, Y);
 
3639
        if i >= 0 then
 
3640
          Result := Result.Items[i]
 
3641
        else
 
3642
          break;
 
3643
      end;
 
3644
    end;
3412
3645
  end;
3413
3646
end;
3414
3647
 
3428
3661
  if (X >= BorderWidth) and (X < ClientWidth - BorderWidth) then
3429
3662
  begin
3430
3663
    Result := GetNodeAtY(Y);
3431
 
    if Result <> nil then
3432
 
    begin
3433
 
      if (X < Result.DisplayExpandSignLeft) then
3434
 
        Result := nil;
3435
 
    end;
 
3664
    if Assigned(Result) and (X < Result.DisplayExpandSignLeft) then
 
3665
      Result := nil;
3436
3666
  end;
3437
3667
end;
3438
3668
 
3594
3824
 
3595
3825
function TCustomTreeView.IsNodeVisible(ANode: TTreeNode): Boolean;
3596
3826
begin
3597
 
  Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
3598
 
  //DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
3599
 
  //' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
 
3827
  Result:=(ANode<>nil) and (ANode.Visible) and (ANode.AreParentsExpandedAndVisible);
3600
3828
  if Result then begin
3601
3829
    //DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
3602
3830
    //  ' ',dbgs(FScrolledTop)+'>=',dbgs(ANode.Top+ANode.Height)+' or =',dbgs(FScrolledTop),'+'+dbgs(ClientHeight)+'<',dbgs(ANode.Top));
3611
3839
 
3612
3840
function TCustomTreeView.IsNodeHeightFullVisible(ANode: TTreeNode): Boolean;
3613
3841
begin
3614
 
  Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
3615
 
  //DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
3616
 
  //' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
 
3842
  Result:=(ANode<>nil) and (ANode.AreParentsExpandedAndVisible);
3617
3843
  if Result then begin
3618
3844
    //DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
3619
3845
    //' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top);
3633
3859
  EditKeyShift = [];
3634
3860
var
3635
3861
  I: Integer;
3636
 
  lNode: TTreeNode;
 
3862
  lNode, tempNode: TTreeNode;
3637
3863
begin
3638
3864
  inherited KeyDown(Key, Shift);
3639
3865
 
3692
3918
      lNode.Expanded := False;
3693
3919
 
3694
3920
  VK_HOME:
3695
 
    if Items.GetFirstNode<>nil then
3696
 
      lNode := Items.GetFirstNode;
 
3921
    begin
 
3922
      tempNode := Items.GetFirstVisibleNode;
 
3923
      if tempNode<>nil then
 
3924
        lNode := tempNode;
 
3925
    end;
3697
3926
 
3698
3927
  VK_END:
3699
 
    if Items.GetFirstNode<>nil then
3700
 
      lNode := Items.GetLastExpandedSubNode;
3701
 
      
 
3928
    begin
 
3929
      tempNode := Items.GetLastExpandedSubNode;
 
3930
      if tempNode<>nil then
 
3931
        lNode := tempNode;
 
3932
    end;
 
3933
 
3702
3934
  VK_PRIOR: // Page Up
3703
3935
    if lNode <> nil then
3704
3936
    begin
3784
4016
end;
3785
4017
 
3786
4018
procedure TCustomTreeView.UpdateScrollbars;
3787
 
 
3788
 
  function Max(i1, i2: integer): integer;
3789
 
  begin
3790
 
    if i1>i2 then
3791
 
      Result:=i1
3792
 
    else
3793
 
      Result:=i2;
3794
 
  end;
3795
 
 
3796
4019
var
3797
4020
  ScrollInfo: TScrollInfo;
3798
4021
begin
3894
4117
end;
3895
4118
 
3896
4119
procedure TCustomTreeView.SetSelection(Value: TTreeNode);
3897
 
var OldNode: TTreeNode;
 
4120
var
 
4121
  OldNode: TTreeNode;
3898
4122
begin
3899
 
  if FSelectedNode=Value then exit;
 
4123
  if FSelectedNode = Value then Exit;
3900
4124
  if not CanChange(FSelectedNode) then
3901
4125
    exit;
 
4126
  {$IFDEF TREEVIEW_DEBUG}
 
4127
  DebugLn('TCustomTreeView.SetSelection: Changing selection for Node: ', Text);
 
4128
  {$ENDIF}
3902
4129
  EndEditing(true); // end editing before FSelectedNode change
3903
 
  OldNode:=FSelectedNode;
3904
 
  FSelectedNode:=Value;
3905
 
  if OldNode<>nil then begin
3906
 
    OldNode.Selected:=false;
3907
 
  end;
3908
 
  if Value <> nil then begin
 
4130
  OldNode := FSelectedNode;
 
4131
  FSelectedNode := Value;
 
4132
  if Assigned(OldNode) then
 
4133
    OldNode.Selected := False;
 
4134
  if Assigned(Value) then
 
4135
  begin
3909
4136
    Value.Selected := True;
3910
4137
    Value.MakeVisible;
3911
4138
  end;
4046
4273
 
4047
4274
function TCustomTreeView.GetDragImages: TDragImageList;
4048
4275
begin
4049
 
  if FDragImage.Count > 0 then
 
4276
  if Assigned(FDragImage) and (FDragImage.Count > 0) then
4050
4277
    Result := FDragImage
4051
4278
  else
4052
4279
    Result := nil;
4067
4294
end;
4068
4295
 
4069
4296
procedure TCustomTreeView.DoSelectionChanged;
 
4297
var
 
4298
  lAccessibleObject: TLazAccessibleObject;
 
4299
  lSelection: TTreeNode;
 
4300
  lSelectedText: string;
4070
4301
begin
 
4302
  // Update the accessibility information
 
4303
  lAccessibleObject := GetAccessibleObject();
 
4304
  lSelection := Self.Selected;
 
4305
  if lSelection = nil then lSelectedText := ''
 
4306
  else lSelectedText := lSelection.Text;
 
4307
  lAccessibleObject.AccessibleValue := lSelectedText;
 
4308
 
4071
4309
  if Assigned(OnSelectionChanged) then OnSelectionChanged(Self);
4072
4310
end;
4073
4311
 
4187
4425
      //if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
4188
4426
      while Node <> nil do
4189
4427
      begin
4190
 
        DoPaintNode(Node);
 
4428
        if Node.Visible then
 
4429
          DoPaintNode(Node);
4191
4430
        Node := Node.GetNextVisible;
4192
4431
        //write('[TCustomTreeView.DoPaint] B Node=',DbgS(Node));
4193
4432
        //if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
4276
4515
      Exit;
4277
4516
    if TreeLinePenStyle = psPattern then
4278
4517
    begin
4279
 
      // since we draw node by node and always add 2 pixels we need to start always
4280
 
      // only from odd or only from even points. Let's choose to start from odd
4281
 
 
4282
 
      if not Odd(Y1) then
4283
 
        inc(Y1);
4284
 
 
4285
4518
      // TODO: implement psPattern support in the LCL
4286
4519
      while Y1 < Y2 do
4287
4520
      begin
4302
4535
      Exit;
4303
4536
    if TreeLinePenStyle = psPattern then
4304
4537
    begin
4305
 
      // to match our DrawVertLine rules
4306
 
      if not Odd(Y) then
4307
 
        inc(Y);
4308
 
 
4309
4538
      // TODO: implement psPattern support in the LCL
4310
4539
      while X1 < X2 do
4311
4540
      begin
4340
4569
            DrawHorzLine(VertMid, CurMid, Result + Indent);
4341
4570
        end;
4342
4571
 
4343
 
        if (CurNode.GetNextSibling <> nil) then
 
4572
        if (CurNode.GetNextVisibleSibling <> nil) then
4344
4573
        begin
4345
4574
          // draw vertical line to next brother
4346
4575
          if (CurNode = Node) and HasExpandSign then
4548
4777
          Details := ThemeServices.GetElementDetails(ttItemSelected)
4549
4778
        else
4550
4779
          Details := ThemeServices.GetElementDetails(ttItemSelectedNotFocus);
 
4780
        if ThemeServices.HasTransparentParts(Details) then
 
4781
        begin
 
4782
          Canvas.Brush.Color := BackgroundColor;
 
4783
          Canvas.FillRect(ARect);
 
4784
        end;
4551
4785
        ThemeServices.DrawElement(Canvas.Handle, Details, ARect, nil);
4552
4786
        Exit;
4553
4787
      end
4589
4823
      Details := ThemeServices.GetElementDetails(ttItemNormal);
4590
4824
 
4591
4825
    if (tvoThemedDraw in Options) then
4592
 
      ThemeServices.DrawText(Canvas, Details, AText, NodeRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE, 0)
 
4826
      ThemeServices.DrawText(Canvas, Details, AText, NodeRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0)
4593
4827
    else
4594
 
      DrawText(Canvas.Handle, PChar(AText), -1, NodeRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
 
4828
      DrawText(Canvas.Handle, PChar(AText), -1, NodeRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
4595
4829
  end;
4596
4830
 
4597
4831
 
4653
4887
      end;
4654
4888
      if (ImgIndex >= 0) and (ImgIndex < Images.Count) then
4655
4889
        Images.Draw(Canvas, x + 1, (NodeRect.Top + NodeRect.Bottom - Images.Height) div 2,
4656
 
          ImgIndex, True);
 
4890
            ImgIndex, Node.FNodeEffect);
4657
4891
      inc(x, Images.Width + 2);
4658
4892
    end;
4659
4893
 
4870
5104
          if (ssShift in Shift) then
4871
5105
          begin
4872
5106
            Exclude(FStates,tvsEditOnMouseUp);
4873
 
            CursorNode.MultiSelectGroup;
 
5107
            LockSelectionChangeEvent;
 
5108
            try
 
5109
              Items.ClearMultiSelection;
 
5110
              CursorNode.MultiSelectGroup;
 
5111
            finally
 
5112
              UnlockSelectionChangeEvent;
 
5113
            end;
4874
5114
          end
4875
5115
          else
4876
5116
          if (ssCtrl in Shift) then
4908
5148
  if Button=mbLeft then
4909
5149
    MouseCapture := False;
4910
5150
  if (Button=mbLeft)
4911
 
  and (fStates * [tvsDblClicked, tvsTripleClicked, tvsQuadClicked] = [])
 
5151
  and (FStates * [tvsDblClicked, tvsTripleClicked, tvsQuadClicked] = [])
4912
5152
  then begin
4913
5153
    //AquirePrimarySelection;
4914
5154
    if (tvsEditOnMouseUp in FStates) and (not ReadOnly)
4916
5156
    and (GetNodeAt(fMouseDownPos.X,fMouseDownPos.Y)=GetNodeAt(X,Y)) then
4917
5157
      BeginEditing(Selected);
4918
5158
  end;
4919
 
  fStates:=fStates-[tvsDblClicked,tvsTripleClicked,tvsQuadClicked,tvsEditOnMouseUp];
 
5159
  FStates:=FStates-[tvsDblClicked,tvsTripleClicked,tvsQuadClicked,tvsEditOnMouseUp];
4920
5160
end;
4921
5161
 
4922
 
procedure TCustomTreeView.Notification(AComponent: TComponent;
4923
 
  Operation: TOperation);
 
5162
procedure TCustomTreeView.Notification(AComponent: TComponent; Operation: TOperation);
4924
5163
begin
4925
5164
  inherited Notification(AComponent, Operation);
4926
5165
  if Operation = opRemove then begin
5071
5310
end;
5072
5311
 
5073
5312
procedure TCustomTreeView.WMLButtonDown(var AMessage: TLMLButtonDown);
5074
 
{var
5075
 
  Node: TTreeNode;
5076
 
  MousePos: TPoint;
5077
 
  P: TSmallPoint;}
5078
5313
begin
5079
5314
  {$IFDEF VerboseDrag}
5080
5315
  DebugLn('TCustomTreeView.WMLButtonDown A ',Name,':',ClassName,' ');
5105
5340
 
5106
5341
procedure TCustomTreeView.Resize;
5107
5342
begin
5108
 
  FStates:=FStates+[tvsScrollbarChanged,
5109
 
                    tvsBottomItemNeedsUpdate];
 
5343
  FStates:=FStates+[tvsScrollbarChanged,tvsBottomItemNeedsUpdate];
5110
5344
  inherited Resize;
5111
5345
end;
5112
5346
 
 
5347
function TCustomTreeView.GetSelectedChildAccessibleObject: TLazAccessibleObject;
 
5348
var
 
5349
  lNode: TTreeNode;
 
5350
begin
 
5351
  Result := nil;
 
5352
  lNode := GetSelection();
 
5353
  if lNode = nil then Exit;
 
5354
  Result := FAccessibleObject.GetChildAccessibleObjectWithDataObject(lNode);
 
5355
end;
 
5356
 
 
5357
function TCustomTreeView.GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject;
 
5358
var
 
5359
  lNode: TTreeNode;
 
5360
begin
 
5361
  Result := nil;
 
5362
  lNode := GetNodeAt(APos.X, APos.Y);
 
5363
  //if lNode = nil then DebugLn('[TCustomTreeView.GetChildAccessibleObjectAtPos] lNode=nil')
 
5364
  //else DebugLn('[TCustomTreeView.GetChildAccessibleObjectAtPos] lNode=' + lNode.Text);
 
5365
  if lNode = nil then Exit;
 
5366
  Result := FAccessibleObject.GetChildAccessibleObjectWithDataObject(lNode);
 
5367
end;
 
5368
 
5113
5369
procedure TCustomTreeView.InternalSelectionChanged;
5114
5370
begin
5115
 
  if fSelectionChangeEventLock>0 then begin
5116
 
    Include(fStates,tvsSelectionChanged);
5117
 
  end else begin
5118
 
    Exclude(fStates,tvsSelectionChanged);
 
5371
  if FSelectionChangeEventLock > 0 then
 
5372
    Include(FStates, tvsSelectionChanged)
 
5373
  else
 
5374
  begin
 
5375
    Exclude(FStates, tvsSelectionChanged);
5119
5376
    DoSelectionChanged;
5120
 
    FChangeTimer.Enabled := false;
5121
 
    FChangeTimer.Enabled := true;
 
5377
    FChangeTimer.Enabled := False;
 
5378
    FChangeTimer.Enabled := True;
5122
5379
    //debugln('TCustomTreeView.InternalSelectionChanged');
5123
5380
  end;
5124
5381
end;
5146
5403
var
5147
5404
  WasFocused: Boolean;
5148
5405
begin
5149
 
  WasFocused:=(FEditor<>nil) and FEditor.Focused;
 
5406
  WasFocused := (FEditor<>nil) and FEditor.Focused;
5150
5407
  EndEditing;
5151
5408
  if WasFocused then
5152
5409
    SetFocus;
5157
5414
var
5158
5415
  WasFocused: Boolean;
5159
5416
begin
5160
 
  if (Key=VK_ESCAPE) or (Key=VK_RETURN) then begin
5161
 
    WasFocused:=(FEditor<>nil) and FEditor.Focused;
5162
 
    EndEditing(Key=VK_ESCAPE);
 
5417
  if (Key = VK_ESCAPE) or (Key = VK_RETURN) then
 
5418
  begin
 
5419
    WasFocused := Assigned(FEditor) and FEditor.Focused;
 
5420
    EndEditing(Key = VK_ESCAPE);
5163
5421
    if WasFocused then
5164
5422
      SetFocus;
5165
 
    Key:=0; // key was handled
 
5423
    Key := 0; // key was handled
5166
5424
  end;
5167
5425
end;
5168
5426
 
5293
5551
 
5294
5552
procedure TCustomTreeView.LockSelectionChangeEvent;
5295
5553
begin
5296
 
  inc(fSelectionChangeEventLock);
 
5554
  inc(FSelectionChangeEventLock);
5297
5555
end;
5298
5556
 
5299
5557
procedure TCustomTreeView.UnlockSelectionChangeEvent;
5300
5558
begin
5301
 
  dec(fSelectionChangeEventLock);
5302
 
  if fSelectionChangeEventLock<0 then
 
5559
  dec(FSelectionChangeEventLock);
 
5560
  if FSelectionChangeEventLock<0 then
5303
5561
    RaiseGDBException('TCustomTreeView.UnlockSelectionChangeEvent');
5304
 
  if (fSelectionChangeEventLock=0)
5305
 
  and (tvsSelectionChanged in fStates) then
 
5562
  if (FSelectionChangeEventLock=0) and (tvsSelectionChanged in FStates) then
5306
5563
    InternalSelectionChanged;
5307
5564
end;
5308
5565
 
5351
5608
  ANode.MakeVisible;
5352
5609
end;
5353
5610
 
5354
 
procedure TCustomTreeView.SetSeparatorColor(const AValue: TColor);
5355
 
begin
5356
 
  if fSeparatorColor=AValue then exit;
5357
 
  fSeparatorColor:=AValue;
5358
 
  if tvoShowSeparators in Options then
5359
 
    Invalidate;
 
5611
procedure TCustomTreeView.ClearInvisibleSelection;
 
5612
var
 
5613
  ANode: TTreeNode;
 
5614
begin
 
5615
  if tvoAllowMultiSelect in FOptions then begin
 
5616
    Items.ClearMultiSelection(True);       // Now clears all multi-selected
 
5617
  end
 
5618
  else begin
 
5619
    ANode := Selected;            // Clear a single selection only if not visible
 
5620
    if Assigned(ANode) and not ANode.Visible then
 
5621
      ANode.Selected:=False;       // Selected := nil;
 
5622
  end;
 
5623
end;
 
5624
 
 
5625
procedure TCustomTreeView.MoveToNextNode;
 
5626
var
 
5627
  ANode: TTreeNode;
 
5628
begin
 
5629
  if tvoAllowMultiSelect in FOptions then
 
5630
    ANode := FTreeNodes.FLastMultiSelected
 
5631
  else
 
5632
    ANode := Selected;
 
5633
  if ANode <> nil then
 
5634
    ANode := ANode.GetNextVisible;
 
5635
  if (ANode = nil) and (Items.Count > 0) then
 
5636
    ANode := FTreeNodes.GetFirstVisibleNode;
 
5637
  if ANode <> nil then
 
5638
    if tvoAllowMultiSelect in FOptions then
 
5639
      FTreeNodes.SelectOnlyThis(ANode)
 
5640
    else
 
5641
      Selected := ANode;
 
5642
end;
 
5643
 
 
5644
procedure TCustomTreeView.MoveToPrevNode;
 
5645
var
 
5646
  ANode: TTreeNode;
 
5647
begin
 
5648
  if tvoAllowMultiSelect in FOptions then
 
5649
    ANode := FTreeNodes.FLastMultiSelected
 
5650
  else
 
5651
    ANode := Selected;
 
5652
  if ANode <> nil then
 
5653
    ANode := ANode.GetPrevVisible;
 
5654
  if (ANode = nil) and (Items.Count > 0) then
 
5655
    ANode := Items.GetLastExpandedSubNode;
 
5656
  if ANode <> nil then
 
5657
    if tvoAllowMultiSelect in FOptions then
 
5658
      FTreeNodes.SelectOnlyThis(ANode)
 
5659
    else
 
5660
      Selected := ANode;
 
5661
end;
 
5662
 
 
5663
function TCustomTreeView.StoreCurrentSelection: TStringList;
 
5664
var
 
5665
  ANode: TTreeNode;
 
5666
begin
 
5667
  Result:=TStringList.Create;
 
5668
  ANode:=Selected;
 
5669
  while ANode<>nil do begin
 
5670
    Result.Insert(0,ANode.Text);
 
5671
    ANode:=ANode.Parent;
 
5672
  end;
 
5673
end;
 
5674
 
 
5675
procedure TCustomTreeView.ApplyStoredSelection(ASelection: TStringList; FreeList: boolean);
 
5676
var
 
5677
  ANode: TTreeNode;
 
5678
  CurText: string;
 
5679
begin
 
5680
  ANode:=nil;
 
5681
  while ASelection.Count>0 do begin
 
5682
    CurText:=ASelection[0];
 
5683
    if ANode=nil then
 
5684
      ANode:=Items.GetFirstNode
 
5685
    else
 
5686
      ANode:=ANode.GetFirstChild;
 
5687
    while (ANode<>nil) and (ANode.Text<>CurText) do
 
5688
      ANode:=ANode.GetNextSibling;
 
5689
    if ANode=nil then break;
 
5690
    ASelection.Delete(0);
 
5691
  end;
 
5692
  if ANode<>nil then
 
5693
    Selected:=ANode;
 
5694
  if FreeList then
 
5695
    ASelection.Free;
5360
5696
end;
5361
5697
 
5362
5698
// back to comctrls.pp