Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:

Error. Page cannot be displayed. Please contact your service provider for more details. (11)


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

Поиск:
Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину.
Здесь создана процедура GetLine, которая возвращает одну строку, начиная с заданного символа. Программа находит разницу между шириной текста и реальной длинной строки и при выводе компенсирует эту разницу удлинением пробелов.
Эта программа выводит на экран текст из файла C:\text.txt, выравнивая его по двум краям.

Код
type
 ...
 TLine = 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 GetLine(index: integer): TLine;

var
 i: integer;
 s1: string;
 first: integer;
begin
 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;
 line: TLine;
 OneWord: string;
 LineN: integer;
 SpaceCount: integer;
 TextLeft: integer;
 shift, allshift: integer;
 d: integer;
 LineCount: integer;

begin
 with bm.Canvas do begin
   FillRect(ClipRect);
   i := 1;
   LineCount := 0;
   for j := 1 to Form1.ScrollBar1.Position do begin
     line := GetLine(i);
     inc(i, line.length);
     inc(LineCount);
   end;
   LineN := 0;
   repeat
     line := GetLine(i);
     SpaceCount := 0;
     TextLeft := 0;
     for j := 1 to Length(line.s) do
       if line.s[j] = #32 then inc(SpaceCount);

     if line.wrap = false
       then allshift := MaxTextWidth - RealTextWidth(line.s)
       else allshift := 0;
     if allshift > 40 * SpaceCount then allshift := 0;
     shift := 0;
     for j := 1 to Length(line.s) do begin
       if (not (line.s[j] in [#9, #32])) and (j < Length(line.s)) then begin
         OneWord := OneWord + line.s[j];

       end else begin
         OneWord := OneWord + line.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, line.length);
     inc(LineN);
   until (LineN * LineH > Form1.PaintBox1.Height) or (i >= Length(s));

   repeat
     line := GetLine(i);
     inc(i, line.length);
     inc(LineCount);
   until i >= Length(s);
   inc(LineCount, LineN);
   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;
Автор: Даниил Карапетян, Алексей Денисов






Просмотров: 3778

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную