////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// TMemo helper for CRW-DAQ to add Undo/Redo/Find/Print features.             //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20240110 - Created by A.K.                                                 //
// 20251127 - MemoCaretPosNeedBugFix,TextRowColToCharPosUtf8,ApplyGoToRowCol  //
////////////////////////////////////////////////////////////////////////////////

unit _crw_memo; //  TMemo helper for CRW-DAQ.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, strutils, math, lazUTF8,
 Graphics, Controls, Forms, Dialogs, LMessages,
 ExtCtrls, ComCtrls, StdCtrls, Buttons, Clipbrd,
 printer4lazarus, PrintersDlgs, character, Printers, LclIntf,
 _crw_alloc, _crw_utf8, _crw_str, _crw_hash, _crw_eldraw,
 _crw_ef, _crw_appforms, _crw_apptools;

 ////////////////////////////
 // Text find/replace options
 ////////////////////////////
type
 TSearchType = (stWholeWord, stMatchCase);
 TSearchTypes = set of TSearchType;

 /////////////////////////////////////////////////////////////////
 // TCrwMemo - class helper for TMemo to add text find, print etc.
 /////////////////////////////////////////////////////////////////
type
 TCrwMemo = class helper for TMemo
 public
  procedure Print(const aCaption:LongString);
 public // Find text in Memo.Text. StartPos and Result is zero-based.
  function  FindText(const SearchStr:LongString; StartPos,Tail:Integer; Options:TSearchTypes):Integer;
  function  GetPrintableImage:TBitmap;
  procedure MoveCaretToEnd(Mode:Integer=1);
  procedure ApplyGoToRowCol(aRow,aCol:Integer);
 end;

 ///////////////////////////////////////////////////////////////////////////////
 // Bug in i386-Win32 FPC 3.2.2 LCL 3.6.0.0 WidgetSet win32.
 // lazarus\lcl\interfaces\win32\win32wsstdctrls.pp[1476:73]:
 // class procedure TWin32WSCustomEdit.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint);
 // begin
 //  Windows.SendMessageW(ACustomEdit.Handle, EM_SETSEL, NewPos.X, NewPos.X);
 // end;
 // Bug is 'NewPos.X' instead of expected 'NewPos.Y'.
 // To fix this bug, TMemo.SelStart uses instead of CaretPos.
 // TextRowColToCharPosUtf8 uses to calculate SelStart by (row,col).
 ///////////////////////////////////////////////////////////////////////////////
const
 MemoCaretPosNeedBugFix : Boolean = {$IFDEF WINDOWS} True {$ELSE} False {$ENDIF};

function TextRowColToCharPosUtf8(Lines:TStrings; row,col:Integer):SizeInt;

 ////////////////////////////////////////////
 // TUndoStep - one step of undo history data
 ////////////////////////////////////////////
type
 TUndoStep = class(TMasterObject)
 private
  myBytePos  : SizeInt;
  mySelStart : SizeInt;
  myInsStr   : LongString;
  myDelStr   : LongString;
  myCheckSum : QWord;
  function  GetBytePos:SizeInt;
  function  GetSelStart:SizeInt;
  function  GetInsStr:LongString;
  function  GetDelStr:LongString;
  function  GetSize:SizeInt;
  function  GetCheckSum:QWord;
 public
  constructor Create(aBytePos,aSelStart:SizeInt;
               const aInsStr,aDelStr:LongString; aCheckSum:QWord);
  destructor  Destroy; override;
 public
  property BytePos  : SizeInt    read GetBytePos;
  property SelStart : SizeInt    read GetSelStart;
  property InsStr   : LongString read GetInsStr;
  property DelStr   : LongString read GetDelStr;
  property Size     : SizeInt    read GetSize;
  property CheckSum : QWord      read GetCheckSum;
 end;

function NewUndoStep(aBytePos,aSelStart:SizeInt;
               const aInsStr,aDelStr:LongString; aCheckSum:QWord):TUndoStep;
procedure Kill(var TheObject:TUndoStep); overload;

///////////////////////////////////////////////////
// TUndoHistory - list of Undo/Redo steps for TMemo
///////////////////////////////////////////////////
type
 TUndoHistory = class(TMasterObject)
 private
  myMemo           : TMemo;         // Associated Memo
  mySteps          : TList;         // History records data
  myIndex          : Integer;       // History index, 0 based
  myPrevContent    : LongString;    // The content of Memo before OnChange event
  myPrevOnChange   : TNotifyEvent;  // Previous Memo.OnChange
  mySize           : SizeInt;       // All steps byte size
  myInEdit         : Boolean;       // Flag of edit state
  myFixOnChangeBug : Boolean;       // Flag to fix OnChange
  myUndoErrors     : QWord;
  myRedoErrors     : QWord;
  myUtf8Errors     : QWord;
  myFailErrors     : QWord;
  function    GetSize:SizeInt;
  function    CurStep:TUndoStep;
  function    GetStep(aIndex:Integer):TUndoStep;
  function    GetErrors:QWord;
  function    GetUndoErrors:QWord;
  function    GetRedoErrors:QWord;
  function    GetUtf8Errors:QWord;
  function    GetFailErrors:QWord;
  procedure   AddStep(aBytePos,aSelStart:SizeInt;
                const aInsStr,aDelStr:LongString; aCheckSum:QWord);
  procedure   DelStep(aIndex:Integer);
  procedure   BugReport(E:Exception; O:TObject; const S:LongString);
 public
  procedure   MemoOnChange(Sender:TObject);
  function    StrDiff(const aCurrContent:LongString;
                      out aBytePos,aSelStart:SizeInt;
                      out aInsStr,aDelStr:LongString):Boolean;
 public
  class function EvalCheckSum(const Data:LongString):QWord;
 public
  constructor Create(aMemo:TMemo);
  destructor  Destroy; override;
 public
  property    Size:SizeInt read GetSize;
  property    Errors:QWord read GetErrors;
  property    UndoErrors:QWord read GetUndoErrors;
  property    RedoErrors:QWord read GetRedoErrors;
  property    Utf8Errors:QWord read GetUtf8Errors;
  property    FailErrors:QWord read GetFailErrors;
  function    HasMemo:Boolean;
  function    CanUndo:Boolean;
  function    CanRedo:Boolean;
  procedure   Undo;
  procedure   Redo;
 public
  // You should use Paste[Clip]Text to paste text instead of
  // TMemo.PasteFromClipboard, otherwise your paste operation
  // may need to perform twice Undo to restore to the state
  // before paste.
  procedure   PasteText(const aText:LongString);
  procedure   PasteFromClipboard;
 public // Use UndoHistory.ClearSelection instead of Memo.ClearSelection
  procedure   ClearSelection(aCutToClip:Boolean=false);
  procedure   CutToClipboard;
 public
  procedure   Reset;
 end;

function NewUndoHistory(aMemo:TMemo):TUndoHistory;
procedure Kill(var TheObject:TUndoHistory); overload;

implementation

//////////////////////////
// TCrwMemo implementation
//////////////////////////
procedure TCrwMemo.Print(const aCaption:LongString);
var bmp:TBitmap; ppw,pph,ax,ay,bx,by,pw,ph:Integer; scale,piw,pih:Double;
var msg:LongString;
begin
 if Assigned(Self) then
 if Assigned(Screen) then
 if Assigned(Printer) then
 try
  // Try external print command
  if IsUnix or IsWindows then begin
   if ExternalTextLinesPrint(Lines.Text) then Exit;
   // Otherwise print as window image
  end;
  bmp:=GetPrintableImage;
  if Assigned(Bmp) then
  try
    Printer.BeginDoc;
    try
     scale:=PrinterPageSettings.Scale;
     ax:=Trunc(CentimeterToInch(PrinterPageSettings.Indent.a.x)*Printer.XDPI);
     ay:=Trunc(CentimeterToInch(PrinterPageSettings.Indent.a.y)*Printer.YDPI);
     bx:=Trunc(CentimeterToInch(PrinterPageSettings.Indent.b.x)*Printer.XDPI);
     by:=Trunc(CentimeterToInch(PrinterPageSettings.Indent.b.y)*Printer.YDPI);
     ppw:=Printer.PageWidth-ax-bx;
     pph:=Printer.PageHeight-ay-by;
     if (ppw<10) or (pph<10) or (scale<1e-3) or (scale>1e3)
     then Raise EEchoException.Create(RusEng('Неверные параметры страницы',
                                             'Invalid page settings'));
     piw:=bmp.Width*(Printer.XDPI/Screen.PixelsPerInch);
     pih:=bmp.Height*(Printer.YDPI/Screen.PixelsPerInch);
     if (PrinterPageSettings.Adjust>0) then begin
      if (piw>ppw) then scale:=Min(scale,ppw/piw);
      if (pih>pph) then scale:=Min(scale,pph/pih);
     end;
     pw:=Trunc(piw*scale); ph:=Trunc(pih*scale);
     Printer.Canvas.StretchDraw(Rect(ax,ay,ax+pw,ay+ph),bmp);
    finally
     Printer.EndDoc;
    end;
    msg:=RusEng('Окно ','Form ')+AnsiQuotedStr(aCaption,QuoteMark)
        +RusEng(' отправлено на Принтер: ',' sent to Printer: ')+Printer.PrinterName;
    Echo(msg);
  finally
   Kill(bmp);
  end;
 except
  on E:Exception do BugReport(E,Self,'Print');
 end;
end;

function TCrwMemo.GetPrintableImage:TBitmap;
var aRect:TRect;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Result:=TBitmap.Create;
  try
   aRect:=Default(TRect);
   Result.SetSize(ClientWidth,ClientHeight);
   LCLIntf.GetWindowRect(Handle,aRect);
   with GetClientOrigin do PaintTo(Result.Canvas,aRect.Left-X,aRect.Top-Y);
  except
   Kill(Result);
   raise;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetPrintableImage');
 end;
end;

function IsBoundChar(c:WideChar):Boolean;
begin
 if IsLetterOrDigit(c) then Exit(False);
 if (c='_') then Exit(False);
 Result:=true;
end;

function IsWholeWord(const src:WideString; p,n:Integer):Boolean;
var bef,aft:WideChar;
begin
 Result:=false;
 if (src<>'') and (n>0) then
 if InRange(p,1,Length(src)) then begin
  aft:=StrFetch(src,p+n); // Char after  Copy(src,p,n)
  bef:=StrFetch(src,p-1); // Char before Copy(src,p,n)
  if IsBoundChar(bef) and IsBoundChar(aft) then Result:=true;
 end;
end;

function TCrwMemo.FindText(const SearchStr:LongString;
         StartPos,Tail:Integer; Options:TSearchTypes):Integer;
var sub,src:WideString;
begin
 Result:=-1;
 if Assigned(Self) then
 with TMemo(Self) do
 try
  src:=StrToWide(Text);
  sub:=StrToWide(SearchStr);
  if (Length(src)<=0) then Exit;
  if (Length(sub)<=0) then Exit;
  src:=Copy(src,StartPos+1,Tail);
  if (Length(src)<=0) then Exit;
  if not (stMatchCase in Options) then begin
   src:=WideLowerCase(src);
   sub:=WideLowerCase(sub);
  end;
  Result:=1;
  while InRange(Result,1,Length(src)) do begin
   Result:=Pos(sub,src,Result);
   if (Result<=0) then Break;
   if (stWholeWord in Options) then begin
    if IsWholeWord(src,Result,Length(sub))
    then Break;
   end else Break;
   Inc(Result,Length(sub));
  end;
  if (Result<=0) then Result:=-1 else Result:=StartPos+Result-1;
 except
  on E:Exception do BugReport(E,Self,'FindText');
 end;
end;

procedure TCrwMemo.MoveCaretToEnd(Mode:Integer);
begin
 if Assigned(Self) then
 try
  if HasFlags(Mode,1) or MemoCaretPosNeedBugFix
  then SelStart:=MaxInt
  else CaretPos:=Point(0,Max(0,Lines.Count-1));
 except
  on E:Exception do BugReport(E,Self,'MoveCaretToEnd');
 end;
end;

procedure TCrwMemo.ApplyGoToRowCol(aRow,aCol:Integer);
var Len:Integer; Editor:TMemo;
begin
 if Assigned(Self) then
 try
  Editor:=Self;
  aRow:=Max(0,Min(aRow-1,Editor.Lines.Count-1));
  if not InRange(aRow,0,Editor.Lines.Count-1) then Exit;
  Len:=Length(StrToWide(Editor.Lines[aRow]));
  aCol:=Max(0,Min(aCol-1,Len));
  if not InRange(aCol,0,Len) then Exit;
  Editor.SelLength:=0;
  if MemoCaretPosNeedBugFix
  then Editor.SelStart:=Max(0,TextRowColToCharPosUtf8(Editor.Lines,aRow,aCol))
  else Editor.CaretPos:=Point(aCol,aRow);
 except
  on E:Exception do BugReport(E,Self,'ApplyGoToRowCol');
 end;
end;

function TextRowColToCharPosUtf8(Lines:TStrings; row,col:Integer):SizeInt;
var r:Integer; line,s:LongString;
begin
 Result:=0;
 if Assigned(Lines) then
 try
  for r:=0 to Lines.Count-1 do begin
   line:=Lines.Strings[r];
   if not utf8_valid(line) then Exit(-1);
   if (r=row) then  begin
    s:=utf8_copy(line,1,col);
    Inc(Result,utf8_length(s));
    Break;
   end;
   Inc(Result,utf8_length(Line));
   Inc(Result,utf8_length(EOL));
  end;
 except
  on E:Exception do BugReport(E,nil,'TextRowColToCharPosUtf8');
 end;
end;

///////////////////////////
// TUndoStep implementation
///////////////////////////

constructor TUndoStep.Create(aBytePos,aSelStart:SizeInt;
                       const aInsStr,aDelStr:LongString; aCheckSum:QWord);
begin
 inherited Create;
 myInsStr:=aInsStr;
 myDelStr:=aDelStr;
 myBytePos:=aBytePos;
 mySelStart:=aSelStart;
 myCheckSum:=aCheckSum;
end;

destructor TUndoStep.Destroy;
begin
 myInsStr:='';
 myDelStr:='';
 inherited Destroy;
end;

function TUndoStep.GetBytePos:SizeInt;
begin
 if Assigned(Self) then Result:=myBytePos else Result:=0;
end;

function TUndoStep.GetSelStart:SizeInt;
begin
 if Assigned(Self) then Result:=mySelStart else Result:=0;
end;

function TUndoStep.GetInsStr:LongString;
begin
 if Assigned(Self) then Result:=myInsStr else Result:='';
end;

function TUndoStep.GetDelStr:LongString;
begin
 if Assigned(Self) then Result:=myDelStr else Result:='';
end;

function TUndoStep.GetSize:SizeInt;
begin
 if Assigned(Self)
 then Result:=InstanceSize+Length(myInsStr)+Length(myDelStr)
 else Result:=0;
end;

function TUndoStep.GetCheckSum:QWord;
begin
 if Assigned(Self)
 then Result:=myCheckSum
 else Result:=0;
end;

function NewUndoStep(aBytePos,aSelStart:SizeInt;
               const aInsStr,aDelStr:LongString; aCheckSum:QWord):TUndoStep;
begin
 Result:=TUndoStep.Create(aBytePos,aSelStart,aInsStr,aDelStr,aCheckSum);
end;

procedure Kill(var TheObject:TUndoStep);
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

//////////////////////////////
// TUndoHistory implementation
//////////////////////////////

constructor TUndoHistory.Create(aMemo:TMemo);
begin
 inherited Create;
 mySteps:=TList.Create;
 myPrevContent:='';
 myUndoErrors:=0;
 myRedoErrors:=0;
 myUtf8Errors:=0;
 myFailErrors:=0;
 myInEdit:=True;
 myIndex:=-1;
 myMemo:=aMemo;
 if Assigned(myMemo) then begin
  myPrevOnChange:=myMemo.OnChange;
  myMemo.OnChange:=MemoOnChange;
  myPrevContent:=myMemo.Text;
 end;
end;

destructor TUndoHistory.Destroy;
begin
 if Assigned(myMemo) then begin
  myMemo.OnChange:=myPrevOnChange;
  myMemo:=nil;
 end;
 DelStep(0);
 mySteps.Free;
 myPrevContent:='';
 inherited Destroy;
end;

procedure TUndoHistory.BugReport(E:Exception; O:TObject; const S:LongString);
begin
 if Assigned(Self) then Inc(myFailErrors);
 _crw_alloc.BugReport(E,O,S);
end;

function TUndoHistory.CurStep:TUndoStep;
begin
 if Assigned(Self)
 then Result:=GetStep(myIndex)
 else Result:=nil;
end;

function TUndoHistory.GetStep(aIndex:Integer):TUndoStep;
begin
 if Assigned(Self) and InRange(aIndex,0,mySteps.Count-1)
 then Result:=TUndoStep(mySteps[aIndex])
 else Result:=nil;
end;

function TUndoHistory.GetErrors:QWord;
begin
 if Assigned(Self)
 then Result:=myUndoErrors+myRedoErrors+myUtf8Errors+myFailErrors
 else Result:=0;
end;

function TUndoHistory.GetUndoErrors:QWord;
begin
 if Assigned(Self)
 then Result:=myUndoErrors
 else Result:=0;
end;

function TUndoHistory.GetRedoErrors:QWord;
begin
 if Assigned(Self)
 then Result:=myRedoErrors
 else Result:=0;
end;

function TUndoHistory.GetUtf8Errors:QWord;
begin
 if Assigned(Self)
 then Result:=myUtf8Errors
 else Result:=0;
end;

function TUndoHistory.GetFailErrors:QWord;
begin
 if Assigned(Self)
 then Result:=myFailErrors
 else Result:=0;
end;

procedure TUndoHistory.AddStep(aBytePos,aSelStart:SizeInt;
                         const aInsStr,aDelStr:LongString; aCheckSum:QWord);
var aStep:TUndoStep;
begin
 if Assigned(Self) then
 try
  DelStep(myIndex+1);
  aStep:=NewUndoStep(aBytePos,aSelStart,aInsStr,aDelStr,aCheckSum);
  mySteps.Add(aStep); Inc(myIndex); Inc(mySize,aStep.Size);
 except
  on E:Exception do BugReport(E,Self,'AddStep');
 end;
end;

procedure TUndoHistory.DelStep(aIndex:Integer);
var i:Integer; aStep:TUndoStep;
begin
 if Assigned(Self) then
 try
  aIndex:=Max(aIndex,0);
  for i:=mySteps.Count-1 downto aIndex do begin
   aStep:=GetStep(i);
   Dec(mySize,aStep.Size);
   mySteps.Delete(i);
   Kill(aStep);
  end;
  myIndex:=aIndex-1;
 except
  on E:Exception do BugReport(E,Self,'DelStep');
 end;
end;

procedure TUndoHistory.MemoOnChange(Sender: TObject);
var CurrContent,InsStr,DelStr:LongString; BytePos,SelStart:SizeInt;
var CheckSum:QWord;
begin
 if Assigned(Self) then
 if HasMemo then
 try
  if myInEdit then begin
   CurrContent:=myMemo.Text;
   CheckSum:=EvalCheckSum(myPrevContent);
   if StrDiff(CurrContent,BytePos,SelStart,InsStr,DelStr)
   then AddStep(BytePos,SelStart,InsStr,DelStr,CheckSum);
   myPrevContent:=CurrContent;
  end;
  myFixOnChangeBug:=False;
  if Assigned(myPrevOnChange) then myPrevOnChange(Sender);
 except
  on E:Exception do BugReport(E,Self,'MemoOnChange');
 end;
end;

function TUndoHistory.StrDiff(const aCurrContent:LongString;
  out aBytePos,aSelStart:SizeInt; out aInsStr,aDelStr:LongString):Boolean;
var CurrBeg,CurrPos,CurrEnd,PrevPos:PChar;
var CurrLen,PrevLen,DiffLen:SizeInt;
var CharLen:LongInt;
begin
 Result:=false;
 if Assigned(Self) then
 if HasMemo then
 try
  CurrBeg:=PChar(aCurrContent);
  CurrPos:=PChar(aCurrContent);
  PrevPos:=PChar(myPrevContent);
  CurrLen:=Length(aCurrContent);  // Use Length(string);
  PrevLen:=Length(myPrevContent); // DO NOT use Length(PChar)
  DiffLen:=CurrLen-PrevLen;
  if (DiffLen<0) then CurrEnd:=CurrPos+CurrLen-1 else
  if (DiffLen>0) then CurrEnd:=CurrPos+PrevLen-1 else Exit(False);
  while (CurrPos<=CurrEnd) do begin
   if (CurrPos^<>PrevPos^) then Break;
   Inc(CurrPos);
   Inc(PrevPos);
  end;
  if not Utf8TryFindCodepointStart(CurrBeg,CurrPos,CharLen) then Inc(myUtf8Errors);
  aBytePos:=CurrPos-CurrBeg+1;
  if (DiffLen>0) then begin
   aInsStr:=Copy(aCurrContent,aBytePos,DiffLen);
   aDelStr:='';
  end else begin
   aInsStr:='';
   aDelStr:=Copy(myPrevContent,aBytePos,-DiffLen);
  end;
  aSelStart:=myMemo.SelStart;
  Result:=True;
 except
  on E:Exception do BugReport(E,Self,'StrDiff');
 end;
end;

class function TUndoHistory.EvalCheckSum(const Data:LongString):QWord;
begin
 if (Data='') then Exit(0);
 if IsCpu64
 then Result:=Hash64_RS(PChar(Data),Length(Data))
 else Result:=Hash32_RS(PChar(Data),Length(Data));
end;

function TUndoHistory.HasMemo:Boolean;
begin
 if Assigned(Self)
 then Result:=Assigned(myMemo)
 else Result:=False;
end;

function TUndoHistory.GetSize:SizeInt;
begin
 if Assigned(Self)
 then Result:=mySize+Length(myPrevContent)
 else Result:=0;
end;

function TUndoHistory.CanUndo:Boolean;
begin
 if Assigned(Self)
 then Result:=(myIndex>=0)
 else Result:=False;
end;

function TUndoHistory.CanRedo:Boolean;
begin
 if Assigned(Self)
 then Result:=(myIndex<mySteps.Count-1)
 else Result:=False;
end;

procedure TUndoHistory.Undo;
var NewSelStart:SizeInt; CS1,CS2:QWord;
begin
 if Assigned(Self) then
 if HasMemo then
 if CanUndo then
 try
  myInEdit:=False;
  myFixOnChangeBug:=True;
  // Assume myPrevContent == myMemo.Text
  with CurStep do begin
   if (InsStr<>'') then begin
    Delete(myPrevContent,BytePos,Length(InsStr));
    NewSelStart:=SelStart-UTF8Length(InsStr);
   end;
   if (DelStr<>'') then begin
    Insert(DelStr,myPrevContent,BytePos);
    NewSelStart:=SelStart+UTF8Length(DelStr);
   end;
   CS1:=CheckSum;
   CS2:=EvalCheckSum(myPrevContent);
   if (CS1<>CS2) then Inc(myUndoErrors);
  end;
  myMemo.Lines.Text:=myPrevContent;
  myMemo.SelStart:=NewSelStart;
  Dec(myIndex);
  if myFixOnChangeBug then MemoOnChange(myMemo);
  myInEdit := True;
 except
  on E:Exception do BugReport(E,Self,'Undo');
 end;
end;

procedure TUndoHistory.Redo;
var NewSelStart:SizeInt; CS1,CS2:QWord;
begin
 if Assigned(Self) then
 if HasMemo then
 if CanRedo then
 try
  myInEdit:=False;
  myFixOnChangeBug:=True;
  Inc(myIndex);
  // myPrevContent == myMemo.Text
  with CurStep do begin
   CS1:=CheckSum;
   CS2:=EvalCheckSum(myPrevContent);
   if (CS1<>CS2) then Inc(myRedoErrors);
   if (DelStr<>'') then begin
    Delete(myPrevContent,BytePos,Length(DelStr));
    NewSelStart:=SelStart;
   end;
   if (InsStr<>'') then begin
    Insert(InsStr,myPrevContent,BytePos);
    NewSelStart:=SelStart;
   end;
  end;
  myMemo.Lines.Text:=myPrevContent;
  myMemo.SelStart:=NewSelStart;
  if myFixOnChangeBug then MemoOnChange(myMemo);
  myInEdit:=True;
 except
  on E:Exception do BugReport(E,Self,'Redo');
 end;
end;

function UTF8PosToBytePos(const aStr:LongString; const aSize:SizeInt; aPos:SizeInt):SizeInt;
begin
 Result:=UTF8CodepointToByteIndex(PChar(aStr),aSize,aPos-1)+1;
end;

procedure TUndoHistory.PasteText(const aText:LongString);
var BytePos:SizeInt; CheckSum:QWord;
begin
 if Assigned(Self) then
 if (aText<>'') then
 if HasMemo then
 try
  myInEdit:=False;
  try
   myFixOnChangeBug:=True;
   CheckSum:=EvalCheckSum(myPrevContent);
   // Assume myPrevContent == myMemo.Text
   BytePos:=UTF8PosToBytePos(myPrevContent,Length(myPrevContent),myMemo.SelStart+1);
   AddStep(BytePos,myMemo.SelStart,aText,myMemo.SelText,CheckSum);
   myMemo.SelText:=aText; myPrevContent:=myMemo.Text;
   if myFixOnChangeBug then MemoOnChange(myMemo);
  finally
   myInEdit:=True;
  end;
 except
  on E:Exception do BugReport(E,Self,'PasteText');
 end;
end;

procedure TUndoHistory.PasteFromClipboard;
var ClipBoardText:LongString;
begin
 if Assigned(Self) then
 if HasMemo then
 try
  ClipBoardText:=ClipBoard.AsText;
  if (ClipBoardText<>'') then PasteText(ClipBoardText);
 except
  on E:Exception do BugReport(E,Self,'PasteFromClipboard');
 end;
end;

procedure TUndoHistory.ClearSelection(aCutToClip:Boolean=false);
var BytePos:SizeInt; CheckSum:QWord;
begin
 if Assigned(Self) then
 if HasMemo then
 try
  myInEdit:=False;
  if (myMemo.SelLength>0) then begin
   myFixOnChangeBug:=True;
   CheckSum:=EvalCheckSum(myPrevContent);
   // Assume myPrevContent == myMemo.Text
   if aCutToClip then ClipBoard.AsText:=myMemo.SelText;
   BytePos:=UTF8PosToBytePos(myPrevContent,Length(myPrevContent),myMemo.SelStart+1);
   AddStep(BytePos,myMemo.SelStart,'',myMemo.SelText,CheckSum);
   myMemo.SelText:=''; myPrevContent:=myMemo.Text;
   if myFixOnChangeBug then MemoOnChange(myMemo);
  end;
  myInEdit:=True;
 except
  on E:Exception do BugReport(E,Self,'ClearSelection');
 end;
end;

procedure TUndoHistory.CutToClipboard;
begin
 if Assigned(Self) then ClearSelection(true);
end;

procedure TUndoHistory.Reset;
begin
 if Assigned(Self) then
 try
  DelStep(0);
  myUndoErrors:=0;
  myRedoErrors:=0;
  myUtf8Errors:=0;
  myFailErrors:=0;
  myPrevContent:='';
  if HasMemo then myPrevContent:=myMemo.Text;
 except
  on E:Exception do BugReport(E,Self,'Reset');
 end;
end;

function NewUndoHistory(aMemo:TMemo):TUndoHistory;
begin
 if Assigned(aMemo)
 then Result:=TUndoHistory.Create(aMemo)
 else Result:=nil;
end;

procedure Kill(var TheObject:TUndoHistory);
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_memo;
begin
end;

procedure Free_crw_memo;
begin
end;

initialization

 Init_crw_memo;

finalization

 Free_crw_memo;

end.

//////////////
// END OF FILE
//////////////

