Forum programmation
 
AccueilPortailFAQRechercherS'enregistrerMembresGroupesConnexion

Partagez | 
 

 Manipulation des chaine et des bases ...

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Manipulation des chaine et des bases ...   Mar 17 Avr - 12:36

salut les amis !
jai fini mon projet et le problme c k'il ya de petite faute .
essayer avec moi a trouver ces faute!
(i manque les 2 procédure VAL ET STR )
_____________________________________________


 
program projet;

uses wincrt;



var

chx1,chx2,chx3,a:integer; bin,oct,hex,ch:string; c,b:char;



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



{fonction length}

function Length2(Ch : string):integer;

begin

Length2 := Integer(Ch[0]);

end;





{fonction concat}

function Concat2(Ch1, Ch2 : string):string;

begin

Concat2 := Ch1 + Ch2;

end;



{Fonction Copy}

function Copy2(Ch : string ;p : integer ; cnt : integer) : string;

var l, i : integer;

st : string;

begin

st := '';

i := p;

l := Length(Ch);

while (i <= l) and (i - p < cnt) do begin
st := st + Ch[i];
i := i + 1;
end;

Copy2 := st;
end;

{Fonction POS}
function Pos2(Ch1, Ch2 : string ; p : integer):integer;
var l1, l2, p1, i, j : integer;
begin
l1 := Length(Ch1);
l2 := length(Ch2);
{ on suppose que la chaine est introuvable}
p1 := 0;
{On ne cherche que s'il y'a suffisament de caractères }
if ((l1 + p - 1) <= l2) then begin
i := p;
{ On recherche tant que la chaine est introuvable }
while (i <= l2 - l1 + 1) and (p1 = 0) do begin
{ On compte le nombre de caractères identiques}
j := 0;
while (j < l1) and (Ch2[i+j] = Ch1[j+1]) do j:=j+1;
{ Si ce nombre est égal à la longueur de la chaine }
{ recherchée donc la chaine Ch1 se trouve à la position i}
if (j = l1) then p1 := i;
i := i + 1;
end;
end;
{ On retourne la position de la chaine }
Pos2 := p1;
end;

{Procedure DELETE}
{ Supprimer cnt caractères à partir de la position p de la chaine Ch }
procedure supprimer(var Ch : string ; p, cnt : integer);
var Ch1 : string;
i : integer;
begin
Ch1 := '';
for i:=1 to p-1 do Ch1 := Ch1 + Ch[i];
for i:=p + cnt to length(Ch) do Ch1 := Ch1 + Ch[i];
Ch := Ch1;

end;

{Procedure insert}
{ Insère la chaine Ch1 dans la chaine Ch à partir de la position p }
procedure Insert2(ch1 : string ; Var Ch : string ; p : integer);
begin
Ch := Copy(Ch, 1, p - 1) + Ch1 + Copy(Ch, p, length(Ch) - p + 1);
end;

(* conversion de la base 10 à la base 2 *)
function DecToBin(a : integer):string;
var s : string;
begin
s := '';
while (a <> 0) do begin
s := chr(48 + a and 1) + s;
a := a shr 1; (* diviser a par deux *)
end;
DecToBin := s;
end;
{***********************************************************}
(* conversion de la base 2 à la base 10 *)
function BinToDec(bin : string):integer;
var i, v : integer;
begin
v := 0;
for i:=1 to length(bin) do begin
v := v shl 1 + Ord(bin[i]) - 48;
end;
BinToDec := v;
end;
{*********************************************************}
(* conversion de la base 10 à la base 8 *)
function DecToOct(a : integer):string;
var s : string;
begin
s := '';
while (a <> 0) do begin
s := chr(48 + a and 7) + s;
a := a shr 3; (* diviser a par huit *)
end;
DecToOct := s;
end;
{********************************************************}
(* conversion de la base 8 à la base 10 *)
function OctToDec(oct : string):integer;
var i, v : integer;
begin
v := 0;
for i:=1 to length(oct) do begin
v := v shl 3 + Ord(oct[i]) - 48;
end;
OctToDec := v;
end;
{*******************************************************}
(* conversion de la base 10 à la base 16 *)
function DecToHex(a : integer):string;
var s : string;
const h : string[16] = '0123456789ABCDEF';
begin
s := '';
while (a <> 0) do begin
s := h[a and 15 + 1] + s;
a := a shr 4; (* diviser a par seize *)
end;
DecToHex := s;
end;
{*******************************************************}
(* conversion de la base 16 à la base 10 *)
function HexToDec(hex : string):integer;
var i, v, v1 : integer;
begin
v := 0;
for i:=1 to length(hex) do begin
if (hex[i] <= '9') then
v1 := Ord(hex[i]) - 48
else
(* ord('A') = 65 ; ord('0') = 48 ; A(16) = 10(10) ==> 65 - (48 + 7) = 10 *)
v1 := Ord(hex[i]) - (48 + 7);
v := v shl 4 + v1;
end;
HexToDec := v;
end;
{***********************************************************}
(* conversion de la base 2 à la base 8 *)
function BinToOct(bin : string):string;
var i, v : integer;
oct : string;
begin
i:=length(bin);
oct := '';
while (i >= 1) do begin
v := ord(bin[i]) - 48;
i := i - 1;
if (i >= 1) then begin
v := v + (ord(bin[i]) - 48) * 2;
i := i - 1;
end;
if (i >= 1) then begin
v := v + (ord(bin[i]) - 48) * 4;
i := i - 1;
end;
oct := chr(v + 48) + oct;
end;
BinToOct := oct;
end;
{**********************************************************}
(* conversion de la base 8 à la base 2*)
function OctToBin(oct : string):string;
var bin : string;
i, j, v : integer;
begin
bin := '';
for i:=1 to length(oct) do begin
v := ord(oct[i]) - 48;
bin := bin +
chr(48 + (v and 4) shr 2) +
chr(48 + (v and 2) shr 1) +
chr(48 + v and 1);
end;
while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
OctToBin := bin;
end;


(* conversion de la base 2 à la base 16 *)
function BinToHex(bin : string):string;
const h : string = '0123456789ABCDEF';
var i, v, c : integer;
hex : string;
begin
i:=length(bin);
c:=1; v:=0;
hex := '';
while (i >= 1) do begin
v := v + c * (ord(bin[i]) - 48);
if (c = 8) or (i = 1) then begin
hex := h[v+1] + hex;
v := 0; c:=1;
end else c := c * 2;
i := i - 1;
end;
BinToHex := hex;
end;

(* conversion de la base 16 à la base 2 *)
function HexToBin(hex : string):string;
var i, v : integer;
bin : string;
begin
bin := '';
for i:=1 to length(hex) do begin
v := ord(hex[i]) - 48;
if (v > 9) then v := v - 7;
bin := bin +
chr(48 + (v and 8) shr 3) +
chr(48 + (v and 4) shr 2) +
chr(48 + (v and 2) shr 1) +
chr(48 + v and 1);
end;
while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
HexToBin := bin;
end;

(* conversion de la base 8 à la base 16 *)
function OctToHex(oct : string):string;
begin
OctToHex := DecToHex(OctToDec(oct));
end;

(* conversion de la base 16 à la base 8 *)
function HexToOct(hex : string):string;
begin
HexToOct := DecToOct(HexToDec(hex));
end;

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


{MENU principale}
procedure menu_principal(var chx1:integer);
begin

clrscr;
writeln(' ***Bienvenue !*** ');
writeln(' *********** ');
writeln('');
writeln('La conversion entre les bases : 1');
writeln('Manipilation des chaines .....: 2');
writeln('Quitter ......................: 3');
repeat
write('Entrer votre choix : ');
readln(chx1);
until (chx1 in [1..3]);
if chx1= 3 then donewincrt ;
end;



procedure mech(var chx3:integer;var ch:string);
type tch=array [1..20] of string;
var x,ch1,ch2,chp:string;p,cnt,chx1,n,i,longeur:integer;


t:tch;
begin


case chx3 of
1:begin
readln(ch);
writeln('Donner votre chaine : ');readln(ch);
repeat
write('Taper la position a partir de la quelle tu veux supprimer : ');readln(p);
until p in [1..((length(ch)))];
{repeat }
writeln('Combien de caractère vouler vous supprimer ? '); readln(cnt);
{until ((cnt+p)<=(length(ch))) ; }
supprimer(ch,p,cnt);
writeln('Votre chaine devient après les modifications : ');writeln(ch);
end;


2:begin
readln(ch);
writeln('Donner Votre chaine : ');
readln(ch);
write('Donner votre chaine a inserer : ');readln(ch1);
write('Donner la position d''insertion : ');readln (p);
insert2(ch1,ch,p);
writeln(ch);
end;

{3:convch(n,ch);
4:valeur(ch,n,e);}
5:begin
readln (ch);
write('Donner Votre chaine : ');readln(ch);
writeln('La longeur de votre chaine est : ', length2(ch));
end;
6:begin
readln(ch1);
write('Donner votre chaine : ');readln(ch2);
write('Donner la chaine a chercher : ');readln(ch1);

writeln('La position de la 1ère occurence est : ',pos2(ch1,ch2,p));

end;

7:begin
readln(ch);
write('Donner votre chaine : ');readln(ch);

repeat
write('Taper la position de la sous-chaine : ');readln(p);
until p in [1..((length(ch))-1)];
repeat
write('Combien de caractère vouler vous COPIER ? '); readln(cnt);
until ((cnt+p)<=(length(ch))) ;
writeln('Votre chaine devient après les modifications : ', copy2(ch,p,cnt));
end;

8:begin
write('Combient de chaines voulez vous concater ? : ');readln(n);
for i :=1 to n do
begin
writeln ('Donner la chaine N°',i,' : '); readln (t[i]);
longeur:=longeur+length (T[i]);

end;
if longeur >255 then writeln('Votre chaine est trop longue ! ') else
begin
for i := 1 to n do
chp:=concat2(chp,T[i]);

writeln('Votre chaine après les modifications est devenue : ');
writeln(chp);
end;
end;


9:menu_principal(chx1);
end;
if chx3 <> (9) then
repeat
write('Vouler vous continuer ? o/n ');readln(b);
until (b in ['o','O','n','N']);
end;


procedure Menu_mech(chx3:integer;ch:string;b:char);
var n:integer;
begin
clrscr;
writeln(' ***MANIPULATION DES CHAINES*** ');
writeln(' ________________________ ');
writeln('');
writeln('');
writeln('°°LES PROCEDURES°°');
writeln(' °°°°°°°°°°°°°°');
writeln('');
writeln('Delete : 1');
writeln('Insert : 2');
writeln('STR : 3');
writeln('VAL : 4');
writeln('');
writeln('°°LES FONCTIONS°°');
writeln(' °°°°°°°°°°°°°');
writeln('');
writeln('Length : 5');
writeln('POS : 6');
writeln('Copy : 7');
writeln('Concat : 8');
writeln('');
writeln('Retour : 9');
writeln('');
{ wrileln(' _--------------_');
writeln(''); }

repeat
read;
write('Taper votre choix : ');read(chx3);
until(chx3 in [1..9]);

mech(chx3,ch);

if upcase (b)=('O')then mech(chx3,ch) ;if upcase (b)='N' then menu_principal(chx1);
end;



{choix menu mcb }
procedure choix_mcb(var c:char;var b:char);
var bin,oct,hex:char; a:integer;
begin
case upcase (c) of
'0':begin
writeln('Donner le nombre binaire à convertir : '); readln(bin);

writeln(' = ',BinToOct(bin));
end;
'1':begin
write('Donner un nombre binaire à convertir : ');readln(bin);

writeln(bin,' base 2 = ', BinToDec(bin),' en Base Decimale ');

end;
'2':begin
writeln('Donner le nombre binaire à convertir : '); readln(bin);

writeln(' = ',BinToHex(bin));
end;
'3':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ',OctToBin(oct),' Base 2');

end;
'4':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ', OctToDec(oct),' Base 10');

end;



'5':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ', OctToHex(oct),' Base 16');

end;


'6': begin
write('Donner un nombre décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToBin(a),' Base 2');

end;
'7':begin
write('Donner un nombre décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToOct(a),' Base 8');

end;

'8':begin
write('Donner un nombre en base décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToHex(a),' Base 16');

end;


'9': begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToBin(hex),' Base 2');

end;


'A':begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToOct(hex),' Base 8');

end;

'B':begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToDec(hex),' Base 10');

end;
'R':menu_principal(chx1);
end ;


if upcase (c) <> upcase('R') then
repeat
write('Vouler vous continuer ? o/n ');readln(b);
until (b in ['o','O','n','N']);
end;




{MEnu conversion entre les bases}
procedure mcb(c,b:char);
begin

clrscr;
writeln(' CONVERSION ENTRE LES BASES');
writeln('');
writeln('');
writeln('De la base 2');
writeln(' vers la base 8 : 0');
writeln(' vers la base 10 : 1');
writeln(' vers la base 16 : 2');
writeln('De la base 8');
writeln(' vers la base 2 : 3');
writeln(' vers la base 10 : 4');
writeln(' vers la base 16 : 5');
writeln('De la base 10');
writeln(' vers la base 2 : 6');
writeln(' vers la base 8 : 7');
writeln(' vers la base 16 : 8');
writeln('De la base 16');
writeln(' vers la base 2 : 9');
writeln(' vers la base 8 : A');
writeln(' vers la base 10 : B');
writeln('Retour au menu préscedent ....: R');
writeln(' ________________________ ');
repeat
write('Taper votre choix : ');readln(c);
until (upcase (c) in ['0'..'9','A','B','R'] );
choix_mcb(c,b);

if upcase (b)=('O')then mcb(c,b) ;if upcase (b)='N' then menu_principal(chx1);
end;







{programme principal}
begin

menu_principal(chx1);
case chx1 of
1:mcb(c,b);
2:Menu_mech(chx3,ch,b);
end;
end.























































 
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 12:38

MERCI D'AVANCE !!!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 12:40

je n'est pu pas trouver ce resultat sans l'aide de Mohammed et Chaker !!


Merci !!!!!!!!!!!!!!!!!!!!!!!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 13:45

Je suis fier que tu aie trouver la solution par toi même.

Merci pour avoir partagé ton projet.

J'ai une requête à te faire... Je vois que ton projet sera plus intéressant si tu formules bien son utilité.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 14:21

de rien !!
Dans la vie on doit donner pour recevoir !!

et le plus important c'est PARTAGER tout !!

bon je vois k'il ya un petit problème dans ce programme car il tourne qu'une seule fois !!!
???
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 14:43

J'ai testé ton programme. Il est bon. Mais j'ai quelques remarques.

Je suggère de :
- Changer donewincrt en Halt. donewincrt est liée à Windows.
- revoir le code de conversion de la base 8 --> 2 je lui met 250 et il ne convertit que le premier chiffre !!! En changeant les types de char à string. tu pourras peut-être régler ce problème.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
makram
modérateur
modérateur
avatar

Nombre de messages : 549
Age : 28
Date d'inscription : 29/12/2006

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 15:27

exellent idée de partager les projets dans le forum
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
mtcs
Administrateur
Administrateur
avatar

Nombre de messages : 1605
Date d'inscription : 21/11/2006

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 20:46

Scorshy a écrit:
je n'est pu pas trouver ce resultat sans l'aide de Mohammed et Chaker !!


Merci !!!!!!!!!!!!!!!!!!!!!!!


je vais essyer de t'aider mon ami, a3tini chwaya wa9t akahaw
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mar 17 Avr - 23:23

On a tout le temps nécessaire pour terminer ce petit projet

Lorsqu'on veut On peut !

n'est ce pas les amis??
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
mtcs
Administrateur
Administrateur
avatar

Nombre de messages : 1605
Date d'inscription : 21/11/2006

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 0:41

bien sur mon ami, voilà tes codes avec qq modifications:

Code:
program projet;

uses wincrt;



var

chx1,chx2,chx3,a:integer; bin,oct,hex,ch:string; c,b:char;



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



{fonction length}

function Length2(Ch : string):integer;

begin

Length2 := Integer(Ch[0]);

end;





{fonction concat}

function Concat2(Ch1, Ch2 : string):string;

begin

Concat2 := Ch1 + Ch2;

end;



{Fonction Copy}

function Copy2(Ch : string ;p : integer ; cnt : integer) : string;

var l, i : integer;

st : string;

begin

st := '';

i := p;

l := Length(Ch);

while (i <= l) and (i - p < cnt) do begin
st := st + Ch[i];
i := i + 1;
end;

Copy2 := st;
end;

{Fonction POS}
function Pos2(Ch1, Ch2 : string ; p : integer):integer;
var l1, l2, p1, i, j : integer;
begin
l1 := Length(Ch1);
l2 := length(Ch2);
{ on suppose que la chaine est introuvable}
p1 := 0;
{On ne cherche que s'il y'a suffisament de caractères }
if ((l1 + p - 1) <= l2) then begin
i := p;
{ On recherche tant que la chaine est introuvable }
while (i <= l2 - l1 + 1) and (p1 = 0) do begin
{ On compte le nombre de caractères identiques}
j := 0;
while (j < l1) and (Ch2[i+j] = Ch1[j+1]) do j:=j+1;
{ Si ce nombre est égal à la longueur de la chaine }
{ recherchée donc la chaine Ch1 se trouve à la position i}
if (j = l1) then p1 := i;
i := i + 1;
end;
end;
{ On retourne la position de la chaine }
Pos2 := p1;
end;

{Procedure DELETE}
{ Supprimer cnt caractères à partir de la position p de la chaine Ch }
procedure supprimer(var Ch : string ; p, cnt : integer);
var Ch1 : string;
i : integer;
begin
Ch1 := '';
for i:=1 to p-1 do Ch1 := Ch1 + Ch[i];
for i:=p + cnt to length(Ch) do Ch1 := Ch1 + Ch[i];
Ch := Ch1;

end;

{Procedure insert}
{ Insère la chaine Ch1 dans la chaine Ch à partir de la position p }
procedure Insert2(ch1 : string ; Var Ch : string ; p : integer);
begin
Ch := Copy(Ch, 1, p - 1) + Ch1 + Copy(Ch, p, length(Ch) - p + 1);
end;

(* conversion de la base 10 à la base 2 *)
function DecToBin(a : integer):string;
var s : string;
begin
s := '';
while (a <> 0) do begin
s := chr(48 + a and 1) + s;
a := a shr 1; (* diviser a par deux *)
end;
DecToBin := s;
end;
{***********************************************************}
(* conversion de la base 2 à la base 10 *)
function BinToDec(bin : string):integer;
var i, v : integer;
begin
v := 0;
for i:=1 to length(bin) do begin
v := v shl 1 + Ord(bin[i]) - 48;
end;
BinToDec := v;
end;
{*********************************************************}
(* conversion de la base 10 à la base 8 *)
function DecToOct(a : integer):string;
var s : string;
begin
s := '';
while (a <> 0) do begin
s := chr(48 + a and 7) + s;
a := a shr 3; (* diviser a par huit *)
end;
DecToOct := s;
end;
{********************************************************}
(* conversion de la base 8 à la base 10 *)
function OctToDec(oct : string):integer;
var i, v : integer;
begin
v := 0;
for i:=1 to length(oct) do begin
v := v shl 3 + Ord(oct[i]) - 48;
end;
OctToDec := v;
end;
{*******************************************************}
(* conversion de la base 10 à la base 16 *)
function DecToHex(a : integer):string;
var s : string;
const h : string[16] = '0123456789ABCDEF';
begin
s := '';
while (a <> 0) do begin
s := h[a and 15 + 1] + s;
a := a shr 4; (* diviser a par seize *)
end;
DecToHex := s;
end;
{*******************************************************}
(* conversion de la base 16 à la base 10 *)
function HexToDec(hex : string):integer;
var i, v, v1 : integer;
begin
v := 0;
for i:=1 to length(hex) do begin
if (hex[i] <= '9') then
v1 := Ord(hex[i]) - 48
else
(* ord('A') = 65 ; ord('0') = 48 ; A(16) = 10(10) ==> 65 - (48 + 7) = 10 *)
v1 := Ord(hex[i]) - (48 + 7);
v := v shl 4 + v1;
end;
HexToDec := v;
end;
{***********************************************************}
(* conversion de la base 2 à la base 8 *)
function BinToOct(bin : string):string;
var i, v : integer;
oct : string;
begin
i:=length(bin);
oct := '';
while (i >= 1) do begin
v := ord(bin[i]) - 48;
i := i - 1;
if (i >= 1) then begin
v := v + (ord(bin[i]) - 48) * 2;
i := i - 1;
end;
if (i >= 1) then begin
v := v + (ord(bin[i]) - 48) * 4;
i := i - 1;
end;
oct := chr(v + 48) + oct;
end;
BinToOct := oct;
end;
{**********************************************************}
(* conversion de la base 8 à la base 2*)
function OctToBin(oct : string):string;
var bin : string;
i, j, v : integer;
begin
bin := '';
for i:=1 to length(oct) do begin
v := ord(oct[i]) - 48;
bin := bin +
chr(48 + (v and 4) shr 2) +
chr(48 + (v and 2) shr 1) +
chr(48 + v and 1);
end;
while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
OctToBin := bin;
end;


(* conversion de la base 2 à la base 16 *)
function BinToHex(bin : string):string;
const h : string = '0123456789ABCDEF';
var i, v, c : integer;
hex : string;
begin
i:=length(bin);
c:=1; v:=0;
hex := '';
while (i >= 1) do begin
v := v + c * (ord(bin[i]) - 48);
if (c = 8) or (i = 1) then begin
hex := h[v+1] + hex;
v := 0; c:=1;
end else c := c * 2;
i := i - 1;
end;
BinToHex := hex;
end;

(* conversion de la base 16 à la base 2 *)
function HexToBin(hex : string):string;
var i, v : integer;
bin : string;
begin
bin := '';
for i:=1 to length(hex) do begin
v := ord(hex[i]) - 48;
if (v > 9) then v := v - 7;
bin := bin +
chr(48 + (v and 8) shr 3) +
chr(48 + (v and 4) shr 2) +
chr(48 + (v and 2) shr 1) +
chr(48 + v and 1);
end;
while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
HexToBin := bin;
end;

(* conversion de la base 8 à la base 16 *)
function OctToHex(oct : string):string;
begin
OctToHex := DecToHex(OctToDec(oct));
end;

(* conversion de la base 16 à la base 8 *)
function HexToOct(hex : string):string;
begin
HexToOct := DecToOct(HexToDec(hex));
end;

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


{MENU principale}
procedure menu_principal(var chx1:integer);
begin

clrscr;
writeln(' ***Bienvenue !*** ');
writeln(' *********** ');
writeln('');
writeln('La conversion entre les bases : 1');
writeln('Manipilation des chaines .....: 2');
writeln('Quitter ......................: 3');
repeat
write('Entrer votre choix : ');
readln(chx1);
until (chx1 in [1..3]);
if chx1= 3 then donewincrt ;
end;



procedure mech(var chx3:integer;var ch:string);
type tch=array [1..20] of string;
var x,ch1,ch2,chp:string;p,cnt,chx1,n,i,longeur:integer;


t:tch;
begin


case chx3 of
1:begin
readln(ch);
writeln('Donner votre chaine : ');readln(ch);
repeat
write('Taper la position a partir de la quelle tu veux supprimer : ');readln(p);
until p in [1..((length(ch)))];
{repeat }
writeln('Combien de caractère vouler vous supprimer ? '); readln(cnt);
{until ((cnt+p)<=(length(ch))) ; }
supprimer(ch,p,cnt);
writeln('Votre chaine devient après les modifications : ');writeln(ch);
end;


2:begin
readln(ch);
writeln('Donner Votre chaine : ');
readln(ch);
write('Donner votre chaine a inserer : ');readln(ch1);
write('Donner la position d''insertion : ');readln (p);
insert2(ch1,ch,p);
writeln(ch);
end;

{3:convch(n,ch);
4:valeur(ch,n,e);}
5:begin
readln (ch);
write('Donner Votre chaine : ');readln(ch);
writeln('La longeur de votre chaine est : ', length2(ch));
end;
6:begin
readln(ch1);
write('Donner votre chaine : ');readln(ch2);
write('Donner la chaine a chercher : ');readln(ch1);

writeln('La position de la 1ère occurence est : ',pos2(ch1,ch2,p));

end;

7:begin
readln(ch);
write('Donner votre chaine : ');readln(ch);

repeat
write('Taper la position de la sous-chaine : ');readln(p);
until p in [1..((length(ch))-1)];
repeat
write('Combien de caractère vouler vous COPIER ? '); readln(cnt);
until ((cnt+p)<=(length(ch))) ;
writeln('Votre chaine devient après les modifications : ', copy2(ch,p,cnt));
end;

8:begin
write('Combient de chaines voulez vous concater ? : ');readln(n);
for i :=1 to n do
begin
writeln ('Donner la chaine N°',i,' : '); readln (t[i]);
longeur:=longeur+length (T[i]);

end;
if longeur >255 then writeln('Votre chaine est trop longue ! ') else
begin
for i := 1 to n do
chp:=concat2(chp,T[i]);

writeln('Votre chaine après les modifications est devenue : ');
writeln(chp);
end;
end;


9:menu_principal(chx1);
end;
if chx3 <> (9) then
repeat
write('Vouler vous continuer ? o/n ');readln(b);
until (b in ['o','O','n','N']);
end;


procedure Menu_mech(chx3:integer;ch:string;b:char);
var n:integer;
begin
clrscr;
writeln(' ***MANIPULATION DES CHAINES*** ');
writeln(' ________________________ ');
writeln('');
writeln('');
writeln('°°LES PROCEDURES°°');
writeln(' °°°°°°°°°°°°°°');
writeln('');
writeln('  Delete : 1');
writeln('  Insert : 2');
writeln('  STR    : 3');
writeln('  VAL    : 4');
writeln;
writeln('°°LES FONCTIONS°°');
writeln(' °°°°°°°°°°°°°');
writeln;
writeln('  Length : 5');
writeln('  POS    : 6');
writeln('  Copy  : 7');
writeln('  Concat : 8');
writeln;
writeln('  Retour : 9');
writeln('');
{ wrileln(' _--------------_');
writeln(''); }

repeat
read;
write('Taper votre choix : ');read(chx3);
until(chx3 in [1..9]);

mech(chx3,ch);

if upcase (b)=('O')then mech(chx3,ch) ;if upcase (b)='N' then menu_principal(chx1);
end;



{choix menu mcb }
procedure choix_mcb(var c:char;var b:char);
var bin,oct,hex:char; a:integer;
begin
case upcase (c) of
'0':begin
writeln('Donner le nombre binaire à convertir : '); readln(bin);

writeln(' = ',BinToOct(bin));
end;
'1':begin
write('Donner un nombre binaire à convertir : ');readln(bin);

writeln(bin,' base 2 = ', BinToDec(bin),' en Base Decimale ');

end;
'2':begin
writeln('Donner le nombre binaire à convertir : '); readln(bin);

writeln(' = ',BinToHex(bin));
end;
'3':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ',OctToBin(oct),' Base 2');

end;
'4':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ', OctToDec(oct),' Base 10');

end;



'5':begin
write('Donner votre nombre octale à convertir : ');readln(oct);
writeln(oct,' base 8 = ', OctToHex(oct),' Base 16');

end;


'6': begin
write('Donner un nombre décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToBin(a),' Base 2');

end;
'7':begin
write('Donner un nombre décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToOct(a),' Base 8');

end;

'8':begin
write('Donner un nombre en base décimale à convertir : ');readln(a);
writeln(a,' base 10 = ', DecToHex(a),' Base 16');

end;


'9': begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToBin(hex),' Base 2');

end;


'A':begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToOct(hex),' Base 8');

end;

'B':begin
write('Donner un nombre en base héxadécimale à convertir : ');readln(hex);
writeln(hex,' base 16 = ', HexToDec(hex),' Base 10');

end;
'R':menu_principal(chx1);
end ;


if upcase (c) <> upcase('R') then
repeat
write('Vouler vous continuer ? o/n ');readln(b);
until (b in ['o','O','n','N']);
end;




{MEnu conversion entre les bases}
procedure mcb(c,b:char);
begin

clrscr;
writeln(' CONVERSION ENTRE LES BASES');
writeln('');
writeln('');
writeln('De la base 2');
writeln('              vers la base 8  : 0');
writeln('              vers la base 10  : 1');
writeln('              vers la base 16  : 2');
writeln('De la base 8');
writeln('              vers la base 2  : 3');
writeln('              vers la base 10  : 4');
writeln('              vers la base 16  : 5');
writeln('De la base 10');
writeln('              vers la base 2  : 6');
writeln('              vers la base 8  : 7');
writeln('              vers la base 16  : 8');
writeln('De la base 16');
writeln('              vers la base 2  : 9');
writeln('              vers la base 8  : A');
writeln('              vers la base 10  : B');
writeln('Retour au menu préscedent .... : R');
writeln(' ________________________ ');
repeat
write('Taper votre choix : ');readln(c);
until (upcase (c) in ['0'..'9','A','B','R'] );
choix_mcb(c,b);

if upcase (b)=('O')then mcb(c,b) ;if upcase (b)='N' then menu_principal(chx1);
end;







{programme principal}
begin
repeat
menu_principal(chx1);
case chx1 of
1:mcb(c,b);
2:Menu_mech(chx3,ch,b);
end;
until (chx1 in [1..3]);
end.

Rq: je n'ai pas ajouter les procedures val & pour le moument, je te lesse pour le faire tout seul Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 12:48

Merci

je suis en train de faire les procedure val et str !!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 13:50

J'ai fait quelques modifications pour la manipulation des chaines je terminerai inchallah la conversion plus tard. Merci pour votre compréhension...

Code:
program projet;
uses crt;
{ déclaration des nouveaux types }
type tab_chaine=array [1..20] of string;

{************************************************************}
{ modules de traitement des chaines                          }
{************************************************************}
{ fonction length }
function Length2(Ch : string):integer;
begin
  Length2 := Integer(Ch[0]);
end;

{fonction concat}
function Concat2(Ch1, Ch2 : string):string;
begin
  Concat2 := Ch1 + Ch2;
end;

{Fonction Copy}
function Copy2(Ch : string ;p : integer ; cnt : integer) : string;
var l, i : integer;
st : string;
begin
  st := '';
  i := p;
  l := Length(Ch);
  while (i <= l) and (i - p < cnt) do begin
    st := st + Ch[i];
    i := i + 1;
  end;
  Copy2 := st;
end;

{Fonction POS}
function Pos2(Ch1, Ch2 : string ; p : integer):integer;
var l1, l2, p1, i, j : integer;
begin
  l1 := Length(Ch1);
  l2 := length(Ch2);
  { on suppose que la chaine est introuvable}
  p1 := 0;
  {On ne cherche que s'il y'a suffisament de caractères }
  if ((l1 + p - 1) <= l2) then begin
    i := p;
    { On recherche tant que la chaine est introuvable }
    while (i <= l2 - l1 + 1) and (p1 = 0) do begin
      { On compte le nombre de caractères identiques}
      j := 0;
      while (j < l1) and (Ch2[i+j] = Ch1[j+1]) do j:=j+1;
      { Si ce nombre est égal à la longueur de la chaine }
      { recherchée donc la chaine Ch1 se trouve à la position i}
      if (j = l1) then p1 := i;
      i := i + 1;
    end;
  end;
  { On retourne la position de la chaine }
  Pos2 := p1;
end;

{Procedure DELETE}
{ Supprimer cnt caractères à partir de la position p de la chaine Ch }
procedure Delete2(var Ch : string ; p, cnt : integer);
var Ch1 : string;
i : integer;
begin
  Ch1 := '';
  for i:=1 to p-1 do Ch1 := Ch1 + Ch[i];
  for i:=p + cnt to length(Ch) do Ch1 := Ch1 + Ch[i];
  Ch := Ch1;
end;

{Procedure insert}
{ Insère la chaine Ch1 dans la chaine Ch à partir de la position p }
procedure Insert2(ch1 : string ; Var Ch : string ; p : integer);
begin
  Ch := Copy(Ch, 1, p - 1) + Ch1 + Copy(Ch, p, length(Ch) - p + 1);
end;

{************************************************************}
{ modules de conversion entre les bases                      }
{************************************************************}

(* conversion de la base 10 à la base 2 *)
function DecToBin(a : integer):string;
var s : string;
begin
  s := '';
  while (a <> 0) do begin
    s := chr(48 + a and 1) + s;
    a := a shr 1; (* diviser a par deux *)
  end;
  DecToBin := s;
end;

(* conversion de la base 2 à la base 10 *)
function BinToDec(bin : string):integer;
var i, v : integer;
begin
  v := 0;
  for i:=1 to length(bin) do begin
    v := v shl 1 + Ord(bin[i]) - 48;
  end;
  BinToDec := v;
end;

(* conversion de la base 10 à la base 8 *)
function DecToOct(a : integer):string;
var s : string;
begin
  s := '';
  while (a <> 0) do begin
    s := chr(48 + a and 7) + s;
    a := a shr 3; (* diviser a par huit *)
  end;
  DecToOct := s;
end;

(* conversion de la base 8 à la base 10 *)
function OctToDec(oct : string):integer;
var i, v : integer;
begin
  v := 0;
  for i:=1 to length(oct) do begin
    v := v shl 3 + Ord(oct[i]) - 48;
  end;
  OctToDec := v;
end;

(* conversion de la base 10 à la base 16 *)
function DecToHex(a : integer):string;
var s : string;
const h : string[16] = '0123456789ABCDEF';
begin
  s := '';
  while (a <> 0) do begin
    s := h[a and 15 + 1] + s;
    a := a shr 4; (* diviser a par seize *)
  end;
  DecToHex := s;
end;

(* conversion de la base 16 à la base 10 *)
function HexToDec(hex : string):integer;
var i, v, v1 : integer;
begin
  v := 0;
  for i:=1 to length(hex) do begin
    if (hex[i] <= '9') then
      v1 := Ord(hex[i]) - 48
    else
      (* ord('A') = 65 ; ord('0') = 48 ; A(16) = 10(10) ==> 65 - (48 + 7) = 10 *)
      v1 := Ord(hex[i]) - (48 + 7);
    v := v shl 4 + v1;
  end;
  HexToDec := v;
end;

(* conversion de la base 2 à la base 8 *)
function BinToOct(bin : string):string;
var i, v : integer;
oct : string;
begin
  i:=length(bin);
  oct := '';
  while (i >= 1) do begin
    v := ord(bin[i]) - 48;
    i := i - 1;
    if (i >= 1) then begin
      v := v + (ord(bin[i]) - 48) * 2;
      i := i - 1;
    end;
    if (i >= 1) then begin
      v := v + (ord(bin[i]) - 48) * 4;
      i := i - 1;
    end;
    oct := chr(v + 48) + oct;
  end;
  BinToOct := oct;
end;

(* conversion de la base 8 à la base 2*)
function OctToBin(oct : string):string;
var bin : string;
i, j, v : integer;
begin
  bin := '';
  for i:=1 to length(oct) do begin
    v := ord(oct[i]) - 48;
    bin := bin +
    chr(48 + (v and 4) shr 2) +
    chr(48 + (v and 2) shr 1) +
    chr(48 + v and 1);
  end;
  while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
  OctToBin := bin;
end;

(* conversion de la base 2 à la base 16 *)
function BinToHex(bin : string):string;
const h : string = '0123456789ABCDEF';
var i, v, c : integer;
hex : string;
begin
  i:=length(bin);
  c:=1; v:=0;
  hex := '';
  while (i >= 1) do begin
    v := v + c * (ord(bin[i]) - 48);
    if (c = 8) or (i = 1) then begin
      hex := h[v+1] + hex;
      v := 0; c:=1;
    end else c := c * 2;
  i := i - 1;
  end;
  BinToHex := hex;
end;

(* conversion de la base 16 à la base 2 *)
function HexToBin(hex : string):string;
var i, v : integer;
bin : string;
begin
  bin := '';
  for i:=1 to length(hex) do begin
    v := ord(hex[i]) - 48;
    if (v > 9) then v := v - 7;
    bin := bin +
    chr(48 + (v and 8) shr 3) +
    chr(48 + (v and 4) shr 2) +
    chr(48 + (v and 2) shr 1) +
    chr(48 + v and 1);
  end;
  while (length(bin) > 1) and (bin[1] = '0') do Delete(bin, 1, 1);
  HexToBin := bin;
end;

(* conversion de la base 8 à la base 16 *)
function OctToHex(oct : string):string;
begin
  OctToHex := DecToHex(OctToDec(oct));
end;

(* conversion de la base 16 à la base 8 *)
function HexToOct(hex : string):string;
begin
  HexToOct := DecToOct(HexToDec(hex));
end;

{************************************************************}
{ modules des menus utilisateurs                            }
{************************************************************}

{Menu Principal}
procedure menu_principal(var chx1:integer);
begin
  clrscr;
  writeln(' ***! Bienvenue !*** ');
  writeln(' ******************* ');
  writeln;
  writeln('1. Conversions entre les bases');
  writeln('2. Manipulations des chaines');
  writeln('3. Quitter');
  repeat
    write('Entrer votre choix : ');
    readln(chx1);
  until (chx1 in [1..3]);
  if chx1= 3 then halt ;
end;

procedure Trait_Chaines(var choix:integer);
var Ch1,ch:string;
    p, n, i, long, cnt:integer;
begin
  ClrScr;
  case choix of
    1: (* Traitements si choix = 1 *)
      begin
        Writeln('Fonction Delete démo');
        Writeln;
       
        write('Donner votre chaine : ');
        readln(ch);
        repeat
          write('Postion de suppression [1..',length(Ch),'] : ');
          readln(p);
        until (p >= 1) and (p <= length(ch));
       
        write('Nombre de caractère à supprimer : ');
        readln(cnt);
       
        Delete2(ch, p, cnt);
       
        write('Résultat : ');
        writeln(ch);
      end;
   
   
    2: (* Traitements si choix = 2 *)
      begin
        Writeln('Fonction Insert démo');
        Writeln;
       
        write('Donner votre chaine : ');
        readln(ch);
       
        write('Chaine à insérer : ');
        readln(ch1);
       
        write('Position d''insertion : ');
        readln(p);
       
        Insert2(ch1,ch,p);
       
        write('Résultat : ');
        writeln(ch);
      end;
   
    {3:convch(n,ch);
    4:valeur(ch,n,e);}
    5: (* Traitements si choix = 5 *)
      begin
        Writeln('Fonction Length démo');
        Writeln;
       
        write('Donner Votre chaine : ');
        readln(ch);
       
        writeln('Longeur du chaine : ', length2(ch));
      end;
   
    6: (* Traitements si choix = 6 *)
      begin
        Writeln('Fonction Pos démo');
        Writeln;
       
        write('Donner votre chaine : ');
        readln(ch);
       
        write('Chaine à rechercher : ');
        readln(ch1);
       
        p := Pos2(Ch1, Ch, 1); (* cherche à partir de la première position *)
        if (p = 0) then
          Writeln(Ch1, ' n''est pas trouvée dans ', Ch)
        else
          Writeln(Ch1, ' trouvée à la position ', p);
      end;
   
    7: (* Traitements si choix = 7 *)
      begin
        Writeln('Fonction Copy démo');
        Writeln;

        write('Donner votre chaine : ');
        readln(ch);
               
        repeat
          write('Postion de copie [1..',length(Ch),'] : ');
          readln(p);
        until (p >= 1) and (p <= length(ch));
       
        repeat
          write('Nombre de caractères à copier (<', length(ch) - p,') : ');
          readln(cnt);
        until ((cnt+p)<=length(ch)) ;
       
        write('Résultat : ');
        writeln(ch);
      end;
   
    8:
      begin
        Writeln('Fonction Concat démo');
        Writeln;
       
        repeat
          write('Nombre de chaines à concaténer [2..50] : ');
          readln(n);
        until (n >= 2) and (n <= 50);
       
        long := 0;
        for i :=1 to n do begin
          write('Donner la chaine N°',i,' : ');
          readln(Ch1);
          long:=long+length(Ch1);
          if (long <= 255) then Ch := Concat2(Ch, Ch1);
        end;
       
        if (long > 255) then
          writeln('Votre chaine est trop longue ! ')
        else begin       
          writeln('Résultat : ');
          writeln(Ch);
        end;
      end;
  end;
end;


procedure Menu_Chaines;
var n, choix :integer;
    cRep : char;
begin
  repeat
    clrscr;
    writeln(' *** MANIPULATION DES CHAINES ***');
    writeln(' --------------------------------');
    writeln;
    writeln;
    writeln('°°LES PROCEDURES°°');
    writeln(' °°°°°°°°°°°°°°');
    writeln;
    writeln('1. Delete');
    writeln('2. Insert');
    writeln('3. Str (n''est pas disponible)');
    writeln('4. Val (n''est pas disponible)');
    writeln;
    writeln('°°LES FONCTIONS°°');
    writeln(' °°°°°°°°°°°°°');
    writeln;
    writeln('5. Length');
    writeln('6. Pos');
    writeln('7. Copy');
    writeln('8. Concat');
    writeln;
    writeln('9. Menu Principal');
    writeln;
     
    repeat
      read;
      write('Votre choix [1..9] : ');
      readln(choix);
    until(choix in [1..9]);
   
    if (choix <> 9) then begin
      Trait_Chaines(choix);
      repeat
        write('Continuer (O/N) ? ');
        readln(cRep);
        cRep := UpCase(cRep);
      until (cRep in ['O','N']);
    end;
  until (cRep = 'N') or (choix = 9);
end;

{programme principal}
var choix:integer;
begin
  repeat
    Menu_Principal(choix);
    case choix of
      1 :
        begin
          Writeln('Non disponible pour l''instant.');
          Readln;
        end;
      2 : Menu_Chaines;
    end;
  until (choix = 3);
end.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 13:53

Remarque :
- Pour tester avec TPW remplacer Uses Crt; par Uses WinCrt;
- J'ai supprimé le bataillon de variables inutiles. Malgré qu'il en reste encore quelques unes.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 13:57

scorchy ... Tu trouvera les fonctions :
- Str2 qui permet de convertir un reél en une chaine
- Val2 qui permet de convertir une chaine en un réel
en suivant ce lien.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 14:09

Je vous fournit la version non achevée des modules de conversion vers les bases:
Code:

{ ... uniquement la partie que j'ai modifié ... }

{ traiter le choix de l'utilisateur }
procedure Trait_Conversion(choix : integer);
begin
 { à implémenter }
end;

{Menu conversion entre les bases }
procedure Menu_Bases;
var choix : integer;
    cRep : char;
begin
  repeat
    ClrScr;
    writeln(' CONVERSION ENTRE LES BASES');
    writeln;
    writeln;
    writeln('Base 2 ===>');
    writeln('1. Base 8');
    writeln('2. Base 10');
    writeln('3. Base 16');
    writeln('Base 8 ===>');
    writeln('4. Base 2');
    writeln('5. Base 10');
    writeln('6. Base 16');
    writeln('Base 10 ===>');
    writeln('7. Base 2');
    writeln('8. Base 8');
    writeln('9. Base 16');
    writeln('Base 16 ===>');
    writeln('10. Base 2');
    writeln('11. Base 8');
    writeln('12. Base 10');
    Writeln;
    writeln('13. Menu précédent');
    writeln(' ________________________ ');
    repeat
      write('Votre choix : ');
      readln(choix);
    until (choix in [1..13]);
   
    if (choix <> 13) then begin
      Trait_Conversion(choix);
      repeat
        write('Continuer (O/N) ? ');
        readln(cRep);
        cRep := UpCase(cRep);
      until (cRep in ['O','N']);
    end;
  until (cRep = 'N') or (choix = 13);
end;

{programme principal}
var choix:integer;
begin
  repeat
    Menu_Principal(choix);
    case choix of
      1 : Menu_Bases;
      2 : Menu_Chaines;
    end;
  until (choix = 3);
end.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
mtcs
Administrateur
Administrateur
avatar

Nombre de messages : 1605
Date d'inscription : 21/11/2006

MessageSujet: Re: Manipulation des chaine et des bases ...   Mer 18 Avr - 20:18

exellent travail manianis
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Jeu 19 Avr - 12:49

De rien ... Mohamed ... J'attends vos contributions pour achever ce travail.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Sam 21 Avr - 20:05

les amis voila ce ke  g pu faire moi :
 
 
 
{______________________________________________________valeur_______________________________________________________________}
function valeur:string;
var
a,b,xb:integer;
chf,chf1:string;
begin
chf:='';
write('Tapez votre chaine: ');readln(chf);
a:=0; b:=0;
chf1:='';xb:=long(chf);
repeat
begin
if chf[b] in ['0'..'9'] then
chf1:=chf1+chf[b]
else
a:=b;
b:=b+1;
end;
until (b=xb+1) or (a<>0) or ((chf[b])=(chr(0)));
if a<>0 then
writeln('Votre entier est: ',chf1,' est l''erreur se trouve dan la position ',a)
else
writeln('Votre entier est: ',chf1);
end;
{______________________________________________________convch_______________________________________________________________}
function convch:string;
var
a,lc,b:integer;
c:boolean;
chc:string;
begin
repeat
begin
chc:='';
write('Saisir un nombre: ');readln(chc);
b:=0;
lc:=long(chc);
repeat
begin
b:=b+1;
c:=false;
if (chc[b]in['0'..'9'])then
c:=true
end;
until(c=false)or(b=lc);
end;
until (c=true);
write ('Votre chaine est: ''');
for a:= 1 to b do
write(chc[a]);
write('''');
end;
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Sam 21 Avr - 23:34

function valeur:string;
devra normalement retourner une valeur numérique des paramètres passés en paramètres.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
manianis
V.I.P
V.I.P
avatar

Nombre de messages : 471
Age : 106
Date d'inscription : 19/03/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Sam 21 Avr - 23:38

Je te propose la fonction suivante:

procedure Val2(Ch : string ; var re : real ; var err : integer);
var virgule, exp : boolean;
i, vex : integer;
re1, mul : real;
sgn : integer;
begin
virgule := False;
exp := False;
re1 := 0;
err := 0;
i := 1;
mul := 10.0;
sgn := 1;

re := 0;
{ traiter le nombre qui précède l'exposant }
while (i <= length(ch)) and (err = 0) and (Not exp) do begin
if (ch[i] = '-') and (re1 = 0) then
{ traiter le signe (-) }
sgn := sgn * (-1)
else
if (ch[i] = '+') and (re1 = 0) then
{ traiter le signe (+) }
sgn := sgn
else
if (ch[i] in ['0'..'9']) then begin
{ traiter les chiffres }
if (Not virgule) then
{ Traiter les chiffres avant la virgule }
re1 := re1 * mul + (Ord(Ch[i]) - 48)
else begin
{ Tariter les chiffres aprés la virgule }
mul := mul / 10.0;
re1 := re1 + (Ord(Ch[i]) - 48) * mul;
end;
end else
if (ch[i] = '.') and (Not virgule) then begin
{ prendre en compte la virgule }
virgule := True;
mul := 1.0;
end else
if (ch[i] in ['E', 'e']) and (Not exp) then begin
exp := True;
end else
if (Ch[i] <> ' ') then
{ erreur à la position i }
err := i;

i := i + 1;
end;
re1 := sgn * re1;

{ traiter les chiffres qui succèdent l'exposant }
vex := 0;
sgn := 1;
while (i <= length(Ch)) and (err = 0) and (exp) do begin
if (ch[i] = '-') and (vex = 0) then
{ traiter le signe (-) }
sgn := sgn * (-1)
else if (ch[i] = '+') and (vex = 0) then
{ traiter le signe (+) }
sgn := sgn
else if (ch[i] in ['0'..'9']) then
{ traiter les chiffres}
vex := vex * 10 + (Ord(Ch[i]) - 48)
else
err := i;

i := i + 1;
end;

if (err = 0) and (exp) then begin
{ 111E-2 = 111 * 10^(-1 * 2) }
if (sgn > 0) then mul := 10.0 else mul := 0.1;

{ 111E-2 = (111 * 0.1) * 0.1 }
{ 111E2 = (111 * 10.0) * 10.0 }
for i:=1 to vex do re1 := re1 * mul;
end;

{ s'il y'a une erreur on doit retourner 0 }
if (err = 0) then re := re1;
end;

qui permet de convertir une valeur réelle en chaine de caractères en utilisant la notation scientifique càd par exemple 1.000E+20
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://manianis.sitesled.com/
Scorshy
utilisateur régulier
utilisateur régulier
avatar

Nombre de messages : 78
Age : 27
Date d'inscription : 18/02/2007

MessageSujet: Re: Manipulation des chaine et des bases ...   Dim 22 Avr - 12:20

merci ;
et pour convch c juste j'espère ke wi?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Manipulation des chaine et des bases ...   

Revenir en haut Aller en bas
 
Manipulation des chaine et des bases ...
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» afficher les guillemets d'une chaine.
» Création et manipulation d'une "base de données" externe...
» Chaine perso youtube
» Mauvaise manipulation avec template
» Problème dû à une mauvaise manipulation

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
Forum programmation :: Programmation :: Delphi & Pascal :: Pascal :: Exercices-
Sauter vers: