[Back to MENU SWAG index] [Back to Main SWAG index] [Original]
{
Vertical menu unit.
You can find my horizontal menu unit in the SWAG (since November 96).
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º º°
º AVONTURE CHRISTOPHE º°
º AVC SOFTWARE º°
º BOULEVARD EDMOND MACHTENS 157/53 º°
º B-1080 BRUXELLES º°
º BELGIQUE º°
º º°
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ°
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
This is one of my very best unit. Please send me a postcard if you find
it usefull. Thanks in advance!
==> Hey, is there somebody in the United States of America? I have <==
==> received postcard from severall country but none from the States <==
==> Be the first! <==
}
Unit Menu;
Interface
Uses Crt;
Type TCadre = Array [1..8] of Char;
Const Choixxx : Byte = 0;
Double : Tcadre = ('É','Í','»','º','º','È','Í','¼'); { Cadre }
Var TMenu, TMenu2 : Array [1..25,1..2] of string[80];
{ Show a menu option. Equivalent of @X,Y Prompt "Texte" of Clipper
}
Procedure Prompt (X,Y : Word; Option, Aide : String);
{ This function allowed the selection of an option. You must first call
the Prompt procedure and display all wanted options. Then the MChoix
function will made everything.
If the user press the escape Key, the result will be 255
F1 key 59
F2 60
..
F10 68
The return result is the index of the option in the TMenu array
}
Function MChoix (X, Y, Nombre : Word) : Byte;
{ This procedure show an animated line at the specified screen coordinates
For example,
Scroll (25, 10, 70, 'You are a very good Pascal Programmer');
}
Procedure Scroll (X, Y0, Y1 : Byte; Texte : String);
{ Draw a cadre
}
Procedure Cadre (ColD, LigD, ColF, LigF, Attr, Back : Byte; Cad : TCadre);
{ Write a string at the specified screen coordinates and with the given
color attribut
}
Procedure WriteStrXY (X, Y, TAttr, TBack : Word; Texte : String);
Implementation
Var
TextBack : Byte;
Ch : Char;
sBlankLine: String;
{ Draw a cadre
}
Procedure Cadre (ColD, LigD, ColF, LigF, Attr, Back : Byte; Cad : TCadre);
Var
X, Y, I, Longueur, Hauteur : Byte;
sLine : String;
Begin
X := WhereX; Y := WhereY;
Longueur := (ColF-ColD)-1;
Hauteur := (LigF-LigD)-1;
WriteStrXy (ColD, LigD, Attr, Back, Cad[1]);
FillChar (sLine[1], Longueur, Cad[2]);
sLine [0] := Chr(Longueur);
WriteStrXy (ColD+1, LigD, Attr, Back, sLine);
WriteStrXy (ColD+1+Longueur, LigD, Attr, Back, Cad[3]);
For i:= 1 To Hauteur Do Begin
WriteStrXy (ColD, LigD+I, Attr, Back, Cad[4]);
FillChar (sLine[1], Longueur, ' ');
sLine [0] := Chr(Longueur);
WriteStrXy (ColD+1, LigD+I, Attr, Back, sLine);
WriteStrXy (ColD+1+Longueur, LigD+I, Attr, Back, Cad[5]);
End;
WriteStrXy (ColD, LigF, Attr, Back, Cad[6]);
FillChar (sLine[1], Longueur, Cad[7]);
sLine [0] := Chr(Longueur);
WriteStrXy (ColD+1, LigF, Attr, Back, sLine);
WriteStrXy (ColD+1+Longueur, LigF, Attr, Back, Cad[8]);
GotoXy (X, Y);
End;
{ Write a string at the specified screen coordinates and with the given
color attribut
}
Procedure WriteStrXY (X, Y, TAttr, TBack : Word; Texte : String);
Var Offset : Word;
i : Byte;
Attr : Word;
Begin
offset := Y * 160 + X Shl 1;
Attr := ((TAttr+(TBack Shl 4)) shl 8);
For i:= 1 to Length (Texte) do Begin
MemW[$B800:Offset] := Attr or Ord(Texte[i]);
Inc (Offset,2);
End;
End;
{ Show a menu option. Equivalent of @X,Y Prompt "Texte" of Clipper
}
Procedure Prompt (X,Y : Word; Option, Aide : String);
Begin
WriteStrXy (X,Y, TextAttr,TextBack,Option);
WriteStrXy (0,24,TextAttr,TextBack,sBlankLine);
WriteStrXy (2,24,TextAttr,TextBack,Aide);
End;
{ This function allowed the selection of an option. You must first call
the Prompt procedure and display all wanted options. Then the MChoix
function will made everything.
If the user press the escape Key, the result will be 255
F1 key 59
F2 60
..
F10 68
The return result is the index of the option in the TMenu array
}
Function MChoix (X, Y, Nombre : Word) : Byte;
Begin
GotoXy (X, Y+Choixxx-1);
TextBack := 5;
Repeat
Prompt (X, Y+Choixxx, TMenu [Choixxx+1,1], TMenu [Choixxx+1,2]);
TextBack := 1;
Ch := Readkey; If Ch = #0 then Ch := Readkey;
Prompt (X, Y+Choixxx, TMenu [Choixxx+1,1], TMenu [Choixxx+1,2]);
TextBack := 05;
If (Ch = #72) then begin
If Not (Choixxx = 0) then Begin
GotoXy (X,Y-1); {UpKey}
Dec (choixxx);
End
Else Begin
Choixxx := Nombre - 1;
GotoXy (X,Y+Choixxx);
End
End
Else If (Ch = #80) then begin
If not (Choixxx = Nombre-1) then Begin
GotoXy (X,Y+1);
Inc (Choixxx); {DownKey}
End
Else Begin
Choixxx := 0;
GotoXy (X,Y);
End
End
Else If (Ch = #71) then Begin
GotoXy (X,Y); {Home}
Choixxx := 0;
End
Else If (Ch = #79) then Begin
GotoXy (X,Y+Nombre); {End}
Choixxx := Nombre-1;
End;
Until ((ch = #13) or (ch = #27) or (Ch in [#59..#68]));
If Ch = #27 then MChoix := 255
Else If Ch in [#59..#68] then MChoix := Ord(Ch)
Else MChoix := Choixxx + 1;
End;
{ This procedure show an animated line at the specified screen coordinates
For example,
Scroll (25, 10, 70, 'You are a very good Pascal Programmer');
}
Procedure Scroll (X, Y0, Y1 : Byte; Texte : String);
Type TCell = Record
C : Char;
A : Byte;
End;
TScreen = array[1..25, 1..80] of TCell;
Var Scr : TScreen Absolute $B800:0;
I, J : Byte;
Tour : LongInt;
Begin
I := 1;
Repeat
While (port[$3da] and 8) <> 0 Do; { wait retrace }
While (port[$3da] and 8) = 0 Do;
For J := Y0 To (Y1-1) Do
Scr[X, J] := Scr[X, J+1]; { shift cell left }
Scr[X, Y1].C := Texte[I]; { add new cell }
Scr[X, Y1].A := 14 + (1 * 16);
I := 1 + (I mod Length(Texte));
Until Keypressed;
End;
Begin
FillChar (sBlankLine[1], 80, ' ');
sBlankLine[0] := #80;
End.
{ ----------------------------- cut here --------------------------------- }
{
Example of the vertical menu unit
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º º°
º AVONTURE CHRISTOPHE º°
º AVC SOFTWARE º°
º BOULEVARD EDMOND MACHTENS 157/53 º°
º B-1080 BRUXELLES º°
º BELGIQUE º°
º º°
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ°
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
}
Uses Crt, Menu;
Const
TextColor = 15; { Color Fore and Back color }
BackColor = 01;
Var Choix, I : Byte;
Lig : String;
Begin
{ Draw the screen }
TextAttr := TextColor + (BackColor Shl 4);
ClrScr;
Cadre (02, 01, 78, 05, TextColor, BackColor, Double);
WriteStrXy (04, 03, TextColor, BackColor, 'Vertical Unit Menu Sample.');
WriteStrXy (04, 04, TextColor, BackColor, 'Try the '+
'horizontal Menu Unit of AVONTURE Christophe -see in the SWAG- ');
Cadre (41, 07, 78, 20, TextColor, BackColor, Double);
WriteStrXy (43, 09, TextColor, BackColor,
'This is a little example to show');
WriteStrXy (43, 10, TextColor, BackColor, 'you the feature of the menu unit.');
WriteStrXy (43, 13, TextColor, BackColor,
'This menu unit has been written by');
WriteStrXy (50, 14, TextColor, BackColor, 'AVONTURE Christophe');
Cadre (02, 07, 38, 15, TextColor, BackColor, Double);
WriteStrXy (00, 24, TextColor, BackColor, ' ');
{ Set the menu option. The first index is the option and the second, the
help line
}
TMenu [1,1] := 'This is the first option';
TMenu [1,2] := 'This option can be used in order to ... :=) ';
TMenu [2,1] := 'Send a postcard';
TMenu [2,2] := '... for me? This idea is very good! I wait news from you...';
TMenu [3,1] := 'This unit is great, isn''t it?';
TMenu [3,2] := 'Happy to see that you can find this unit usefull...';
TMenu [4,1] := 'Nice to meet you';
TMenu [4,2] := 'Hello, How are you?';
TMenu [5,1] := 'Terminate this example';
TMenu [5,2] := 'You can also use the Escape key';
{ Put the options on the screen: Column, line, option, help.
}
Prompt (04, 09, TMenu [1,1], TMenu [1,2]);
Prompt (04, 10, TMenu [2,1], TMenu [2,2]);
Prompt (04, 11, TMenu [3,1], TMenu [3,2]);
Prompt (04, 12, TMenu [4,1], TMenu [4,2]);
Prompt (04, 13, TMenu [5,1], TMenu [5,2]);
{ Show a little string animation...
}
Scroll (25, 01, 79, 'WOW!!! What a cool vertical menu unit...'+
' ');
Repeat Until KeyPressed; ReadKey;
{ Clear the last line of the screen
}
GotoXy (1, 25);
ClrEol;
{ Process the menu option selection
}
Repeat
{ Call the menu handler with three argument :
the first is the start column of the first option
the second is the start line of the first option
the last is the number of option in our menu
}
Choix := MChoix (4,9,5);
{ Once the user has been pressed on a function key (F1 to F10), the
escape key or the enter key, then the MChoix function will return
a numeric value:
59 to 68 if a function key has been pressed (59 = F1, ...)
255 if the Escape key has been pressed
a number from 1 to the option number; so if the user has
pressed the enter key on the third option, the return value
will be equal to 3.
}
Str (Choix, Lig);
Lig := 'The selected option is : '+ Lig;
WriteStrXy (43, 17, 15, 01, Lig);
{ I continue until the escape key is pressed or the 'Quit' option has
been selected (this is the 5 option)
}
Until ((Choix = 5) or (Choix = 255));
ClrScr;
End.
[Back to MENU SWAG index] [Back to Main SWAG index] [Original]