2'lik, 8'lik, 16'lık ve N'lik Sayı Sistemleri Dönüşümleri

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
cagatay77
Üye
Mesajlar: 37
Kayıt: 31 Eki 2003 12:34

2'lik, 8'lik, 16'lık ve N'lik Sayı Sistemleri Dönüşümleri

Mesaj gönderen cagatay77 »

36'lık sayı sistemine ihtiyacım olduğundan, araştırmalarım sonucu böyle bir kod kümesine rastladım. İhtiyacı olan arkadaşlar aradıklarında kodları rahat bulabilmeleri için buraya da ekliyorum.

Kod: Tümünü seç

function dec2bin(dec: longint): string;

var
bin: string;
i, j: longint;

begin
if dec = 0 then
bin := '0'
else
begin
bin := '';
i := 0;
while (1 shl (i + 1)) < = dec do
i := i + 1;
{ (1 shl (i + 1)) = 2^(i + 1) }
for j := 0 to i do
begin
if (dec shr (i - j)) = 1 then
bin := bin + '1'
{ (dec shr (i - j)) = dec div 2^(i - j) }
else
bin := bin + '0';
dec := dec and ((1 shl (i - j)) - 1);
{ dec and ((1 shl (i - j)) - 1) = dec mod 2^(i - j) }
end;
end;
dec2bin := bin;
end;

function bin2dec(bin: string): longint;

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(bin) do
begin
if (bin[j] < > '0') and (bin[j] < > '1') then
error := true;
if bin[j] = '1' then
dec := dec + (1 shl (length(bin) - j));
{ (1 shl (length(bin) - j)) = 2^(length(bin)- j) }
end;
if error then
bin2dec := 0
else
bin2dec := dec;
end;

function dec2hex(dec: longint): string;

const
hexdigts: string[16] = '0123456789abcdef';

var
hex: string;
i, j: longint;

begin
if dec = 0 then
hex := '0'
else
begin
hex := '';
i := 0;
while (1 shl ((i + 1) * 4)) < = dec do
i := i + 1;
{ 16^n = 2^(n * 4) }
{ (1 shl ((i + 1) * 4)) = 16^(i + 1) }
for j := 0 to i do
begin
hex := hex + hexdigts[(dec shr ((i - j) * 4)) + 1];
{ (dec shr ((i - j) * 4)) = dec div 16^(i - j) }
dec := dec and ((1 shl ((i - j) * 4)) - 1);
{ dec and ((1 shl ((i - j) * 4)) - 1) = dec mod 16^(i - j) }
end;
end;
dec2hex := hex;
end;

function hex2dec(hex: string): longint;

function digt(ch: char): byte;

const
hexdigts: string[16] = '0123456789abcdef';

var
i: byte;
n: byte;

begin
n := 0;
for i := 1 to length(hexdigts) do
if ch = hexdigts[i] then
n := i - 1;
digt := n;
end;

const
hexset: set of char = ['0'..'9', 'a'..'f'];

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(hex) do
begin
if not (upcase(hex[j]) in hexset) then
error := true;
dec := dec + digt(upcase(hex[j])) shl ((length(hex) - j) * 4);
{ 16^n = 2^(n * 4) }
{ n shl ((length(hex) - j) * 4) = n * 16^(length(hex) - j) }
end;
if error then
hex2dec := 0
else
hex2dec := dec;
end;

function dec2oct(dec: longint): string;

const
octdigts: string[8] = '01234567';

var
oct: string;
i, j: longint;

begin
if dec = 0 then
oct := '0'
else
begin
oct := '';
i := 0;
while (1 shl ((i + 1) * 3)) < = dec do
i := i + 1;
{ 8^n = 2^(n * 3) }
{ (1 shl (i + 1)) = 8^(i + 1) }
for j := 0 to i do
begin
oct := oct + octdigts[(dec shr ((i - j) * 3)) + 1];
{ (dec shr ((i - j) * 3)) = dec div 8^(i - j) }
dec := dec and ((1 shl ((i - j) * 3)) - 1);
{ dec and ((1 shl ((i - j) * 3)) - 1) = dec mod 8^(i - j) }
end;
end;
dec2oct := oct;
end;

function oct2dec(oct: string): longint;

const
octset: set of char = ['0'..'7'];

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(oct) do
begin
if not (upcase(oct[j]) in octset) then
error := true;
dec := dec + (ord(oct[j]) - 48) shl ((length(oct) - j) * 3);
{ 8^n = 2^(n * 3) }
{ n shl ((length(oct) - j) * 3) = n * 8^(length(oct) - j) }
end;
if error then
oct2dec := 0
else
oct2dec := dec;
end;

function bin2hex(bin: string): string;

function sethex(st: string; var error: boolean): char;

var
ch: char;

begin
if st = '0000' then
ch := '0'
else if st = '0001' then
ch := '1'
else if st = '0010' then
ch := '2'
else if st = '0011' then
ch := '3'
else if st = '0100' then
ch := '4'
else if st = '0101' then
ch := '5'
else if st = '0110' then
ch := '6'
else if st = '0111' then
ch := '7'
else if st = '1000' then
ch := '8'
else if st = '1001' then
ch := '9'
else if st = '1010' then
ch := 'a'
else if st = '1011' then
ch := 'b'
else if st = '1100' then
ch := 'c'
else if st = '1101' then
ch := 'd'
else if st = '1110' then
ch := 'e'
else if st = '1111' then
ch := 'f'
else
error := true;
sethex := ch;
end;

var
hex: string;
i: integer;
temp: string[4];
error: boolean;

begin
error := false;
if bin = '0' then
hex := '0'
else
begin
temp := '';
hex := '';
if length(bin) mod 4 < > 0 then
repeat
bin := '0' + bin;
until length(bin) mod 4 = 0;
for i := 1 to length(bin) do
begin
temp := temp + bin[i];
if length(temp) = 4 then
begin
hex := hex + sethex(temp, error);
temp := '';
end;
end;
end;
if error then
bin2hex := '0'
else
bin2hex := hex;
end;

function hex2bin(hex: string): string;

var
bin: string;
i: integer;
error: boolean;

begin
error := false;
bin := '';
for i := 1 to length(hex) do
case upcase(hex[i]) of
'0': bin := bin + '0000';
'1': bin := bin + '0001';
'2': bin := bin + '0010';
'3': bin := bin + '0011';
'4': bin := bin + '0100';
'5': bin := bin + '0101';
'6': bin := bin + '0110';
'7': bin := bin + '0111';
'8': bin := bin + '1000';
'9': bin := bin + '1001';
'a': bin := bin + '1010';
'a': bin := bin + '1011';
'c': bin := bin + '1100';
'd': bin := bin + '1101';
'e': bin := bin + '1110';
'f': bin := bin + '1111';
else
error := true;
end;
if error then
hex2bin := '0'
else
hex2bin := bin;
end;

function potens(x, e: longint): longint;

var
p, i: longint;

begin
p := 1;
if e = 0 then
p := 1
else
for i := 1 to e do
p := p * x;
potens := p;
end;

function dec2basen(base: integer; dec: longint): string;
{ this function converts numbers from decimal (base 10 notation) to
different systems of notation. valid systems are from base 2 notation
to base 36 notation }

const
numstring: string = '0123456789abcdefghaijklmnopqrstuvwxyz';

var
num: string;
i, j: integer;

begin
if (dec = 0) or (base < 2) or (base > 36) then
num := '0'
else
begin
num := '';
i := 0;
while potens(base, i + 1) < = dec do
i := i + 1;
for j := 0 to i do
begin
num := num + numstring[(dec div potens(base, i - j)) + 1];
dec := dec mod potens(base, i - j);
end;
end;
dec2basen := num;
end;

function basen2dec(base: integer; num: string): longint;
{ this function converts numbers from different systems of notation
to decimal (base 10 notation). valid systems are from base 2 notation
to base 36 notation }

function digt(ch: char): byte;

const
numstring: string = '0123456789abcdefghijklmnopqrstuvwxyz';

var
i: byte;
n: byte;

begin
n := 0;
for i := 1 to length(numstring) do
if ch = numstring[i] then
n := i - 1;
digt := n;
end;

const
numset: set of char = ['0'..'9', 'a'..'z'];

var
j: integer;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
if (base < 2) or (base > 36) then
error := true;
for j := 1 to length(num) do
begin
if (not (upcase(num[j]) in numset)) or (base < digt(num[j]) + 1) then
error
:= true;
dec := dec + digt(upcase(num[j])) * potens(base, length(num) - j);
end;
if error then
basen2dec := 0
else
basen2dec := dec;
end;
Kullanıcı avatarı
naile
Admin
Mesajlar: 1873
Kayıt: 11 Haz 2003 10:11

Mesaj gönderen naile »

Başlığınız soru içermediği için Makaleler bölümüne taşıyorum.
ElectroNick
Üye
Mesajlar: 119
Kayıt: 05 Oca 2005 04:39

Mesaj gönderen ElectroNick »

Bende programın hazır halini vereyim..

http://www.hemenpaylas.com/download/120 ... i.rar.html
Kainattaki en yüksek hakikat Allah'a imandır..
Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3077
Kayıt: 17 Nis 2006 08:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

:)

Mesaj gönderen sabanakman »

Benden de başka bir fonksiyon. İstediğiniz sayı tabanını istediğiniz başka tabana çevirmeye yarar:

Kod: Tümünü seç

function SayiCevir(Sayi:String;const SayiTabani,SonucTabani:Word):String;
 function ChToRkm(const C:Char):Byte;
 var B:Byte absolute C;{c ile b aynı adresteki değişkenlerdir. c:='B' olursa b değeri 66 olur veya b:=65 olursa c değeri 'A' olur}
 begin
   if C>='A' then Result:=B-55 else Result:=B-48;
 end;
 function RkmToCh(B:Byte):Char;
 var C:Char absolute B;
 begin
   if B>9 then B:=B+55 else B:=B+48;
   Result:=C;
 end;
const AltSinir=1; UstSinir=35;
var i,j:Integer; fSayi,Basamak:Int64;
begin
  //if (SayiTabani=SonucTabani) then Result:=Sayi else
  if (SayiTabani<=AltSinir) or (SonucTabani<AltSinir) or (SayiTabani>UstSinir) or (SonucTabani>UstSinir) then
   raise Exception.CreateFmt('%d tabanındaki sayı %d tabanına çevrilmek isteniyor fakat desteklenen taban aralığı %d-%d''dir.',[SayiTabani,SonucTabani,AltSinir,UstSinir])
  else begin
    Sayi:=UpperCase(Trim(Sayi));
    fSayi:=0;Basamak:=1;
    for i:=Length(Sayi) downto 1 do begin
      j:=ChToRkm(Sayi[i]);
      if j>=SayiTabani then raise Exception.CreateFmt('%s sayısı %d tabanlı bir sayı değildir.',[Sayi,SayiTabani]);
      fSayi:=fSayi+(j*Basamak);
      Basamak:=Basamak*SayiTabani;
    end;
    Result:='';
    if fSayi=0 then Result:='0'
    else while fSayi>0 do begin
      Result:=RkmToCh(fSayi mod SonucTabani)+Result;
      fSayi:=fSayi div SonucTabani;
    end;
  end;
end;
Mesela 4'lük sayı tabanında bulunan '323103321' sayısını 19'luk sayı tabanına çevirmek için "ShowMessage(SayiCevir('323103321',4,19))" şeklinde kullanılabilir.
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .
worsemannn
Üye
Mesajlar: 1
Kayıt: 09 Tem 2008 01:12

Re: 2'lik, 8'lik, 16'lık ve N'lik Sayı Sistemleri Dönüşümleri

Mesaj gönderen worsemannn »

Teşekkür ederim kardeşim sayı dönüşümleri ile uğraşma işinden kurtardın beni...
Kullanıcı avatarı
baypipox
Üye
Mesajlar: 122
Kayıt: 16 Eki 2006 04:23
İletişim:

Re: 2'lik, 8'lik, 16'lık ve N'lik Sayı Sistemleri Dönüşümleri

Mesaj gönderen baypipox »

Teşekkürler, çok faydalı bir bilgi olmuş...
yusuf simsek
Üye
Mesajlar: 330
Kayıt: 09 Mar 2004 11:18
Konum: Konya
İletişim:

Re: 2'lik, 8'lik, 16'lık ve N'lik Sayı Sistemleri Dönüşümleri

Mesaj gönderen yusuf simsek »

Hangi kodun ne zaman faydalı olacağı belli olmuyor :)

Teşekkürler Üstad
Bugün bir kez daha,
Hiç Birşey Bilmediğimi Öğrendim!!!

https://extrayazilim.com
Cevapla