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

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

2013-08-20T17:17:39+07:00

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

Здесь создана процедура 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;

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

2013-08-20T17:09:49+07:00

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

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

2013-08-20T19:28:34+07:00

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])

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

2013-08-20T17:08:25+07:00

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

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

2013-08-20T18:35:41+07:00

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;

{©Drkb v.3(2007): www.drkb,

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

begin

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

end;

Наполнение строки

2013-08-20T19:32:15+07:00

Code:

function Spcs(num : byte) : string;

var

tmp : string;

begin

fillchar(tmp, num+1, ' '); {инициализация всей строки пробелами}

tmp[0] := chr(num); {устанавливаем длину строки с пробелами}

result := tmp;

end;

//Теперь достаточно написать

Edit1.Text := SurName + spcs(10) + FirstName

https://delphiworld.narod

DelphiWorld 6.0

Решением является создание функции, функционально похожей на функцию Clipper:

PadL(string, width, character)

Code:

function TfrmFunc.PadL(cVal: string; nWide: integer; cChr: char): string;

var

i1, nStart: integer;

begin

if length(cVal) < nWide then

begin

nStart:=length(cVal);

for i1:=nStart to nWide-1do

cVal:=cChar+cVal;

end;

PadL:=cVal;

end;

Затем это может вызываться c любой строкой, которой вы хотите задать определенную длину. Пользуйтесь функцией также, как вы привыкли пользоваться прежней - PadL(A,length(B),'0'); Она имеет большую гибкость - возможно заполнение любым символом до необходимой длины (удобно для задания текстовых счетчиков с фиксированным количеством символов -- PadL(A,6,'0').

https://delphiworld.narod

DelphiWorld 6.0

Code:

function LeftPad(S: string; Ch: Char; Len: Integer): string;

var

RestLen: Integer;

begin

Result := S;

RestLen := Len - Length(s);

if RestLen < 1then Exit;

Result := S + StringOfChar(Ch, RestLen);

end;

function RightPad(S: string; Ch: Char; Len: Integer): string;

var

RestLen: Integer;

begin

Result := S;

RestLen := Len - Length(s);

if RestLen < 1then Exit;

Result := StringOfChar(Ch, RestLen) + S;

end;

{Beispiel / Example}

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.Text := Rightpad(Edit2.Text, '-', 30);

end;

Обрезание строки по длине

2013-08-20T18:36:23+07:00

Автор: ___Nikolay

Code:

// Обрезание строки по длине

function TfmDW6Main.BeautyStr(s: string; iLength: integer): string;

var

bm: TBitmap;

sResult: string;

iStrLen: integer;

bAdd: boolean;

begin

Result := s;

if Trim(s) = ''then

exit;

bAdd := false;

sResult := s;

bm := TBitmap.Create;

bm.Width := 100;

bm.Height := 100;

iStrLen := bm.Canvas.TextWidth(sResult);

while iStrLen > iLength do

begin

if Length(sResult) < 4then

break;

Delete(sResult, Length(sResult) - 2, 3);

bAdd := true;

iStrLen := bm.Canvas.TextWidth(sResult);

end;

if (iStrLen <= iLength) and bAdd then

sResult := sResult + '...';

bm.Free;

Result := sResult;

end;

Очистка строки (символьное значение числа) от пробелов, нулей и точки

2013-08-20T18:45:07+07:00

Code:

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

>> Очистка строки (символьное значение числа) от пробелов, нулей и точки

Функция возращает строку очищенную от символов: пробел, ноль, точка.

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

Автор: Виталий, center_sapr @ mnogo.ru, Львов

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

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

unit Unit2;

interface

function StrFl(st: string): string;

implementation

function StrFl(st: string): string;

label

p1, p2, p3;

var

poz: Byte;

k: integer;

stt: string;

begin

k := Length(st);

if k <= 1then

goto p2;

p1:

stt := Copy(st, 1, 1); {Очистка от пробелов}

if stt = ' 'then

begin

st := Copy(st, 2, k - 1);

k := k - 1;

goto p1;

end;

stt := Copy(st, k, 1);

if stt = ' 'then

begin

st := Copy(st, 1, k - 1);

k := k - 1;

goto p1;

end;

p3:

poz := Pos('.', st); {Очистка от нулей}

if poz = 0then

goto p2;

stt := Copy(st, k, 1);

if stt = '0'then

begin

st := Copy(st, 1, k - 1);

k := k - 1;

goto p3;

end;

if stt = '.'then{Очистка от точки}

begin

st := Copy(st, 1, k - 1);

end;

p2:

StrFl := st;

end;

end.

//Пример результатов:

//5.000 -> 5

//5.001 -> 5.001

//05.100 -> 05.1

Очистка строки слева и справа от указанного символа

2013-08-20T18:47:11+07:00

Code:

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

>> Очистка строки слева и справа от указанного символа

Функция возвращает строку Str, очищенную слева и справа от указанного символа Symbol.

Работает быстрее аналогичной функции UBPFD.TrimEx, так как не использует функцию

поиска Pos, имеет более компактный код.

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

Автор: lipskiy, lipskiyn@ mail.ru,

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

function TrimString(Str: string; Symbol: char): string;

begin

Result := Str;

if Str = ''then

exit;

Str := Trim(Str);

// Удаляем в начале строки

while (length(Str) > 0) and

(AnsiUpperCase(Str[1]) = AnsiUpperCase(Symbol)) do

Delete(Str, 1, 1);

// Удаляем в конце строки

while (length(Str) > 0) and

(AnsiUpperCase(Str[length(Str)]) = AnsiUpperCase(Symbol)) do

Delete(Str, length(Str), 1);

Result := Str;

end;

Code:

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

>> Очистка строки слева и справа от указанных символов

Функция возвращает word, очищеный от начальных и конечных символов, которые

попадают в строку TrimSymbols.

Например, ShowMessage (TrimEx('<MegaTeg>', '<>')), выведет сообщение "MegaTeg"

(без кавычек).

Зависимости: system, sysutils

Автор: VID, vidsnap @ mail.ru, ICQ:132234868, Махачкала

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

function TrimEX(Word, TrimSymbols: string): string;

var

x, a, b: Integer;

begin

Result := Word;

if TrimSymbols = ''then

exit;

Word := Trim(word);

if length(word) = 0then

exit;

x := 0;

repeat

x := x + 1;

until (pos(ansiuppercase(word[x]), ansiuppercase(TrimSymbols)) = 0)

or (x = length(word));

a := x;

x := length(word) + 1;

repeat

x := x - 1;

until (pos(ansiuppercase(word[x]), ansiuppercase(TrimSymbols)) = 0)

or (x = 1);

b := x;

word := copy(word, a, b - a + 1);

result := word;

end;

Первая буква каждого слова в верхнем регистре

2013-08-20T18:34:12+07:00

Code:

function LowCase(ch: CHAR): CHAR;

begin

case ch of

'A'..'Z': LowCase := CHR(ORD(ch) + 31);

else

LowCase := ch;

end;

function proper(s: string): string;

var

t: string;

i: integer;

newWord: boolean;

begin

if s = ''then

exit;

s := lowercase(s);

t := uppercase(s);

newWord := true;

for i := 1to length(s) do

begin

if newWord and (s[i] in ['a'..'z']) then

begin

s[i] := t[i];

newWord := false;

continue;

end;

if s[i] in ['a'..'z', ''''] then

continue;

newWord := true;

end;

result := s;

end;

Перевод символа в верхний регистр для русского алфавита

2013-08-20T18:48:06+07:00

Code:

function UpCaseRus(ch: Char): Char;

asm

CMP AL,'a'

JB @@exit

CMP AL,'z'

JA @@Rus

SUB AL,'a' - 'A'

RET

@@Rus:

CMP AL,'я'

JA @@Exit

CMP AL,'а'

JB @@yo

SUB AL,'я' - 'Я'

RET

@@yo:

CMP AL,'?'

JNE @@exit

MOV AL,'?'

@@exit:

end;

Перевод символа в нижний регистр

2013-08-20T18:49:19+07:00

Code:

function LoCaseRus( ch : Char ) : Char;

{Перевод символа в нижний регистр для русского алфавита}

asm

CMP AL,'A'

JB @@exit

CMP AL,'Z'

JA @@Rus

ADD AL,'a' - 'A'

RET

@@Rus:

CMP AL,'Я'

JA @@Exit

CMP AL,'А'

JB @@yo

ADD AL,'я' - 'Я'

RET

@@yo:

CMP AL,'?'

JNE @@exit

MOV AL,'?'

@@exit:

end;

Повтор строки N количество раз

2013-08-20T18:50:41+07:00

Code:

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

>> Повтор строки заданное количество раз

Input - строка для повторения

Rep - количество повторений

Строка на выходе это входная строка повторенная Rep раз.

Зависимости: Стандартные модули

Автор: Ru, DiVo_Ru @ rambler.ru, Одесса

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

function MulStr(Input: string; Rep: integer): string;

var

i: integer;

begin

for i := 0to Rep - 1do

result := result + Input;

end;

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

s1 := 'Привет';

s := MulStr(s1, 3);

// результат:

s := 'ПриветПриветПривет';

Примеры форматирования строк с использованием API-функции wvsprintf

2013-08-20T20:00:16+07:00

Code:

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

>> Примеры форматирования строк с использованием API-функции wvsprintf

Примеры показывают приемы использования функции wvsprintf в Delphi для

форматирования строк. Эта функция входит в состав Windows API

(реализована в user32.dll), поэтому не требует подключения модуля

SysUtils по сравнению с аналогичной функцией Format.

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

Автор: Внук, Zhigalin @ poria.ru, ICQ:60571446, Самара

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

// Пример использования функции wvsprintf с двумя параметрами разного типа

function WinFormat(out TargetString: AnsiString): Boolean;

const

FormatStr = 'String Parameter:"%s", Number Parameter:%05d';

var

StrParam: AnsiString;

NumberParam, FormatResult: Integer;

ParamArray: array[0..1] of Pointer;

begin

NumberParam := 105; // Задаем значение первого параметра

StrParam := 'Hello'; // Задаем значение второго параметра

SetLength(TargetString, 50); // Должно быть достаточно места для результата.

// Без этой строки работать не будет

ParamArray[0] := @StrParam[1];

ParamArray[1] := Pointer(NumberParam);

FormatResult := wvsprintf(PChar(TargetString), FormatStr, PChar(@ParamArray));

if FormatResult < Length(FormatStr) then// В случае ошибки значение функции

// меньше длины шаблонной строки

begin

TargetString := '';

Result := False;

end

else

result := True;

end;

// Пример использования функции wvsprintf с одним параметром

function SimpleWinFormat(out TargetString: AnsiString): Boolean;

const

FormatStr = 'Number Parameter:%05d';

var

NumberParam, FormatResult: Integer;

begin

NumberParam := 112;

SetLength(TargetString, 50); // Должно быть достаточно места для результата.

// Без этой строки работать не будет

FormatResult := wvsprintf(PChar(TargetString), FormatStr,

PChar(@NumberParam));

if FormatResult < Length(FormatStr) then// В случае ошибки значение функции

// меньше длины шаблонной строки

begin

TargetString := '';

Result := False;

end

else

result := True;

end;

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

uses Dialogs, ...;

...

var

S: AnsiString;

...

begin

...

if WinFormat(S) then

ShowMessage(S)

else

ShowMessage('An error has been occured!');

if SimpleWinFormat(S) then

ShowMessage(S)

else

ShowMessage('An error has been occured!');

...

end;

...

Удаление лишних пробелов в строке

2013-08-20T19:58:59+07:00

Code:

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

>> удаление лишних пробелов в строке

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

Зависимости: стандартные модули

Автор: Артем, boss1999 @ mail.ru, москва

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

{процедура удаления лишних пробелов в строке (см. function Sha_SpaceCompress)}

var

c, i: integer;

stt, st, st1: string;

begin

c := 0;

st := edit1.Text;

for i := 1to Length(st) do

begin

stt := copy(st, i, 1);

if (stt = ' ') and (c >= 1) then

begin

st1 := st1;

c := c + 1;

end

elseif (stt = ' ') and (c = 0) then

begin

c := c + 1;

st1 := st1 + stt;

end

elseif (stt <> ' ') then

begin

c := 0;

st1 := st1 + stt;

end

end;

edit2.text := st1;

end;

Code:

Function DeleteUselessSpaces(s:String):string;

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

begin

Repeat

Result:=s;

s:=StringReplace(Result,' ',' ',[rfReplaceAll]); //заменяем все двойные пробелы на одинарные

Until Result=s; //повторяем до тех пор пока есть двойные пробелы

end;

Удаление ненужных подстрок из строки

2013-08-20T19:34:14+07:00

Code:

procedure RemoveInvalid(what, where: string): string;

// what - удаляемая подстрока, where - обрабатываемая строка

var

tstr: string;

begin

tstr:=where;

while pos(what, tstr)>0do

tstr:=copy(tstr,1,pos(what,tstr)-1) +

copy(tstr,pos(what,tstr)+length(tstr),length(tstr));

Result:=tstr;

end;

//Применение:

NewStr:=RemoveInvalid('<брак>','Этот <брак> в моей строке, и я хочу

удалить из нее этот <брак>');

Используйте стандартную функцию Pascal DELETE...

Пользуясь тем же примером, вы можете сделать так....

Code:

Target:='<брак>';

While POS(Target,string)>0do

begin

P := POS(Target,string);

DELETE(string,P,Length(Target));

end;

Всё даже проще:

Code:

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

Result:=StringReplace(ИсходнаяСтрока,ТоЧтоНадоУдалить,'',[rfReplaceAll])

Удаление пробелов в начале строки

2013-08-20T19:57:22+07:00

Code:

{ **** UBPFD *********** by delphibas e.endimus .com ****

>> Удаление пробелов в начале строки

Функция возвращает строку без пробелов в начале (если они были)

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

Автор: Hastlero

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

var

i: Integer;

begin

if Length(str) = 0then

begin

DelSpaces := str;

Exit;

end;

for i := 1to length(str) do

begin

if pos(' ', str) = 1then

delete(str, 1, 1)

else

begin

DelSpaces := str;

Break;

end;

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

Str := DelSpaces(Str);

Изобретателям велосипеда посвящается:

TrimRight - удаляет пробелы в начале строки, в том числе и в юникодных строках

TrimLeft - удаляет пробелы в конце строки, в том числе и в юникодных строках

Trim - удаляет пробелы в начале и в коце строки, в том числе и в юникодных строках

Форматирование строки с использованием подстановочных символов

2013-08-20T19:24:39+07:00

Code:

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

>> Форматирование строки с использованием подстановочных символов %1, %2 и т.д.

Функция заменяет в строке Str все подстроки '%1', '%2', и т.д. На

соответсвующие значения из массива Values. При этом значения этого массива

не должны содержать подстановочных подстрок, в противном случае возможно

зависание функции.

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

Автор: Dimka Maslov, mainbox @ endimus.ru, ICQ:148442121, Санкт-Петербург

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

{Эта функция работает неверно, если в строке, на которую надо

заменить %1,%2,… содержится одна из строк %1,%2,…

( она зависнет в бесконечном цикле )}

function FmtString(const Str: string; const Values: arrayofstring): string;

function InternalPos(SubStr: string; Str: PChar; out P: Integer): Integer;

var

Ptr: PChar;

begin

Ptr := StrPos(Str, PChar(SubStr));

if Ptr = nilthen

Result := -1

else

Result := Integer(Ptr) - Integer(Str);

P := Result;

end;

function InternalReplace(const Str, OldSub, NewSub: string): string;

var

PrePos: Integer;

CurPos: Integer;

OldLen, NewLen: Integer;

begin

PrePos := 1;

Result := Str;

OldLen := Length(OldSub);

NewLen := Length(NewSub);

while InternalPos(OldSub, @Result[PrePos], CurPos) >= 0do

begin

Inc(PrePos, CurPos);

Delete(Result, PrePos, OldLen);

Insert(NewSub, Result, PrePos);

Inc(PrePos, NewLen);

end;

var

i: Integer;

begin

Result := Str;

for i := High(Values) downto Low(Values) do

Result := InternalReplace(Result, '%' + IntToStr(i + 1), Values[i]);

end;

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

FmtString('%1 %2', ['Пример', 'использования']);

Функции форматирования строк

2013-08-20T17:07:26+07:00

Еще со времен языка FORTRAN у программистов появилась необходимость форматировать строки, направляемые на устройства вывода. Требовался легкий способ для того, чтобы не просто преобразовать число в строку, но также объединить эту строку с другими и включить ее в состав целого предложения.

В Delphi существует группа функций форматирования строк. Их рассмотрение начнем с наиболее часто встречающегося представителя — функции Format:

Code:

function Format (const Format: string; const Args: arrayofconst) : string;

Первым параметром функции выступает форматирующая строка. Это — обычная текстовая строка, но в ней на нужных местах стоят специальные символы, которые определяют, какие и как туда будут подставлены параметры.

Второй параметр функции Format называется списком аргументов. Он и содержит "вставляемые" в форматирующую строку параметры. Обратите внимение, что этот открытый массив имеет тип array of const. и в нем может передаваться переменное число разнотипных параметров. Например, после выполнения

Code:

S := Format('Product %s , version %d.%d', [ 'Borland Delphi' , 1, 0]);

строке S будет присвоено: Product Borland Delphi , version 1.0. Рассмотрим подробнее правила, по которьм составляется форматирующая строка.

"Специальные" места в ней называются спецификаторами формата и представляют собой следующие конструкции

"%" [index":"] ["-"I [width] ["."prec] type

где обозначены:

• символ -%", с которого начинаются все спецификаторы формата (обязательный);

• поле индекса аргумента [ index " : " ] (необязательное);

• признак выравнивания по левому краю ["-"I (необязательный);

• поле ширины [width] (необязательное);

• поле точности [ - . - prec ] (необязательное);

• символ типа преобразования type (обязательный).

Каждый спецификатор формата соответствует как минимум одному из элементов списка аргументов и определяет, как именно рассматривать его и преобразовывать в строку.

Функция Format поддерживает следующие символы типа преобразования:

d Десятичный Элемент должен быть целым числом и преобразуется в строку десятичных цифр. Если при символе есть поле точности, то в выходной строке будет минимум ргес цифр; если при преобразовании числа их потребуется меньше, то строка дополняется слева нулями.

х Шестнадцатиричный Как тип d, но элемент преобразуется в строку шестнадцатиричных цифр.

е Научный Элемент должен быть числом с плавающей точкой. Он преобразуется к нормализованному виду -d.dddE+ddd. Перед десятичной точкой всегда находится одна цифра (при необходимости, с минусом). После символа "Е" идет показатель степени, имеющий знак и состоящий не менее чем из 3 цифр. Общее число символов в представлении числа определяется полем ргес (по умолчанию 15).

f Фиксированный Элемент должен быть числом с плавающей точкой. Он преобразуется к виду -ddd.ddd. Поле ргес означает количество цифр после десятичной точки (по умолчанию 2).

l Обобщенный Элемент должен быть числом с плавающей точкой. Он преобразуется к одному из двух вышеперечисленных видов — выбирается тот, который обеспечивает более короткую запись. Если требуемое число цифр слева от десятичной точки меньше значения поля ширины и само число больше 10" , применяется фиксированный тип. Удаляются все впереди идущие нули, десятичная точка (при возможности), а также символы, разделяющие строку на группы по три цифры.

п m Числовой Денежный Совпадает с типом f за исключением того, что после каждой группы из трех цифр ставятся разделительные символы: d,ddd, ddd.ddd.... Элемент должен быть числом с плавающей точкой, отражающей денежную сумму. Способ ее представления зависит от значений глобальных констант, определенных в модуле SYSUTILS (см. ниже). В свою очередь, они зависят от настройки Windows на обозначения, принятые в данной стране.

Р Указатель Элемент должен быть указателем. На выходе он будет представлять из себя строку шестнадцатиричных цифр вида ХХХХ: YYYY, где ХХХХ — селектор, YYYY — смещение.

s Строка Элемент может иметь тип string, PChar или быть отдельным символом (Char). Эта строка (или символ) вставляются вместо спецификатора формата. Если присутствует поле ргес и длина строки больше его значения, то она усекается.

Примечания:

1. Форматирующие символы можно задавать как в верхнем, так и в нижнем регистрах.

2. Тип преобразования m (денежный) тесно связан с правилами представления, принятыми в конкретной стране. Для этого в модуле SYSUTILS определены значения ряда типизированных констант, начальные значения которых берутся из секции [Inti] файла WIN.INI. Вы можете изменять их значения в соответствии с вашими потребностями:

CurrencyString: string[7]; Символ (или символы), добавляемые к строке с представлением денежной суммы и обозначающие национальную денежную единицу. Это может быть, например, '$', 'DM' или 'руб'.

CurrencyFormat: Byte; Определяет способ добавления знака денежной единицы к строке. Число 1 будет преобразовано так в зависимости от значения этого параметра: '$!' при 0; '1$' при 1; '$ Г при 2; '1 $' при 3.

NegCurrFormat: Byte; Определяет способ добавления знака денежной единицы и минуса к строке в том случае, если происходит преобразование отрицательного числа (к положительным числам отношения не имеет). Число -1 будет преобразовано так в зависимости от значения этого параметра: '($!)' при 0; '-$!' при 1; '$-1' при 2; '$!-' при 3; '(!$)' при 4; '-!$' при 5; 'i-$' при 6; '!$-' при 7; '-1 $' при 8; '-$ Г при 9; '$ 1-' при 10.

CurrencyDecimals: Byte; Число знаков после запятой в представлении денежных сумм. Например, число 10.15 при разных значениях этого параметра отобразится так: '$10' при 0, '$10.15' при 2, '$10.1500' при 4.

ThousandSeparator: Char; Символ, разделяющий строку на группы по три цифры справа налево (разделитель тысяч). Применяется, в частности, в типе преобразования п.

DecimalSeparator: Char; Символ, отделяющий дробную часть числа от целой.

Мы закончили рассмотрение символа типа преобразования. Рассмотрим остальные составные части спецификатора формата.

Поле шириныустанавливает минимально допустимое количество символов в преобразованной строке. Это означает, что если она короче, чем задано в этом поле, то происходит добавление пробелов до требуемого количества. По умолчанию пробелы добавляются спереди (выравнивание по правому краю), но признак выравнивания по левому краю ("-"; он должен стоять перед полем ширины) позволяет выравнивать строку по-иному.

Поле индекса позволяет динамически изменить последовательность извлечения аргументов из массива. Обычно аргументы извлекаются последовательно, по мере их востребования спецификаторами формата. Поле индекса означает, что следующим нужно извлечь аргумент с данным индексом. Пользуясь индексом, одни и те же аргументы могут быть использованы многократно. Например, вызов Format ( ' %s %s %0 : s %s ', [ 'Yes', 'No' ] ) Даст на выходе строку 'Yes No Yes No'.

Поле точностииграет разную роль в зависимости от того, с каким типом преобразования применяется. Его особенности приведены вместе с описанием типа (с теми из них, где оно имеет смысл).

Поля индекса, ширины и точности могут быть заданы напрямую или косвенно. Первый способ подразумевает явное указание значения поля (например, ' %10 . 5f '). Для косвенного задания значений нужно в соответствующих местах цифры заменить звездочками (например, '%*.*f'). В этом случае вместо звездочек будут подставлены следующие значения из списка аргументов (они обязательно должны быть целыми числами). Например, выражение

Code:

Format('Value is %*.*',[10,5, 2.718]);

эквивалентно:

Code:

Format('Value is %10.5',[2.718]);

Как уже упоминалось, наиболее употребимой функцией из группы форматирующих является Format, которая работает со строками типа string и максимально освобождает программиста от рутинной работы. Другие функции используют то же ядро и правила преобразования, но отличаются параметрами:

procedure FmtStr(var Result: string; const Format: string; const Args: array of const); To же, что и Format, но оформлено в виде процедуры. Результат преобразования возвращается в параметре Result.

function StrFmt(Buffer, Format: PChar; const Args: array of const): PChar; Форматирующая строка должна находиться в параметре Format, а результирующая помещается в буфер Buffer (он должен иметь нужную длину). Функция возвращает указатель на Buffer.

function StrLFmt(Buffer: PChar; MaxLen: Cardinal; Format: PChar; const Args: array of const) : PChar; Работает как StrFmt, но длина результирующей строки не будет превышать MaxLen символов.

function FormatBuf(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const) : Cardinal; Форматирующая строка находится в буфере Format длиной FmtLen, a результирующая — в буфере Buffer длиной BufLen. Функция возвращает число реально помещенных в Buffer символов, причем оно всегда меньше или равно BufLen.

Функция для удаления из строки лишних символов

2013-08-20T19:26:40+07:00

Code:

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

>> Функция для удаления из строки "лишних" символов.

Функция для удаления из строки "лишних" символов.

Входные параметры:

Input - входная строка, которую необходимо очистить от лишних символов

EArray - строка, содержащая набор разрешенных или запрещеных символов

в зависимости от Action

Action - указывает на то, что из себя представляет массив EArray.

Action может принимать следующие значения:

1 - массив EArray представляет собой строку разрешенных символов

2 - EArray - массив запрещенных символов.

Зависимости: делал в Д5, 6 под Win9x

Автор: Ru, DiVo_Ru @ rambler.ru, Одесса

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

function strtst(var Input: string; EArray: string; Action: integer): string;

begin

case Action of

begin

while length(Input) <> 0do

begin

if pos(Input[1], EArray) = 0then

delete(Input, 1, 1)

else

begin

result := result + Input[1];

delete(Input, 1, 1);

end;

begin

while length(Input) <> 0do

begin

if pos(Input[1], EArray) <> 0then

delete(Input, 1, 1)

else

begin

result := result + Input[1];

delete(Input, 1, 1);

end;

else

messagebox(0, 'Не корректный вызов функции.', '', mb_ok);

end;

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

// 1.

s := edit1.text;

s := strtst(s, '0123456789.', 1);

edit1.text := s;

// например на входе: 0.16+

// на выходе будет: 0.16

// 2.

s := edit1.text;

s := strtst(s, '/*-+,', 2);

edit1.text := s;

// на входе: 0.16+

// на выходе будет: 0.16