【delphi】TMS_Component_Pack_v9.2.4.0中的TadvMemo 支持中文完美修改

大家知道，在delphi的开发环境中，TMS是赫赫有名的三方控件提供商，基本上没有不知道或者没有不使用的。TMS提供的控件包罗万象，非常丰富。但是有一个控件TadvMemo的一个编辑控件，支持语法（delphi,basic,HTML,javascript,css,SQL,C#等等）高亮，很好用，就是有一个硬结是不支持中文，相信大家在使用的过程中都有体会，我问了TMS，答复是tadvMemo只支持monospace字体。而且这个控件版本已经升级的很高了也没有支持中文，看来只能自己修改了。于是我们修改了TadvMemo源代码，使其完美支持中文。

简单的几个函数就可以让TadvMemo 支持中文，修改后的代码下载。
修改后的TadvMemo支持中文功能测试如下：

编号	功能	结论
1	输入中文显示半个汉字	修改后正确显示
2	光标不能放置到一个汉字的中间	修改后正确
3	Ctrl + Left（home）光标到行首	修改后正确
4	Ctrl + Right（end）光标到行尾	修改后正确
5	鼠标或者按键反选	修改后正常
6	反选后拷贝到外边	修改后正常
7	从外边拷贝进入编辑器	修改后正常
8	overwrite下输入中文	修改后正常
9	光标上移或者下移不能移动到一个汉字中间	修改后正常

1. 修改原理

TadvMemo认为字符都是等宽的，等宽的概念是显示一个字符就只能占用一个显示位置，对于英文字符是没有问题的，但是对于中文，就不一样的，一个中文汉字显示的时候会占用两个英文字符的位置，这样就会产生问题。我们要做的就是把中文字符能够合理的告知TadvMemo，为此，我们需要书写如下函数：

1.1 修复需要的函数

一、将光标位置转换成实际的字符位置。比如字符串：”A伟大123“，当光标位于”大"和“1”之间的时候，光标是5，但是对于字符串”A伟大123“来说，如果我们要获取光标前的字符串“A伟大”，就不能使用光标位置5，而应该使用长度3，因为一个汉字作为字符串处理(unicode)也是1。

参数说明：
S：是实际字符串
CurX：表示光标位置，光标在行首的时候是0，每向右移动一个英文字符光标加1，移动一个汉字光标加2.
positon：表示转换后字符串的位置。

结果为 True表示转换成功，否则表示转换失败。

function Get_InsertPositonX_02(S : string; CurX : integer; var position : word) : Boolean;
vari : integer;B : TBytes;E_Char_Count : Word;A1 : integer;
begin//s := 'A你好12大小3设那个';if S = '' then Exit(True);E_Char_Count := 0;B := TEncoding.ANSI.GetBytes(S);//计算有多少个 英文字符for i:= 0 to CurX - 1 doif B[i] < $80 thenE_Char_Count := E_Char_Count + 1;A1 := CurX - E_Char_Count;A1 := (CurX - E_Char_Count) mod 2;A1 := E_Char_Count + (CurX - E_Char_Count) div 2;Result := ((CurX - E_Char_Count) mod 2) = 0;if Result thenposition := E_Char_Count + (CurX - E_Char_Count) div 2elseposition := E_Char_Count + (CurX - E_Char_Count + 1) div 2;end;

二、判断当前光标前是不是一个汉字, True 表示是汉字，否则是英文字母，光标左移是需要使用此函数。

参数说明：
S：是实际字符串
CurX：表示光标位置，

function is_Chinese_Char_Left(S : string; CurX : integer) : Boolean;
varB : TBytes;i,count : integer;
beginB := TEncoding.ANSI.GetBytes(S);if Length(B) = 0 then Exit(False);if CurX = 0 then Exit(False);if Length(B) < CurX then Exit(False);//Result := B[CurX - 1] > $80;if B[CurX -1] < $80 then Exit(False);//需要进一步判断，判断是不是在一个汉字的中间,如果是则返回Falsecount := 0;for i := 0 to CurX - 1 doif B[i] > $80 thencount := count + 1;Result := (count mod 2) = 0;end;

三、判断当前光标后是不是一个汉字, True 表示是汉字，否则是英文字母，光标右移的时候需要使用该函数

参数说明：
S：是实际字符串
CurX：表示光标位置

function is_Chinese_Char_Right(S : string; CurX : integer) : Boolean;
varB : TBytes;i,count : integer;
beginB := TEncoding.ANSI.GetBytes(S);if Length(B) = 0 then Exit(False);//if CurX = 0 then Exit(False);if Length(B) < CurX then Exit(False);//Result := B[CurX] > $80;if B[CurX] < $80 then Exit(False);//需要进一步判断，判断是不是在一个汉字的中间,如果是则返回Falsecount := 0;for i := CurX to Length(B) - 1 doif B[i] > $80 thencount := count + 1;Result := (count mod 2) = 0;end;

四、判断光标是否在一个完整汉字的中间，正常编辑是不应该出现这个问题的。

参数说明：
S：需要判断的字符串
CurX：表示光标位置

返回结果True 表示是在一个汉字中间，否则不是

function is_Half_Chinense(S : string; CurX : integer) : Boolean;
vari : integer;B : TBytes;o : integer;  //记录半个函数数量
beginB := TEncoding.ANSI.GetBytes(S);if CurX > Length(B) then Exit(False);if CurX = 0 then Exit(False);//光标前或者后是一个英文字符，则直接表示不再半个汉字中间if (B[CurX - 1] < $80) or (B[CurX] < $80) then  Exit(False);o := 0;for i := CurX - 1 downto 0 dobeginif B[i] < $80 thenbeginif (o mod 2) = 0 thenExit(False)elseExit(True);end;o := o + 1;end;if (o mod 2) = 0 thenExit(False)elseExit(True);
end;

2. 需要修改的地方举例

一、使用 TEncoding.ANSI.GetBytes 直接调整光标位置。

例如，当需要把光标移动到行尾，也就是按下Ctrl + Right（end)键的时候，需要修改函数中的CurX：

修改前函数：

procedure TAdvCustomMemo.GotoEnd;
beginCurY := Lines.Count - 1;CurX := Length(Lines[Lines.Count - 1]);
end;

修改后函数：按照汉字字节数调整了光标的位置。

procedure TAdvCustomMemo.GotoEnd;
beginCurY := Lines.Count - 1;//SZHN 20210113//CurX := Length(Lines[Lines.Count - 1]);CurX := Length(TEncoding.ANSI.GetBytes(Lines[Lines.Count - 1]));
end;

二、使用我们的函数调整，例如反选后需要拷贝到剪贴板，此时需要修改函数：TAdvCustomMemo.CopyToClipBoard;

修改前函数代码：

procedure TAdvCustomMemo.CopyToClipBoard;
varMemHandleRTF: THandle;MemHandleHTML: THandle;rtfstr, htmlstr: AnsiString;sl,el: string;ChangeEvt: TNotifyEvent;
beginFRTFEngine := TRTFEngine.Create;ChangeEvt := OnChange;OnChange := nil;sl := InternalLines[SelStartY];el := InternalLines[SelEndY];if (SelStartY < SelEndY) thenbeginInternalLines[SelStartY] := Copy(sl, SelStartX, Length(sl));InternalLines[SelEndY] := Copy(el, 1, SelEndX);endelsebeginInternalLines[SelStartY] := Copy(sl, 1, SelStartX);InternalLines[SelEndY] := Copy(el, SelEndX, Length(el));end;下面还有，不需要修改就不贴出来....

修改后代码：注意使用了 Get_InsertPositonX_02 函数

procedure TAdvCustomMemo.CopyToClipBoard;
varMemHandleRTF: THandle;MemHandleHTML: THandle;rtfstr, htmlstr: AnsiString;sl,el: string;ChangeEvt: TNotifyEvent;//LXY 20210112positionStart,positionEnd:word;
beginFRTFEngine := TRTFEngine.Create;ChangeEvt := OnChange;OnChange := nil;sl := InternalLines[SelStartY];el := InternalLines[SelEndY];//LXY 20210113 重新定位位置{if (SelStartY < SelEndY) thenbeginInternalLines[SelStartY] := Copy(sl, SelStartX, Length(sl));InternalLines[SelEndY] := Copy(el, 1, SelEndX);endelsebeginInternalLines[SelStartY] := Copy(sl, 1, SelStartX);InternalLines[SelEndY] := Copy(el, SelEndX, Length(el));end;}if (SelStartY < SelEndY) thenbeginGet_InsertPositonX_02(sl,SelStartX,positionStart);Get_InsertPositonX_02(el,SelEndX,positionEnd);InternalLines[SelStartY] := Copy(sl, positionStart+1, Length(sl));InternalLines[SelEndY] := Copy(el, 1, positionEnd);endelsebeginGet_InsertPositonX_02(sl,SelStartX,positionStart);Get_InsertPositonX_02(el,SelEndX,positionEnd);InternalLines[SelStartY] := Copy(sl, 1, positionStart);InternalLines[SelEndY] := Copy(el, positionEnd, Length(el));end;//=================================================================>

类似需要修改的地方大概有上百处，这里不详细列举，需要的朋友可以下载。资源下载