paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-31 13:56:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed TTreeNode.Delete and deleting in between node

Browse Source 
git-svn-id: trunk@5567 -
This commit is contained in:
mattias 2004-06-15 17:21:01 +00:00
parent b77559cc9b
commit 8ddb84becd
6 changed files with 166 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
examples/treeview/tv_add_remove.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="2"/> <Version Value="3"/>
<General> <General>
<ProjectType Value="Application"/> <ProjectType Value="Application"/>
<Flags> <Flags>
@ -9,32 +9,30 @@
<SaveOnlyProjectUnits Value="True"/> <SaveOnlyProjectUnits Value="True"/>
</Flags> </Flags>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="1"/> <ActiveEditorIndexAtStart Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
<Title Value="TV_Add_Remove"/> <Title Value="TV_Add_Remove"/>
</General> </General>
<Units Count="2"> <Units Count="2">
<Unit0> <Unit0>
<CursorPos X="1" Y="7"/> <CursorPos X="6" Y="11"/>
<EditorIndex Value="0"/>
<Filename Value="TV_Add_Remove.dpr"/> <Filename Value="TV_Add_Remove.dpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="20"/> <UsageCount Value="36"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<CursorPos X="19" Y="52"/> <CursorPos X="1" Y="98"/>
<EditorIndex Value="1"/> <EditorIndex Value="0"/>
<Filename Value="tv_add_remove_u1.pas"/> <Filename Value="tv_add_remove_u1.pas"/>
<ComponentName Value="Form1"/> <ComponentName Value="Form1"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<ResourceFilename Value="tv_add_remove_u1.lrs"/> <ResourceFilename Value="tv_add_remove_u1.lrs"/>
<TopLine Value="38"/> <TopLine Value="75"/>
<UnitName Value="TV_Add_Remove_U1"/> <UnitName Value="TV_Add_Remove_U1"/>
<UsageCount Value="20"/> <UsageCount Value="36"/>
</Unit1> </Unit1>
</Units> </Units>
<PublishOptions> <PublishOptions>
@ -57,10 +55,14 @@
</RequiredPackages> </RequiredPackages>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="2"/>
<SearchPaths> <SearchPaths>
<LCLWidgetType Value="gtk"/> <LCLWidgetType Value="gtk"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/> <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
</SearchPaths> </SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other> <Other>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>

16
examples/treeview/tv_add_remove_u1.pas
View File

@ -12,7 +12,7 @@ component can be found here:
interface interface
uses uses
Messages, SysUtils, LResources, Classes, Graphics, Controls, Forms, Dialogs, SysUtils, LResources, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons; StdCtrls, ComCtrls, Buttons;
type type
@ -26,6 +26,7 @@ type
{ Private declarations } { Private declarations }
public public
{ Public declarations } { Public declarations }
constructor Create(TheOwner: TComponent); override;
end; end;
var var
@ -49,6 +50,7 @@ begin
with tv_eg1.Items.AddFirst( nil, 'Root' ) do with tv_eg1.Items.AddFirst( nil, 'Root' ) do
begin begin
Selected := true; Selected := true;
writeln('tv_eg1.Selected=',HexStr(Cardinal(tv_eg1.Selected),8));
end; end;
end end
else begin else begin
@ -96,6 +98,18 @@ begin
tv_eg1.Selected.Delete; tv_eg1.Selected.Delete;
end; end;
constructor TForm1.Create(TheOwner: TComponent);
var
RootNode: TTreeNode;
begin
inherited Create(TheOwner);
RootNode:=tv_eg1.Items.AddFirst(nil,'Root');
tv_eg1.Items.AddChild(RootNode,'Node1');
tv_eg1.Items.AddChild(RootNode,'Node2');
tv_eg1.Items.AddChild(RootNode,'Node3');
RootNode.Expanded:=true;
end;
Initialization Initialization
{$I tv_add_remove_u1.lrs} {$I tv_add_remove_u1.lrs}

9
lcl/comctrls.pp
View File

@ -1619,7 +1619,7 @@ type
procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual; procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual;
procedure MultiSelectGroup; procedure MultiSelectGroup;
procedure Update; procedure Update;
function ConsistencyCheck: integer; procedure ConsistencyCheck;
procedure WriteDebugReport(const Prefix: string; Recurse: boolean); procedure WriteDebugReport(const Prefix: string; Recurse: boolean);
property AbsoluteIndex: Integer read GetAbsoluteIndex; property AbsoluteIndex: Integer read GetAbsoluteIndex;
property Count: Integer read GetCount; property Count: Integer read GetCount;
@ -1727,7 +1727,7 @@ type
function InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode; function InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode;
function InsertObjectBehind(PrevNode: TTreeNode; const S: string; function InsertObjectBehind(PrevNode: TTreeNode; const S: string;
Data: Pointer): TTreeNode; Data: Pointer): TTreeNode;
function ConsistencyCheck: integer; procedure ConsistencyCheck;
procedure WriteDebugReport(const Prefix: string; AllNodes: boolean); procedure WriteDebugReport(const Prefix: string; AllNodes: boolean);
property Count: Integer read GetCount; property Count: Integer read GetCount;
property Items[Index: Integer]: TTreeNode read GetNodeFromIndex; default; property Items[Index: Integer]: TTreeNode read GetNodeFromIndex; default;
@ -2032,7 +2032,7 @@ type
constructor Create(AnOwner: TComponent); override; constructor Create(AnOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function AlphaSort: Boolean; function AlphaSort: Boolean;
function ConsistencyCheck: integer; procedure ConsistencyCheck;
function CustomSort(SortProc: TTreeNodeCompare): Boolean; function CustomSort(SortProc: TTreeNodeCompare): Boolean;
function GetHitTestInfoAt(X, Y: Integer): THitTests; function GetHitTestInfoAt(X, Y: Integer): THitTests;
function GetNodeAt(X, Y: Integer): TTreeNode; function GetNodeAt(X, Y: Integer): TTreeNode;
@ -2254,6 +2254,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.132 2004/06/15 17:21:01 mattias
fixed TTreeNode.Delete and deleting in between node
Revision 1.131 2004/06/05 10:29:15 mattias Revision 1.131 2004/06/05 10:29:15 mattias
replaced FindMask by global function from Vincent replaced FindMask by global function from Vincent

5
lcl/include/control.inc
View File

@ -235,6 +235,8 @@ end;
procedure TControl.SetAction(Value: TBasicAction); procedure TControl.SetAction(Value: TBasicAction);
begin begin
writeln('TControl.SetAction A ',Name,':',ClassName,' ',HexStr(Cardinal(Value),8),' Old=',HexStr(Cardinal(Action),8));
if (Value=Action) then exit;
if Value = nil then begin if Value = nil then begin
ActionLink.Free; ActionLink.Free;
ActionLink:=nil; ActionLink:=nil;
@ -3194,6 +3196,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.191 2004/06/15 17:21:01 mattias
fixed TTreeNode.Delete and deleting in between node
Revision 1.190 2004/06/14 12:54:02 micha Revision 1.190 2004/06/14 12:54:02 micha
fix designer cursor to not set Form.Cursor directly fix designer cursor to not set Form.Cursor directly

220
lcl/include/treeview.inc
View File

@ -190,36 +190,22 @@ begin
end; end;
destructor TTreeNode.Destroy; destructor TTreeNode.Destroy;
//var
// Node: TTreeNode;
// CheckValue: Integer;
begin begin
{$IFDEF TREEVIEW_DEBUG} {$IFDEF TREEVIEW_DEBUG}
DebugLn('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text); DebugLn('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
{$ENDIF} {$ENDIF}
FDeleting := True; FDeleting := True;
// delete childs
HasChildren := false; HasChildren := false;
// unbind all references
Unbind; Unbind;
if Owner<>nil then begin if Owner<>nil then begin
if Owner.Owner<>nil then if Owner.Owner<>nil then
Owner.Owner.Delete(self); Owner.Owner.Delete(self);
dec(Owner.FCount); dec(Owner.FCount);
end; end;
{if Owner.Owner.FLastDropTarget = Self then
Owner.Owner.FLastDropTarget := nil;
Node := Parent;
if (Node <> nil) and (not Node.Deleting) then begin
if Node.IndexOf(Self) <> -1 then
CheckValue := 1
else
CheckValue := 0;
if Node.CompareCount(CheckValue) then begin
Expanded := False;
Node.HasChildren := False; // delete all childs
end;
end;
if ItemId <> nil then TreeView_DeleteItem(Handle, ItemId);}
Data := nil; Data := nil;
// free data
if FItems<>nil then begin if FItems<>nil then begin
FreeMem(FItems); FreeMem(FItems);
FItems:=nil; FItems:=nil;
@ -299,8 +285,10 @@ begin
and (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare) and (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare)
and (not Deleting) and FInTree then and (not Deleting) and FInTree then
begin begin
if Parent <> nil then Parent.AlphaSort if Parent <> nil then
else TreeView.AlphaSort; Parent.AlphaSort
else
TreeView.AlphaSort;
end; end;
end; end;
@ -564,9 +552,11 @@ end;
procedure TTreeNode.SetSelected(AValue: Boolean); procedure TTreeNode.SetSelected(AValue: Boolean);
begin begin
if AValue=GetSelected then exit; if AValue=GetSelected then exit;
if AValue then if AValue then begin
Include(FStates,nsSelected) Include(FStates,nsSelected);
else begin if (TreeView<>nil) and (TreeView.Selected=nil) then
TreeView.Selected:=Self;
end else begin
Exclude(FStates,nsSelected); Exclude(FStates,nsSelected);
if (TreeView<>nil) and (TreeView.Selected=Self) then if (TreeView<>nil) and (TreeView.Selected=Self) then
TreeView.Selected:=nil; TreeView.Selected:=nil;
@ -980,17 +970,8 @@ begin
end; end;
function TTreeNode.GetCount: Integer; function TTreeNode.GetCount: Integer;
//var Node: TTreeNode;
begin begin
Result:=FCount; Result:=FCount;
{
Result := 0;
Node := GetFirstChild;
while Node <> nil do
begin
Inc(Result);
Node := Node.GetNextChild(Node);
end;}
end; end;
procedure TTreeNode.EndEdit(Cancel: Boolean); procedure TTreeNode.EndEdit(Cancel: Boolean);
@ -1002,7 +983,7 @@ begin
end; end;
procedure TTreeNode.Unbind; procedure TTreeNode.Unbind;
// unbind from parent and neighbor siblings // unbind from parent and neighbor siblings, but not from owner
var OldIndex, i: integer; var OldIndex, i: integer;
HigherNode: TTreeNode; HigherNode: TTreeNode;
TheTreeView: TCustomTreeView; TheTreeView: TCustomTreeView;
@ -1010,7 +991,9 @@ begin
{$IFDEF TREEVIEW_DEBUG} {$IFDEF TREEVIEW_DEBUG}
DebugLn('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text); DebugLn('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
{$ENDIF} {$ENDIF}
// remove single select
Selected:=false; Selected:=false;
// invalidate caches of TreeView and if root item, remove from TreeView.Items
if Owner<>nil then begin if Owner<>nil then begin
Owner.ClearCache; Owner.ClearCache;
if FParent=nil then if FParent=nil then
@ -1025,20 +1008,29 @@ begin
TheTreeView.FInsertMarkNode:=nil; TheTreeView.FInsertMarkNode:=nil;
end; end;
end; end;
// unselect (multi)
UnbindFromMultiSelected; UnbindFromMultiSelected;
// remove from sibling list
if FPrevBrother<>nil then FPrevBrother.FNextBrother:=FNextBrother; if FPrevBrother<>nil then FPrevBrother.FNextBrother:=FNextBrother;
if FNextBrother<>nil then FNextBrother.FPrevBrother:=FPrevBrother; if FNextBrother<>nil then FNextBrother.FPrevBrother:=FPrevBrother;
FPrevBrother:=nil; FPrevBrother:=nil;
FNextBrother:=nil; FNextBrother:=nil;
// remove from parent
if FParent<>nil then begin if FParent<>nil then begin
// update all FSubTreeCount
HigherNode:=FParent; HigherNode:=FParent;
while HigherNode<>nil do begin while HigherNode<>nil do begin
dec(HigherNode.FSubTreeCount,FSubTreeCount); dec(HigherNode.FSubTreeCount,FSubTreeCount);
HigherNode:=HigherNode.Parent; HigherNode:=HigherNode.Parent;
end; end;
//if TreeNodes<>nil then Dec(TreeNodes.FCount,FSubTreeCount); //if TreeNodes<>nil then Dec(TreeNodes.FCount,FSubTreeCount);
OldIndex:=Index; // remove from parents list
for i:=OldIndex to Count-1 do OldIndex:=FParent.FCount-1;
while (OldIndex>=0) and (FParent.FItems[OldIndex]<>Self) do
dec(OldIndex);
if OldIndex<0 then
RaiseGDBException('');
for i:=OldIndex to FParent.FCount-2 do
FParent.FItems[i]:=FParent.FItems[i+1]; FParent.FItems[i]:=FParent.FItems[i+1];
dec(FParent.FCount); dec(FParent.FCount);
if (FParent.FCapacity>15) and (FParent.FCount<(FParent.FCapacity shr 2)) if (FParent.FCapacity>15) and (FParent.FCount<(FParent.FCapacity shr 2))
@ -1084,7 +1076,7 @@ var HigherNode: TTreeNode;
NewIndex, NewParentItemSize, i: integer; NewIndex, NewParentItemSize, i: integer;
begin begin
{$IFDEF TREEVIEW_DEBUG} {$IFDEF TREEVIEW_DEBUG}
write('[TTreeNode.InternalMove] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text DbgOut('[TTreeNode.InternalMove] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text
,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]); ,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text); if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
DebugLn(''); DebugLn('');
@ -1646,58 +1638,63 @@ begin
Items[I].WriteDelphiData(Stream, Info); Items[I].WriteDelphiData(Stream, Info);
end; end;
function TTreeNode.ConsistencyCheck: integer; procedure TTreeNode.ConsistencyCheck;
var RealSubTreeCount: integer; var RealSubTreeCount: integer;
i: integer; i: integer;
Node1: TTreeNode; Node1: TTreeNode;
begin begin
if FOwner<>nil then begin if FOwner<>nil then begin
end; end;
if FCapacity<0 then exit(-1); if FCapacity<0 then RaiseGDBException('');
if FCapacity<FCount then exit(-2); if FCapacity<FCount then RaiseGDBException('');
if FCount<0 then exit(-3); if FCount<0 then RaiseGDBException('');
if FHeight<0 then exit(-4); if FHeight<0 then RaiseGDBException('');
if (FItems<>nil) and (FCapacity<=0) then exit(-5); if (FItems<>nil) and (FCapacity<=0) then RaiseGDBException('');
if (FCapacity>0) and (FItems=nil) then exit(-6); if (FCapacity>0) and (FItems=nil) then RaiseGDBException('');
if (FNextBrother<>nil) and (FNextBrother.FPrevBrother<>Self) then exit(-7); if (FNextBrother<>nil) and (FNextBrother.FPrevBrother<>Self) then
if (FPrevBrother<>nil) and (FPrevBrother.FNextBrother<>Self) then exit(-8); RaiseGDBException('');
if (FPrevBrother<>nil) and (FPrevBrother.FNextBrother<>Self) then
RaiseGDBException('');
// check childs // check childs
RealSubTreeCount:=1; RealSubTreeCount:=1;
for i:=0 to FCount-1 do begin for i:=0 to FCount-1 do begin
if (Items[i]=nil) then exit(-9); if (Items[i]=nil) then RaiseGDBException('');
if (i=0) and (Items[i].FPrevBrother<>nil) then exit(-10); if (i=0) and (Items[i].FPrevBrother<>nil) then RaiseGDBException('');
if (i>0) and (Items[i].FPrevBrother<>Items[i-1]) then exit(-11); if (i>0) and (Items[i].FPrevBrother=nil) then RaiseGDBException('');
if (i<FCount-1) and (Items[i].FNextBrother<>Items[i+1]) then exit(-12); if (i>0) and (Items[i].FPrevBrother<>Items[i-1]) then RaiseGDBException('');
if (i=FCount-1) and (Items[i].FNextBrother<>nil) then exit(-13); if (i<FCount-1) and (Items[i].FNextBrother=nil) then
if Items[i].FParent<>Self then exit(-14); RaiseGDBException('');
Result:=Items[i].ConsistencyCheck; if (i<FCount-1) and (Items[i].FNextBrother<>Items[i+1]) then
if Result<>0 then exit; RaiseGDBException('');
if (i=FCount-1) and (Items[i].FNextBrother<>nil) then
RaiseGDBException('');
if Items[i].FParent<>Self then RaiseGDBException('');
Items[i].ConsistencyCheck;
inc(RealSubTreeCount,Items[i].SubTreeCount); inc(RealSubTreeCount,Items[i].SubTreeCount);
end; end;
if FParent<>nil then begin if FParent<>nil then begin
if FParent.IndexOf(Self)<0 then exit(-15); if FParent.IndexOf(Self)<0 then RaiseGDBException('');
end; end;
if RealSubTreeCount<>SubTreeCount then exit(-16); if RealSubTreeCount<>SubTreeCount then RaiseGDBException('');
if FTop<0 then exit(-17); if FTop<0 then RaiseGDBException('');
// check for circles // check for circles
if FNextBrother=Self then exit(-18); if FNextBrother=Self then RaiseGDBException('');
if FPrevBrother=Self then exit(-19); if FPrevBrother=Self then RaiseGDBException('');
if FParent=Self then exit(-20); if FParent=Self then RaiseGDBException('');
Node1:=FParent; Node1:=FParent;
while Node1<>nil do begin while Node1<>nil do begin
if (Node1=Self) then exit(-21); if (Node1=Self) then RaiseGDBException('');
Node1:=Node1.FParent; Node1:=Node1.FParent;
end; end;
Result:=0;
end; end;
procedure TTreeNode.WriteDebugReport(const Prefix: string; Recurse: boolean); procedure TTreeNode.WriteDebugReport(const Prefix: string; Recurse: boolean);
var i: integer; var i: integer;
begin begin
write(Prefix); DbgOut(Prefix);
write('TTreeNode.WriteDebugReport Self=',HexStr(Cardinal(Self),8)); DbgOut('TTreeNode.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck); ConsistencyCheck;
write(' Text=',Text); DbgOut(' Text=',Text);
DebugLn(''); DebugLn('');
if Recurse then begin if Recurse then begin
for i:=0 to FCount-1 do for i:=0 to FCount-1 do
@ -2313,48 +2310,51 @@ begin
FNodeCache.CacheNode := nil; FNodeCache.CacheNode := nil;
end; end;
function TTreeNodes.ConsistencyCheck: integer; procedure TTreeNodes.ConsistencyCheck;
var Node: TTreeNode; var Node: TTreeNode;
RealCount, i: integer; RealCount, i: integer;
OldCache: TNodeCache; OldCache: TNodeCache;
begin begin
if FUpdateCount<0 then exit(-1); if FUpdateCount<0 then
RaiseGDBException('FUpdateCount<0');
RealCount:=0; RealCount:=0;
Node:=GetFirstNode; Node:=GetFirstNode;
while Node<>nil do begin while Node<>nil do begin
Result:=Node.ConsistencyCheck; Node.ConsistencyCheck;
if Result<>0 then begin
dec(Result,100);
exit;
end;
inc(RealCount,Node.SubTreeCount); inc(RealCount,Node.SubTreeCount);
//DebugLn(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount); //DebugLn(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount);
Node:=Node.FNextBrother; Node:=Node.FNextBrother;
end; end;
//DebugLn(' ConsistencyCheck: B ',RealCount,',',FCount); //DebugLn(' ConsistencyCheck: B ',RealCount,',',FCount);
if RealCount<>FCount then exit(-3); if RealCount<>FCount then
if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then exit(-4); RaiseGDBException('RealCount<>FCount');
if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then exit(-5); if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then
if FTopLvlCapacity<FTopLvlCount then exit(-6); RaiseGDBException('');
if (FTopLvlCount<0) then exit(-7); if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then
RaiseGDBException('');
if FTopLvlCapacity<FTopLvlCount then
RaiseGDBException('');
if (FTopLvlCount<0) then
RaiseGDBException('');
for i:=0 to FTopLvlCount-1 do begin for i:=0 to FTopLvlCount-1 do begin
if (i=0) and (FTopLvlItems[i].FPrevBrother<>nil) then exit(-8); if (i=0) and (FTopLvlItems[i].FPrevBrother<>nil) then
RaiseGDBException('');
if (i>0) and (FTopLvlItems[i].FPrevBrother<>FTopLvlItems[i-1]) then if (i>0) and (FTopLvlItems[i].FPrevBrother<>FTopLvlItems[i-1]) then
exit(-9); RaiseGDBException('');
if (i<FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>FTopLvlItems[i+1]) if (i<FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>FTopLvlItems[i+1])
then begin then begin
DebugLn(' CONSISTENCY i=',dbgs(i),' FTopLvlCount=',dbgs(FTopLvlCount),' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8)); DebugLn(' CONSISTENCY i=',dbgs(i),' FTopLvlCount=',dbgs(FTopLvlCount),' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8));
exit(-10); RaiseGDBException('');
end; end;
if (i=FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>nil) then if (i=FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>nil) then
exit(-11); RaiseGDBException('');
end; end;
if FNodeCache.CacheNode<>nil then begin if FNodeCache.CacheNode<>nil then begin
OldCache:=FNodeCache; OldCache:=FNodeCache;
ClearCache; ClearCache;
if GetNodeFromIndex(OldCache.CacheIndex)<>OldCache.CacheNode then exit(-12); if GetNodeFromIndex(OldCache.CacheIndex)<>OldCache.CacheNode then
RaiseGDBException('');
end; end;
Result:=0;
end; end;
procedure TTreeNodes.WriteDebugReport(const Prefix: string; AllNodes: boolean); procedure TTreeNodes.WriteDebugReport(const Prefix: string; AllNodes: boolean);
@ -2362,7 +2362,7 @@ var Node: TTreeNode;
begin begin
write(Prefix); write(Prefix);
write('TTreeNodes.WriteDebugReport Self=',HexStr(Cardinal(Self),8)); write('TTreeNodes.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck); ConsistencyCheck;
DebugLn(''); DebugLn('');
if AllNodes then begin if AllNodes then begin
Node:=GetFirstNode; Node:=GetFirstNode;
@ -4959,57 +4959,67 @@ begin
FOnAdvancedCustomDrawItem(Self, Node, State, Stage, PaintImages, Result); FOnAdvancedCustomDrawItem(Self, Node, State, Stage, PaintImages, Result);
end; end;
function TCustomTreeView.ConsistencyCheck: integer; procedure TCustomTreeView.ConsistencyCheck;
var OldMaxRight, OldLastTop, OldMaxLvl: integer; var OldMaxRight, OldLastTop, OldMaxLvl: integer;
OldTopItem, OldBottomItem: TTreeNode; OldTopItem, OldBottomItem: TTreeNode;
begin begin
if Canvas=nil then exit(-1); if Canvas=nil then
if (fExpandSignSize<0) then exit(-2); RaiseGDBException('Canvas=nil');
if FDefItemHeight<0 then exit(-3); if (fExpandSignSize<0) then
if FIndent<0 then exit(-4); RaiseGDBException('fExpandSignSize='+IntToStr(fExpandSignSize));
if FMaxRight<0 then exit(-5); if FDefItemHeight<0 then
if FTreeNodes=nil then exit(-6); RaiseGDBException('FDefItemHeight='+IntToStr(FDefItemHeight));
Result:=FTreeNodes.ConsistencyCheck; if FIndent<0 then
if Result<>0 then begin RaiseGDBException('FIndent='+IntToStr(FIndent));
dec(Result,1000); if FMaxRight<0 then
exit; RaiseGDBException('FMaxRight='+IntToStr(FMaxRight));
end; if FTreeNodes=nil then
if FUpdateCount<0 then exit(-7); RaiseGDBException('FTreeNodes=nil');
FTreeNodes.ConsistencyCheck;
if FUpdateCount<0 then
RaiseGDBException('FUpdateCount='+IntToStr(FUpdateCount));
if (not (tvsTopsNeedsUpdate in FStates)) then begin if (not (tvsTopsNeedsUpdate in FStates)) then begin
if Items.GetLastSubNode<>nil then begin if Items.GetLastSubNode<>nil then begin
OldLastTop:=Items.GetLastSubNode.Top; OldLastTop:=Items.GetLastSubNode.Top;
Include(FStates,tvsTopsNeedsUpdate); Include(FStates,tvsTopsNeedsUpdate);
UpdateAllTops; UpdateAllTops;
if OldLastTop<>Items.GetLastSubNode.Top then exit(-8); if OldLastTop<>Items.GetLastSubNode.Top then
RaiseGDBException('OldLastTop='+HexStr(Cardinal(OldLastTop),8)
+'<>Items.GetLastSubNode.Top='+HexStr(Cardinal(Items.GetLastSubNode.Top),8));
end; end;
end; end;
if not (tvsMaxRightNeedsUpdate in FStates) then begin if not (tvsMaxRightNeedsUpdate in FStates) then begin
OldMaxRight:=FMaxRight; OldMaxRight:=FMaxRight;
Include(FStates,tvsMaxRightNeedsUpdate); Include(FStates,tvsMaxRightNeedsUpdate);
UpdateMaxRight; UpdateMaxRight;
if OldMaxRight<>FMaxRight then exit(-9); if OldMaxRight<>FMaxRight then
RaiseGDBException('OldMaxRight<>FMaxRight');
end; end;
if not (tvsMaxLvlNeedsUpdate in FStates) then begin if not (tvsMaxLvlNeedsUpdate in FStates) then begin
OldMaxLvl:=FMaxLvl; OldMaxLvl:=FMaxLvl;
Include(FStates,tvsMaxLvlNeedsUpdate); Include(FStates,tvsMaxLvlNeedsUpdate);
UpdateMaxLvl; UpdateMaxLvl;
if OldMaxLvl<>FMaxLvl then exit(-10); if OldMaxLvl<>FMaxLvl then
RaiseGDBException('OldMaxLvl<>FMaxLvl');
end; end;
if (tvsIsEditing in FStates) and (FSelectedNode=nil) then exit(-11); if (tvsIsEditing in FStates) and (FSelectedNode=nil) then
RaiseGDBException('');
if (FSelectedNode<>nil) then begin if (FSelectedNode<>nil) then begin
if not FSelectedNode.IsVisible then exit(-12); if not FSelectedNode.IsVisible then
RaiseGDBException('not FSelectedNode.IsVisible');
end; end;
if not (tvsTopItemNeedsUpdate in FStates) then begin if not (tvsTopItemNeedsUpdate in FStates) then begin
OldTopItem:=FTopItem; OldTopItem:=FTopItem;
UpdateTopItem; UpdateTopItem;
if FTopItem<>OldTopItem then exit(-13); if FTopItem<>OldTopItem then
RaiseGDBException('FTopItem<>OldTopItem');
end; end;
if not (tvsBottomItemNeedsUpdate in FStates) then begin if not (tvsBottomItemNeedsUpdate in FStates) then begin
OldBottomItem:=FBottomItem; OldBottomItem:=FBottomItem;
UpdateBottomItem; UpdateBottomItem;
if FBottomItem<>OldBottomItem then exit(-14); if FBottomItem<>OldBottomItem then
RaiseGDBException('FBottomItem<>OldBottomItem');
end; end;
Result:=0;
end; end;
procedure TCustomTreeView.WriteDebugReport(const Prefix: string; procedure TCustomTreeView.WriteDebugReport(const Prefix: string;
@ -5017,7 +5027,7 @@ procedure TCustomTreeView.WriteDebugReport(const Prefix: string;
begin begin
write(Prefix); write(Prefix);
write('TCustomTreeView.WriteDebugReport Self=',HexStr(Cardinal(Self),8)); write('TCustomTreeView.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck); ConsistencyCheck;
DebugLn(''); DebugLn('');
if AllNodes then begin if AllNodes then begin
Items.WriteDebugReport(Prefix+' ',true); Items.WriteDebugReport(Prefix+' ',true);

24
lcl/intfgraphics.pas
View File

@ -3141,18 +3141,6 @@ begin
inherited Create(FImage.Width,FImage.Height); inherited Create(FImage.Width,FImage.Height);
end; end;
//------------------------------------------------------------------------------
procedure InternalInit;
var
c: Char;
begin
for c:=Low(char) to High(char) do begin
IsSpaceChar[c]:=c in [' ',#9,#10,#13];
IsNumberChar[c]:=c in ['0'..'9'];
IsHexNumberChar[c]:=c in ['0'..'9','A'..'F','a'..'f'];
end;
end;
{ TLazReaderPartIcon } { TLazReaderPartIcon }
procedure TLazReaderPartIcon.InternalRead(Stream: TStream; Img: TFPCustomImage); procedure TLazReaderPartIcon.InternalRead(Stream: TStream; Img: TFPCustomImage);
@ -3280,6 +3268,18 @@ begin
FnIcons := IconHeader.idCount; FnIcons := IconHeader.idCount;
end; end;
//------------------------------------------------------------------------------
procedure InternalInit;
var
c: Char;
begin
for c:=Low(char) to High(char) do begin
IsSpaceChar[c]:=c in [' ',#9,#10,#13];
IsNumberChar[c]:=c in ['0'..'9'];
IsHexNumberChar[c]:=c in ['0'..'9','A'..'F','a'..'f'];
end;
end;
initialization initialization
InternalInit; InternalInit;