可以改写 QRCtrls.Pas 中 TCustomLabel.FormatLines 中的内部函数 AddWord 如下:
procedure AddWord(aWord : string);
var
S: string;
begin
if aLineWidth(NewLine + aWord) > Width then
begin
if SysLocale.FarEast then
begin
while aWord<>'' do
begin
if (aWord[1] in LeadBytes) and (Length(aWord) > 1) then
S := copy(aWord, 1, 2)
else
S := copy(aWord, 1, 1);
Delete(aWord, 1, Length(S));
if aLineWidth(NewLine + S) < Width then
NewLine := NewLine + S
else
begin
FlushLine;
NewLine := S;
end;
end;
end
else while aWord<>'' do begin
if aLineWidth(NewLine + aWord[1]) < Width then
NewLine := NewLine + aWord[1]
else begin
FlushLine;
NewLine := aWord[1];
end;
Delete(aWord, 1, 1);
end;
if not WordWrap then
begin
aWord := '';
LineFinished := true;
end;
end;
NewLine := NewLine + aWord;
end;