بربي مساعدة turbo pascal

الموضوع في 'أرشيف المنتدى التعليمي' بواسطة THE_KiNG_OF_MiX, بتاريخ ‏20 أكتوبر 2008.

  1. THE_KiNG_OF_MiX

    THE_KiNG_OF_MiX عضو مميز

    إنضم إلينا في:
    ‏22 مارس 2006
    المشاركات:
    962
    الإعجابات المتلقاة:
    2.360
      20-10-2008 18:09


    الرجاء اطلب منكم algorithme procédure suppression d'un élément و procédure de tri dans les fichier et merci

    انا في bac info و حاجتي باهم شكراا
     
  2. houba

    houba نجم المنتدى

    إنضم إلينا في:
    ‏9 جويلية 2007
    المشاركات:
    3.014
    الإعجابات المتلقاة:
    556
  3. THE_KiNG_OF_MiX

    THE_KiNG_OF_MiX عضو مميز

    إنضم إلينا في:
    ‏22 مارس 2006
    المشاركات:
    962
    الإعجابات المتلقاة:
    2.360
      20-10-2008 23:58
    à l'aide svp voila le program je ve juste ajouter une procedure de tri par moyenne et voir le rang de léleve aussi la supression d'un eleve

    program cours;
    uses wincrt;


    type

    str20 = string[20];

    eleve =record

    nom : str20;
    note1,note2,moy :real;

    rang: integer;

    end;

    moyenne = file of eleve;

    var

    f : moyenne;

    e : eleve;


    {-----------------------------------------**
    procedure ouvrir ( var f : moyenne );
    begin

    {$i-** reset (f); {$i+**

    if ioresult <> 0 then rewrite (f);

    end;


    {-----------------------------------------**

    procedure saisie ( var e : eleve);

    begin

    with e do

    begin


    write ('nom : '); readln (nom);

    repeat

    write ('note 1: ') ; readln (note1)
    until
    (note1>=0) and (note1 <= 20);

    repeat

    write ('note 2 :') ; readln (note2)

    until

    (note2>=0) and (note2 <= 20);

    moy := (note1+2*note2)/3;

    rang :=0;
    end;

    end;
    {-----------------------------------------**
    procedure modifier ( var f: moyenne );

    var

    x : integer ;

    e: eleve ;

    begin

    repeat

    write (' position de lelement a modifier ');

    readln (x);

    until x in [1.. filesize(f)];


    seek (f,x-1);

    saisie (e);

    write (f,e);

    end;

    {-----------------------------------------**
    procedure supprimer (var f : moyenne);

    var

    x :integer;
    e: eleve;

    begin

    repeat

    write (' position de suppression ');

    readln (x);

    until x in [1..filesize(f)];

    seek (f,x-1);

    truncate (f);

    end;

    {-----------------------------------------**
    procedure lecture ( var f : moyenne);
    var
    e:eleve;
    c : char;
    begin
    seek(f,filesize (f));

    repeat

    writeln ('....... nouveau enregistrement ..........');

    saisie (e);

    write (f,e);

    writeln (' echap pour quitter');
    c := readkey

    until (c = chr(27));

    end;

    {-----------------------------------------**
    procedure affiche (var f: moyenne);
    var
    e: eleve;

    begin

    reset(f);

    while not eof (f) do

    begin

    read (f,e);

    writeln (e.nom :10,e.note1:10:2,e.note2:10:2,e.moy:10:2,e.rang:10);


    end;

    end;

    {-----------------------------------------**

    procedure menu ;

    var
    c : char;

    begin


    clrscr;

    writeln (' --------------- MENU ----------------');
    writeln;
    writeln (' @ 1 AJOUTER @ ') ;
    writeln;
    writeln (' @ 2 AFFICHER @ ');
    writeln;
    writeln (' @ 3 MODIFIER @ ');
    writeln;
    writeln (' @ 4 SUPPRIMER @ ');
    writeln;
    writeln (' @ 5 Quitter @ ');
    writeln (' --------------------------------------');
    repeat


    c := readkey;

    until c in ['1'..'5'];

    case c of

    '1' : begin
    clrscr;
    writeln ('---- 1 Ajouter enregistrement ---- ');
    lecture (f);
    menu;

    end;

    '2' :begin

    clrscr;

    writeln (' ---- 2 Afficher tout --------');

    affiche (f);
    readkey;
    menu;
    end;

    '3' : begin

    clrscr;

    writeln (' ------ 3 Modifier ------- ');

    modifier (f);

    readkey;

    menu;

    end;

    '4':
    begin

    clrscr;

    writeln (' -------- 4 supprimer -----');

    supprimer (f);

    readkey;

    menu;


    end;


    '5': donewincrt;


    end;
    end;



    {-----------------------------------------**

    begin

    assign (f,'C:\sinfo\cours.txt');
    ouvrir (f);

    menu;



    end.
     

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

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