added ToDo for textstrings.pas

git-svn-id: trunk@4442 -
This commit is contained in:
mattias 2003-07-31 17:16:32 +00:00
parent 20bf90d158
commit a178223f0d
3 changed files with 47 additions and 13 deletions

View File

@ -29,7 +29,7 @@ uses
LCLStrConsts, LCLStrConsts,
// base classes // base classes
LazQueue, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList, LazQueue, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList,
ExtendedStrings, DynamicArray, UTrace, ExtendedStrings, DynamicArray, UTrace, TextStrings,
// base types and base functions // base types and base functions
LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages, LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages,
// the interface base // the interface base
@ -47,6 +47,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.25 2003/07/31 17:16:32 mattias
added ToDo for textstrings.pas
Revision 1.24 2003/07/04 22:06:49 mattias Revision 1.24 2003/07/04 22:06:49 mattias
implemented interface graphics implemented interface graphics

View File

@ -172,6 +172,7 @@ ResourceString
rsNoInterfaceObject = 'No interface object. ' rsNoInterfaceObject = 'No interface object. '
+'Plz check if the unit "interfaces" was added to the programs uses clause.'; +'Plz check if the unit "interfaces" was added to the programs uses clause.';
rsCanNotFocus = 'Can not focus'; rsCanNotFocus = 'Can not focus';
rsListIndexExceedsBounds = 'List index exceeds bounds (%d)';

View File

@ -24,6 +24,20 @@
complete text as whole instead of as line by line as in TStringList. complete text as whole instead of as line by line as in TStringList.
UNDER CONSTRUCTION by Mattias Gaertner UNDER CONSTRUCTION by Mattias Gaertner
ToDo:
- Capacity
- Add
- Delete
- Exchange
- Insert
- GetObject
- Put
- PutObject
- Sort
- CustomSort
- Find
- Index
} }
unit TextStrings; unit TextStrings;
@ -32,22 +46,28 @@ unit TextStrings;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, LCLStrConsts;
type type
TLineRange = record TLineRange = record
StartPos, EndPos: integer; StartPos: integer; // start of line in Text
Line: string; EndPos: integer; // end of line in Text (= start of newline character(s))
Line: string; // cached line as string
TheObject: TObject;
end; end;
TTextStrings = class(TStrings) TTextStrings = class(TStrings)
private
FOnChange: TNotifyEvent;
FOnChanging: TNotifyEvent;
protected protected
FArraysValid: boolean; FArraysValid: boolean;
FLineCount: integer; FLineCount: integer;
FLineRanges: ^TLineRange;// array of TLineRange FLineRanges: ^TLineRange;// array of TLineRange
FText: string; FText: string;
FUpdateCount: integer;
function GetTextStr: string; override; function GetTextStr: string; override;
procedure SetTextStr(const Value: string); override; procedure SetTextStr(const AValue: string); override;
procedure BuildArrays; virtual; procedure BuildArrays; virtual;
function GetCount: Integer; override; function GetCount: Integer; override;
procedure Changed; virtual; procedure Changed; virtual;
@ -57,9 +77,11 @@ type
public public
destructor Destroy; override; destructor Destroy; override;
procedure Clear; override; procedure Clear; override;
procedure SetText(TheText: PChar); virtual; procedure SetText(TheText: PChar); override;
public public
property Text: string read FText write SetTextStr; property Text: string read FText write SetTextStr;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
end; end;
implementation implementation
@ -71,7 +93,7 @@ begin
Result:=FText; Result:=FText;
end; end;
procedure TTextStrings.SetTextStr(const Value: string); procedure TTextStrings.SetTextStr(const AValue: string);
begin begin
if FText=AValue then exit; if FText=AValue then exit;
FText:=AValue; FText:=AValue;
@ -82,6 +104,7 @@ procedure TTextStrings.BuildArrays;
var var
p, line: integer; p, line: integer;
l: Integer; l: Integer;
ArraySize: Integer;
begin begin
//writeln('[TTextStrings.BuildLineRanges] A Self=',HexStr(Cardinal(Self),8),',LineCount=',FLineCount,' Len=',SourceLength); //writeln('[TTextStrings.BuildLineRanges] A Self=',HexStr(Cardinal(Self),8),',LineCount=',FLineCount,' Len=',SourceLength);
if FArraysValid then exit; if FArraysValid then exit;
@ -107,11 +130,13 @@ begin
inc(FLineCount); inc(FLineCount);
// build line range list // build line range list
if FLineCount>0 then begin if FLineCount>0 then begin
GetMem(FLineRanges,FLineCount*SizeOf(TLineRange)); ArraySize:=FLineCount*SizeOf(TLineRange);
GetMem(FLineRanges,ArraySize);
FillChar(FLineRanges^,ArraySize,0);
p:=1; p:=1;
line:=0; line:=0;
FLineRanges[line].StartPos:=1; FLineRanges[line].StartPos:=1;
FLineRanges[FLineCount-1].EndPos:=fSrcLen+1; FLineRanges[FLineCount-1].EndPos:=l+1;
while (p<=l) do begin while (p<=l) do begin
if (not (FText[p] in [#10,#13])) then begin if (not (FText[p] in [#10,#13])) then begin
inc(p); inc(p);
@ -133,7 +158,7 @@ end;
function TTextStrings.GetCount: Integer; function TTextStrings.GetCount: Integer;
begin begin
if not FArraysValid then BuildLineRanges; if not FArraysValid then BuildArrays;
Result:=FLineCount; Result:=FLineCount;
end; end;
@ -153,10 +178,15 @@ end;
function TTextStrings.Get(Index: Integer): string; function TTextStrings.Get(Index: Integer): string;
begin begin
BuildLineRanges; if not FArraysValid then BuildArrays;
if (Index<0) or (Index>=FLineCount) then if (Index<0) or (Index>=FLineCount) then
Error(SListIndexError,Index); Error(rsListIndexExceedsBounds, Index);
// ToDo if (FLineRanges[Index].Line='')
and (FLineRanges[Index].StartPos<FLineRanges[Index].EndPos) then begin
FLineRanges[Index].Line:=copy(FText,FLineRanges[Index].StartPos,
FLineRanges[Index].EndPos-FLineRanges[Index].StartPos);
end;
Result:=FLineRanges[Index].Line;
end; end;
procedure TTextStrings.ClearArrays; procedure TTextStrings.ClearArrays;