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.

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.

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.

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.