Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки.

 

При попытке открыть проект созданный в Delphi 6 из Delphi 5 возникает

проблема с чтением DFM-файла. Проблема заключается в том, что Delphi5

не может прочитать строки, записанные в формате Unicode (WideString).

Данная функция переводит строки из DFM файла в формат ANSI, после чего

DFM файл читается в D5. Но при этом может возникнуть проблема,

связанная с незнакомыми для D5 свойствами компонентов, которая,

в свою очередь, решается игнорированием этих свойств.

 

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

Автор: Радионов Алексей (Alx2), Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:113442587, Ульяновск

Copyright: Alx2

Дата: 31 мая 2002 г.

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

 

Procedure RemoveUnicodeFromDFM(Const Filename: String);

Function isChanges(Const S: String; Var Res: String): Boolean;

Var len: Integer;

Function LexemSharp(Var K: Integer): Boolean;

Begin

Result := (K < len) And (S[K] = '#');

If Result Then

Begin

inc(K);

While (K <= len) And (S[K] In ['0'..'9']) Do inc(K);

End;

End;

Function LexemAp(Var K: Integer): Boolean;

Begin

Result := (K < len) And (S[K] = '''');

If Result Then

Begin

inc(K);

While (K <= len) And (S[K] <> '''') Do inc(K);

If K <= len

Then

inc(K);

End;

End;

 

Function Lexem(Var K: Integer; Var Str: String): Boolean;

Var

Start: Integer;

ValS : String;

Begin

Result := False;

Start := K;

If LexemSharp(K) Then

Begin

ValS := Copy(S, Start + 1, K - Start - 1);

Str := WideChar(StrToInt(ValS));

Result := True;

End

Else

If LexemAp(K) Then

Begin

Str := Copy(S, Start + 1, K - Start - 2);

Result := True;

End;

End;

 

Function Prepare(Var K: Integer): String;

Var Str: String;

WasLexem: Boolean;

Begin

Result := '';

WasLexem := False;

While Lexem(K, Str) Do

Begin

Result := Result + Str;

WasLexem := True;

End;

If Result <> ''Then

Result := '''' + Result + '''' + Copy(S, K, Length(S))

Else

IfNot WasLexem Then

Result := S

Else

Result := '''''';

End;

Function Min(A, B: Integer): Integer;

Begin

If A = 0Then Result := B

Else

If B = 0Then Result := A

Else

If A > B Then Result := B

Else Result := A;

End;

 

Var

StartIdx: Integer;

Begin

Result := False;

StartIdx := Min(Pos('#', S), Pos('''', S));

If StartIdx > 0Then

Begin

len := Length(S);

While (StartIdx <= len) And (Not (S[StartIdx] In ['#', ''''])) Do inc(StartIdx);

If StartIdx < len Then

Begin

Res := Copy(S, 1, StartIdx - 1) + Prepare(StartIdx);

Result := True;

End;

End;

End;

 

Var

SList: TStringList;

K : Integer;

Res : String;

Begin

SList := TStringList.Create;

Try

SList.LOADFROMFILE(Filename);

For K := 0To SList.Count - 1Do

If isChanges(SList[K], Res) Then

SList[K] := Res;

SList.SaveToFile(Filename);

Finally

SList.Free;

End;

End;

 

 

 

 

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

Code:

Procedure TForm1.Button1Click(Sender: TObject);

Var

K: Integer;

Begin

If OpenDialog1.Execute Then

For K := 0To OpenDialog1.Files.Count - 1Do

RemoveUnicodeFromDFM(OpenDialog1.Files[K]);

End;

Code:

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

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

 

Преобразует строку в число, при этом удаля из строки все лишние символы

 

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

Автор: Separator, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:162770303, Алматы

Copyright: Separator

 

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

 

function StringToNumber(const Value: string): string;

var

ResStr: string;

i, j, L: integer;

Ch: char;

E, DS: boolean;

 

begin

Result := '0';

L := Length(Value);

if L <> 0then

begin

SetLength(ResStr, L);

E := false;

DS := false;

j := 0;

for i := 1to L do

begin

Ch := Value[i];

case Ch of

'0'..'9':

begin

Inc(j);

ResStr[j] := Ch

end; //'0'..'9': begin

'.', ',': if (not DS) and (not E) and (i <> L) then

begin

DS := true;

Ch := DecimalSeparator;

if j = 0then

begin

Inc(j);

ResStr[j] := '0';

end; //if j = 0 then begin

Inc(j);

ResStr[j] := Ch

end; //'.', ',': if (not DS) and (i <> L) then begin

'e', 'E': if (not E) and (i <> L) then

begin

E := true;

Ch := 'E';

if j = 0then

begin

Inc(j);

ResStr[j] := '0';

end; //if j = 0 then begin

Inc(j);

ResStr[j] := Ch

end//'.', ',': if (not DS) and (i <> L) then begin

end//case Ch of

end; //for i:= 1 to L do begin

if j <> 0then

begin

if ResStr[j] = 'E'then

Dec(j);

if ResStr[j] = DecimalSeparator then

Dec(j);

SetLength(ResStr, j);

Result := ResStr

end//if j <> 0 then begin

end//if L <> 0 then begin

end;

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

 

Edit1.Text = ',...,fgftgtr656,.567erdf..5,,632'

Edit2.Text := StringToNumber(Edit1.Text);

Edit2.Text = 0, 656567E5632

 

©Drkb::00919


 

Code:

type

TCharSet = setof Char;

 

function StripNonConforming(const S: string;

const ValidChars: TCharSet): string;

var

DestI: Integer;

SourceI: Integer;

begin

SetLength(Result, Length(S));

DestI := 0;

for SourceI := 1to Length(S) do

if S[SourceI] in ValidChars then

begin

Inc(DestI);

Result[DestI] := S[SourceI]

end;

SetLength(Result, DestI)

end;

 

function StripNonNumeric(const S: string): string;

begin

Result := StripNonConforming(S, ['0'..'9'])

end;

 

 

https://delphiworld.narod

DelphiWorld 6.0

Вот 2 функции которыми я очень часто пользуюсь - они выделяют из строки подстроку, которая находится до или после ключевого словаю Задача надо сказать частая, например есть строка:

 "Total-2.00$"

 Нижеприведенные функции позволяют выделить из строки логические элементы:

 

Code:

functionGetBefore(substr, str:string):string;

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

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

begin

if pos(substr,str)>0then

result:=copy(str,1,pos(substr,str)-1)

else

result:='';

end;

 

functionGetAfter(substr, str:string):string;

{©Drkb v.3(2007): www.drk b. ru, 

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

begin

if pos(substr,str)>0then

result:=copy(str,pos(substr,str)+length(substr),length(str))

else

result:='';

end;

 

Примеры:

 1) Найти название параметра (оно находится до символа "-"):

 GetBefore('-', 'Total-2.00$') // Результат будет "Total"

 2) Найти сумму денег (оно находится после символа "-"):

 GetAfter('-', 'Total-2.00$') // Результат будет "2.00$"

 3) Найти сумму денег без знака доллара и остатка строки(оно находится после символа "-", но до символа "$"):

 GetBefore('$',GetAfter('-', 'Total-2.00$ (общая сумма)') // Результат будет "2.00"

 

Автор:Vit 

 

StringToWideChar Преобразовывает строку формата ANSI в Unicode-строку.

 

WideCharLenToString Преобразовывает указанное количество символов Unicode-строки в ANSI строку.

 

WideCharLenToStrVar Преобразовывает заданное количество символов Unicode-строки в ANSI формат и копирует результат в указанную переменную.

 

WideCharToString Преобразовывает длинную строку Unicode в ANSI строку.

 

WideCharLenToStrVar Преобразовывает строку формата Unicode в ANSI-формат и копирует результирующую строку в указанную переменную.

 

Взято с https://atrussk.ru/delphi/

Code:

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

>> Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3

 

Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3

соответственно или меньше в зависимости от длины исходной строки.

 

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

Автор: Сергей, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Краснодар

Copyright: VIP BANK

 

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

 

procedure DivPart(aStr: string; var St1, St2, St3: string; Long1, Long2, Long3:

byte);

var

i, pos, Long: byte;

begin

St1 := '';

St2 := '';

St3 := '';

aStr := Trim(aStr);

Long := Length(aStr);

if Long <= Long1 then

begin

St1 := aStr;

Exit

end;

Pos := Long1;

for i := 1to Long1 + 1do

if aStr[i] = ' 'then

Pos := i;

St1 := TrimRight(Copy(aStr, 1, Pos));

Delete(aStr, 1, Pos);

aStr := TrimLeft(aStr);

Long := Length(aStr);

if Long <= Long2 then

begin

St2 := aStr;

Exit

end;

Pos := Long2;

for i := 1to Long2 + 1do

if aStr[i] = ' 'then

Pos := i;

St2 := TrimRight(Copy(aStr, 1, Pos));

St3 := Trim(Copy(aStr, Pos + 1, Long3))

end;

 

©Drkb::00841


 

Code:

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

>> Разбивка строки на подстроки с использованием заданного разделителя

 

Параметры: Str: WideString - Строка для разбивки

Delimiter: String - Разделитель подстрок с строке Str

Результат: TStringList: Список найденных подстрок

 

Зависимости: System, Sysutils, Classes

Автор: Stoma, stoma @ bitex.bg

Copyright: Собственная разработка

 

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

 

function Tokenize(Str: WideString; Delimiter: string): TStringList;

var

tmpStrList: TStringList;

tmpString, tmpVal: WideString;

DelimPos: LongInt;

begin

tmpStrList := TStringList.Create;

TmpString := Str;

DelimPos := 1;

while DelimPos > 0do

begin

DelimPos := LastDelimiter(Delimiter, TmpString);

tmpVal := Copy(TmpString, DelimPos + 1, Length(TmpString));

if tmpVal <> ''then

tmpStrList.Add(UpperCase(tmpVal));

Delete(TmpString, DelimPos, Length(TmpString));

end;

Tokenize := tmpStrList;

end;

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

 

function TForm1.GetDirNames(FullPath: string): TStringList;

begin

GetDirNames := Tokenize(FullPath, '\');

end;

 

 


 

Code:

procedure Explode(var a: arrayofstring; Border, S: string);

var

S2: string;

i: Integer;

begin

i := 0;

S2 := S + Border;

repeat

a[i] := Copy(S2, 0,Pos(Border, S2) - 1);

Delete(S2, 1,Length(a[i] + Border));

Inc(i);

until S2 = '';

end;

 

// How to use it:

// Und hier ein Beispiel zur Verwendung:

 

procedure TForm1.Button1Click(Sender: TObject);

var

S: string;

A: arrayofString;

begin

S := 'Ein Text durch Leerzeichen getrennt';

SetLength(A, 10);

Explode(A, ' ', S);

ShowMessage(A[0] + ' ' + A[1] + ' ' + A[2] + ' ' + A[3] + ' ' + A[4]);

end;