Работа со строками

Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину.

Здесь создана процедура GetLine, которая возвращает одну строку, начиная с заданного символа. Программа находит разницу между шириной текста и реальной длинной строки и при выводе компенсирует эту разницу удлинением пробелов.

Эта программа выводит на экран текст из файла C:\text.txt, выравнивая его по двум краям.

Code:

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');

ifnot 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 = 128then

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 := 1to Length(s) do

if s[i] = #9then

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)] = #32then

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) > 0then

begin

if s1[Length(s1)] = #9then

delete(s1, Length(s1), 1);

if s1[length(s1) - 1] + s1[length(s1)] = #13#10then

delete(s1, length(s1) - 1, 2);

end;

result.s := s1;

result.wrap := true;

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 := 1to 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 := 1to Length(line.s) do

if line.s[j] = #32then

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 := 1to 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 = #9then

begin

inc(TextLeft, 40);

end

else

begin

if OneWord = #13#10then

begin

inc(LineN);

end

else

begin

TextOut(10 + TextLeft, LineN * LineH, OneWord);

if SpaceCount = 0then

d := 0

else

d := (allshift - shift) div (SpaceCount);

inc(shift, d);

inc(TextLeft, TextWidth(OneWord) + d);

dec(SpaceCount);

end;

OneWord := '';

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;

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Форматирование строк

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Дополнение строки пробелами слева

Дополненяет строку слева пробелами до указанной длины

Зависимости: нет

Автор: Anatoly Podgoretsky, anatoly@podgoretsky, Johvi

Дата: 26 апреля 2002 г.

***************************************************** }

function PADL(Src: string; Lg: Integer): string;

begin

Result := Src;

while Length(Result) < Lg do

Result := ' ' + Result;

end;

{ **** UBPFD *********** by delphibase.endimus ****

>> Дополнение строки пробелами справа

Дополняет строку пробелами справа до указанной длины.

Зависимости: нет

Автор: Anatoly Podgoretsky, anatoly@podgoretsky, Johvi

***************************************************** }

function PADR(Src: string; Lg: Integer): string;

begin

Result := Src;

while Length(Result) < Lg do

Result := Result + ' ';

end;

{ **** UBPFD *********** by delphibase.endimus ****

>> Дополнение строки пробелами с обоих сторон

Дополнение строки пробелами с обоих сторон до указанной длины

Зависимости: нет

Автор: Anatoly Podgoretsky, anatoly@podgoretsky, Johvi

***************************************************** }

function PADC(Src: string; Lg: Integer): string;

begin

Result := Src;

while Length(Result) < Lg do

begin

Result := Result + ' ';

if Length(Result) < Lg then

begin

Result := ' ' + Result;

end;

//Пример использования:

S := PADL(S,32);

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Форматирование строк

Sometimes you probably have written something like this:

Code:

s := Format('Hello %s, your name is %s %s', [FirstName, FirstName, LastName]);

(an admittedly stupid example ;-) )

And if you do, you probably found it annoying that you need to specify the FirstName parameter twice, in particular if there are lots of similar lines. But this isn't necessary because you can specify the parameter position to use for the placeholder

in the format string like this:

Code:

s := Format('Hello %0:s, your name is %0:s %1:s', [FirstName, LastName]);

Just one more example from a code generator I am currently writing:

Code:

TableName := 'Customer';

...

s := Format(' f%0:sTableAuto := T%0:sTableAuto.Create(f%0:Table);', [TableName]);

which results in

Code:

s := ' fCustomerTableAuto := TCustomerTableAuto.Create(fCustmerTable);';

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Форматирование строк

Code:

{ **** UBPFD *********** by delphibase .endimus .com ****

>> Функция замены в строке всех вхождений одной подстроки на другую

В отличие от других подобных функций, эта - не зависнет, если в строке нужно

заменить не только одно слово совершенно другим,

но и допустим, слово "Штаны" на "-Штаны-"

(Т.е. начальное слово после замены остается, но к нему добавляется какой нибудь

символ справа, или слева. В данном случае по краям слова добавлен знак минуса).

Я пересмотрел много примеров, и ни один из них не справился с этой задачей.

(Может я плохо искал?).

Зависимости: Windows, SysUtils

Автор: Матюшкин Сергей, seregam @ ua.fm, ICQ:162733776, Днепропетровск

***************************************************** }

function Replace(Str, X, Y: string): string;

{Str - строка, в которой будет производиться замена.

X - подстрока, которая должна быть заменена.

Y - подстрока, на которую будет произведена заменена}

var

buf1, buf2, buffer: string;

i: Integer;

begin

buf1 := '';

buf2 := Str;

Buffer := Str;

while Pos(X, buf2) > 0do

begin

buf2 := Copy(buf2, Pos(X, buf2), (Length(buf2) - Pos(X, buf2)) + 1);

buf1 := Copy(Buffer, 1, Length(Buffer) - Length(buf2)) + Y;

Delete(buf2, Pos(X, buf2), Length(X));

Buffer := buf1 + buf2;

end;

Replace := Buffer;

end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);

var

a: Integer;

begin

for a := 0to Memo1.Lines.Count do

Memo1.Lines[a] := Replace(Memo1.Lines[a], 'Штаны', '-Штаны-');

end;

Всё значительно проще! В Борланд уже всё сделали до нас:

Code:

//заменить первое вхождение подстроки с учётом регистра

S:=StringReplace(ИсходнаяСтрока, ЧтоЗаменять, НаЧтоЗаменять, [])

//заменить все вхождения подстроки с учётом регистра

S:=StringReplace(ИсходнаяСтрока, ЧтоЗаменять, НаЧтоЗаменять, [rfReplaceAll])

//заменить первое вхождение подстроки без учёта регистра

S:=StringReplace(ИсходнаяСтрока, ЧтоЗаменять, НаЧтоЗаменять, [rfIgnoreCase])

//заменить все вхождения подстроки без учёта регистра

S:=StringReplace(ИсходнаяСтрока, ЧтоЗаменять, НаЧтоЗаменять, [rfReplaceAll, rfIgnoreCase])

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Форматирование строк

Code:

function DeleteLineBreaks(const S: string): string;

var

Source, SourceEnd: PChar;

begin

Source := Pointer(S);

SourceEnd := Source + Length(S);

while Source < SourceEnd do

begin

case Source^ of

#10: Source^ := #32;

#13: Source^ := #32;

end;

Inc(Source);

end;

Result := S;

end;

https://delphiworld.narod

DelphiWorld 6.0

Можно значительно проще:

Code:

function DeleteLineBreaks(const S: string): string;

®Vit (Vitaly Nevzorov) - nevzorov @ yahoo.com}

begin

Result := StringReplace(S, #10#13, '',[rfReplaceAll]);

end;

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Форматирование строк

Работа со строками

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

Дополнение строки пробелами

Как использовать format parameter больше одного раза?

Замена в строке всех вхождений одной подстроки на другую

Как удалить переносы из строки

Преобразования строк из и в другие типы

Разбор строки, выделение элементов, поиск

Разные вопросы

Слова

Справочные материалы, общие вопросы

Форматирование строк

Системные функции и WinAPI

Вопросы по Delphi

VCL

Язык Дельфи

Облако тегов

Карта сайта