大家知道，在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;
var
i : 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 do
if B[i] < $80 then
E_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 then
position := E_Char_Count + (CurX - E_Char_Count) div 2
else
position := E_Char_Count + (CurX - E_Char_Count + 1) div 2;
end;
二、判断当前光标前是不是一个汉字, True 表示是汉字，否则是英文字母，光标左移是需要使用此函数。
参数说明：
S：是实际字符串
CurX：表示光标位置，
function is_Chinese_Char_Left(S : string; CurX : integer) : Boolean;
var
B : TBytes;
i,count : integer;
begin
B := 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);
//需要进一步判断，判断是不是在一个汉字的中间,如果是则返回False
count := 0;
for i := 0 to CurX - 1 do
if B[i] > $80 then
count := count + 1;
Result := (count mod 2) = 0;
end;
三、判断当前光标后是不是一个汉字, True 表示是汉字，否则是英文字母，光标右移的时候需要使用该函数
参数说明：
S：是实际字符串
CurX：表示光标位置
function is_Chinese_Char_Right(S : string; CurX : integer) : Boolean;
var
B : TBytes;
i,count : integer;
begin
B := 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);
//需要进一步判断，判断是不是在一个汉字的中间,如果是则返回False
count := 0;
for i := CurX to Length(B) - 1 do
if B[i] > $80 then
count := count + 1;
Result := (count mod 2) = 0;
end;
四、判断光标是否在一个完整汉字的中间，正常编辑是不应该出现这个问题的。
参数说明：
S：需要判断的字符串
CurX：表示光标位置
返回结果True 表示是在一个汉字中间，否则不是
function is_Half_Chinense(S : string; CurX : integer) : Boolean;
var
i : integer;
B : TBytes;
o : integer; //记录半个函数数量
begin
B := 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 do
begin
if B[i] < $80 then
begin
if (o mod 2) = 0 then
Exit(False)
else
Exit(True);
end;
o := o + 1;
end;
if (o mod 2) = 0 then
Exit(False)
else
Exit(True);
end;
2. 需要修改的地方举例
一、使用 TEncoding.ANSI.GetBytes 直接调整光标位置。
例如，当需要把光标移动到行尾，也就是按下Ctrl + Right（end)键的时候，需要修改函数中的CurX：
修改前函数：
procedure TAdvCustomMemo.GotoEnd;
begin
CurY := Lines.Count - 1;
CurX := Length(Lines[Lines.Count - 1]);
end;
修改后函数：按照汉字字节数调整了光标的位置。
procedure TAdvCustomMemo.GotoEnd;
begin
CurY := 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;
var
MemHandleRTF: THandle;
MemHandleHTML: THandle;
rtfstr, htmlstr: AnsiString;
sl,el: string;
ChangeEvt: TNotifyEvent;
begin
FRTFEngine := TRTFEngine.Create;
ChangeEvt := OnChange;
OnChange := nil;
sl := InternalLines[SelStartY];
el := InternalLines[SelEndY];
if (SelStartY < SelEndY) then
begin
InternalLines[SelStartY] := Copy(sl, SelStartX, Length(sl));
InternalLines[SelEndY] := Copy(el, 1, SelEndX);
end
else
begin
InternalLines[SelStartY] := Copy(sl, 1, SelStartX);
InternalLines[SelEndY] := Copy(el, SelEndX, Length(el));
end;
下面还有，不需要修改就不贴出来....
修改后代码：注意使用了 Get_InsertPositonX_02 函数
procedure TAdvCustomMemo.CopyToClipBoard;
var
MemHandleRTF: THandle;
MemHandleHTML: THandle;
rtfstr, htmlstr: AnsiString;
sl,el: string;
ChangeEvt: TNotifyEvent;
//LXY 20210112
positionStart,positionEnd:word;
begin
FRTFEngine := TRTFEngine.Create;
ChangeEvt := OnChange;
OnChange := nil;
sl := InternalLines[SelStartY];
el := InternalLines[SelEndY];
//LXY 20210113 重新定位位置
{
if (SelStartY < SelEndY) then
begin
InternalLines[SelStartY] := Copy(sl, SelStartX, Length(sl));
InternalLines[SelEndY] := Copy(el, 1, SelEndX);
end
else
begin
InternalLines[SelStartY] := Copy(sl, 1, SelStartX);
InternalLines[SelEndY] := Copy(el, SelEndX, Length(el));
end;
}
if (SelStartY < SelEndY) then
begin
Get_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);
end
else
begin
Get_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;
//=================================================================>
类似需要修改的地方大概有上百处，这里不详细列举，需要的朋友可以下载。资源下载
扫一扫
484
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
