summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/gui_memo.pas898
1 files changed, 833 insertions, 65 deletions
diff --git a/src/gui/gui_memo.pas b/src/gui/gui_memo.pas
index 6b0a3559..d680fd2b 100644
--- a/src/gui/gui_memo.pas
+++ b/src/gui/gui_memo.pas
@@ -37,7 +37,7 @@ type
TfpgMemo = class(TfpgWidget)
private
- FLines: TStringList;
+ FLines: TStrings;
FMaxLength: integer;
FCursorPos: integer;
FCursorLine: integer;
@@ -62,7 +62,7 @@ type
FLongestLineWidth: TfpgCoord;
function GetFontDesc: string;
procedure SetFontDesc(const AValue: string);
- procedure RecalcLongestLine;
+ procedure RecalcLongestLine(AStartLine, AEndLine: Integer; OnlyCheckifBigger: Boolean);
procedure DeleteSelection;
procedure DoCopy;
procedure DoPaste;
@@ -82,8 +82,13 @@ type
procedure SetCursorLine(aValue: integer);
procedure UpdateScrollBarCoords;
protected
+ procedure MsgTextChanged(var msg: TfpgMessageRec); message FPGM_TEXT_CHANGE;
+ procedure MsgTextInsert(var msg: TfpgMessageRec); message FPGM_TEXT_INSERT;
+ procedure MsgTextDelete(var msg: TfpgMessageRec); message FPGM_TEXT_DELETE;
+ protected
procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override;
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+ procedure HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
procedure HandleResize(dwidth, dheight: integer); override;
@@ -92,10 +97,14 @@ type
procedure HandleShow; override;
procedure HandleMouseEnter; override;
procedure HandleMouseExit; override;
+ procedure HandleTextChanged; virtual;
+ procedure HandleTextInsert(AText: PChar; ALength: Integer; BeforeEvent: Boolean; AStartLine, AEndLine: Integer); virtual;
+ procedure HandleTextDelete(AText: PChar; ALength: Integer; BeforeEvent: Boolean; AStartLine, AEndLine: Integer); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateScrollBars;
+ procedure Refresh;
function SelectionText: string;
property CursorLine: integer read FCursorLine write SetCursorLine;
property Font: TfpgFont read FFont;
@@ -107,7 +116,7 @@ type
published
property BackgroundColor default clBoxColor;
property FontDesc: string read GetFontDesc write SetFontDesc;
- property Lines: TStringList read FLines;
+ property Lines: TStrings read FLines;
property TabOrder;
property TextColor;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
@@ -125,50 +134,735 @@ uses
type
// custom stringlist that will notify the memo of item changes
- TfpgMemoStrings = class(TStringList)
+
+
+ { TfpgMemoIndex }
+
+ TfpgMemoIndex = object
+ FLineIndices : array of Integer;
+ FLineLength : array of Integer;
+ FLineCount : Integer;
+ FLastLine : Integer;
+ FChangeAmount : Integer;
+
+ procedure ApplyChanges(AToLine: Integer = -1);
+
+ constructor Init;
+ destructor Destroy;
+
+ function LineCount: Integer;
+ function LineFromOffset(const AOffset: Integer): Integer;
+ function LineLength(const AIndex: Integer): Integer; // UTF8 chars
+ function OffsetFromLine(AIndex: Integer): Integer;
+ procedure AdjustLinesAfterIndex(const AIndex: Integer; const ADelta: Integer);
+ procedure InsertLines(AIndex: Integer; const ACount: Integer);
+ procedure DeleteLines(const AStartIndex: Integer; const ACount: Integer);
+ procedure SetLineCount(const AValue: Integer);
+ procedure SetLineLength(const AIndex: Integer; const AValue: Integer); // UTF8 chars
+ procedure SetLineOffset(const AIndex: Integer; const AOffset: Integer);
+ end;
+
+ { TfpgMemoStrings }
+
+ TfpgMemoStrings = class(TStrings)
+ private
+ FTextStream: TMemoryStream;
+ FTextStreamSize: Integer;
+ FIndex : TfpgMemoIndex;
+ Memo : TfpgMemo;
+ FCursorPos : Integer;
+ FUpdating : Boolean;
+ function LineHasLineEnding(AIndex: Integer): Boolean;
protected
- Memo: TfpgMemo;
+ function Get(Index: Integer): string; override;
+ function GetCount: Integer; override;
+ function GetTextStr: string; override;
+ procedure Put(Index: Integer; const S: string); override;
+ procedure SetTextStr(const Value: string); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ function StreamSize(SetToSize: Integer = -1): Integer;
public
constructor Create(AMemo: TfpgMemo); reintroduce;
destructor Destroy; override;
+
function Add(const s: String): Integer; override;
- procedure Delete(Index: Integer); override;
+ procedure Assign(Source: TPersistent); override;
procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Insert(Index: Integer; const S: string); override;
+ procedure SaveToStream(Stream: TStream); override;
+
+ procedure InsertText(AText: String; AOffset: Integer);
+ procedure DeleteText(AOffset, ALength: Integer);
+
+ // Offsets are in UTF chars
+ procedure DeleteCharsByLines(AStartLine, AEndLine, AStartLineOffset, AEndLineOffset: Integer);
+ procedure InsertCharsByLine (AChars: String; AStartLine, ALineOffset: Integer);
+ end;
+
+{ TfpgMemoIndex }
+
+function TfpgMemoIndex.LineCount: Integer;
+begin
+ Result := FLineCount;
+end;
+
+function TfpgMemoIndex.LineFromOffset(const AOffset: Integer): Integer;
+var
+ i: Integer;
+ maxLine,
+ minLine: Integer;
+ factor: Integer;
+ tmpOffset: Integer;
+ tmpIndex: Integer;
+begin
+ if OffsetFromLine(FLastLine) = AOffset then
+ Exit(FLastLine); //==>
+
+ if AOffset = 0 then
+ Exit(0); //==>
+
+
+ // divide linst in half and move in the right direction
+ factor := FLineCount div 2;
+ tmpIndex := 0;
+ maxLine := LineCount-1;
+ minLine := 0;
+ while factor > 10 do
+ begin
+ ApplyChanges(tmpIndex+factor);
+ tmpOffset := FLineIndices[tmpIndex+factor];
+ if tmpOffset = AOffset then
+ Exit(tmpIndex+factor) //==>
+ else if tmpOffset > AOffset then
+ begin
+ maxLine := tmpIndex+factor;
+ end
+ else if tmpOffset < AOffset then
+ begin
+ tmpIndex := minLine+factor;
+ minLine := tmpIndex;
+ end;
+ factor := (maxLine - minLine) div 2;
+ if factor mod 2 <> 0 then
+ Inc(factor);
end;
+ if minline < 15 then
+ minLine := 0;
+ //writeln('minline = ', minline,' maxline = ', maxline);
+ for i := minLine to maxLine do
+ begin
+ if FLineIndices[i] > AOffset then
+ Exit(i-1); //==>
+ end;
+
+ Result := FLineCount-1;
+end;
+
+function TfpgMemoIndex.LineLength(const AIndex: Integer): Integer;
+begin
+ Result := FLineLength[AIndex];
+end;
+
+function TfpgMemoIndex.OffsetFromLine(AIndex: Integer): Integer;
+begin
+ ApplyChanges(AIndex);
+
+ if AIndex < LineCount then
+ Result := FLineIndices[AIndex]
+ else
+ Result := -1;
+ WriteLn('LineCount = ', FLineCount,' Want LineIndex=', AIndex, ' Result Offset = ',Result);
+end;
+
+procedure TfpgMemoIndex.ApplyChanges(AToLine: Integer = -1);
+var
+ i: Integer;
+begin
+ if FChangeAmount = 0 then
+ Exit; //==>
+ if (AToLine <= FLastLine) and (AToLine > -1) then
+ Exit; //==>
+
+ if (AToLine = -1) or (AToLine > FLastLine-1) then
+ AToLine := FLineCount-1;
+ //WriteLn('Applying Changes from ', FLastLine+1, ' to ', AToLine, ' by ',FChangeAmount);
+ for i := FLastLine+1 to AToLine do
+ FLineIndices[i] := FLineIndices[i] + FChangeAmount;
+ FChangeAmount := 0;
+ //WriteLn('Line 0 offset = ', FLineIndices[0], ' Line 1 offset = ', FLineIndices[1]);
+end;
+
+procedure TfpgMemoIndex.AdjustLinesAfterIndex(const AIndex: Integer;
+ const ADelta: Integer);
+var
+ FOldDelta: Integer;
+begin
+ WriteLN('Adjusting lines after ', AIndex, ' by ', ADelta);
+ if AIndex < 0 then
+ begin
+ //WriteLn('AHHHH!');
+ end;
+ if AIndex > FLastLine then
+ begin
+ FOldDelta := FChangeAmount;
+ ApplyChanges(AIndex);
+ FChangeAmount := FOldDelta;
+ end
+ else if AIndex < FLastLine then
+ begin
+ ApplyChanges;
+ end;
+
+ FChangeAmount := FChangeAmount + ADelta;
+ FLastLine := AIndex;
+end;
+
+procedure TfpgMemoIndex.InsertLines(AIndex: Integer; const ACount: Integer);
+var
+ NeedMove: Boolean;
+begin
+ //WriteLn('Inserting Lines, Count = ', Acount, ' At index: ', AIndex);
+ if ACount = 0 then
+ Exit; //==>
+
+ NeedMove := AIndex < FLineCount;
+ SetLineCount(LineCount+ACount);
+
+ if NeedMove then
+ begin
+ //WriteLn('Moving ahead by: ', LineCount-AIndex-ACount);
+ Move(FLineIndices[AIndex], FLineIndices[AIndex+ACount], (LineCount-AIndex-ACount)*SizeOf(Integer));
+ Move(FLineLength[AIndex], FLineLength[AIndex+ACount], (LineCount-AIndex-ACount)*SizeOf(Integer));
+ end;
+end;
+
+procedure TfpgMemoIndex.DeleteLines(const AStartIndex: Integer; const ACount: Integer
+ );
+begin
+ //WriteLn('Deleting Indices starting at ', AStartIndex,' Count = ', ACount);
+ if ACount <= 0 then
+ Exit; //==>
+ if AStartIndex+ACount <> LineCount then
+ begin
+ Move(FLineIndices[AStartIndex+ACount], FLineIndices[AStartIndex], (LineCount-AStartIndex-ACount)*SizeOf(Integer));
+ Move(FLineLength[AStartIndex+ACount], FLineLength[AStartIndex], (LineCount-AStartIndex-ACount)*SizeOf(Integer));
+ end;
+ SetLineCount(LineCount-ACount);
+end;
+
+procedure TfpgMemoIndex.SetLineCount(const AValue: Integer);
+var
+ ArraySize: Integer;
+begin
+ if AValue = 0 then
+ begin
+ SetLength(FLineIndices, 0);
+ SetLength(FLineLength, 0);
+ FLineCount := 0;
+ Exit; //==>
+ end;
+ ArraySize := Length(FLineIndices);
+
+ if (AValue < ArraySize-99) or (AValue > ArraySize) then
+ begin
+ SetLength(FLineIndices,AValue+50);
+ SetLength(FLineLength, AValue+50);
+ end;
+ FLineCount := AValue;
+end;
+
+procedure TfpgMemoIndex.SetLineLength(const AIndex: Integer;
+ const AValue: Integer);
+begin
+ FLineLength[AIndex] := AValue;
+end;
+
+procedure TfpgMemoIndex.SetLineOffset(const AIndex: Integer; const AOffset: Integer);
+begin
+ FLineIndices[AIndex] := AOffset;
+end;
+
+constructor TfpgMemoIndex.Init;
+begin
+ FLineCount := 0;
+ FLastLine := 0;
+ FChangeAmount := 0;
+end;
+
+destructor TfpgMemoIndex.Destroy;
+begin
+ SetLineCount(0);
+end;
{ TfpgMemoStrings }
+procedure TfpgMemoStrings.InsertText(AText: String; AOffset: Integer);
+type
+ PLineData = ^TLineData;
+ TLineData = record
+ LineSize : Integer;
+ LineOffset: Integer;
+ LineLength: Integer; // UTF8 chars
+ end;
+var
+ NewLines: TList;
+ NewLineCount: Integer;
+ NewLineStart: Integer;
+ LastLineHasEnd: Boolean;
+ LastLineOffset: Integer;
+ LineSize: Integer;
+ TextSize: Integer;
+ Line: PLineData;
+ Buf: String;
+ TmpStr: String;
+ i: Integer;
+ StartIndex: Integer;
+ CurentOffset: Integer;
+ msgParm: TfpgMessageParams;
+begin
+ //if AOffset < 0 then //WriteLn('ERROR! AOffset < 0 !');
+ TextSize := Length(AText);
+
+ if TextSize = 0 then
+ Exit; //==>
+
+ NewLines := TList.Create;
+ NewLineStart := 1;
+
+ // check for lines in text to be added
+ SetLength(Buf, Length(LineEnding));
+ for i := 1 to TextSize do
+ begin
+ if i < NewLineStart then
+ Continue;
+ Buf := Copy(AText, i, Length(LineEnding));
+ if (i = Length(AText)) or (Buf = LineEnding) then
+ begin
+ Line := New(PLineData);
+ Line^.LineOffset := i;
+ Line^.LineSize := i-NewLineStart+1;
+ TmpStr := Copy(AText, NewLineStart, Line^.LineSize);
+ Line^.LineLength := UTF8Length(TmpStr);
+ //WriteLn('TmpStr = "', tmpstr,'"');
+ Inc(NewLineStart, Line^.LineSize);
+ NewLines.Add(Line);
+ WriteLn('Added Line');
+ end;
+ //WriteLn('In loop i = ',i,' Length = ', Length(Atext));
+ end;
+ LastLineHasEnd := Buf = LineEnding;
+ WriteLn('NewLines.Count = ', NewLines.Count);
+ // update line indices
+ StartIndex := FIndex.LineFromOffset(AOffset);
+ WriteLn('Got StartIndex = ', StartIndex);
+ if (StartIndex = Count-1) and (AOffset = StreamSize) then
+ if LineHasLineEnding(StartIndex) then
+ StartIndex := Count;
+
+ WriteLn('after check StartIndex = ', StartIndex);
+
+ if LastLineHasEnd or (FIndex.LineCount = 0) then
+ NewLineCount := NewLines.Count
+ else
+ NewLineCount := NewLines.Count-1;
+
+ msgParm.text.StartLine := StartIndex;
+ msgParm.text.EndLine := StartIndex + NewLineCount;
+ msgParm.text.Text := PChar(AText);
+ msgParm.text.Length := TextSize;
+ msgParm.text.Before := True;
+ fpgPostMessage(Self, Memo, FPGM_TEXT_INSERT, msgParm);
+
+ FIndex.InsertLines(StartIndex+Ord(FIndex.OffsetFromLine(StartIndex)>AOffset), NewLineCount);
+
+ // write new text to the stream
+ StreamSize(StreamSize + TextSize);
+ if AOffset < StreamSize then
+ begin
+ System.Move((FTextStream.Memory+AOffset)^, (FTextStream.Memory+AOffset+TextSize)^, StreamSize - AOffset - TextSize)
+ end;
+ FTextStream.Position := AOffset;
+ FTextStream.Write(AText[1], TextSize);
+
+ //Dec(StartIndex);
+ CurentOffset := AOffset;
+
+ for i := 0 to NewLines.Count-1 do
+ begin
+ Line := PLineData(NewLines[i]);
+ //WriteLn('AOffset = ', Aoffset);
+ if (i = 0)
+ and (((FIndex.OffsetFromLine(StartIndex) <> 0) and (StartIndex > 0)) or (StartIndex = 0))
+ and (FIndex.OffsetFromLine(StartIndex) < AOffset) then
+ // we need to update the prev line UTF8 length since we inserted in the middle of the line
+ begin
+ WriteLn('Inserting In the middle');
+ if i = NewLines.Count-1 then
+ begin
+ if LastLineHasEnd then
+ begin
+ LineSize := (CurentOffset - FIndex.FLineIndices[StartIndex]) + Line^.LineSize;
+ FIndex.SetLineOffset(StartIndex+1, FIndex.FLineIndices[StartIndex]+LineSize-TextSize);
+ SetLength(TmpStr, LineSize);
+ FTextStream.Position := FIndex.OffsetFromLine(StartIndex+1);
+ FTextStream.Read(TmpStr[1], LineSize);
+ FIndex.SetLineLength(StartIndex+1, UTF8Length(TmpStr));
+ end
+ else if StartIndex < FIndex.LineCount-1 then
+ LineSize := FIndex.FLineIndices[StartIndex+1+NewLineCount] - FIndex.FLineIndices[StartIndex]
+ else
+ LineSize := StreamSize - Findex.OffsetFromLine(StartIndex) + Line^.LineSize;
+ WriteLn('Adjusted Line Size = ',LineSize);
+
+ end
+ else begin
+ LineSize := AOffset - FIndex.OffsetFromLine(StartIndex) + Line^.LineSize;
+ FIndex.SetLineOffset(StartIndex+1, FIndex.OffsetFromLine(StartIndex)+ LineSize);
+ end;
+
+ SetLength(TmpStr, LineSize);
+ FTextStream.Position := FIndex.OffsetFromLine(StartIndex);
+ FTextStream.Read(TmpStr[1], LineSize);
+ FIndex.SetLineLength(StartIndex-1, UTF8Length(TmpStr));
+ end
+ else if (LastLineHasEnd = False) and (i = NewLines.Count-1) then
+ begin
+ WriteLn ('Inserting with no lineending at ', StartIndex + i);
+ //WriteLn('Line Offset = ',Findex.OffsetFromLine(StartIndex));
+ //WriteLn('NewLineCount = ',NewLineCount);
+ if i+StartIndex < FIndex.LineCount-1 then
+ LineSize := FIndex.FLineIndices[StartIndex+1+i+NewLineCount] - FIndex.FLineIndices[StartIndex+i]
+ else
+ LineSize := StreamSize - Findex.OffsetFromLine(StartIndex+i);
+ //WriteLn('OldLineSize = ', LineSize);
+ Inc(LineSize, Line^.LineSize);
+ //WriteLn('NewLineSize = ', LineSize);
+
+ SetLength(TmpStr, LineSize);
+ FTextStream.Position := FIndex.OffsetFromLine(StartIndex+i);
+ FTextStream.Read(TmpStr[1], LineSize);
+ FIndex.SetLineLength(StartIndex+i, UTF8Length(TmpStr));
+ FIndex.SetLineOffset(StartIndex+i, CurentOffset);
+ //if StartIndex+i < FIndex.LineCount-1 then
+ //FIndex.SetLineOffset(StartIndex+i+1, CurentOffset + Line^.LineSize);
+ end
+ else begin
+ WriteLn('Inserting normal line');
+ FIndex.SetLineLength(StartIndex+i, Line^.LineLength);
+ //if StartIndex+i > 0 then
+ WriteLn('CurentOffset = ', CurentOffset);
+ FIndex.SetLineOffset(StartIndex+i, CurentOffset);
+ end;
+ Inc(CurentOffset, Line^.LineSize);
+ end;
+ //WriteLn('LineSize = ', Line^.LineSize);
+ //WriteLn('StartIndex = ', StartIndex,' i = ',i);
+ FIndex.AdjustLinesAfterIndex(StartIndex+i, TextSize);
+ WriteLn('Line Count = ', Count);
+ // free our temp index
+ for i := 0 to NewLines.Count-1 do
+ Dispose(PLineData(NewLines[i]));
+ NewLines.Free;
+
+ msgParm.text.Before := False;
+ fpgPostMessage(Self, Memo, FPGM_TEXT_INSERT, msgParm);
+ //WriteLn;
+
+end;
+
+procedure TfpgMemoStrings.DeleteText(AOffset, ALength: Integer);
+var
+ FirstIndex,
+ LastIndex : Integer;
+ NextLineStart: Integer;
+ TmpStr: String;
+ IgnoreCount: Integer;
+ LineStart: Integer;
+ msgPArm: TfpgMessageParams;
+ KeepStartLine: Boolean;
+begin
+ if ALength = 0 then
+ Exit;//==>
+ //WriteLn('Before');
+ for LineStart := 0 to Count-1 do
+ begin
+ //WriteLN('Line ', LineStart,' offset = ', FIndex.OffsetFromLine(LineStart));
+ //WriteLN('Line ', LineStart,' Length = ', FIndex.LineLength(LineStart));
+ end;
+
+ //WriteLn('DeleteOffset = ', AOffset,' Length = ', ALength);
+
+ FirstIndex := FIndex.LineFromOffset(AOffset);
+ LastIndex := FIndex.LineFromOffset(AOffset+ALength);
+
+ //WriteLn('FirstIndex = ', FirstIndex,' LastIndex = ', LastIndex);
+
+ msgParm.text.StartLine := FirstIndex;
+ msgParm.text.EndLine := LastIndex;
+ msgParm.text.Text := PChar(FTextStream.Memory+AOffset);
+ msgParm.text.Length := ALength;
+ msgParm.text.Before := True;
+ fpgPostMessage(Self, Memo, FPGM_TEXT_DELETE, msgParm);
+
+ if LastIndex < FIndex.LineCount-1 then
+ NextLineStart := Findex.OffsetFromLine(LastIndex+1) - ALength
+ else
+ NextLineStart := StreamSize-ALength;
+
+ KeepStartLine := FirstIndex = 0;{(Findex.OffsetFromLine(FirstIndex) < AOffset)
+ or ((Findex.OffsetFromLine(FirstIndex) = AOffset) and (AOffset + ALength < NextLineStart));}
+
+
+ FIndex.DeleteLines(FirstIndex+1{Ord(KeepStartLine)}, LastIndex - (FirstIndex{+Ord(KeepStartLine)}));
+
+ FTextStream.Position := AOffset;
+ FTextStream.Write((FTextStream.Memory+AOffset+ALength)^, StreamSize-(AOffset+ALength));
+ StreamSize(StreamSize-ALength);
+
+ LineStart := FIndex.OffsetFromLine(FirstIndex-Ord(not KeepStartLine));
+
+ SetLength(TmpStr, NextLineStart-LineStart);
+
+ FTextStream.Position := LineStart;
+ FTextStream.Read(TmpStr[1], NextLineStart-LineStart);
+
+ FIndex.SetLineLength(FirstIndex-Ord(not KeepStartLine), UTF8Length(TmpStr));
+
+ FIndex.AdjustLinesAfterIndex(FirstIndex{-Ord(not KeepStartLine)}, -ALength);
+ //WriteLn('After');
+ for LineStart := 0 to Count-1 do
+ begin
+ //WriteLN('Line ', LineStart,' offset = ', FIndex.OffsetFromLine(LineStart));
+ //WriteLN('Line ', LineStart,' Length = ', FIndex.LineLength(LineStart));
+ end;
+ //WriteLN;
+
+ msgParm.text.Text := nil;
+ msgParm.text.Length := 0;
+ msgParm.text.Before := False;
+ fpgPostMessage(Self, Memo, FPGM_TEXT_DELETE, msgParm);
+end;
+
+procedure TfpgMemoStrings.DeleteCharsByLines(AStartLine, AEndLine,
+ AStartLineOffset, AEndLineOffset: Integer);
+var
+ LineString: string;
+ Offset: Integer;
+ LineStart: PChar;
+ StartPos,
+ EndPos: Integer;
+begin
+ inherited;
+
+ LineString := Get(AStartLine);
+ LineStart := PChar(LineString);
+ //WriteLn('StartLine = ', AStartLine);
+ //WriteLn('EndLine = ', AEndLine);
+
+ OffSet := FIndex.OffsetFromLine(AStartLine);
+ if Offset < 0 then
+ Offset := 0;
+ StartPos := Offset + (UTF8CharStart(LineStart, Length(LineString), AStartLineOffset) - LineStart);
+ //WriteLn('Inserting char at offset ',LineBytePos-Offset,' on line ', AStartLine);
+ if AEndLine <> AStartLine then
+ begin
+ if AEndLineOffset > 0 then
+ begin
+ LineString := Get(AEndLine);
+ LineStart := PChar(LineString);
+ end;
+ OffSet := FIndex.OffsetFromLine(AEndLine);
+ if Offset < 0 then
+ Offset := 0;
+ end;
+
+ if AEndLineOffset > 0 then
+ EndPos := Offset + (UTF8CharStart(LineStart, Length(LineString), AEndLineOffset) - LineStart)
+ else
+ EndPos := Offset;
+
+ DeleteText(StartPos, EndPos- StartPos);
+end;
+
+procedure TfpgMemoStrings.InsertCharsByLine(AChars: String; AStartLine,
+ ALineOffset: Integer);
+var
+ LineString: string;
+ Offset: Integer;
+ LineStart: PChar;
+ LineBytePos: Integer;
+begin
+ inherited;
+
+ LineString := Get(AStartLine);
+ LineStart := PChar(LineString);
+ //WriteLn('LineIndex = ', AStartLine);
+
+ OffSet := FIndex.OffsetFromLine(AStartLine);
+ if Offset < 0 then
+ Offset := 0;
+ LineBytePos := Offset + (UTF8CharStart(LineStart, Length(LineString), ALineOffset) - LineStart);
+ //WriteLn('Inserting char at offset ',LineBytePos-Offset,' on line ', AStartLine);
+ InsertText(AChars, LineBytePos);
+end;
+
+function TfpgMemoStrings.LineHasLineEnding(AIndex: Integer): Boolean;
+var
+ Str: String;
+ StrEnd: Integer;
+begin
+ SetLength(Str, Length(LineEnding));
+ if AIndex < Count-1 then
+ StrEnd := FIndex.OffsetFromLine(AIndex+1)
+ else
+ StrEnd := StreamSize;
+
+ FTextStream.Position:= StrEnd-Length(LineEnding);
+ FTextStream.Read(Str[1], Length(LineEnding));
+
+ Result := Str = LineEnding;
+end;
+
+function TfpgMemoStrings.Get(Index: Integer): string;
+var
+ LineStart,
+ LineEnd: Integer;
+begin
+ LineStart := FIndex.OffsetFromLine(Index);
+ if Index < FIndex.LineCount-1 then
+ LineEnd := FIndex.OffsetFromLine(Index+1)
+ else
+ LineEnd := StreamSize;
+ SetLength(Result, LineEnd-LineStart);
+ FTextStream.Position := LineStart;
+ FTextStream.Read(Result[1], LineEnd-LineStart);
+ if Copy(Result, Length(Result)+1-Length(LineEnding), Length(LineEnding)) = LineEnding then
+ SetLength(Result, Length(Result) - Length(LineEnding));
+
+end;
+
+function TfpgMemoStrings.GetCount: Integer;
+begin
+ Result := FIndex.LineCount;
+end;
+
+function TfpgMemoStrings.GetTextStr: string;
+begin
+ SetLength(Result, StreamSize);
+ FTextStream.Position := 0;
+ FTextStream.Read(Result[1], StreamSize);
+end;
+
+procedure TfpgMemoStrings.Put(Index: Integer; const S: string);
+begin
+ BeginUpdate;
+ Inherited;
+ EndUpdate;
+end;
+
+procedure TfpgMemoStrings.SetTextStr(const Value: string);
+begin
+ Clear;
+ //WriteLn('InsertingText: ', Value);
+ InsertText(Value, 0);
+end;
+
+procedure TfpgMemoStrings.SetUpdateState(Updating: Boolean);
+begin
+ FUpdating := Updating;
+end;
+
+function TfpgMemoStrings.StreamSize(SetToSize: Integer): Integer;
+begin
+ if SetToSize > -1 then
+ begin
+ FTextStreamSize := SetToSize;
+ if (FTextStreamSize > FTextStream.Size)
+ or (FTextStream.Size - 256 > FTextStreamSize)
+ then
+ FTextStream.Size := FTextStreamSize + 128
+ end;
+ Result := FTextStreamSize;
+end;
+
constructor TfpgMemoStrings.Create(AMemo: TfpgMemo);
begin
inherited Create;
Memo := AMemo;
+ FTextStream := TMemoryStream.Create;
+ FIndex.Init;
end;
destructor TfpgMemoStrings.Destroy;
begin
+ if Memo.FLines = Self then
+ Memo.FLines := nil;
Memo := nil;
+ FTextStream.Free;
+ FIndex.Destroy;
inherited Destroy;
end;
function TfpgMemoStrings.Add(const s: String): Integer;
begin
- Result := inherited Add(s);
- if Assigned(Memo) and (Memo.HasHandle) then
- Memo.Invalidate;
+ Insert(Count, S);
+end;
+
+procedure TfpgMemoStrings.Assign(Source: TPersistent);
+begin
+
end;
procedure TfpgMemoStrings.Delete(Index: Integer);
+var
+ Offset: Integer;
+ DelCount: Integer;
begin
- inherited Delete(Index);
- if Assigned(Memo) and (Memo.HasHandle) then
- Memo.Invalidate;
+ Offset := FIndex.OffsetFromLine(Index);
+ if Offset = -1 then
+ Offset := StreamSize;
+
+ if Index < Count-1 then
+ DelCount := FIndex.OffsetFromLine(Index+1) - Offset
+ else
+ DelCount := StreamSize-Offset;
+
+ DeleteText(Offset, DelCount);
+
+ if (FUpdating = False) and Assigned(Memo) and (Memo.HasHandle) then
+ Memo.Refresh;
+end;
+
+procedure TfpgMemoStrings.Insert(Index: Integer; const S: string);
+var
+ Offset: Integer;
+begin
+ WriteLn('Begin Insert');
+ Offset := FIndex.OffsetFromLine(Index);
+ if Offset = -1 then
+ Offset := StreamSize;
+ //WriteLn('FTextStream Size = ', StreamSize);
+ InsertText(S+LineEnding, Offset);
+ WriteLn('End Insert');
+ WriteLn();
+
+ if (FUpdating = False) and Assigned(Memo) and (Memo.HasHandle) then
+ Memo.Refresh;
+
+end;
+
+procedure TfpgMemoStrings.SaveToStream(Stream: TStream);
+begin
+ Stream.WriteBuffer(FTextStream.Memory^,StreamSize);
end;
procedure TfpgMemoStrings.Clear;
begin
- inherited Clear;
+ FIndex.SetLineCount(0);
+ FTextStream.SetSize(0);
if Assigned(Memo) and (Memo.HasHandle) then
- Memo.Invalidate;
+ Memo.Refresh;
end;
@@ -255,6 +949,35 @@ begin
FHScrollBar.UpdateWindowPosition;
end;
+procedure TfpgMemo.MsgTextChanged(var msg: TfpgMessageRec);
+begin
+ if Assigned(FFormDesigner) then
+ FFormDesigner.Dispatch(msg);
+ if msg.Stop then
+ Exit; //==>
+ HandleTextChanged;
+end;
+
+procedure TfpgMemo.MsgTextInsert(var msg: TfpgMessageRec);
+begin
+ if Assigned(FFormDesigner) then
+ FFormDesigner.Dispatch(msg);
+ if msg.Stop then
+ Exit; //==>
+ with msg.Params do
+ HandleTextInsert(text.Text, text.Length, text.Before, text.StartLine,text.EndLine);
+end;
+
+procedure TfpgMemo.MsgTextDelete(var msg: TfpgMessageRec);
+begin
+ if Assigned(FFormDesigner) then
+ FFormDesigner.Dispatch(msg);
+ if msg.Stop then
+ Exit; //==>
+ with msg.Params do
+ HandleTextDelete(text.Text, text.Length, text.Before, text.StartLine, text.EndLine);
+end;
+
constructor TfpgMemo.Create(AOwner: TComponent);
begin
inherited;
@@ -300,18 +1023,20 @@ end;
destructor TfpgMemo.Destroy;
begin
- TfpgMemoStrings(FLines).Free;
+ if Assigned(FLines) then
+ TfpgMemoStrings(FLines).Free;
FFont.Free;
inherited Destroy;
end;
-procedure TfpgMemo.RecalcLongestLine;
+procedure TfpgMemo.RecalcLongestLine(AStartLine, AEndLine: Integer; OnlyCheckifBigger: Boolean);
var
n: integer;
lw: TfpgCoord;
begin
- FLongestLineWidth := 0;
- for n := 1 to LineCount do
+ if OnlyCheckIfBigger = False then
+ FLongestLineWidth := 0;
+ for n := AStartLine to AEndLine do
begin
lw := FFont.TextWidth(getlinetext(n));
if lw > FlongestLineWidth then
@@ -352,6 +1077,10 @@ begin
selsl := FSelEndLine;
selsp := FSelEndPos;
end;
+
+ TfpgMemoStrings(Lines).DeleteCharsByLines(selsl-1, selel-1, selsp, selep);
+
+ {//WriteLn('Start=',FSelStartPos,' End=', FSelEndPos);
for n := selsl to selel do
begin
@@ -367,6 +1096,7 @@ begin
len := selep - st;
UTF8Delete(ls, st + 1, len);
+
SetLineText(n, ls);
end;
@@ -378,7 +1108,7 @@ begin
end;
for n := selsl + 1 to selel do
- FLines.Delete(selsl);
+ FLines.Delete(selsl);}
FCursorPos := selsp;
FCursorLine := selsl;
@@ -420,7 +1150,7 @@ begin
for n := selsl to selel do
begin
if n > selsl then
- s := s + #13#10;
+ s := s + LineEnding;//#13#10;
ls := GetLineText(n);
@@ -508,7 +1238,7 @@ var
tw: integer;
begin
// horizontal adjust
- RecalcLongestLine;
+ //RecalcLongestLine(1, LineCount, True);
tw := FFont.TextWidth(UTF8Copy(CurrentLine, 1, FCursorPos));
if tw - FDrawOffset > VisibleWidth - 2 then
@@ -601,6 +1331,12 @@ begin
AdjustCursor;
end;
+procedure TfpgMemo.Refresh;
+begin
+ UpdateScrollBars;
+ Invalidate;
+end;
+
function TfpgMemo.LineCount: integer;
begin
Result := FLines.Count;
@@ -694,7 +1430,7 @@ begin
inherited HandleShow;
if (csLoading in ComponentState) then
Exit;
- RecalcLongestLine;
+ RecalcLongestLine(1, LineCount, True);
UpdateScrollBars;
UpdateScrollBarCoords;
end;
@@ -850,38 +1586,30 @@ end;
procedure TfpgMemo.HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean);
var
- prevval: string;
s: string;
- ls: string;
+ Strings: TfpgMemoStrings;
begin
inherited;
- prevval := Text;
s := AText;
+
+ Strings := TfpgMemoStrings(FLines);
// Printable characters only
// Note: This is now UTF-8 compliant!
if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then
begin
- if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then
- begin
- DeleteSelection;
- ls := GetLineText(FCursorLine);
- UTF8Insert(s, ls, FCursorPos + 1);
- SetLineText(FCursorLine, ls);
- Inc(FCursorPos);
- FSelStartPos := FCursorPos;
- FSelStartLine := FCursorLine;
- FSelEndLine := 0;
- AdjustCursor;
- end;
+ DeleteSelection;
+ Strings.InsertCharsByLine(s, FCursorLine-1, FCursorPos);
+
+ Inc(FCursorPos);
+ FSelStartPos := FCursorPos;
+ FSelStartLine := FCursorLine;
+ FSelEndLine := 0;
+ AdjustCursor;
consumed := True;
end;
- if prevval <> Text then
- if Assigned(FOnChange) then
- FOnChange(self);
-
if consumed then
RePaint;
end;
@@ -902,6 +1630,7 @@ var
end;
begin
+ Lines.BeginUpdate;
Consumed := True;
hasChanged := False;
case CheckClipBoardKey(keycode, shiftstate) of
@@ -932,9 +1661,14 @@ begin
case keycode of
keyLeft:
- if FCursorPos > 0 then
begin
- Dec(FCursorPos);
+ if FCursorPos > 0 then
+ Dec(FCursorPos)
+ else if FCursorLine > 1 then
+ begin
+ Dec(FCursorLine);
+ FCursorPos := UTF8Length(CurrentLine);
+ end;
if (ssCtrl in shiftstate) then
// word search...
@@ -949,9 +1683,14 @@ begin
end;// left
keyRight:
- if FCursorPos < UTF8Length(CurrentLine) then
begin
- Inc(FCursorPos);
+ if FCursorPos < UTF8Length(CurrentLine) then
+ Inc(FCursorPos)
+ else if FCursorLine < Lines.Count then
+ begin
+ Inc(FCursorLine);
+ FCursorPos := 0;
+ end;
if (ssCtrl in shiftstate) then
// word search...
@@ -1046,30 +1785,28 @@ begin
case keycode of
keyReturn:
begin
- ls := UTF8Copy(FLines[FCursorline - 1], 1, FCursorPos);
- ls2 := UTF8Copy(FLines[FCursorline - 1], FCursorPos + 1, UTF8Length(FLines[FCursorline - 1]));
- FLines.Insert(FCursorLine - 1, ls);
+ TfpgMemoStrings(Lines).InsertCharsByLine(LineEnding, FCursorLine-1, FCursorPos);
Inc(FCursorLine);
- SetLineText(FCursorLine, ls2);
FCursorPos := 0;
hasChanged := True;
end;
keyBackSpace:
begin
- if FCursorPos > 0 then
+ if FSelEndLine > 0 then
+ DeleteSelection
+ else if FCursorPos > 0 then
begin
- ls := GetLineText(FCursorLine);
- UTF8Delete(ls, FCursorPos, 1);
- SetLineText(FCursorLine, ls);
+ TfpgMemoStrings(Lines).DeleteCharsByLines
+ (FCursorLine-1, FCursorLine-1, FCursorPos-1 , FCursorPos);
Dec(FCursorPos);
end
else if FCursorLine > 1 then
begin
- ls := CurrentLine;
- FLines.Delete(FCursorLine - 1);
Dec(FCursorLine);
FCursorPos := UTF8Length(FLines.Strings[FCursorLine - 1]);
- FLines.Strings[FCursorLine - 1] := FLines.Strings[FCursorLine - 1] + ls;
+ TfpgMemoStrings(Lines).DeleteCharsByLines
+ (FCursorLine-1, FCursorLine, FCursorPos , 0);
+
end;
hasChanged := True;
end;
@@ -1081,14 +1818,18 @@ begin
DeleteSelection
else if FCursorPos < UTF8Length(ls) then
begin
- UTF8Delete(ls, FCursorPos + 1, 1);
- SetLineText(FCursorLine, ls);
+ //UTF8Delete(ls, FCursorPos + 1, 1);
+ //SetLineText(FCursorLine, ls);
+ TfpgMemoStrings(Lines).DeleteCharsByLines
+ (FCursorLine-1, FCursorLine-1, FCursorPos , FCursorPos+1);
end
else if FCursorLine < LineCount then
begin
- ls2 := FLines.Strings[FCursorLine];
+ TfpgMemoStrings(Lines).DeleteCharsByLines
+ (FCursorLine-1, FCursorLine, FCursorPos, 0);
+ {ls2 := FLines.Strings[FCursorLine];
FLines.Delete(FCursorLine);
- FLines.Strings[FCursorLine - 1] := ls + ls2;
+ FLines.Strings[FCursorLine - 1] := ls + ls2;}
end;
hasChanged := True;
end;
@@ -1138,6 +1879,13 @@ begin
FOnChange(self);
end;
+procedure TfpgMemo.HandleKeyRelease(var keycode: word;
+ var shiftstate: TShiftState; var consumed: boolean);
+begin
+ inherited HandleKeyRelease(keycode, shiftstate, consumed);
+ Lines.EndUpdate;
+end;
+
procedure TfpgMemo.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
var
n: integer;
@@ -1347,6 +2095,24 @@ begin
end;
end;
+procedure TfpgMemo.HandleTextChanged;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(self);
+end;
+
+procedure TfpgMemo.HandleTextInsert(AText: PChar; ALength: Integer; BeforeEvent: Boolean; AStartLine, AEndLine: Integer);
+begin
+ if Not BeforeEvent then
+ RecalcLongestLine(AStartLine, AEndLine, False);
+end;
+
+procedure TfpgMemo.HandleTextDelete(AText: PChar; ALength: Integer; BeforeEvent: Boolean; AStartLine, AEndLine: Integer);
+begin
+ if Not BeforeEvent then
+ RecalcLongestLine(AStartLine, AEndLine, False);
+end;
+
function TfpgMemo.SelectionText: string;
begin
{
@@ -1371,14 +2137,15 @@ var
n: integer;
s: string;
begin
- s := '';
+ {s := '';
for n := 1 to LineCount do
begin
if n > 1 then
- s := s + #13#10;
+ s := s + LineEnding;//#13#10;
s := s + GetLineText(n);
end;
- Result := s;
+ Result := s;}
+ Result := Lines.Text;
end;
procedure TfpgMemo.SetText(const AValue: string);
@@ -1388,7 +2155,7 @@ var
s: string;
begin
FLines.Clear;
- s := '';
+ {s := '';
n := 1;
while n <= UTF8Length(AValue) do
begin
@@ -1407,7 +2174,8 @@ begin
end;
if s <> '' then
- FLines.Add(s);
+ FLines.Add(s); }
+ TfpgMemoStrings(FLines).SetTextStr(AValue);
FDrawOffset := 0;
FCursorPos := 0;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 14:48:10 +0000