S'enregistrerS'enregistrer RechercherRechercher FAQFAQ ConnexionConnexion
Delphi: Fusion

 
Poster un nouveau sujet   Répondre au sujet    Teamatic.net Index du Forum -> Travaux de groupes
Message Auteur
MessagePosté le: 05 11 2002 20:32    Sujet du message: Delphi: Fusion

Unité Ufichier:
Code:
unit UFichier;

interface

   uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
        Dialogs, StdCtrls, Buttons;
   procedure OuvertureFichierEnLecture(var f:TextFile; var Success: Byte);
   procedure OuvertureFichierEnEcriture(var f:TextFile; var Success: Byte);
   procedure OuvertureFichierEnAppend(var f:TextFile; var Success: Byte);
   procedure FermerFichier (var f:TextFile);


implementation

procedure OuvertureFichierEnLecture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
    CodeErreur:Integer;

begin
    s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
    nomf:=s;
    assignfile(f,nomf);
    {$I-}
    reset(f);
    codeerreur:=ioresult;
    {$I-}
    if codeerreur<>0 then
      case codeerreur of
        1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
        2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
        3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
        4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
        5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
       10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
       15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
       16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
      else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
      end
   else
    begin
      showmessage ('Fichier ouvert en lecture');
    end;
end;

procedure OuvertureFichierEnEcriture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
    CodeErreur:Integer;

begin
    s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
    nomf:=s;
    assignfile(f,nomf);
    {$I-}
    rewrite(f);
    codeerreur:=ioresult;
    {$I+}
    if codeerreur<>0 then
      case codeerreur of
        1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
        2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
        3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
        4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
        5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
       10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
       15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
       16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
      else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
      end
   else
    begin
      showmessage ('Fichier ouvert en lecture');
    end;
end;

procedure OuvertureFichierEnAppend(var f:TextFile; var Success: Byte);
var S,Nomf:string;
    CodeErreur:Integer;

begin
    s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
    nomf:=s;
    assignfile(f,nomf);
    {$I-}
    append(f);
    {$I-}
    codeerreur:=ioresult;
    if codeerreur<>0 then
      case codeerreur of
        1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
        2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
        3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
        4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
        5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
       10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
       15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
       16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
      else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
      end
   else
    begin
      showmessage ('Fichier ouvert en lecture');
    end;
end;

procedure FermerFichier (var f:TextFile);
begin
closefile(f);
end;

end.


Unité Unit1:
Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,Ufichier;

type
  TFusion = class(TForm)
    ListBox1: TListBox;
    Fusion: TBitBtn;
    Affichage: TBitBtn;
    Quitter: TBitBtn;
    procedure QuitterClick(Sender: TObject);
    procedure AffichageClick(Sender: TObject);
    procedure FusionClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const Sentinelle=32767;

var
  Fusion: TFusion;
  Source, Ajout, Resultat,f:textfile;
  Success:Byte;
  NomSource,NomAjout:string[30];
  ValeurSource,ValeurAjout:integer;
  Ligne:String ;

implementation

{$R *.dfm}

procedure TFusion.QuitterClick(Sender: TObject);
begin
application.terminate
end;

procedure TFusion.AffichageClick(Sender: TObject);
var f:textfile;
    s:string;
    success:byte;
begin
    listBox1.clear;
    ouvertureFichierEnLecture(f,success);
    while not Eof(f)do
      begin
        readln(f,s);
        listbox1.Items.Add(s)
      end;
    FermerFichier(f)
end;

procedure TFusion.FusionClick(Sender: TObject);
begin
    OuvertureFichierEnLecture(Source,Success);
    OuvertureFichierEnLecture(Ajout, Success);
    OuvertureFichierEnEcriture(Resultat, Success);
    readln (Source,NomSource,ValeurSource);
    while not eof (Ajout)Do
      begin
        readln (Ajout,NomAjout,ValeurAjout);
        while  (ValeurSource < ValeurAjout) do
          begin
            writeln(resultat,NomSource:30,ValeurSource:4);
            if not eof (source) then readln (Source,NomSource,valeurSource)
            else ValeurSource:=Sentinelle
          end;
       writeln(resultat,NomAjout:30,ValeurAjout:4)
      end;
    if ValeurSource <>Sentinelle then
      begin
        while not eof (source)do
          begin
            writeln(resultat,NomSource:30,ValeurSource:4);
            readln (resultat,NomSource,ValeurSource)
          end;
    writeln(resultat,NomSource:30,ValeurSource:4);
end;


end;

end.


A utiliser sous Delphi 6 Wink
Kaizen
Webmaster
Webmaster


Inscrit le: 07 Mar 2002
Messages: 2253
Localisation: Québec, France et ailleurs...

Revenir en haut
Montrer les messages depuis:   
Poster un nouveau sujet   Répondre au sujet Toutes les heures sont au format GMT
Page 1 sur 1

 
 
 
Powered by phpBB © 2001, 2005 phpBB Group - Traduction : phpBB-fr.com
Gzip: Disabled  -  Queries: 15  -  Generation Time: 0.52799 s