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

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 ****

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

Функция возвращает строку 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:

{ **** 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:

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;