Выравнивание текста по ширине

=== Выравнивание текста по ширине ===
Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину. 
Здесь создана процедура GetLine, которая возвращает одну строку, начиная с заданного символа. Программа находит разницу между шириной текста и реальной длинной строки и при выводе компенсирует эту разницу удлинением пробелов. 
Эта программа выводит на экран текст из файла C:\text.txt, выравнивая его по двум краям. 
type
 TLineItem = record
 s: string;
 Wrap: Boolean;
 Length: Integer;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
const
 FileName = 'C:\text.txt';
var
 s: string;
 bm: TBitMap;
 LineH: Integer;
 MaxTextWidth: Integer;
procedure TForm1.FormCreate(Sender: TObject);
var
 F: TFileStream;
 buf: array [0..127] of Char;
 l: Integer;
begin
 ScrollBar1.Kind := sbVertical;
 bm := TBitMap.Create;
 with bm.Canvas.Font do
 begin
 Name := 'Serif';
 Size := 12;
 end;
 LineH := bm.Canvas.TextHeight('123');
 if not FileExists(FileName) then
 begin
 ShowMessage('Can not find file ' + FileName);
 Exit;
 end;
 F := TFileStream.Create(FileName, fmOpenRead);
 repeat
 l := F.Read(buf, 128);
 if l = 128 then
 s := s + buf
 else
 s := s + Copy(buf, 1, l);
 until
 l < 128;
 F.Destroy;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
 PaintBox1.Left := 0;
 PaintBox1.Top := 0;
 PaintBox1.Height := Form1.ClientHeight;
 PaintBox1.Width := Form1.ClientWidth - ScrollBar1.Width;
 ScrollBar1.Left := PaintBox1.Width;
 ScrollBar1.Top := 0;
 ScrollBar1.Height := PaintBox1.Height;
 bm.Width := PaintBox1.Width;
 bm.Height := PaintBox1.Height;
 ScrollBar1.Max := 1000;
 MaxTextWidth := PaintBox1.Width - 20;
end;
function RealTextWidth(s: string): Integer;
var
 i: Integer;
begin
 Result := bm.Canvas.TextWidth(s);
 for i := 1 to Length(s) do
 if s[i] = #9 then
 Inc(Result, 40 - bm.Canvas.TextWidth(#9));
end;
function GetLineItem(index: Integer): TLineItem;
var
 i: Integer;
 s1: string;
 first: Integer;
begin
 if s = then Exit;
 if (s[index] = #13) and (s[index + 1] = #10) then
 begin
 Result.s := ;
 Result.Length := 2;
 Result.Wrap := True;
 Exit;
 end;
 first := index;
 while (first <= Length(s)) and (s[first] in [#32]) do
 Inc(first);
 i := first;
 repeat
 while (i <= Length(s)) and (not (s[i] in [#9, #32])) and (s[i] <> #13) do
 Inc(i);
 s1 := Copy(s, first, i - index);
 Inc(i);
 until
 (i >= Length(s)) or (s[i-1] = #13) or (RealTextWidth(s1) > MaxTextWidth);
 if RealTextWidth(s1) > MaxTextWidth then
 begin
 Result.Wrap := False;
 if i < Length(s) then
 begin
 Dec(i, 2);
 while (i > 0) and (not (s[i] in [#9, #32])) do
 Dec(i);
 Result.Length := i - index;
 while (i > 0) and (s[i] in [#9, #32]) do
 Dec(i);
 end;
 Result.s := Copy(s, first, i - index + 1);
 if Result.s[Length(Result.s)] = #32 then
 Delete(Result.s, Length(Result.s), 1);
 end
 else
 begin
 Result.Length := i - index + 1;
 s1 := Copy(s, first, i - index + 1);
 if Length(s1) > 0 then
 begin
 if s1[Length(s1)] = #9 then
 Delete(s1, Length(s1), 1);
 if s1[length(s1) - 1] + s1[length(s1)] = #13#10 then
 Delete(s1, Length(s1) - 1, 2);
 end;
 Result.s := s1;
 Result.Wrap := True;
 end;
end;
procedure Draw();
var
 i, j: Integer;
 LineItem: TLineItem;
 OneWord: string;
 LineN: Integer;
 SpaceCount: Integer;
 TextLeft: Integer;
 shift, AllShift: Integer;
 d: Integer;
 LineCount: Integer;
begin
 if s = then Exit;
 OneWord := ;
 with bm.Canvas do
 begin
 FillRect(ClipRect);
 i := 1;
 LineCount := 0;
 for j := 1 to Form1.ScrollBar1.Position do
 begin
 LineItem := GetLineItem(i);
 Inc(i, LineItem.Length);
 Inc(LineCount);
 end;
 LineN := 0;
 repeat
 LineItem := GetLineItem(i);
 SpaceCount := 0;
 TextLeft := 0;
 for j := 1 to Length(LineItem.s) do
 if LineItem.s[j] = #32 then
 Inc(SpaceCount);
 if LineItem.Wrap = False then
 AllShift := MaxTextWidth - RealTextWidth(LineItem.s)
 else
 AllShift := 0;
 if AllShift > 40 * SpaceCount then
 AllShift := 0;
 shift := 0;
 for j := 1 to Length(LineItem.s) do
 begin
 if (not (LineItem.s[j] in [#9, #32])) and (j < Length(LineItem.s)) then
 begin
 OneWord := OneWord + LineItem.s[j];
 end
 else
 begin
 OneWord := OneWord + LineItem.s[j];
 if OneWord = #9 then
 begin
 Inc(TextLeft, 40);
 end
 else
 begin
 if OneWord = #13#10 then
 begin
 Inc(LineN);
 end
 else
 begin
 TextOut(10 + TextLeft, LineN * LineH, OneWord);
 if SpaceCount = 0 then
 d := 0
 else
 d := (AllShift - shift) div (SpaceCount);
 Inc(shift, d);
 Inc(TextLeft, TextWidth(OneWord) + d);
 Dec(SpaceCount);
 end;
 end;
 OneWord := ;
 end;
 end;
 Inc(i, LineItem.Length);
 Inc(LineN);
 until
 (LineN * LineH > Form1.PaintBox1.Height) or (i >= Length(s));
 repeat
 LineItem := GetLineItem(i);
 Inc(i, LineItem.Length);
 Inc(LineCount);
 until
 i >= Length(s);
 Inc(LineCount, LineN);
 if LineCount - Form1.PaintBox1.Height div LineH > 0 then
 Form1.ScrollBar1.Max := LineCount - Form1.PaintBox1.Height div LineH;
 end;
 Form1.PaintBox1.Canvas.Draw(0, 0, bm);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 Draw;
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
 Draw;
end;
Source: http://delphiworld.narod.ru/
ID: 00843
ID: 03655
Category:Графика
Category:Работа с текстом