Code:

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

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

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

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

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

Copyright:

Дата: 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

Copyright: Anatoly Podgoretsky

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

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

Copyright:

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

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;

end;

end;

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

S := PADL(S,32);

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;

Code:

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

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

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

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

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

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

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

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

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

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

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

Copyright: Sergey_M

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

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:

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

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

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

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

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

Copyright: Witek

Дата: 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

Code:

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

Code:

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

Code:

TableName := 'Customer';

...

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

Code:

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

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, Махачкала

Copyright: VID

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

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;

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;

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;

Code:

function LowCase(ch: CHAR): CHAR;

begin

case ch of

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

else

LowCase := ch;

end;

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;

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

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;

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;

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;