urgent -- pascal

الموضوع في 'أرشيف المنتدى التعليمي' بواسطة Dartagnan, بتاريخ ‏19 ماي 2009.

  1. Dartagnan

    Dartagnan عضو نشيط

    إنضم إلينا في:
    ‏9 ديسمبر 2007
    المشاركات:
    123
    الإعجابات المتلقاة:
    130
      19-05-2009 09:00
    Bonjour
    je vais passer le devoir de bac info à 14h
    et j'ai rencontré un probleme avec le turbo pascal...
    il ne fonctionne plus
    je veux tester ces programes
    كود (text):

    Program devoir;
    USES wincrt;
    var n,s,s1,s2:integer;
    function readn(n:integer):integer;
    begin
    repeat
    writeln('Entrer la valeur de n positif et superieur à 100 '); readln(n);
    until (n>100);
    end;
    procedure calcs (n:integer; var s:integer);
    var i:integer; ch:string;
        p,e:integer;
    begin
    str(n,ch);
    s:=0;
    for i:=1 to length(ch) Do
    begin
    val(ch[i],p,e);
    s:=s+p;
    end;
    end;
    procedure calcs2 (s:integer; var s1:integer);
    var i,p,e:integer; ch:string;
    begin
    while Not(s in [1..9]) Do
    str(s,ch);
    s1:=0;
    for i:=1 to length(ch) Do
    begin
    val(ch[i],p,e);
    s1:=s1+p;
    end;
    end;
    procedure code (s1,s2:integer);
    var ch1,ch2,code:string;
    begin
    str(s1,ch1);
    str(s2,ch2);
    code := concat(ch1,ch2);
    writeln(code);
    end;
    begin
    readn(n);
    calcs(n,s);
    calcs2(s,s1);
    code(s1,s2);
    end.
     
    كود (text):

    program test;
    uses WINCRT;
    Type TAB=array[1..30] of string;
    var T:TAB; n,p,e,i:integer;
    function saisir_n (n:integer):integer;
    begin
    repeat
    writeln('n '); readln(n);
    until(n in [5..30]);
    end;
    procedure remplirT(n:integer; var T:tab);
    begin
    for i:=1 to n Do
    begin
    writeln('Entrer T[',i,'] ! ');
    readln(T[i]);
    end
    end;
    procedure eliminer(T:TAB; n:integer);
    begin
    for i:=1 to n do
    begin
    val(T[i],p,e);
    T[i]:=T[i][p];
    end;
    end;
    procedure afficher(T:tab);
    begin
    for i:= 1 to n Do
    while(T[i] <> '') Do
    writeln(T[i]);
    end;
    begin
    saisir_n(n);
    remplirT(n,T);
    eliminer(T,n);
    afficher(T);
    end.
     
    Pour le 2éme programe, je l'ai deja testé hier mais ça marche pas, je sais pas d'ou vien l'erreur, si quelqu'un peut m'aider de poster les solutions...
    et voila les enoncés
     
  2. Dartagnan

    Dartagnan عضو نشيط

    إنضم إلينا في:
    ‏9 ديسمبر 2007
    المشاركات:
    123
    الإعجابات المتلقاة:
    130
      19-05-2009 09:05
    Voila les enoncés
     

    الملفات المرفقة:

  3. Marvy

    Marvy عضو نشيط

    إنضم إلينا في:
    ‏23 ديسمبر 2007
    المشاركات:
    177
    الإعجابات المتلقاة:
    66
      19-05-2009 09:08
    la 1er ne marche pas quand j'ecrit la valeur le programe est bloqué
     
  4. Marvy

    Marvy عضو نشيط

    إنضم إلينا في:
    ‏23 ديسمبر 2007
    المشاركات:
    177
    الإعجابات المتلقاة:
    66
      19-05-2009 09:10
    voila la correction de la 1er


    program mai_22_2008_10h30;
    uses wincrt;
    var n:longint;
    procedure saisie( var n: longint);
    begin
    repeat
    writeln (' donner n');
    readln (n);
    until (n >=100);
    end;
    function Somme ( n:longint): integer;
    var S: integer;
    begin
    s:=0;
    while( n<>0) do
    begin
    s:= s+(n mod 10);
    n:= n div 10;
    end;
    Somme :=s;
    end;
    function code ( n: longint): string;
    var ch1,ch2: string;
    s: integer;
    begin
    s:=n;
    while (s>9) do
    begin
    s:= somme ( s);
    end;
    str (n,ch1);
    str (s,ch2);
    code:= ch2+ch1;
    end;

    begin
    saisie (n);
    writeln (' le code est ', code ( n));
    end.
     
    1 person likes this.
  5. Marvy

    Marvy عضو نشيط

    إنضم إلينا في:
    ‏23 ديسمبر 2007
    المشاركات:
    177
    الإعجابات المتلقاة:
    66
      19-05-2009 09:12
    la 2eme



    22-5-2008 de 15h30 à 16h30
    program BacPratique2008ep4;
    uses wincrt;
    type
    tab = array [1..30] of string;
    var
    t :tab;
    n : integer;
    {************ Saisir b *****************
    procedure saisir (var b : integer);
    begin
    repeat
    writeln('donner un entier');
    readln(b);
    until(b in [5..30]);
    end;
    {*************** Remplir un tableau de chaînes *****************
    procedure remplir( var t1 : tab ; k : integer);
    var
    s : integer ;
    begin
    for s:=1 to k do
    begin
    writeln('donner un mot ',s);
    readln(t1);
    end;
    end;
    {***** éliminer les caractères non alphabétiques et les chaînes vides ************
    procedure elimine ( var t1 : tab ; n : integer);
    var
    i,j:integer;
    ch:string;
    begin
    for i:= 1 to n do
    begin
    j:=1;
    ch:=t1;
    repeat
    if (ch[j] in ['a'..'z','A'..'Z']) then j:=j+1
    else delete(ch,j,1);
    until(j > length(ch) );
    if length(ch) > 0 then writeln(i,' ',ch);
    end;
    end;
    begin
    saisir(n);
    remplir(t,n);
    elimine(t,n);
    end.


     
    2 شخص معجب بهذا.
  6. Dartagnan

    Dartagnan عضو نشيط

    إنضم إلينا في:
    ‏9 ديسمبر 2007
    المشاركات:
    123
    الإعجابات المتلقاة:
    130
      19-05-2009 09:16
    merci pour la correction, j'ai deja cette correction mais j'ai bien compris la solution
    j'aime bien utiliser ma methode
    ou si tu peux m'expliquer les etapes
     
  7. djerbienboy

    djerbienboy عضو نشيط

    إنضم إلينا في:
    ‏27 فيفري 2008
    المشاركات:
    123
    الإعجابات المتلقاة:
    68
      19-05-2009 10:03
    Program devoir;
    USES wincrt;
    var n,s,s1,s2:integer; ch:string;
    function readn(var n:integer):integer;
    begin
    repeat
    writeln('Entrer la valeur de n positif et superieur à 100 '); readln(n);
    until (n>100);
    end;
    procedure calcs (var n:integer; var ch:string);
    var i:integer;
    p,e:integer;
    begin
    str(n,ch);

    repeat
    s:=0;
    for i:=1 to length(ch) Do
    begin
    val(ch,p,e);
    s:=s+p;

    end;
    str(s,ch);
    until ( length(ch)=1);

    end;


    {procedure calcs2 (var s:integer; var s1:integer);
    var i,p,e:integer; ch:string;
    begin
    while Not(s in [1..9]) Do
    str(s,ch);
    s1:=0;
    for i:=1 to length(ch) Do
    begin
    val(ch,p,e);
    s1:=s1+p;
    end;
    end;**



    procedure code (var ch:string ;var n:integer);
    var ch1,code:string;
    begin
    str(n,ch1);
    writeln (ch);
    code := concat (ch,ch1) ;
    writeln('votre code est : ', code);
    end;


    begin
    writeln ('****************copyright Dartagnan **************************');
    readn(n);
    calcs(n,ch);

    {calcs2(s,s1);**
    code(ch,n);
    end.
     

    الملفات المرفقة:

    • dartagna.rar
      dartagna.rar
      حجم الملف:
      538 بايت
      المشاهدات:
      6
    1 person likes this.
  8. king.men

    king.men عضو جديد

    إنضم إلينا في:
    ‏17 أفريل 2009
    المشاركات:
    49
    الإعجابات المتلقاة:
    16
      19-05-2009 13:30

    on première lieu vous ne pouvait pas écrire readn(n) dans pascal ou n'importe quel langage de programmation car ce dernier est de type entier il faut alors écrire par exemple s:=readn(n); inchalla rabi m3ak et bonne revison
     

مشاركة هذه الصفحة

جاري تحميل الصفحة...