Code:

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

>> Преобразование набора чисел, предопределённых символом "#" в строку

 

Функция преобразует набор чисел, предопределённых символом "#" в

соответствующую строку. Каждое число в наборе чисел должно представлять из

себя код символа по ASCII таблице.

Например, если AsciiString '#72#101#108#108#111', то Result = 'Hello';

 

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

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

Copyright: VID

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

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

 

function ASCIIToStr(AsciiString: string): string;

var

I, X, L, Lastpos: Integer;

CurDIGChar, CurrAddChar, RS: string;

begin

RESULT := '';

L := Length(AsciiString);

if L = 0then

Exit;

X := 0;

LASTPOS := 1;

repeat

I := X;

CurDIGChar := '';

repeat

I := I + 1;

if AsciiString[I] <> '#'then

CurDIGChar := CurDIGChar + AsciiString[I];

until (AsciiString[I] = '#') or (i = l);

X := I;

if CurDIGChar <> ''then

begin

try

CurrAddChar := CHR(STRTOINT(CurDIGChar));

except CurrAddChar := '';

end;

Insert(CurrAddChar, RS, lastpos);

LastPos := LastPos + Length(CurrAddChar);

end;

until (X >= L) or (I >= L);

Result := RS;

end;

 

Code:

function BCDToNumString(const inStr: string): string;

procedure UnPack(ch: Char; var ch1, ch2: Char);

begin

ch1 := Chr((Ord(ch) and$F) + $30);

ch2 := Chr(((Ord(ch) shr4) and$F) + $30);

Assert((ch1 >= '0') and (ch1 <= '9'));

Assert((ch2 >= '0') and (ch2 <= '9'));

end;

var

i: Integer;

begin

SetLength(Result, Length(inStr) * 2);

for i := 1to Length(inStr) do

UnPack(inStr[i], Result[2 * i - 1], Result[2 * i]);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

S1, S2: string;

begin

S1 := '15151515151515151515';

S2 := NumStringToBCD(S1);

memo1.lines.add('S1: ' + S1);

memo1.lines.add('Length(S2): ' + IntToStr(Length(S2)));

memo1.lines.add('S2 unpacked again: ' + BCDToNumString(S2));

end;

 

 

 

Взято с сайтаhttps://www.swissdelphicenter.ch/en/tipsindex

 

 

Code:

function BinToInt(Value: string): Integer;

var

i, iValueSize: Integer;

begin

Result := 0;

iValueSize := Length(Value);

for i := iValueSize downto1do

if Value[i] = '1'then Result := Result + (1shl (iValueSize - i));

end;

 

Взято с сайта: https://www.swissdelphicenter

 

 


 

Code:

{by Andre Fritzsche}

 

unit BinConvert;

 

interface

 

//Wandelt Bytewert (Value) zu Binarwert und trennt mit Splitter Hi- und Lo-Bits

function ToBin(Value: Byte; Splitter: Char): string; overload;

 

//Wandelt Wordwert (Value) zu Binarwert und trennt mit Splitter Hi- und Lo-Byte

function ToBin(Value: Word; Splitter: Char): string; overload;

 

//Wandelt Binarwert (String) zu Zahl (Cardinal)

function BinTo(Value: string): Cardinal;

 

implementation

{------------------------------------------------------------------------------}

 

function ToBin(Value: Byte; Splitter: Char): string;

var

val, bit, intX: Byte;

begin

val := Value;

for intX := 0to7do

begin//Alle 8 Bits durchlaufen

bit := 48; //48 (='0') zu bit

val := val shr1; //Value um 1 Bit nach rechts verschieben

asm

adc bit,0//CarryFlag zu bit addieren

end;

if intX = 4then Result := Splitter + Result;

Result := Chr(bit) + Result; //zu Result hinzufugen

end;

end;

{------------------------------------------------------------------------------}

 

function ToBin(Value: Word; Splitter: Char): string;

begin

Result := ToBin(Byte(Hi(Value)), Splitter) + Splitter + ToBin(Byte(Lo(Value)), Splitter);

end;

{------------------------------------------------------------------------------}

 

function BinTo(Value: string): Cardinal;

var

intX, PosCnt: Byte;

begin

Result := 0;

PosCnt := 0;

for intX := Length(Value) - 1downto0do//zeichen von rechts durchlaufen

case Value[intX + 1] of//prufen, ob 0 oder 1

'0': Inc(PosCnt); //bei 0 nur Pos-Zahler erhohen

'1':

begin//bei 1 Bit an Position einfugen

Result := Result or (1shl PosCnt);

Inc(PosCnt); //und Zahler erhohen

end;

end;

end;

{------------------------------------------------------------------------------}

 

end.

 

 

Взято с сайта: https://www.swissdelphicenter

Code:

function BinStrToByte(a_sBinStr: string): byte;

var

i: integer;

begin

Result := 0;

for i := 1to length(a_sBinStr) do

Result := (Result shl1) or byte(a_sBinStr[i] = '1');

end;

 

 

https://delphiworld.narod

DelphiWorld 6.0

 

 

Code:

function ByteToBinStr(a_bByte: byte): string;

var

i: integer;

begin

SetLength(Result, 8);

for i := 8downto1do

begin

Result[i] := chr($30 + (a_bByte and1));

a_bByte := a_bByte shr1;

end;

end;

 

 

https://delphiworld.narod

DelphiWorld 6.0