home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 19
/
CD_ASCQ_19_010295.iso
/
dos
/
prg
/
pas
/
ktools
/
source
/
batmenu.pas
next >
Wrap
Pascal/Delphi Source File
|
1994-11-17
|
3KB
|
177 lines
Program BatMenu;
{ Programme à insérer dans un fichier BATCH de menu }
{ Le programme transmet le choix effectué par l'intermédiaire de
errorlevel. }
{ KB mai 1994 }
{.$DEFINE debug}
{$IFDEF debug}
{$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
{$ELSE}
{$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
{$ENDIF}
Uses Dos,
UDrivers,UMem,
OTableau,
OGenView,OTxtView,ODialWin;
Const
BatFileName='MENU.BAT';
Type
PBatMenuWin=^TBatMenuWin;
TBatMenuWin=object(TSelWin)
Items:TTableau;
Constructor Init(NomFichier:PathStr);
Destructor Done;virtual;
Function Ligne(n:Integer):String;virtual;
Function NombreItems:Integer;virtual;
Procedure HandleEvent(Var Event:TEvent);virtual;
End;
TBatMenuApp=object(TTextApp)
Menu:PBatMenuWin;
Constructor Init;
End;
Const
EndCode:Byte=0;
Maxlen=40;
Procedure Traite(Var Ligne:String);
Var Car:Char;
Rang:Byte;
Begin
Rang:=Pos('#',Ligne);
if Rang=0
then begin
Ligne:='Rien';
Exit;
end
else begin
Ligne:=Copy(Ligne,Rang+1,length(Ligne)-Rang);
if length(Ligne)>MaxLen
then Ligne[0]:=chr(MaxLen);
end;
End;
{ objet TBatMenuWin }
Constructor TBatMenuWin.Init(NomFichier:PathStr);
Var Fichier:Text;
Tempo:string;
l,h:Byte;
Begin
TSelWin.Init(0,0,8,2,'');
Ident:='MENU';
Items.Init(10,5,maxlen+1);
assign(fichier,NomFichier);
{$I-}
reset(fichier);
{$I+}
if IOResult<>0
then begin
ErrorFlag:=2;
exit;
end;
l:=0;
While not Eof(fichier) do
begin
Readln(fichier,Tempo);
Traite(Tempo);
if Tempo <> 'Rien'
then begin
Items.Ajouter(Tempo);
if length(Tempo)>l
then l:=length(Tempo);
end;
end;
Close(fichier);
Origin.X:=(80-l-4) div 2;
h:=NombreItems;
if h>20
then h:=20;
Origin.Y:=(24-h-2) div 2;
Size.X:=l+3;
Size.Y:=h+2;
End;
Destructor TBatMenuWin.Done;
Begin
Items.Done;
TSelWin.Done;
End;
Function TBatMenuWin.Ligne(n:Integer):String;
Var S:String;
Begin
if (n<1) or (n>NombreItems)
then S:=''
else Items.Lire(S,n);
Ligne:=S;
End;
Function TBatMenuWin.NombreItems:Integer;
Begin
NombreItems:=Items.NombreItems;
End;
Procedure TBatMenuWin.HandleEvent(Var Event:TEvent);
Begin
TSelWin.HandleEvent(Event);
if ExitCode=exOk
then begin
EndCode:=Choix;
QuitMsg:=Ligne(Choix);
end;
if ExitCode<>0
then SetCommand(cmQuit);
End;
{ objet TBatMenuApp }
Constructor TBatMenuApp.Init;
Var S:String;
Begin
TTextApp.Init;
Titre:='BATMENU (KB mai 1994)';
EndCode:=0;
if paramcount>0
then S:=paramstr(1)
else S:=BatFileName;
Menu:=new(PBatMenuWin,Init(S));
if not Menu^.IsValid
then begin
Message(' Erreur d''initialisation ! ');
dispose(Menu,Done);
SetCommand(cmQuit);
end
else begin
Insert(Menu);
Menu^.Select;
end;
End;
{************************ Début du Programme *****************************}
Var BatMenuApp:TBatMenuApp;
b:Byte;
Begin
{$ifdef debug}
initmem;
{$endif}
BatMenuApp.Init;
b:=BatMenuApp.Exec;
BatMenuApp.Done;
{$ifdef debug}
diagmem;
{$endif}
Halt(EndCode);
End.
{ Fin du fichier BatMenu.Pas }