TMS套件当中TAdvMemo对多字节文字（MultiByte）-中文支持的修正

最新推荐文章于 2021-01-13 18:00:06 发布

僵哥

最新推荐文章于 2021-01-13 18:00:06 发布

阅读量3.7k

点赞数

分类专栏： Delphi 文章标签： integer delete string button c user

本文链接：https://blog.csdn.net/unsigned/article/details/2464856

版权

Delphi 专栏收录该内容

16 篇文章

订阅专栏

本文介绍了一个文本编辑器中实现光标移动、字符删除及文本选择功能的具体算法。涉及光标按单词移动、考虑换行和折叠代码、支持中文字符检测等功能。通过这些算法确保了用户在进行文本编辑时拥有流畅且准确的操作体验。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

//--------------------------------------------------------------
// MOVE CURSOR
//--------------------------------------------------------------

procedure TAdvCustomMemo.MoveCursor(dX, dY: integer; Shift: TShiftState);
var
Selecting: Boolean;
S: string;

//------------------------------------------------------------
procedure MoveWordLeft;
begin
FLetRefresh := false;
CurX := CurX - 1;

    S := TrimRightWW(CurY);
    while (CurX > 0) and (CurX <= Length(s)) do
    begin
//      if (S[CurX] = ' ') and (S[CurX + 1] <> ' ') then
      if IsDelimiter(S[CurX]) and (S[CurX + 1] <> ' ') then
        Break;
      CurX := CurX - 1;
    end;
    if (CurX < 0) then
      if CurY > 0 then
      begin
        if not CodeFolding.Enabled then // kh: not passed
          CurY := CurY - 1
        else
          CurY := VisIndexToLineIndex(LineIndexToVisIndex(CurY) - 1);
        CurX := Length(InternalLines[CurY]);
      end;
    FLetRefresh := true;
end;

//------------------------------------------------------------
procedure MoveWordRight;
var
    Len: Integer;
begin
    FLetRefresh := false;
    S := TrimRightWW(CurY);
    Len := Length(S);
    CurX := CurX + 1;
    while CurX < Len do
    begin
//      if (S[CurX] = ' ') and (S[CurX + 1] <> ' ') then
      if IsDelimiter(S[CurX]) and (S[CurX + 1] <> ' ') then
        Break;
      CurX := CurX + 1;
    end;
    if CurX > Len then
      if CurY < InternalLines.Count - 1 then
      begin
        if not CodeFolding.Enabled then // kh:
          CurY := CurY + 1
        else
          CurY := VisIndexToLineIndex(LineIndexToVisIndex(CurY) + 1);
        CurX := 0;
      end;
    FLetRefresh := true;
end;
//------------------------------------------------------------
begin
Selecting := (ssShift in Shift) and (CurX = FPrevSelX) and (CurY = FPrevSelY);

if ssCtrl in Shift then
begin
    if dX > 0 then MoveWordRight;
    if dX < 0 then MoveWordLeft;
end
else
begin
    if not CodeFolding.Enabled then // kh:
      CurY := CurY + dY
    else
      CurY := VisIndexToLineIndex(LineIndexToVisIndex(CurY) + dY);

    if (ssShift in Shift) then // kh: Restricting Selection to end.
    - CurX := min(Length(InternalLines[cury]), CurX + dX)
    -else
    - CurX := CurX + dX;
    + begin
    +    CurX := min(Length(InternalLines[cury]), CurX + dX);
    +    { TODO :MoveCursor-Shift-选择: 中文检测 }
    +    if Length(InternalLines[cury])>=(CurX + 1) then
    +      begin
    +        if Length(WideString(Copy(InternalLines[cury],1,CurX))) = Length(WideString(Copy(InternalLines[cury],1,CurX + 1))) then
    +          begin
    +            if dX < 0 then
    +              begin
    +                if CurX > 0 then
    +                  CurX := CurX - 1
    +              end
    +            else
    +              CurX := min(Length(InternalLines[cury]), CurX + 1);
    +          end;
    +      end;
    + end
    +else
    + begin
    +    { TODO :MoveCursor-nonShift: 中文检测 }
    +    CurX := CurX + dX;
    +    if Length(InternalLines[cury])>=(CurX + 1) then
    +      begin
    +        if Length(WideString(Copy(InternalLines[cury],1,CurX))) = Length(WideString(Copy(InternalLines[cury],1,CurX + 1))) then
    +          begin
    +            if dX < 0 then
    +              begin
    +                if CurX > 0 then
    +                  CurX := CurX - 1
    +              end
    +            else
    +              CurX := min(Length(InternalLines[cury]), CurX + 1);
    +          end;
    +      end;
    + end;
end;

if Selecting then
ExpandSelection
else
ClearSelection;
end;

//--------------------------------------------------------------
// DELETE CHAR
//--------------------------------------------------------------

procedure TAdvCustomMemo.DeleteChar(OldX, OldY: integer);
var
S: string;
-C: char;
+{ TODO :DeleteChar-SingleByte 2 MultiByte: 中文检测 }
+C: String;
Undo: TDeleteCharUndo;
IsBackspace: boolean;
CurLnIdx: Integer;
Tlp: TLineProp;
begin
if not EditCanModify then
Exit;

Fletrefresh := False;

if OldX < 0 then
begin
    OldX := CurX;
    OldY := CurY;
    IsBackspace := False;
end
else
    IsBackspace := True;

ClearSelection;

{$IFDEF TMSDEBUG}
outputdebugstring(pchar('before delete ->' + InternalLines[cury] + '*'));
{$ENDIF}

//if not FCodeFolding.Enabled then
    CurLnIdx := CurY; // kh:
//else
    //CurLnIdx := VisIndexToLineIndex(CurY);
if (CurX < Length(InternalLines[CurLnIdx])) then
begin
    S := InternalLines[CurLnIdx];
    -C := S[CurX + 1];
    -Delete(S, CurX + 1, 1);
    +{ TODO :DeleteChar-In Current Line: 中文检测 }
    +if (Length(S)> CurX + 1) and (Length(WideString(Copy(S,1,CurX + 1))) = Length(WideString(Copy(S,1,CurX+2)))) then
    + begin
    +    C := Copy(S,CurX + 1 ,2);
    +    Delete(S,CurX + 1 ,2);
    + end
    +else
    + begin
    +    C := S[CurX + 1];
    +    Delete(S, CurX + 1, 1);
    + end;
    InternalLines[CurLnIdx] := S;

    Undo := TDeleteCharUndo.Create(OldX, OldY, CurX, CurLnIdx, C);
    Undo.IsBackSpace := IsBackSpace;
    InternalUndoList.Add(Undo);
end
else if CurY < InternalLines.Count - 1 then
begin
    Tlp := InternalLines.GetLineProp(CurY+1);
    if Assigned(Tlp) and (Tlp is TLineProp) and (WordWrap <> WWNone) and tlp.Wrapped then
    begin
      S := InternalLines[CurY+1];
      -C := S[1];
      -Delete(S, 1, 1);
      +{ TODO :DeleteChar-In Different Lines: 中文检测 }
      +if (Length(S)> 2) and (Length(WideString(Copy(S,1,2))) = Length(WideString(Copy(S,1,2+1)))) then
      + begin
      +    C := Copy(S,1,2);
      +    Delete(S,1,2);
      + end
      +else
      + begin
      +    C := S[1];
      +    Delete(S, 1, 1);
      + end;
      InternalLines[CurY+1] := S;

      Undo := TDeleteCharUndo.Create(OldX, OldY, CurX, CurY+1, C);
      Undo.IsBackSpace := IsBackSpace;
      InternalUndoList.Add(Undo);
    end
    else
    begin
      S := InternalLines[CurY] + InternalLines[CurY + 1];
      InternalLines[CurY] := S;

      InternalLines.Delete(CurY + 1);
      Undo := TDeleteCharUndo.Create(OldX, OldY, CurX, CurY, #13);
      Undo.IsBackSpace := IsBackSpace;
      InternalUndoList.Add(Undo);

AutoCodeFold;
end;
end;

UpdateWrap;

Fletrefresh := True;
LinesChanged(nil);

//--1.6
//Invalidate;

{$IFDEF TMSDEBUG}
outputdebugstring(pchar('after delete ->' + InternalLines[cury] + '*'));
{$ENDIF}
end;

procedure TAdvCustomMemo.SelClickUpdate(X, Y: Integer; Down: Boolean; Shift: TShiftState; Button: TMouseButton);
var
newPos: TCellPos;
yold: Integer;
lc, OldV: Boolean;
tp: integer;
begin
if PointInRect(Point(X, Y), EditorRect) then
begin
newPos := CellFromPos(X, Y);

TextFromPos(newPos.X + LeftCol, newPos.Y + TopLine, tp);

    // do not unselect for click on selected text
    if (SelStart < tp) and (SelStart + SelLength > tp) and Down then
    begin
      FSelButtonDown := True;
      Exit;
    end;

ShowCaret(False);

yold := Fcury;

    if newPos.x < 0 then
      newPos.x := 0;
    if newPos.y < 0 then
      newPos.y := 0;

    FCursorChangedTrigered := False;
    // Please leave FCury not Cury (otherwise problems appear when the text is
    // scrolled and when the cursor is not in the visible area and the user
    // clicks)

    if not CodeFolding.Enabled then   // kh:
      FCurY := newPos.Y + FTopLine
    else
      FCurY := VisIndexToLineIndex(newPos.Y + LineIndexToVisIndex(FTopLine));

if FCury >= InternalLines.Count then
FCury := InternalLines.Count - 1;

if FCury < 0 then
FCury := 0;

// 1.6.0.12
FSelClick := true;

    OldV := FAutoExpand;
    if AutoExpand and FCodeFolding.Enabled and (InternalLines.Count > 0) then
    begin
      if (FCurY < InternalLines.Count) and IsNode(FCurY) and not ExpandNode[FCurY] then
      begin
        if (newPos.X + FLeftCol > Length(InternalLines[FCurY])) and (newPos.X + FLeftCol < Length(InternalLines[FCurY]) + 5) then
          FAutoExpand := False;
      end;
    end;

    CurX := newPos.X + FLeftCol;
    CurY := FCury;
    +{ TODO :SelClickUpdate: 中文检测 }
    +if Length(InternalLines[FCury]) > CurX then
    + if Length(WideString(Copy(InternalLines[FCury],1,CurX))) = Length(WideString(Copy(InternalLines[FCury],1,CurX + 1))) then
    +    CurX := CurX + 1;

FAutoExpand := OldV;

    if not FCursorChangedTrigered and (yold <> FCurY) then
      CursorChanged;
    // 1.6.0.12
    MakeVisible;

lc := FLetRefresh;
FLetRefresh := False;

if (yold <> FCurY) and (yold < InternalLines.Count) then
InternalLines[yold] := TrimRightWW(yold);

FLetRefresh := lc;

    if (Button = mbLeft) and Down then
    begin
      if (ssShift in Shift) then
        ExpandSelection
      else
        ClearSelection;

      FLeftButtonDown := True; //Continue selection if hold shift and mouse move
      if CurY < InternalLines.Count then
        TestForURLClick(InternalLines[CurY]);
    end
    else
      ShowCaret(True);
end;
end;

///-------------------------------------------------------------
// MOUSE MOVE
//--------------------------------------------------------------

procedure TAdvCustomMemo.MouseMove(Shift: TShiftState; X, Y: integer);
var
newPos: TCellPos;
oldSx, oldSy, oldEy, oldEx: integer;
begin
inherited;

// 1.6.0.12
if FSelClick then
begin
FSelClick := false;
Exit;
end;

newPos := CellFromPos(X, Y);
if newPos.x < 0 then
newPos.x := 0
else
newPos.x := newPos.x + FLeftCol;

if newPos.Y < 0 then newPos.y := 0
else
newPos.y := newPos.y + FTopLine;

if ShowHint and (FLastHintPos.X >= 0) and (FLastHintPos.Y >= 0) then
begin
    if (FLastHintPos.X <> newPos.x) or (FLastHintPos.Y <> newpos.y) then
    begin
      Application.CancelHint;
      FLastHintPos := Point(-1, -1);
    end;
end;

if FSelButtonDown then
begin
    FSelDrag := true;
    FSelButtonDown := false;
    BeginDrag(false, 2);
end;

if (newPos.y >= 0) and (newPos.y < InternalLines.Count) then
begin
tokenatxy(newPos.x, newPos.y);

    if TestforURLMove(InternalLines[newPos.y], newPos.x) then
    begin
      if Cursor <> crHandPoint then
        FoldCursor := Cursor;
      inherited Cursor := crHandPoint;
    end
    else
      inherited Cursor := FoldCursor;
end
else
    inherited Cursor := FoldCursor;

oldSx := FSelStartX;
oldSy := FSelStartY;
oldEx := FSelEndX;
oldEY := FSelEndY;

if (ssLeft in Shift) and FLeftButtonDown and not FSelButtonDown and not FSelClick then
begin
    newPos := CellFromPos(X, Y);
   { if newPos.x < 0 then
    begin
      curx := 0;
      FLeftCol := 0;
    end
    else
      CurX := newPos.X + FLeftCol;

    if not CodeFolding.Enabled then    // kh:
      CurY := newPos.Y + FTopLine
    else
      CurY := VisIndexToLineIndex(newPos.Y + LineIndexToVisIndex(FTopLine));
    }
    if not CodeFolding.Enabled then    // kh:
      CurY := newPos.Y + FTopLine
    else
      CurY := VisIndexToLineIndex(newPos.Y + LineIndexToVisIndex(FTopLine));

    if newPos.x < 0 then
    begin
      curx := 0;
      FLeftCol := 0;
    end
    else
      -CurX := min(Length(InternalLines[cury]), newPos.X + FLeftCol);
      +begin
      + CurX := min(Length(InternalLines[cury]), newPos.X + FLeftCol);
      + { TODO :MouseMove: 中文检测 }
      + if Length(InternalLines[cury])>=(CurX + 1) then
      +    begin
      +      if Length(WideString(Copy(InternalLines[cury],1,CurX))) = Length(WideString(Copy(InternalLines[cury],1,CurX + 1))) then
      +        begin
      +          if newPos.X < oldSx then
      +            begin
      +              if CurX > 0 then
      +                CurX := CurX - 1
      +            end
      +          else
      +            CurX := min(Length(InternalLines[cury]), CurX + 1);
      +        end;
      +    end;
      +end;

    ExpandSelection;
    // Force
    if ((oldSx <> FSelStartX) or
      (oldSy <> FSelStartY) or
      (oldEx <> FSelEndX) or
      (oldEY <> FSelEndY)) then Repaint;
end;
end;