home *** CD-ROM | disk | FTP | other *** search
- {.HETURBO-UT.PAS : Pascal tools for application development #}
- { * TURBO-UT.PAS ram/rom * }
- { * by Don Ramsey and Larry Romero * }
- { * March-April-May 1984 * }
-
- program turbo_ut;
-
- {$I UT-MOD00.INC } { load global variables }
-
- {**********************************************************}
- {* Shell-Module 01 *}
- {* Purpose: Misc. utilities and commands *}
- {**********************************************************}
-
- {$I UT-MOD01.INC }
-
- {**********************************************************}
- {* Shell-Module 02 *}
- {* Purpose: Input procedures and commands. *}
- {* These modules are required for use with *}
- {* the Input Procedure but can be used any time. *}
- {**********************************************************}
-
- {$I UT-MOD02.INC }
-
- {******************************************************************}
- {* Shell-Module 03 *}
- {* Purpose : Handle Variables for the Input procedure. *}
- {* These routines handle all input for NEW variables and *}
- {* CHANGES for old inputs. They handle all prompting, *}
- {* defaults, and validation. *}
- {******************************************************************}
-
- {$I UT-MOD03.INC }
-
- {******************************************************************}
- {* Shell-Module 04 *}
- {* Purpose : Provide a Lotus Type Menu. *}
- {* This routine handles all Menu Selections and Prompting *}
- {* for a Lotus Menu. Ths programmer provides Selections *}
- {* and prompts before calling the routine. *}
- {* Requires Global Procedures: *}
- {* Set_Cap_Num, Ck_edit_key *}
- {******************************************************************}
-
- {$I UT-MOD04.INC }
-
- {.pa}
- {******************************************************************}
- {* Shell-Module 10 *}
- {* Purpose : Provide Demonstrations for the Shell-Modules. *}
- {* These demos are instructive for the calling of *}
- {* the above Procedures. *}
- {******************************************************************}
-
- procedure Input2Demo;
- { Demo the Input_Handler procedure }
- var change:boolean;
-
- procedure Demo_Exit;
- begin
- Set_Cap_Num(' ',' ',' ');
- prompt('Press <E> to exit, <C> to make Changes, or',
- 'Any Other Key to repeat Demo');
- Read(kbd,Ch); Ch:=upcase(Ch);
- if Ch='C' then Change:=true else Change:=false;
- end;
-
- begin
- repeat { repeat Demo until user exits }
- clrscr; LowVideo;
-
- P[1]:='4013A03001-020201';
- P[2]:='4014N00702-010301';
- P[3]:='4016F00103-010403';
- P[4]:='4017F00204-010402';
- P[5]:='4019$00705-010501';
-
- fillchar(S,100,#205); S:=copy(S,1,80);
-
- Highvideo; Center('INPUT_HANDLER DEMO',2,1,78); Lowvideo; writeln;
- write(S);
- Center('This routine allows full screen input of variables.',2,3,78);
- Center('It also contains routines that allow the Programmer to',2,4,78);
- Center('specify prompt lines on the bottom 2 lines of the screen',2,5,78);
- Center('as well as validate the entries.',2,6,78);
- Center('However, probably the best feature is the ability to allow',2,7,78);
- Center('corrections to be made at any time by the user!!!',2,8,78);
- Center('GIVE IT A TRY',2,10,78); writeln;
- write(S); gotoXY(1,22); write(S);
-
- Msg('Alphanumeric Input Routine',3,13);
- Msg('Numeric Input Routine',3,14);
- Msg('Formatted Input Routine',3,16);
- Msg('Formatted Input Routine',3,17);
- Msg('Dollar Input Routine',3,19);
-
- Input_Handler('N0105',Escape); {Escape returned from Input_handler}
-
- if not Escape then {Escape is exit by pressing <F1> at the 1st entry}
- begin
- repeat
- Demo_Exit;
- if Change then Input_Handler('C0105',Escape);
- until (Change=false) or (Escape);
- end;
- until (Ch='E') or (Escape); { end repeat Demo }
- end;
-
- procedure Demo1;
- { *** Demo of the Box, Center, & ClrWnd procedure *** }
- var I: integer;
- begin
- ClrScr;
- Box(1,1,38,20,1); Box(42,1,80,20,5);
- Center('* This is Window #1 *',2,3,36);
- Center('* This is Window #2 *',43,3,36); LowVideo;
- for I:=7 to 19 do
- begin
- gotoXY(4,I); write('#1 #1 #1 #1 #1 #1 #1');
- gotoXY(45,I); write('#2 #2 #2 #2 #2 #2 #2');
- end;
- Prompt(' ','Press any key to Clear Window #1'); Option;
- Prompt(' ',' ');
- ClrWnd(4,7,39,19);
- Prompt(' ','Press any key to Clear Window #2'); Option;
- Center('*** Clearing ***',43,3,36); Prompt('','');
- ClrWnd(43,7,79,19);
- prompt('','Press any key to continue...'); Option;
- end; {* Demo1 *}
-
- procedure InputDemo;
- { Demo the input routines and display the returned values }
- begin
- repeat
- clrscr; LowVideo;
- write(' Alphanumeric Input Routine');
- Input('A','This is Default',40,1,30,true,F1,F10);
- writeln; writeln('Returned : ',Answer);
- Msg('Numeric Input Routine',3,5);
- Input('N','',40,5,7,true,F1,F10);
- writeln; writeln('Returned : ',Answer);
- Msg('Formatted Input Routine',3,9);
- Input('F','',40,9,1,true,F1,F10);
- writeln; writeln('Returned : ',answer);
- Msg('Formatted Input Routine',3,13);
- Input('F','',40,13,2,true,F1,F10);
- writeln; writeln('Returned : ',answer);
- Msg('Dollar Input Routine',3,17);
- Input('$','',40,17,7,true,F1,F10);
- writeln; writeln('Returned : ',answer); writeln(' ');
- write('Press <E> to exit or Any Key to repeat Demo');
- Read(kbd,Ch); Ch:=upcase(Ch);
- until Ch='E';
- end;
-
- {.pa}
- procedure L_Menu_Dem;
- procedure Get_var;
- { Lotus Menu Items, Prompts }
- begin
- P[1]:= 'Arrow .Arrow keys will move the cursor' ;
- P[2]:= 'Home .The Home/End keys are active' ;
- P[3]:= 'Space .Space Bar works too' ;
- P[4]:= 'Locate .The menu may be located anywhere';
- P[5]:= 'Prompts.Prompts are programmer definable';
- P[6]:= 'Choices.Choices too are easily redefined';
- P[7]:= 'Quit .Quit this program ' ;
- P[8]:= ' ';
- end;
- begin
- ClrScr; LowVideo;
- HighVideo; Center('L O T U S M E N U D E M O',1,10,80); LowVideo;
- Center('Use the Arrow Keys, Home, End, and Space Bar to move the cursor'
- ,1,13,80);
- Center('All Menu Items and Prompts are PROGARMMER defined',1,15,80);
- Box(1,4,80,22,6);
- repeat
- Get_var; Hmenu(1,2,'Lotus Menu',Ch);
- case Ch of
- 'Q' : Exit :=true;
- end;
- gotoXY(10,25);write('Returned: ',Ch);
- until Exit = true;
- Exit :=false;
- end;
-
- procedure FmtDemo;
- var num : real;
- Nums : array[1..10] of real;
- I : integer;
- begin
- clrscr; Nums[1]:=1; for I:=2 to 10 do Nums[I]:=(Nums[i-1]+i)*4.35;
- for I:=1 to 10 do
- begin
- gotoXY(1,4+i); write('This number ',Nums[I]:12:4);
- gotoXY(32,4+i); writeln(' Formatted is ',fmt_real(nums[I],14,2));
- end;
- writeln;writeln;
- write('The number - 999999.99 ');
- write(' Formatted is ',fmt_real(-999999.99,14,2)); writeln;
- write('The number - 999999.999 ');
- write(' Formatted is ',fmt_real(-999999.999,14,2));
- gotoXY(1,22); write('Press any key to continue...'); read(kbd,ch);
- end;
-
- procedure FlashDemo;
- var i,j: integer;
- begin
- clrscr;
- for i:=1 to 24 do
- begin
- for j:=1 to i do write(' ');
- writeln('This is a demo of the FlashScreen procedure');
- end;
- write('Press any key to Save screen in Memory'); read(kbd,ch);
- SaveScreen; clrscr; write('Press any key to Flash the screen you Saved');
- read(kbd,ch); FlashScreen; gotoXY(1,25); clreol;
- write('Press any key to continue...'); read(kbd,ch);
- First_run:=true;
- end;
-
- {.pa}
- {************************************************************}
- {* Source Code Module: UT-MOD90 *}
- {* Purpose: Main Menu Module : Program Control *}
- {************************************************************}
-
- procedure ProgramExit;
- begin
- Clrscr; Center('This Program is about to end',1,11,80);
- highvideo; Center('Verify Ok (Y/N)',1,13,80); lowvideo;
- repeat
- Option; if not (Ch in ['Y','N']) then beep(350,150);
- until Ch in ['Y','N'];
- end;
-
- procedure MainMenu;
- var I,Tab: integer;
- Okchoices: set of char;
- begin
- if First_run then
- begin
- ClrScr; HighVideo;
- Center('*** MAIN MENU *** ',1,4,80); LowVideo;
- for I:= 1 to 4 do writeln('');
- Tab:= 25;
- writeln('':Tab,'<1> Window & Centering Demo');
- writeln('':Tab,'<2> Demo of Input Routines'); writeln('');
- writeln('':Tab,'<3> Lotus Type Menu Demo');
- writeln('':Tab,'<4> Input Handler Demo'); writeln('');
- writeln('':Tab,'<5> Number Formatting Demo');
- writeln('':Tab,'<6> Screen Flash Demo'); writeln('');
- writeln('':Tab,'<7> Exit the Demo'); writeln('');
- Box(20,2,60,20,6);writeln('');
- SaveScreen; First_run:=false;
- end else FlashScreen;
- Set_Cap_num(' ','N',' '); Say_Cap_Num;
- Highvideo; Center('Press Your Selection',21,19,38); LowVideo;
- OKchoices:=['1'..'7'];
- repeat
- Option; if not (Ch in OKchoices) then Beep(350,150);
- until Ch in OKchoices;
- case Ch of
- '1' : Demo1;
- '2' : InputDemo;
- '3' : L_Menu_Dem;
- '4' : Input2Demo;
- '5' : FmtDemo;
- '6' : FlashDemo;
- '7' : begin
- ProgramExit; if Ch='Y' then Exit := true;
- end;
- end;
- end;
-
- {**********************************************************}
- {* Program Starts Execution *}
- {**********************************************************}
-
- begin
- ClrScr; Exit:=false; First_run:=true;
- repeat
- MainMenu;
- until Exit = true;
- Color(0,7); lowvideo;
- end.