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;