diff options
| -rw-r--r-- | examples/gui/memo/memotest.lpi | 54 | ||||
| -rw-r--r-- | examples/gui/memo/memotest.lpr | 108 | ||||
| -rw-r--r-- | src/corelib/gfxbase.pas | 16 | ||||
| -rw-r--r-- | src/gui/gui_memo.pas | 898 |
4 files changed, 1010 insertions, 66 deletions
diff --git a/examples/gui/memo/memotest.lpi b/examples/gui/memo/memotest.lpi new file mode 100644 index 00000000..a6792148 --- /dev/null +++ b/examples/gui/memo/memotest.lpi @@ -0,0 +1,54 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication Use="True" PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_package"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="memotest.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="memotest"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenGProfCode Value="True"/> + </Debugging> + </Linking> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/examples/gui/memo/memotest.lpr b/examples/gui/memo/memotest.lpr new file mode 100644 index 00000000..c3e106a8 --- /dev/null +++ b/examples/gui/memo/memotest.lpr @@ -0,0 +1,108 @@ +program memotest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + typinfo, + fpgfx, + gfxbase, + gui_form, + gui_button, + gui_label, + gui_memo; + +type + + { TMainForm } + + TMainForm = class(TfpgForm) + private + memo: TfpgMemo; + btnQuit: TfpgButton; + procedure btnQuitClick(Sender: TObject); + procedure HandleResize(awidth, aheight: TfpgCoord); override; + public + constructor Create(AOwner: TComponent); override; + end; + +{ TMainForm } + +procedure TMainForm.btnQuitClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + if Assigned(Memo) then + begin + Memo.SetPosition(Memo.Left, Memo.Top, awidth-20, aheight- Memo.Top - 10); + btnQuit.Left := awidth - btnQuit.Width - 10; + btnQuit.UpdateWindowPosition; + end; +end; + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WindowTitle := 'Memo test'; + SetPosition(100, 100, 300, 300); + + memo := CreateMemo(self, 10, 40, 280, 150); + + memo.Lines.Add('Memo Test0'); + memo.Lines.Add('Memo Test1'); + //memo.Lines.Add('Memo Test2'); + //memo.Lines.Add('Memo Test3'); + //memo.Lines.Add('Memo Test4'); + memo.Lines.Insert(1,'0 Before 1 after'); + //memo.Lines.Delete(1); + //memo.Lines.Text := 'Dude'+LineEnding+'What''s mine say?'+LineEnding;; + //memo.Lines.Text := memo.Lines.Text + 'Sweet'+LineEnding; + //memo.lines.LoadFromFile('/home/andrew/programming/groupprojects/fpgui/src/gui/gui_memo.pas'); + //memo.lines.LoadFromFile('/usr/share/dict/cracklib-small'); + {memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text);} + {memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text);} + {memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text); + memo.lines.Add(memo.lines.text);} + { memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; + memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; + memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; + memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; + memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; + memo.Lines.Text := memo.Lines.Text + memo.Lines.Text; } + btnQuit := CreateButton(self, 210, 10, 80, 'Quit', @btnQuitClick); + btnQuit.ImageName := 'stdimg.quit'; + btnQuit.ShowImage := True; + + HandleResize(Width, Height); + +end; +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + frm.Show; + fpgApplication.Run; + frm.Free; +end; + +begin + MainProc; +end. diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index bc602db0..4faad9ea 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -76,6 +76,11 @@ const FPGM_RESIZE = 15; FPGM_MOVE = 16; FPGM_POPUPCLOSE = 17; + // Text Messages + FPGM_TEXT_CHANGE = 18; + FPGM_TEXT_INSERT = 19; + FPGM_TEXT_DELETE = 20; + FPGM_KILLME = 9999; // The special keys, based on the well-known keyboard scan codes @@ -118,12 +123,22 @@ type shiftstate: TShiftState; end; + + TfpgMsgParmText = record + Text: PChar; + Length: Integer; + StartLine, + EndLine: Integer; + Before: Boolean; + end; + TfpgMessageParams = record case integer of 0: (mouse: TfpgMsgParmMouse); 1: (keyboard: TfpgMsgParmKeyboard); 2: (rect: TfpgRect); + 3: (text: TfpgMsgParmText); end; @@ -136,7 +151,6 @@ type end; PfpgMessageRec = ^TfpgMessageRec; - TfpgLineStyle = (lsSolid, lsDash, lsDot, lsDashDot, lsDashDotDot); 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; |