mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 23:39:08 +02:00
added ToDo for textstrings.pas
git-svn-id: trunk@4442 -
This commit is contained in:
parent
20bf90d158
commit
a178223f0d
@ -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
|
||||||
|
|
||||||
|
@ -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)';
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user