diff --git a/lcl/allunits.pp b/lcl/allunits.pp index 5fc74b094e..b60e91f2cc 100644 --- a/lcl/allunits.pp +++ b/lcl/allunits.pp @@ -29,7 +29,7 @@ uses LCLStrConsts, // base classes LazQueue, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList, - ExtendedStrings, DynamicArray, UTrace, + ExtendedStrings, DynamicArray, UTrace, TextStrings, // base types and base functions LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages, // the interface base @@ -47,6 +47,9 @@ end. { ============================================================================= $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 implemented interface graphics diff --git a/lcl/lclstrconsts.pas b/lcl/lclstrconsts.pas index 46e7358f65..9f73a28b40 100644 --- a/lcl/lclstrconsts.pas +++ b/lcl/lclstrconsts.pas @@ -172,6 +172,7 @@ ResourceString rsNoInterfaceObject = 'No interface object. ' +'Plz check if the unit "interfaces" was added to the programs uses clause.'; rsCanNotFocus = 'Can not focus'; + rsListIndexExceedsBounds = 'List index exceeds bounds (%d)'; diff --git a/lcl/textstrings.pas b/lcl/textstrings.pas index d17611195b..c9a61d9ede 100644 --- a/lcl/textstrings.pas +++ b/lcl/textstrings.pas @@ -24,6 +24,20 @@ complete text as whole instead of as line by line as in TStringList. UNDER CONSTRUCTION by Mattias Gaertner + + ToDo: + - Capacity + - Add + - Delete + - Exchange + - Insert + - GetObject + - Put + - PutObject + - Sort + - CustomSort + - Find + - Index } unit TextStrings; @@ -32,22 +46,28 @@ unit TextStrings; interface uses - Classes, SysUtils; + Classes, SysUtils, LCLStrConsts; type TLineRange = record - StartPos, EndPos: integer; - Line: string; + StartPos: integer; // start of line in Text + EndPos: integer; // end of line in Text (= start of newline character(s)) + Line: string; // cached line as string + TheObject: TObject; end; TTextStrings = class(TStrings) + private + FOnChange: TNotifyEvent; + FOnChanging: TNotifyEvent; protected FArraysValid: boolean; FLineCount: integer; FLineRanges: ^TLineRange;// array of TLineRange FText: string; + FUpdateCount: integer; function GetTextStr: string; override; - procedure SetTextStr(const Value: string); override; + procedure SetTextStr(const AValue: string); override; procedure BuildArrays; virtual; function GetCount: Integer; override; procedure Changed; virtual; @@ -57,9 +77,11 @@ type public destructor Destroy; override; procedure Clear; override; - procedure SetText(TheText: PChar); virtual; + procedure SetText(TheText: PChar); override; public property Text: string read FText write SetTextStr; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; end; implementation @@ -71,7 +93,7 @@ begin Result:=FText; end; -procedure TTextStrings.SetTextStr(const Value: string); +procedure TTextStrings.SetTextStr(const AValue: string); begin if FText=AValue then exit; FText:=AValue; @@ -82,6 +104,7 @@ procedure TTextStrings.BuildArrays; var p, line: integer; l: Integer; + ArraySize: Integer; begin //writeln('[TTextStrings.BuildLineRanges] A Self=',HexStr(Cardinal(Self),8),',LineCount=',FLineCount,' Len=',SourceLength); if FArraysValid then exit; @@ -107,11 +130,13 @@ begin inc(FLineCount); // build line range list if FLineCount>0 then begin - GetMem(FLineRanges,FLineCount*SizeOf(TLineRange)); + ArraySize:=FLineCount*SizeOf(TLineRange); + GetMem(FLineRanges,ArraySize); + FillChar(FLineRanges^,ArraySize,0); p:=1; line:=0; FLineRanges[line].StartPos:=1; - FLineRanges[FLineCount-1].EndPos:=fSrcLen+1; + FLineRanges[FLineCount-1].EndPos:=l+1; while (p<=l) do begin if (not (FText[p] in [#10,#13])) then begin inc(p); @@ -133,7 +158,7 @@ end; function TTextStrings.GetCount: Integer; begin - if not FArraysValid then BuildLineRanges; + if not FArraysValid then BuildArrays; Result:=FLineCount; end; @@ -153,10 +178,15 @@ end; function TTextStrings.Get(Index: Integer): string; begin - BuildLineRanges; + if not FArraysValid then BuildArrays; if (Index<0) or (Index>=FLineCount) then - Error(SListIndexError,Index); - // ToDo + Error(rsListIndexExceedsBounds, Index); + if (FLineRanges[Index].Line='') + and (FLineRanges[Index].StartPos