home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 12
/
CD_ASCQ_12_0294.iso
/
vrac
/
vmschm.zip
/
VMSCHM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-02-18
|
15KB
|
673 lines
PROGRAM VMSCHM;
USES
Crt, Basic;
TYPE
Menustr = array[0..8] of string;
VAR
Datastr : menustr;
wd_colm, wd_row, wd_lgth, wd_hgth: integer;
cl, rw : integer;
i, j, p : integer;
index : integer;
xstr, ystr : string;
tstr : char;
t : integer;
space : integer;
design : char;
(*
==========================================================================
Shows how to divide and design screen and puts the messages. This is a
simple combination of procedures box, border and draw.
==========================================================================
*)
PROCEDURE Info;
begin
screensetup;
set_color(1,0);
box(1,1,80,25, false, false);
set_color(1,1);
draw(2,1,39,22, #219);
set_color(1,0);
draw(2,1,19,22, #219);
border(4,3,80,20,false);
set_color(0,1);
draw(45,4,14,1, #220);
draw(43,4,1,16, #219);
draw(72,4,1,16, #219);
set_color(1,0);
draw(45,19,14,1, #220);
set_color(1,0);
border(43, 5, 115, 16, false);
gotoxy(45,5);
xstr:='Vertical Bar Menu Schemata';
set_color(1,0);
write(centerstr(xstr, 26));
xstr:='(c) 1993| Ali Kocaturk' ;
gotoxy(45,6);
write(#254);
draw(46,5,13,1, #205);
gotoxy(71,6);
write(#254);
gotoxy(48, 6);
write(xstr);
gotoxy(48,8);
write(' Fax: (201) 223 0578 ');
set_color(7,1);
gotoxy(45,9);
writeln('VBMS v1.00 is Shareware. If');
gotoxy(45,10);
writeln('you have any questions and/');
gotoxy(45,11);
writeln('or comments, please contact');
gotoxy(45,12);
writeln('me. Try it out! If you feel');
gotoxy(45,13);
writeln('it is use of to you, please');
gotoxy(45,14);
writeln('register now by sending $15');
gotoxy(45,15);
writeln('--or whatever is fair-- to:');
gotoxy(45,16);
set_color(1,1);
write(spacestr(27));
set_color(7,1);
gotoxy(45,17);
writeln('Ali Kocaturk ');
gotoxy(45,18);
writeln('409 Harmon Cove Towers ');
gotoxy(45,19);
writeln('Secaucus, New Jersey, 07094');
movecursor;
set_color(0,1);
draw(78,1,1,22, #176);
draw(2,1,1,22, #176);
draw(2,1,39,1, #176);
draw(2,22,39,1, #176);
set_color(122,117);
draw(6,3,16,7, #196);
draw(6,4,1,5, #219);
draw(8,9,2,1, #223);
draw(12,4,1,5, #219);
draw(15,4,1,5, #219);
draw(17,4,2,1, #223);
draw(19,4,1,2, #219);
draw(17,6,2,1, #223);
draw(19,6,1,3, #219);
draw(15,9,3,1, #223);
draw(22,4,1,5, #219);
draw(25,5,1,2, #219);
draw(28,4,1,5, #219);
draw(31,4,4,1, #223);
draw(31,4,1,2, #219);
draw(31,6,4,1, #223);
draw(37,6,1,3, #219);
draw(31,9,4,1, #223);
set_color(1,7);
border(6,13,43,8, false);
gotoxy(6,11);
set_color(7,1);
write(spacestr(33));
set_color(0,1);
gotoxy(6,12);
write(spacestr(33));
set_color(0,0);
draw(7,13,15,6, #178);
gotoxy(8,14);
set_color(7,1);
write( #22,' Creates a menu driven ');
gotoxy(8,15);
write(' programs. ');
gotoxy(8,16);
write( #22,' Provides powers to design ');
gotoxy(8 ,17);
write(' screens. ');
gotoxy(8,18);
write( #22,' Contributes to programming ');
gotoxy(8 ,19);
write(' skills. ');
gotoxy(6,21);
set_color(0,1);
write(spacestr(33));
movecursor;
end;
(*
=========================================================================
Draws box and/or boxes at specified coordinates. The line parameter, if
is set to true, prints horizantal bars two rows from the top of the box
and two rows up from the bottom. If line parameter is set to false, the
box will draw a plainbox. The parameter shadow can be used with or with-
out the line parameter.
==========================================================================
*)
PROCEDURE boxdemo;
begin
set_color(0,1);
clrscr;
set_color(0,1);
delay(300);
box(1,1,80,5, false,false);
draw(2,1,39,2,#186);
delay(300);
set_color(1,7);
box(1,6,80,11, false, false);
draw(2,6,39,3, #22);
delay(300);
set_color(0,1);
box(1,9,80,25, false, false);
draw(2,9,39,15, #196);
restore_screen;
delay(600);
set_color(7,1);
box(1,1,80,13,false,false);
delay(600);
set_color(0,1);
box(1,8,80,5,false,false);
delay(600);
set_color(7,1);
box(1,5,80,5,false,false);
delay(600);
set_color(7,1);
box(1,5,80,25, false,false);
delay(600);
set_color(7,1);
box(1,10,80,10, false,false);
delay(600);
set_color(7,1);
box(1,18,80,7,false,false);
gotoxy(2,8);
set_color(0,0);
draw(2,1,39,2, #0);
draw(2,6,39,2, #0);
set_color(0,1);
draw(2,1,39,1,#0);
draw(2,10,39,1,#177);
draw(2,18,39,5,#176);
set_color(7,1);
delay(500);
border(17,2,56,22,false);
border(41,2,104,22,false);
set_color(0,1);
delay(900);
draw(18,2,11,20,#255);
set_color(0,0);
delay(1200);
draw(42,2,11,20,#255);
set_color(1,7);
delay(900);
draw(26,5,2,7, #219);
draw(49,5,4,1,#223);
draw(53,5,3,4,#219);
draw(49,9,5,1,#223);
draw(49,9,2,3,#219);
delay(300);
draw(26,13,2,1, #219);
draw(49,13,2,1,#219);
restore_screen;
end;
(*
==========================================================================
Prints the background character to all locations on the screen; draws
boxes and saves the content.
==========================================================================
*)
PROCEDURE Setup;
begin
set_color(1,15);
screensetup;
set_color(7,1);
box(1,1,80,25, false, true);
gotoxy(2,2);
write(spacestr(78));
save_screen;
end;
(*
==========================================================================
Prints the program's id on the top line; provides information regarding
help on the bottom line. The bottom line is where the information are
to be displayed for the selections.
==========================================================================
*)
PROCEDURE suppl;
begin
gotoxy(2,2);
xstr:='Procedure call: ';
write(centerstr(xstr, 78));
set_color(0,1);
draw(2,3,39,18, #196);
set_color(1,0);
gotoxy(6,9);
xstr:=('**********************************');
write(xstr);
gotoxy(2,23);
set_color(7,1);
xstr:='Use <Enter> to return to menu';
write(centerstr(xstr, 78));
end;
PROCEDURE Status;
begin
xstr:= 'VMSCHM: Vertical Menu Schemata, v 1.oo, (c) 1993 Ali Kocaturk';
set_color(15,1);
gotoxy(2,2);
write(centerstr(xstr, 78));
xstr:='Use initials or <' + #24 + '><' + #25 +
'> to select and <Enter> to execute or <Quit> to exit';
set_color(7,1);
gotoxy(2,23);
write(centerstr(xstr, 78));
set_color(7,4);
border(5,7,24,10, true);
end;
PROCEDURE Main; forward;
PROCEDURE Help; forward;
(*
===========================================================================
All applications must be declared before menu.
===========================================================================
*)
PROCEDURE Aaaaaaa;
begin
setup;
suppl;
gotoxy(9,9);
xstr:=' Aaaaaaa ';
write(xstr);
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Bbbbbbb;
begin
setup;
suppl;
gotoxy(9,9);
write(' Bbbbbbb');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Ccccccc;
begin
setup;
suppl;
gotoxy(9,9);
write(' Ccccccc');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Ddddddd;
begin
setup;
suppl;
gotoxy(9,9);
write(' Ddddddd');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Eeeeeee;
begin
setup;
suppl;
gotoxy(9,9);
write(' Eeeeeee');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Fffffff;
begin
setup;
suppl;
gotoxy(9,9);
write(' Fffffff');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Ggggggg;
begin
setup;
suppl;
gotoxy(9,9);
write(' Ggggggg');
movecursor;
readln;
info;
readln;
main;
end;
PROCEDURE Quit;
begin
halt;
end;
(*
===========================================================================
Writes menu items. The menu items are dimensioned in datastr[i].
===========================================================================
*)
PROCEDURE Tabula;
var
mstr, nstr: string;
max_lgth : integer;
max_number: integer;
begin
datastr[0]:= '<VMSCHM>';
datastr[1]:=' Aaaaaaa ';
datastr[2]:=' Bbbbbbb ';
datastr[3]:=' Ccccccc ';
datastr[4]:=' Ddddddd ';
datastr[5]:=' Eeeeeee ';
datastr[6]:=' Fffffff ';
datastr[7]:=' Ggggggg ';
datastr[8]:=' Quit ';
mstr:=datastr[0];
gotoxy(7,7);
set_color(7,1);
write(mstr);
max_number:=8;
wd_colm:=5;
wd_row:= 7;
for i:= 1 to max_number do begin
gotoxy(wd_colm + 1, wd_row + i);
write(datastr[i]);
end;
nstr:='<F1> for help';
gotoxy(6, 16);
set_color(7,1);
write(nstr);
end;
(*
===========================================================================
Floats the colored bar through the selections; checks the keyboard for
specific keys; provides the choice [p].
===========================================================================
*)
PROCEDURE Selection;
var
max_number: integer;
max_lgth: integer;
begin
tabula;
p:=1;
max_number:=8;
max_lgth:=0;
tstr:=#0; { Must not be changed ! }
for i:= 1 to max_number do begin
if length(datastr[i]) > max_lgth then
max_lgth:= length(datastr[i]);
gotoxy(wd_colm +3, wd_row + i);
set_color(0,0);
write(spacestr(1));
end;
while (tstr <> #27) and (tstr <> #13) do begin
cl:= wd_colm + 1;
rw:= wd_row + p + 1;
xstr:= datastr[p];
gotoxy(cl, rw-1);
set_color(0,1);
gotoxy(cl, rw-1);
write(xstr);
setcursor(0,0);
tstr:= readkey;
if tstr=#0 then begin
repeat
tstr:=readkey;
if tstr=#0 then tstr:= readkey;
until (tstr=#72) or (tstr=#80) or (tstr=#59) ;
end;
rw:= wd_row + p + 1;
cl:= wd_colm + 1;
gotoxy(cl, rw -1);
set_color(7,1);
write(xstr);
if tstr= #27 then index:=0;
if tstr= #13 then index:=p;
if tstr= #72 then dec(p);
if tstr= #80 then inc(p);
if tstr= #71 then p:=1;
if tstr= #79 then p:= max_number;
if p < 1 then p:= max_number;
if p> max_number then p:=1;
if tstr=#59 then help;
for i:= 1 to max_number do begin
gotoxy(wd_colm + 3, wd_row + i);
set_color(0,0);
write(spacestr(1));
end;
tstr:=upcase(tstr);
case tstr of
'A' : Aaaaaaa;
'B' : Bbbbbbb;
'C' : Ccccccc;
'D' : Ddddddd;
'E' : Eeeeeee;
'F' : Fffffff;
'G' : Ggggggg;
'Q' : Quit;
end;
end;
end;
(*
==========================================================================
It is added for the sake of simplicity; and provides bar selection.
==========================================================================
*)
PROCEDURE Main;
begin
setup;
status;
selection;
case p of
1: begin
Aaaaaaa;
end;
2: begin
Bbbbbbb;
end;
3: begin
Ccccccc;
end;
4: begin
Ddddddd;
end;
5: begin
Eeeeeee;
end;
6: begin
Fffffff;
end;
7: begin
Ggggggg;
end;
8: begin
Quit;
end;
end;
end;
(*
===========================================================================
Help can be called by any menu item; provides an information about the
program. Notice the screen design.
===========================================================================
*)
PROCEDURE Help;
begin
info;
readln;
set_color(0,1);
setup;
set_color(1,0);
delay(400);
border(5, 5, 80,16, false);
set_color(1,1);
delay(400);
draw(6,5,35,14, #255);
delay(400);
set_color(7,4);
draw(9,6,32,12, #196);
set_color(1,7);
delay(400);
draw(11,7,30,1, #219);
delay(400);
draw(11,7,30,1, #178);
set_color(4,7);
delay(400);
draw(11,8,30,8, #186);
set_color(0,1);
delay(400);
draw(11,16,30,1, #176);
set_color(1,7);
delay(400);
draw(18,8,23,8, #220);
set_color(7,1);
delay(400);
draw(23,10,18,4, #254);
set_color(7,1);
delay(400);
draw(23,11, 13,2, #16);
set_color(0,1);
delay(400);
draw(34,11, 11,2, #255);
set_color(7,1);
delay(400);
draw(34,11,5,2, #221);
set_color(7,1);
delay(800);
draw(41,11,6,2, #255);
set_color(117,122);
delay(200);
gotoxy(41,12);
write(' VMSCHM ');
set_color(122,117);
delay(400);
draw(41,12,6,1, #255);
gotoxy(41,13);
set_color(1,1);
delay(400);
write(' ');
set_color(7,1);
delay(400);
draw(49,11,5,2, #17);
gotoxy(2,2);
set_color(7,4);
xstr:='This is an Help Message for ..';
delay(400);
write(centerstr(xstr, 78));
gotoxy(2,23);
set_color(7,4);
xstr:='Use <Enter> or <Esc> to return to Menu';
delay(400);
write(centerstr(xstr, 78));
delay(900);
boxdemo;
while (tstr<>#13) do begin
tstr:= #13;
tstr:=readkey;
main;
end;
end;
(*
==========================================================================
Main Program.
==========================================================================
*)
Begin
clrscr;
save_screen;
main;
restore_screen;
End.