Code:

function ToString(Value: Variant): String;

begin

case TVarData(Value).VType of

varSmallInt,

varInteger : Result := IntToStr(Value);

varSingle,

varDouble,

varCurrency : Result := FloatToStr(Value);

varDate : Result := FormatDateTime('dd/mm/yyyy', Value);

varBoolean : if Value then Result := 'T'else Result := 'F';

varString : Result := Value;

else Result := '';

end;

end;

Code:

ShowMessage(ToString(10.87));

ShowMessage(ToString(10));

Code:

var

V1 : Double;

V2 : Integer;

V3 : TDateTime;

V4 : Boolean;

begin

...

ShowMessage(ToString(V1)); // Double a String

ShowMessage(ToString(V2)); // Integer a String

ShowMessage(ToString(V3)); // DateTime a String

ShowMessage(ToString(V4)); // Boolean a String

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

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;

Code:

type

TEmployee = record

cNo: array [0..3] of Char;

cName: array [0..7] of Char;

end;

PEmployee = ^TEmployee;

procedure ParseData;

const

sData = '0001Mosquito';

var

sNo, sName: string;

begin

with PEmployee(Pointer((@sData)^))^ do

begin

sNo := cNo; // sNo = '0001'

sName := cName; // sName = 'Mosquito'

end

end;

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;