Pascal

Bonjour Komane,

Je suis désolé de te répondre comme ça, mais pour ainsi dire personne ne te répondra car ici sur ccm les bénévoles ne sont pas la pour faire ton travail, mais plutôt pour pouvoir t'aider dans le cas où tu serais vraiment bloqué... Essaye de travailler un peu en fesant marcher ta cervelle, et si tu n'y arrives pas la tu pourras poser ta question...

Excuse-moi si tu as mal pris ce que je viens de te dire mais une autre personne aurait pu te le dire ou te laisser dans l'ignorance.

bonne journée

Cordialement

Titfofol

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.