programme pascal de conversion entre bases Fermé

Question

Bonjour,
J'ai fortement besoin d'un programme pascal qui permet de convertir d'une base à une autre 
mercie;;
;)

mimou10 · Accepted Answer

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.

amigo · Answer

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.

slouma bac info · Answer

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.

Original Weld Bled ( 3 éme info ) · Answer

merci khouya demain 3andi devoir algo w hani 5dhit ton programme lol merci (f)

matrix_tn · Answer

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.

Mehdi_info1 · Answer

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

Mehdi_info1 · Answer

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

Mehdi_info1 · Answer

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

Mehdi_info1 · Answer

entrainez vous sur l'analyse il est tres important & interresant,si vous voulez la convertion contraire ECrire........

seifca12 · Answer

mochnormal tbakallah 3likom matrix  w mimooo

jin_bac_info · Answer

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.

Programme pascal de conversion entre bases

11 réponses

Discussions similaires