Programme pascal de conversion entre bases

[Fermé]
Signaler
Messages postés
1
Date d'inscription
vendredi 21 mars 2008
Statut
Membre
Dernière intervention
21 mars 2008
-
 Khouloud Yàkoubi -
Bonjour,
J'ai fortement besoin d'un programme pascal qui permet de convertir d'une base à une autre
mercie;;
;)
A voir également:

11 réponses

conversion de base 2 a base 8 et 16
program test;
uses wincrt;
const
ch1='01';
type
ch=string[46];
chv=string[4];
ch2=string[1];
bits=3..4;
var
n,ph:string;
b:byte;
bit:bits;
k:integer;
v:chv;
procedure saisie_base(var B : byte);
begin
repeat
write('donner une base dans [8,16] : ');
readln(B);
until B in [8,16];
end;

function recherche(n:string):boolean;
var
i:integer;
begin
i:=0;
repeat
i:=i+1;
until (pos(upcase(n[i]),ch1)=0) or (i > length(n));
if i > length(n) then recherche:=true
else recherche:=false;
end;
procedure saisie_ch(var n : string);
begin
repeat
write('donner un nombre dans la base :');
readln(n);
until Recherche(n);
end;

function puissance (b,r:integer):integer;

begin
if r=0
then puissance:=1
else
puissance:=puissance(b,r-1)*b;
end;


function convert (v:chv):ch2;
var
s,e,x,i:integer;
u:string;
begin
s:=0;
for i:=1 to length (v) do
begin
val(v[i],x,e);
s:=s+x*puissance(2,length(v)-i);
end;
if s in[0..9] then str(s,u)
else u:=chr(ord('a')+s-10);
convert:=u;
end;



{function converssion (n:string;b:byte):string;
begin
if b=8 then bit:=3
else bit:=4;
while length(n) mod bit <>0 do
n:=concat('0',n);
k:=length(n);
ph:='';
repeat
v:=copy(n,k-bit+1,bit);
ph:=concat(convert(v),ph);
k:=k-bit;
until k=0;
converssion:=ph;
end;}

function converssion (n:string;b:byte):string;
begin
if b=8 then bit:=3
else bit:=4;
while length(n) mod bit <>0 do
n:=concat('0',n);
k:=0;
ph:='';
repeat
v:=copy(n,k+1,bit);
ph:=concat(ph,convert(v));
k:=k+bit;
until k=length(n);
converssion:=ph;
end;

begin
Saisie_ch(n);
saisie_base(b);
write(converssion(n,b));
end.


***********************************************************


conversion de base 8 et 16 a base 2

program test;
uses wincrt;
type
ch=string[46];
ch0=string[4];
var
n,v:string;
b:byte;
ph:string;

u:string;
r:integer;
procedure saisie_base(var B : byte);
begin
repeat
write('donner une base dans [2..36] : ');
readln(B);
until B in [2..36];
end;
procedure base(var ch1:ch;B:byte);
var
k:integer;
x:string[1];
begin
if b <= 10 then
begin
ch1:='';
for k:=0 to b-1 do begin str(k,x);ch1:=concat(ch1,x); end;
end
else
begin
ch1:='0123456789';
for k:= 10 to b-1 do ch1:=concat(ch1,chr(ord('A')+k-10));
end;
end;
function recherche(n:string;ch1:ch):boolean;
var
i:integer;
begin
i:=0;
repeat
i:=i+1;
until (pos(upcase(n[i]),ch1)=0) or (i > length(n));
if i > length(n) then recherche:=true
else recherche:=false;
end;
procedure saisie_ch(var n : string);
var
ch1:ch;
begin
Base(ch1,B);
repeat
write('donner un nombre dans la base :');
readln(n);
until Recherche(n,ch1);
end;

function convert(c:char;b:byte):ch0;
var j,x,e,r:integer;
v:string[1];
begin
if c in ['0'..'9'] then val(c,x,e)
else x:=ord(upcase(c))-ord('A')+10;

if b=8 then begin
u:='000';
j:=3;
end
else
begin
u:='0000';
j:=4;
end;
repeat
r:=x mod 2;
str(r,v);
u[j]:=v[1];
j:=j-1;
x:=x div 2;
until x=0;
convert:=u;
end;

function conversion (n:string):string;

var i:integer;
begin
ph:='';
for i:=1 to length(n) do
ph:=concat(ph,convert(n[i],b));
conversion:=ph;
end;



begin
saisie_base(b);
Saisie_ch(n);
write(conversion(n));
end.


****************************************************************

conversion de base 10 a l'autres bases

program base10_base;
uses wincrt;
var
n:integer;
b:byte;

procedure saisie_base(var b : byte);
begin
repeat
write('donner une base dans [2..36] : '); readln(b);
until b in [2..36];
end;

procedure saisie_n(var n : integer;x:integer);
begin
repeat
write('donner un entier dans > ',x,' : '); readln(n);
until n > x;
end;

Procedure affichage(x:byte);
begin

if x in [0..9] then write(x)
else write(chr(ord('A')+ x - 10));
end;

procedure remplir (n:integer;b:byte);
begin
if n<>0 then
begin
remplir(n div b,b);
affichage(n mod b);
end;
end;

begin
saisie_n(n,0);
saisie_base(b);
remplir(n,b);
end.





*******************************************************

conversio autres bases a la base 10

program base_base10;
uses wincrt;
type
ch=string[46];
var n:string;
b:byte;
p,s:integer;
procedure saisie_base(var b : byte);
begin
repeat
write('donner une base dans [2..36] : '); readln(b);
until b in [2..36];
end;

procedure base (var ch1:ch;b:byte);
var k:integer;
x:string[1];
begin
if b<=10 then
begin
ch1:='';
for k:=0 to b-1 do
begin str(k,x); ch1:=concat(ch1,x);end;
end
else
begin
ch1:='0123456789';
for k:=10 to b-1 do
ch1:=concat(ch1,chr(ord('A')+k-10));
end;
writeln(ch1);
end;

function recherche (n:string;ch1:ch):boolean;
var
i:integer;
begin
i:=0;
repeat
i:=i+1;
until (pos(upcase(n[i]),ch1)=0) or(i>length(n));
if i>length(n) then recherche:=true
else recherche:=false;
end;


procedure saisie_ch(var n:string);
var ch1:ch;
begin
base (ch1,b);
repeat
write('donner un nombre dans la base: ');
readln(n);
until recherche (n,ch1);
end;

function puis (b,r:integer):integer;
var i:integer;
begin
p:=1;
for i:= 1 to r do
p:=p*b;
puis:=p;
end;

function conver(b:byte; n:string):integer;
var
i,e:integer;
y:integer;
x:string[1];
begin
s:=0;
for i:=1 to length(n) do
begin
if n[i] in ['0'..'9'] then val(n[i],y,e)
else y:= (ord(upcase(n[i]))-ord('A') + 10);

s:=s+y*puis(b,length(n)-i);
end;
conver:=s;
end;
begin
saisie_base(b);
saisie_ch(n);
writeln(conver(b,n));
end.
29
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 42674 internautes nous ont dit merci ce mois-ci


program ex;
uses wincrt;



var
n,b1,b2:integer;
ch:string;




function puis(x,n:integer):integer;
var
p,i:integer;
begin
p:=1;
for i:=1 to n do
p:=p*x;

puis:=p;
end;


function conv_b_10(ch:string; b1:integer):integer;
var
x,e,s,i:integer;

begin
s:=0;

for i:=1 to length(ch) do
begin
if ch[i] in['0'..'9'] then val(ch[i],x,e)
else x:= ord(ch[i])-55;

s:=s+(x*(puis(b1,length(ch)-i)));
end;

conv_b_10:=s;
end;



function conv_10_b(n,b2:integer):string;
var
ch,c:string;
x:integer;
begin

ch:='';
repeat
x:=n mod b2;

if x>=10 then c:=chr(x+55)
else str(x,c);
ch:=c+ch;
n:=n div b2;
until n=0;

conv_10_b:=ch;
end;




begin
writeln('donner base b1 et b2 et un nombre');
readln(b1);
readln(b2);
readln(ch);
n:=conv_b_10(ch,b1);
ch:=conv_10_b(n,b2);
writeln(ch);
end.























Conversion min base 16 au base 2

program ex;
uses wincrt;


var
ch:string;


function bin(c:string):string;
var
ch,ch1:string;
n,x,e,i:integer;

begin

ch:='0000';

if c[1] in['0'..'9'] then val(c[1],n,e)
else n:= ord(c[1])-55;


i:=4;
repeat
x:= n mod 2;
str(x,ch1);
ch[i]:=ch1[1];
i:=i-1;
n:= n div 2;
until n=0;

bin:=ch;
end;


{*************************************}

function conv_bin(ch:string):string;
var
ch1:string;
i:integer;
begin

ch1:='';
for i:=1 to length(ch) do
ch1:=ch1+bin(ch[i]);

conv_bin:=ch1;
end;

{************************}

begin
writeln('donner un nombre en base 16');
readln(ch);
writeln(conv_bin(ch));
end.
ma belle j'etais bac info l'année derniere et j'aime connetre une fille comme toi bac info pardon car j'ecris mon message hors du sujet mais prend mon message comme tous les msgs et mon email est chez vous
nizou stp je veux un programme pascal ki converti d'une base quelconque a une autre base merciiiiiiiiiiiiiiiiiiii

slt stp je veux un programme pascal qui converti une base quelconque a une base quelconque et merci de ta part :)
program bases;
uses wincrt;

var
n,b1,b2:longint;
ch:string;
f:text;

function puis(x,n:longint):integer;
var
p,i:integer;
begin
p:=1;
for i:=1 to n do
p:=p*x;
puis:=p;
end;

function conv_b_10(ch:string; b1:integer):integer;
var
x,e,s,i:integer;
begin
s:=0;
for i:=1 to length(ch) do
begin
if ch[i] in['0'..'9'] then val(ch[i],x,e)
else x:= ord(ch[i])-55;
s:=s+(x*(puis(b1,length(ch)-i)));
end;
conv_b_10:=s;
end;

function conv_10_b(n,b2:integer):string;
var
ch,c:string;
x:integer;
begin
ch:='';
repeat
x:=n mod b2;
if x>=10 then c:=chr(x+55)
else str(x,c);
ch:=c+ch;
n:=n div b2;
until n=0;
conv_10_b:=ch;
end;

procedure remplir (var f:text);
var
i:integer;
begin
append(f);
writeln(f,'le nombre ',n,' en base ',b1,' convertir en base ',b2,' est :',ch);
close(f);
end;

procedure affiche (var f:text);
begin
reset(f);
while not eof(f) do
begin
readln(f,ch);
writeln(ch);
end;
end;

begin
writeln ('donner base b1');
readln(b1);
writeln ('donner base b2');
readln(b2);
writeln ('donner le nombre');
readln(ch);
n:=conv_b_10(ch,b1);
ch:=conv_10_b(n,b2);
writeln(ch);
assign (f,'c:\aziz222.txt');
reset (f);
readln;
remplir(f);
clrscr;
affiche (f);
close(f);
end.
Bonjour,

En ce moment, beaucoup de monde aimerait avoir ce programme. Vous êtes tous de la même école ou quoi?
Seulement, il n'y en a pas un qui propose une esquisse de raisonnement. Si vous vous contentez de pomper bêtement la solution sans rien piger, à quoi ça sert? Les profs ne sont pas dupes et verront bien que c'est du copiage.

Je ne suis pas pro, j'y suis arrivé, pourquoi pas toi?
Alors , si tu veux ton prog, propose un début de soluce, et on t'aidera.

Salut.
merci
mais j'ai fait mon propre prog ;
tout simplement j'ai besoin de l'amiliorer ;
en tout cas merci de vos conseille ;
a bien tot;
;)
Messages postés
9
Date d'inscription
lundi 16 mars 2009
Statut
Membre
Dernière intervention
16 avril 2009
2
voila un analyse d'une fonction qui convertir un nbre de base 10 vers n'importe quelle base



DEF FN conv(n,b:entier):chaine
resultat=conv
conv=[ch<=" "]repeter
r<=n mod b
si r>=10 alors
c<=chr(r+55)
sinon
c<=chr(r+48)
finsi
ch<=c+ch
n<=n div b
jusqu'a n=0
fin conv
Messages postés
5
Date d'inscription
dimanche 26 mai 2013
Statut
Membre
Dernière intervention
26 mai 2013

il faut affecter le résultat au nom de la fonction
conv <-- ch
Messages postés
9
Date d'inscription
lundi 16 mars 2009
Statut
Membre
Dernière intervention
16 avril 2009
2
DEF PROC saisie(var b:entier,var n:chaine)
resultat=b,n
b=repeter
b=donnee("base de depart")
jusqu'a b dans [2..9,11..16]
n=[]repeter
n=donnee("introduire votre nombre")
v<=FN verif(b,n)
{cette fonction permet de verifier si le nbre est compatible avec la base de depart,lire cette FN apres la proc saisie}
jusqu'a v
fin saisie

DF FN verif(b:entier,n:chaine):booleen
resultat=verif
verif=R
R=[i<=0 R<=vrai]repeter
i<=i+1
si ch[i] dans ["A".."F"] alors
c<=ord(n[i])-55
sinonsi n[i] dans ["0".."9"] alors
c<=ord(n[i])-48
sinon
c<=b
si c>=b alors R<=faux
finsi
jusqu'a i=long(ch) ou non(R)
fin
Messages postés
5
Date d'inscription
dimanche 26 mai 2013
Statut
Membre
Dernière intervention
26 mai 2013

dans la fonction verif, la chaine utilisée est n mais pas ch
program ex;
uses wincrt;
var
ch2,ch8,ch16:string;
b:boolean;
rep:integer;





Function verif16(ch16:string):boolean;
var
i:integer;

begin
i:=1;
repeat
b:= ch16[i] in ['0'..'9','A'..'F'];
i:= i+1;
until (b=false) OR (i> length(ch2));
verif16:=b;

end;


{**************************** FN VErIF ****************************}

Function verif(ch2:string):boolean;
var
i:integer;


begin

i:=1;
repeat
b:= ch2[i] in ['0','1'];
i:= i+1;
until (b=false) OR (i> length(ch2));
verif:=b;

end;


{**************************** FN VErIF ch8 ****************************}

Function verif8(ch8:string):boolean;
var
i:integer;

begin

i:=1;
repeat
b:= ch8[i] in ['0'..'7'];
i:= i+1;
until (b=false) OR (i> length(ch8));
verif8:=b;

end;


{**************************** FN VErIF 16 ****************************

Function verif16(ch16:string):boolean;
var
i:integer;
code:string;

begin
code:='0123456789ABCDEF';
i:=1;
repeat
if pos(ch16,code)=0 then
b:=false
else
i:=i+1;
until (b=false) OR (i> length(ch16));
verif16:=b;

end; }

{///////////////////////////// B2 ==============> B8 ////////////////////////////////////////}
Function B2b8 (ch2:string):string;
var
s,d1,d2,d3:integer;
e1,e2,e3:integer;
c:string;

begin


ch8:='';
while length(ch2) mod 3 <>0 do
begin
ch2:= '0'+ ch2;
end;

repeat
val (ch2[1],d1,e1);
val (ch2[2],d2,e2);
val (ch2[3],d3,e3);

s:= d1*4+d2*2+d3*1;
str(s,c);
ch8:=ch8+c;
delete(ch2,1,3);
until ch2='';
b2b8:=ch8;

end;



{///////////////////////////// B2 ====================> B16 ////////////////////////////////////////}
Function B2b16 (ch2:string):string;
var
s,d1,d2,d3,d4:integer;
e1,e2,e3,e4:integer;
c:string;

begin


ch16:='';
while length(ch2) mod 4 <>0 do
begin
ch2:= '0'+ ch2;
end;

repeat
val (ch2[1],d1,e1);
val (ch2[2],d2,e2);
val (ch2[3],d3,e3);
val (ch2[4],d4,e4);
s:= d1*8+d2*4+d3*2+d4*1;
str(s,c);
ch16:=ch16+c;
delete(ch2,1,4);
until ch2='';
b2b16:=ch16;
end;


{********************************* Un_Chiffre8 ****************************************}
Function un_chiffre8 (x:char):string;
var
r,d,e,i:integer;
ch,c:string;
begin
ch:='';
val(x,d,e);
for i:=1 to 3 do
begin
r:=d mod 2;
str(r,c);
ch:=c+ch;
d:= d div 2;
end;
un_chiffre8:=ch;
end;


{ ///////////////////////////////// B8 ==============> B2 ////////////////////////////////}


Function b8b2 (ch8:string):string;
var
i:integer;
begin
ch2:='';
for i:=1 to length(ch8) do
begin
ch2:= ch2+ un_chiffre8(ch8[i]);
end;
b8b2:=ch2;
end;


{********************************* Un_Chiffre16 ****************************************}
Function unchiffre16 (x:char):string;
var
r,d,e,i:integer;
ch,c:string;
begin
ch:='';
if x in ['0'..'9'] then
val(x,d,e)
else
d:= ord(x)-55;
for i:=1 to 4 do
begin
r:=d mod 2;
str(r,c);
ch:=c+ch;
d:= d div 2;
end;
unchiffre16:=ch;
end;

{ ///////////////////////////////// B16 ==============> B2 ////////////////////////////////}


Function b16b2 (ch16:string):string;
var
i:integer;
begin
ch2:='';
for i:=1 to length(ch16) do
begin
ch2:= ch2+unchiffre16(ch16[i]);
end;
b16b2:=ch2;
end;





{-------------- MENU ------------------ }

Procedure menu ;
begin
clrscr;
clrscr;
gotoxy(40,2); Write(' Menu Principale ');
gotoxy(40,3); Write(' --------------- ');
gotoxy(5,8); Write('(1) Conversion de la base 2 a la base 8-----: ');
gotoxy(5,10); Write('(2) Conversion de la base 2 a la base 16---: ');
gotoxy(5,12); Write('(3) Conversion de la base 8 a la base 2----: ');
gotoxy(5,14); Write('(4) Conversion de la base 16 a la base 2---: ');
gotoxy(5,16); Write('(5) Quitter -------------------------------: ');
gotoxy(42,19); Write('Entrer Votre Choix: ');
end;





{ *********************** PROGRAMME PRINCIPALE **********************}

begin
repeat
menu;
repeat
gotoxy(61,19); readln(rep);
until rep in [1..5];

case rep of

1: begin
clrscr;
repeat
write(' Entrer un Nombre Binaire:');
readln(ch2);
until verif(ch2);

writeln('(',ch2,')2 = (',B2b8(ch2),')8');
readln;
end;

2: begin
clrscr;
repeat
write(' Entrer un Nombre Binaire:');
readln(ch2);
until verif(ch2);

writeln('(',ch2,')2 = (',B2b16(ch2),')16');
readln;
end;

3: begin
clrscr;
repeat
write(' Entrer un Nombre Octale:');
readln(ch8);
until verif8(ch8);

writeln('(',ch8,')8 = (',B8b2(ch8),')2');
readln;
end;



4: begin
clrscr;
repeat
write(' Entrer un Nombre Hexadecimale:');
readln(ch16);
until verif16(ch16);

writeln('(',ch16,')16 = (',B16b2(ch16),')2');
readln;
end;
5: donewincrt;

end;

until rep=5


end.
merci bqqqqqqqqqqqqqqq <3

de rien :))
Messages postés
5
Date d'inscription
dimanche 26 mai 2013
Statut
Membre
Dernière intervention
26 mai 2013

lors de la vérification si la valeur est à la base b (2 ou 8 ou 16) vous avez utilisez une variable booléen b sans l'avoir déclaré
Messages postés
5
Date d'inscription
dimanche 26 mai 2013
Statut
Membre
Dernière intervention
26 mai 2013

dans la fonction b2b8 vous avez utilisez une chaine ch8 alors que dans la déclaration vous n'avez déclarez que une chaine c, il faut ajouter la déclaration de ch8
Messages postés
5
Date d'inscription
dimanche 26 mai 2013
Statut
Membre
Dernière intervention
26 mai 2013

convertir de la base 2 a la base 16 nécessite le traitement des cas ou on peut avoir comme résultat A, B, C, D, E et F

merci khouya demain 3andi devoir algo w hani 5dhit ton programme lol merci (f)
Messages postés
9
Date d'inscription
lundi 16 mars 2009
Statut
Membre
Dernière intervention
16 avril 2009
2
autre methode:


R=[i<=0]repeter
i<=i+1
R<=N[i] dans ["0".."9","A".."F"]
si R alors
p<=FN equivalent(N[i]) dans [0..b-1]
fin si
jusqu'a (non(R)) ou (i=long(ch))

_________________________________________________
DEF FN equivalent(c:caractere):entier
resultat=Equivalent
Equivalent<=E
E=[]selon c faire
"0".."9":E<=ord(c)-48
"A".."F":E<=ord(c)-55
fin Equivalent


j'aime que tt ça vous aide
Messages postés
9
Date d'inscription
lundi 16 mars 2009
Statut
Membre
Dernière intervention
16 avril 2009
2
entrainez vous sur l'analyse il est tres important & interresant,si vous voulez la convertion contraire ECrire........
Messages postés
3
Date d'inscription
jeudi 17 avril 2008
Statut
Membre
Dernière intervention
14 mai 2012

mochnormal tbakallah 3likom matrix w mimooo
Messages postés
9
Date d'inscription
lundi 16 mars 2009
Statut
Membre
Dernière intervention
16 avril 2009
2
b9odrat rabi tislkilna bac_info