 Posté le: 13 11 2002 17:00 Sujet du message: Unité ufichier et fictexteclub |
|
|
| Code: | unit ufichier;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;
type tform1=class(tform)
end;
var form1:tform1;
sortir:boolean;
f:textfile;
nomf:string[30];
ligne:string;
sucess:byte;
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);
procedure errorlevel(var success:byte);
implementation
procedure errorlevel(var success:byte);
begin
case success of
2:showmessage('Fichier non trouve');
3:showmessage('chemin du fichier non trouver');
4:showmessage('Trop de fichiers ouvert');
5:showmessage('Acces au fichier interdit');
6:showmessage('indicateur de fichier invalide');
15:showmessage('Numero de lecteur invalide');
100:showmessage('erreur de lecture sur le disque');
101:showmessage('erreur en ecriture,disque plein');
102:showmessage('fichier non assigner');
103:showmessage('fichier non ouvert');
104:showmessage('fichier non ouvert pour lecture');
105:showmessage('fichier non ouvert pour ecriture');
106:showmessage('Format de lecture numerique invalide');
else showmessage('Erreur inconnu...!');
end;
end;
procedure OuvertureFichierEnLecture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:byte;
begin
sortir:=false;
repeat
s:=InputBox('Nom du fichier en lecture:','Entrez le nom du fichier','o');
nomf:=s;
if ((Nomf='f') or (Nomf='F')) then
begin
showmessage('Attention ! Vous avez tapez f pour terminer le programme !');
sortir:=true;
exit;
end;
if nomf= '' then showmessage('ouverture impossible, introduisez le nom');
{$I-}
assignfile(f,nomf);
reset(f);
codeerreur:=ioresult;
{$I+}
if (codeerreur<>0) or (nomf='') then
if nomf ='' then showmessage('ouverture impossible, introduisez le nom')
else
begin
showmessage('Ouverture impossible,erreur # '+inttostr(codeerreur));
erreurlevel(codeerreur);
end;
Until (codeerreur=0) and (nomf<>'');
showmessage('fichier '+nomf+' ouvert en lecture');
end;
procedure OuvertureFichierEnEcriture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:byte;
begin
sortir:=false;
repeat
s:=InputBox('Nom du fichier en lecture:','Entrez le nom du fichier','o');
nomf:=s;
if ((Nomf='f') or (Nomf='F')) then
begin
showmessage('Attention ! Vous avez tapez f pour terminer le programme !');
sortir:=true;
exit;
end;
if nomf= '' then showmessage('ouverture impossible, introduisez le nom');
{$I-}
assignfile(f,nomf);
rewrite(f);
codeerreur:=ioresult;
{$I+}
if (codeerreur<>0) or (nomf='') then
if nomf ='' then showmessage('ouverture impossible, introduisez le nom')
else
begin
showmessage('Ouverture impossible,erreur # '+inttostr(codeerreur));
erreurlevel(codeerreur);
end;
Until (codeerreur=0) and (nomf<>'');
showmessage('fichier '+nomf+' ouvert en ecriture');
end;
procedure OuvertureFichierEnAppend(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:byte;
begin
sortir:=false;
repeat
s:=InputBox('Nom du fichier en lecture:','Entrez le nom du fichier','o');
nomf:=s;
if ((Nomf='f') or (Nomf='F')) then
begin
showmessage('Attention ! Vous avez tapez f pour terminer le programme !');
sortir:=true;
exit;
end;
if nomf= '' then showmessage('ouverture impossible, introduisez le nom');
{$I-}
assignfile(f,nomf);
append(f);
codeerreur:=ioresult;
{$I+}
if (codeerreur<>0) or (nomf='') then
if nomf ='' then showmessage('ouverture impossible, introduisez le nom')
else
begin
showmessage('Ouverture impossible,erreur # '+inttostr(codeerreur));
erreurlevel(codeerreur);
end;
Until (codeerreur=0) and (nomf<>'');
showmessage('fichier '+nomf+' ouvert en append');
end;
procedure FermerFichier (var f:TextFile);
var codeerreur:byte;
begin
{$I-}
closefile(f);
codeerreur:=ioresult;
{$I+}
if codeerreur<>0 then showmessage('Erreur !! Fichier non ouvert')
else showmessage('Le fichier a été fermé !');
end;
end.
*************************************************************
unit fictexteclub;
interface
uses
Windows,ufichier, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs,stdctrls;
type
TForm1 = class(TForm)
ecrire:tbutton;
lecture:tbutton;
quitter:tbutton;
memo1:tmemo;
creer:tbutton;
procedure ecrireclick(sender:tobject);
procedure lectureclick(sender:tobject);
procedure quitterclick(sender:tobject);
procedure creerclick(sender:tobject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure fraismembre(var frais:integer; var nbra,nbre:integer);
const nbligneenreg=3;
nbmax=3;
Type membre=record
nom:string;
prenom:string;
telephone:string[14];
email:string[20];
nombre:integer;
paiement:real;
solde:real;
end;
var
Form1: TForm1;
f:textefile;
adh:0..5;
membres:array[1..nbmax] of membre;
total:real;
nbligne:integer;
ligne:string;
success:byte;
frais:integer;
implementation
{$R *.dfm}
procedure fraismembre(var frais:integer; var nbra,nbre:integer);
begin
frais:=nbra*50+nbre*25;
end;
procedure ajouter;
var s:string;
nbra,nbre:integer;
begin
ouverturefichierenappend(f,success);
with membres[adh] do
begin
s:=inputbox('nom:', 'Entrez le nom:','0');
nom:=s;
s:=inputbox('Prenom:', 'Entrez le prenom:','0');
prenom:=s;
s:=inputbox('telephone:', 'Entrez le numero de telephone:','0');
telephone:=s;
s:=inputbox('e-mail:', 'Entrez l''adresse e-mail:','0');
email:=s;
s:=inputbox('Nombre d''adultes:', 'Entrez le nombre d''adultes:','0');
nbra:=strtoint(s);
s:=inputbox('Nombre d''enfants:', 'Entrez le nombre d''enfants:','0');
nbre:=strtoint(s);
s:=inputbox('Paiement:', 'Entrez le montant paye:','0');
Paiement:=strtofloat(s);
writeln('f,adh,' ',Nom,' ',Prenom,' ',nbra,'adulte',nbre,'enfant');
writeln('f,' ',telephone,' ',email);
writeln('f, ' ','paye : ',paiement:5:2);
fraismembre(frais,nbra,nbre);
solde:= frais-paiement;
writeln('F,' ','solde = ',solde:5:2);
end;
closefile(f);
end;
procedure Tform1.ecrireclick(sender:tobject);
begin
if adh = nbmax then showmessage('Le club est complet !')
else begin
showmessage('Ajouter un nouveau membre');
adh:=adh+1;
ajouter;
end;
end;
procedure tform1.lectureclick(sender:tobject);
var f:textfile;
s,nomf,ligne,texte:string;
begin
s:=inputbox('nom fichier:', 'Entrez le nom du fichier:','0');
nomf:=s;
assignfile(f,nomf);
reset(f);
texte:='';
repeat
readln(f,ligne);
texte:=texte+ligne+chr(13)+chr(10);
memo1.text:=texte;
until eof(f);
closefile(f);
end;
procedure tform1.quitterclick(sender:tobject);
begin
application.terminate;
end;
procedure tform1.creerclick(sender:tobject);
begin
ouverturefichierenecriture(f,success);
with membres[adh] do
writeln(f, 'Nom ',' ',' Prenom');
writeln(f);
writeln(f);
writeln(f,'**********************')'
closefile(f);
end;
end. |
|
|
Invité
|
S'enregistrer
Rechercher
FAQ
Connexion
