forum.boolean.name - Полезные процедуры и функции к MP (СЮДА КИДАЕМ)

forum.boolean.name (http://forum.boolean.name/index.php)

- Основной форум (http://forum.boolean.name/forumdisplay.php?f=49)

Полезные процедуры и функции к MP (СЮДА КИДАЕМ)

Привет всем. Я первый раз на єтом форуме, но не первый раз занимаюсь с МП.
*За*время*изучения*и*писания*на*этом*языке*написал *очень*много*чего...*Постараюсь*поделится*своими*н аработками.*Вы*тоже*в*свою*очередь*не*скупитесь...

текст в хекс (для урл запросов и конвертирования в юникод)

function celoe(ch,n:integer):integer;
Var i:integer;
Begin
while ch>=n do ch:=ch-n;
celoe:=ch
end;

function integertohex(ii:integer):string;
const
Val = 16;
var
HexValue : string;
Remainder : Integer;
begin
HexValue := '';
while ii > 0 do
begin
Remainder := celoe(ii,val);
// showmessage(inttostr( Remainder));
If Remainder = 10 then HexValue := 'A' + HexValue else
If Remainder = 11 then HexValue := 'B' + HexValue else
If Remainder = 12 then HexValue := 'B' + HexValue else
If Remainder = 13 then HexValue := 'D' + HexValue else
If Remainder = 14 then HexValue := 'E' + HexValue else
If Remainder = 15 then HexValue := 'F' + HexValue
else
HexValue := IntegerToString( Remainder ) + HexValue;

ii := Trunc(ii/val);
end;
while length(HexValue)< Trunc(Val/4) do HexValue:='0'+HexValue;
integertohex:=HexValue;
end;

function text2hex(s:string):string;
Var i:integer;
res:string;
Begin
for i:=1 to length(s) do res:=res+integertohex(ord(getchar(s,i-1)));
text2hex:=res;
End;

Перевести кирилицу в транслит

При загрузке апликейшина

Код:

ar1[1]:='a';ar1[2]:='b';ar1[3]:='v';ar1[4]:='g';ar1[5]:='d';ar1[6]:='e';ar1[7]:='yo';ar1[8]:='zh';ar1[9]:='z';ar1[10]:='i';ar1[11]:='y';ar1[12]:='k';ar1[13]:='l';ar1[14]:='m';ar1[15]:='n';ar1[16]:='o';ar1[17]:='p';ar1[18]:='r';ar1[19]:='s';ar1[20]:='t';ar1[21]:='u';ar1[22]:='f';ar1[23]:='kh';ar1[24]:='ts';ar1[25]:='ch';ar1[26]:='sh';ar1[27]:='shch';ar1[28]:='`';ar1[29]:='y';ar1[30]:='`';ar1[31]:='e';ar1[32]:='yu';ar1[33]:='ya';

ar2[1]:='A';ar2[2]:='B';ar2[3]:='V';ar2[4]:='G';ar2[5]:='D';ar2[6]:='E';ar2[7]:='Yo';ar2[8]:='Zh';ar2[9]:='Z';ar2[10]:='I';ar2[11]:='Y';ar2[12]:='K';ar2[13]:='L';ar2[14]:='M';ar2[15]:='N';ar2[16]:='O';ar2[17]:='P';ar2[18]:='R';ar2[19]:='S';ar2[20]:='T';ar2[21]:='U';ar2[22]:='F';ar2[23]:='Kh';ar2[24]:='Ts';ar2[25]:='Ch';ar2[26]:='Sh';ar2[27]:='Shch';ar2[28]:='`';ar2[29]:='Y';ar2[30]:='`';ar2[31]:='E';ar2[32]:='Yu';ar2[33]:='Ya';

не знаю как в этом языке присвоить значение в масиве...

function rus2lat(Str: string): string;
const
RArrayL = 'абвгдеёжзийклмнопрстуфхцчшщьыъэюя';
RArrayU = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ';
colChar = 33;
var
i,i2: Integer;
LenS: Integer;
result,ch:string;
ok:boolean;
Begin
result := '';
LenS := length(str);
ok:=false;
for i := 0 to lenS-1 do
begin
ch:=getChar(str,i);
// showmessage(ch,1000);
for i2:= 1 to colChar do
begin

if (ch=getChar(RArrayL,i2))and(not ok) then begin ok:=true; result:=result+ar1[i2+1];end;
if (ch=getChar(RArrayU,i2))and(not ok) then begin ok:=true; result:=result+ar2[i2+1];end

end;
if (not ok) then result:=result+ch;
ok:=false;

end;
rus2lat:= result;

end;

Re: Полезные процедуры и функции к MP (СЮДА КИДАЕМ)

еще много чего етсть но это будет позже и вылаживать я буду их в полном виде...