求:DrawTextEx自动换行问题(100分)

  • 主题发起人 主题发起人 若醉
  • 开始时间 开始时间

若醉

Unregistered / Unconfirmed
GUEST, unregistred user!
用DrawTextEx自动换行可以用DT_WORDBREAK标志
但该自动换行标志只用于单词或汉字
而如“DDDDDDDDDDDDDDDDDDDDTTTTTTTTSSSSS”这样
就不能自动换行了
现求不通过自己加回车换行符而让非单词也能自动换行了方法!
(如Excel中就可以)
如有好办法!另加300分
 
procedure FormatLines(Line: TStrings; Canvas: TCanvas; Width: integer);
function aLineWidth(Line : string) : integer;
begin
Result := Canvas.TextWidth(Line);
end;

function LineCutPosition(Line : string) : integer;
var i: integer;
begin
Result := Length(Line);
for i := 0 to Length(Line) - 1 do
begin
if aLineWidth(Copy(Line, 1, i + 1)) > Width then
begin
if ByteType(Line, i) = mbLeadByte then
Result := i - 1
else
Result := i;
Exit;
end;
end;
end;

procedure AddLine(ALines: TStringList; Line : string);
var CutPosition: integer;
begin
if aLineWidth(Line) <= Width then
ALines.Add(Line)
else
begin
CutPosition := LineCutPosition(Line);
if CutPosition = 0 then Exit;
ALines.Add(Copy(Line, 1, CutPosition));
Delete(Line, 1, CutPosition);
AddLine(ALines, Line);
end;
end;
var
NewLines: TStringList;
i: Integer;
begin
NewLines := TStringList.Create;
try
for i := 0 to Lines.Count - 1 do
AddLine(NewLines, Lines);
Lines.Assign(NewLines);
finally
NewLines.Free;
end;
end;
 
后退
顶部