home *** CD-ROM | disk | FTP | other *** search
- Program Illustrating_the_Toolkit;
-
-
- {IMPORTANT NOTE: compile with the Options Compiler Conditional defines set with
-
- DIRFULL
- }
-
-
- Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5,
- MenuTTT5, IOTTT5, PullTTT5, DirTTT5, NestTTT5,
- ListTTT5,StrnTTT5, MiscTTT5;
- var
- Main_Choice,Choice,Error : integer;
- ScanTop, ScanBot : byte;
- M1, MM : Menu_record;
- Ch : char;
- Const
- Author = 'Bob Ainsbury, TechnoJock';
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { T H E M A I N M E N U P R O C E D U R E S }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Define_Menu1;
- begin
- Menu_Set(M1);
- With M1 do
- begin
- Heading1 := 'TechnoJock''s Turbo Toolkit';
- Heading2 := 'Main Menu';
- Topic[1] := ' The Toolkit explained';
- Topic[2] := ' FastTTT5 Unit';
- Topic[3] := ' WinTTT5 Unit';
- Topic[4] := ' Menus';
- Topic[5] := ' IOTTT5 Unit';
- Topic[6] := ' DirTTT5 Unit';
- Topic[7] := ' Documentation';
- Topic[8] := ' Unit Summary';
- Topic[9] := ' Quit to DOS';
- TotalPicks := 9;
- PicksPerLine := 1; {one column of choices}
- Addprefix := 1; {add function key prefixes}
- TopleftXY[1] := 0; {system will center menu}
- TopleftXY[2] := 3; {Y coordinate}
- Boxtype := 5; {fancy box}
- If ColorScreen then
- begin
- Colors[1] := white; {hi forground}
- Colors[2] := red; {hi background}
- Colors[3] := lightgray; {lo foreground}
- Colors[4] := blue; {lo background}
- Colors[5] := lightcyan; {box color}
- end
- else
- begin
- Colors[1] := white; {hi forground}
- Colors[2] := black; {hi background}
- Colors[3] := black; {lo foreground}
- Colors[4] := lightgray; {lo background}
- Colors[5] := white; {box color}
- end;
- AllowEsc := false; {inactivate the escape key}
- Margins := 5;
- end; {with M1 do}
- end; {Define_Menu1}
-
- Procedure Define_Menu_menu;
- begin
- Menu_Set(MM);
- With MM do
- begin
- Heading1 := 'Menu Units';
- Heading2 := '';
- Topic[1] := ' Introduction ';
- Topic[2] := ' MenuTTT5 ';
- Topic[3] := ' PullTTT5 ';
- Topic[4] := ' NestTTT5 ';
- Topic[5] := ' ListTTT5 ';
- Topic[6] := ' Return to main menu ';
- TotalPicks := 6;
- TopleftXY[1] := 40; {Y coordinate}
- TopleftXY[2] := 9; {Y coordinate}
- AddPrefix := 4;
- Boxtype := 5; {fancy box}
- If ColorScreen then
- begin
- Colors[1] := white; {hi forground}
- Colors[2] := red; {hi background}
- Colors[3] := lightgray; {lo foreground}
- Colors[4] := blue; {lo background}
- Colors[5] := lightcyan; {box color}
- end
- else
- begin
- Colors[1] := white; {hi forground}
- Colors[2] := black; {hi background}
- Colors[3] := black; {lo foreground}
- Colors[4] := lightgray; {lo background}
- Colors[5] := white; {box color}
- end;
- AllowEsc := true; {inactivate the escape key}
- Margins := 5;
- end; {with M1 do}
- end; {Define_Menu_menu}
-
-
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 1 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Toolkit_Explained;
- const
- X1 = 1;
- Y1 = 1;
- X2 = 80;
- Y2 = 24;
- var
- C1,C2,C3 : byte;
- begin
- If ColorScreen then
- begin
- C1 := Lightgreen;
- C2 := black;
- C3 := yellow;
- end
- else
- begin
- C1 := white;
- C2 := black;
- C3 := white;
- end;
- Savescreen(1);
- FBox(X1,Y1,X2,Y2,C1,C2,4);
- OffCursor;
- WriteCenter(Y1,C1,C2,' THE TOOLKIT EXPLAINED ');
- WriteAT(X1+1,Y1+2,C3,C2,
- 'TechnoJock''s Turbo Toolkit is a collection of procedures and functions');
- WriteAT(X1+3,Y1+3,C3,C2,
- 'for Turbo Pascal programmers. It will reduce the time taken to write');
- WriteAT(X1+1,Y1+4,C3,C2,
- 'applications and is designed for novice and expert programmer alike.');
- WriteAT(X1+1,Y1+6,C3,C2,
- 'The real purpose of the Toolkit is to provide easy-to-implement procedures');
- WriteAT(X1+1,Y1+7,C3,C2,
- 'that free the programmer from the more tedious and repetitive programming');
- WriteAT(X1+1,Y1+8,C3,C2,
- 'chores, such as windows, menus, user input, string formatting, directory');
- WriteAT(X1+1,Y1+9,C3,C2,
- 'listings, mouse support, etc.');
- WriteAT(X1+1,Y1+11,C3,C2,
- 'The Toolkit is being used by many programmers and corporations throughout');
- WriteAT(X1+1,Y1+12,C3,C2,
- 'the world. There are TechnoJock Turboholics in Canada, Australia, Norway');
- WriteAT(X1+1,Y1+13,C3,C2,
- 'UK, New Zealand, Switzerland, Sweden, West Germany, and all over the USA. ');
- WriteAT(X1+1,Y1+15,C3,C2,
- 'If you use the Toolkit, please register your copy and support its further');
- WriteAT(X1+1,Y1+16,C3,C2,
- 'development. Registration is $49.95 plus shipping and this includes 300 a');
- WriteAT(X1+1,Y1+17,C3,C2,
- 'page typeset manual.');
-
- WriteAT(X1+17,Y1+20,C1,C2,
- 'Enjoy.....');
- WriteAT(X1+28,Y1+22,white,C2,
- 'TechnoJock Software, Inc., Houston.');
- WriteAT(X2-20,Y2,C1,C2,' press any key ... ');
- Ch := GetKey;
- RestoreScreen(1);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 2 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Explain_Fastwrite;
- const
- X1 = 1;
- Y1 = 1;
- X2 = 80;
- Y2 = 25;
- C1 = white;
- C2 = yellow;
- C3 = black;
- Max_Picks = 14;
-
- Procedure MainText;
- begin
- Box(X1,Y1,X2,Y2,C2,C3,1);
- Horizline(3,77,19,red,black,1);
- WriteCenter(Y1+1,C2,C3,'FastTTT5 Unit');
- WriteAT(X1+5,Y1+3,C1,C3,
- 'The FastTTT5 unit contains a host of procedures for updating the');
- WriteAT(X1+5,Y1+4,C1,C3,
- 'screen, at speeds exceeding an Isuzu.');
- WriteAT(X1+5,Y1+6,C1,C3,
- 'The latest version of Turbo Pascal has some significantly improved');
- WriteAT(X1+5,Y1+7,C1,C3,
- 'screen writing procedures. But the FastTTT5 unit is faster still,');
- WriteAT(X1+5,Y1+8,C1,C3,
- 'especially on systems that are prone to snow.');
- WriteAT(X1+5,Y1+10,C1,C3,
- 'The procedures are designed to work on IBM systems and 100% compatibles.');
- WriteAT(X1+5,Y1+11,C1,C3,
- 'Listed below are just a few of the procedures in this unit. Move the cursor');
- WriteAT(X1+5,Y1+12,C1,C3,
- 'to see a fuller description. Press [End] or [Esc] to return to the menu.');
- end; {sub proc Main_text}
-
- Procedure WriteOption(Pick,F,B:integer);
- const
- Lineone = 15;
- LeftTab = 6;
- Tab = 18;
- begin
- Case Pick of
- 1 : WriteAT(LeftTab,Lineone,F,B, ' Box ');
- 2 : WriteAT(LeftTab+Tab,Lineone,F,B, ' HorizLine ');
- 3 : WriteAT(LeftTab+2*Tab,LineOne,F,B, ' VertLine ');
- 4 : WriteAT(LeftTab+3*Tab,LineOne,F,B, ' WriteAT ');
- 5 : WriteAT(LeftTab,LineOne+1,F,B, ' ClearText ');
- 6 : WriteAT(LeftTab+Tab,LineOne+1,F,B, ' WriteCenter ');
- 7 : WriteAT(LeftTab+2*Tab,LineOne+1,F,B, ' WriteBetween ');
- 8 : WriteAT(LeftTab+3*Tab,LineOne+1,F,B, ' WriteVert ');
- 9 : WriteAT(LeftTab,Lineone+2,F,B, ' FBox ');
- 10: WriteAt(LeftTab+tab,LineOne+2,F,B, ' GrowFBox ');
- 11: WriteAt(LeftTab+2*tab,LineOne+2,F,B, ' ClearLine ');
- 12: WriteAt(LeftTab+3*Tab,LineOne+2,F,B, ' Attr ');
- 13: WriteAT(LeftTab,Lineone+3,F,B, ' FastWrite ');
- 14: WriteAt(LeftTab+tab,LineOne+3,F,B, ' PlainWrite ');
- end; {case}
- end; {WriteOption}
-
- Procedure Hilite(Pick:integer);
- begin
- WriteOption(Pick,White,red);
- end; {HiLite}
-
- Procedure LoLite(Pick:integer);
- begin
- WriteOption(Pick,Lightgray,C3);
- end; {LoLite}
-
- Procedure DisplayDescription(Pick : integer);
- const
- X = 7;
- Y = 20;
- C = yellow;
- begin
- case Pick of
- 1 : begin
- WriteAT(X,Y,C,black, 'Syntax : Box(X1,Y1,X2,Y2,F,B,boxtype : integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
- WriteAT(X,Y+3,C,black,' F and background color B. The boxtype indicates what line ');
- WriteAT(X,Y+4,C,black,' type to use i.e. single, double or combined. ');
- end;
- 2 : begin
- WriteAT(X,Y,C,black, 'Syntax : HorizLine(X1,X2,Y,F,B,LineType:integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Draws a horizontal line on the screen in foreground color ');
- WriteAT(X,Y+3,C,black,' F and background color B. The linetype indicates what line');
- WriteAT(X,Y+4,C,black,' type to use i.e. single or double. ');
- end;
- 3 : begin
- WriteAT(X,Y,C,black, 'Syntax : VertLine(X,Y1,Y2,F,B,LineType:integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Draws a vertical line on the screen in foreground color F ');
- WriteAT(X,Y+3,C,black,' and background color B. The linetype indicates what line ');
- WriteAT(X,Y+4,C,black,' type to use i.e. single or double. ');
- end;
- 4 : begin
- WriteAT(X,Y,C,black, 'Syntax : WriteAT(X,Y,F,B:integer;ST:string80); ');
- WriteAT(X,Y+2,C,black,'Purpose : Writes the string St very quickly on the screen starting ');
- WriteAT(X,Y+3,C,black,' at (X,Y) in foreground color F and background color B. The');
- WriteAT(X,Y+4,C,black,' string may be concatenated e.g. ''Techno''+''Jock''. ');
- end;
- 5 : begin
- WriteAT(X,Y,C,black, 'Syntax : ClearText(X1,Y1,X2,Y2,F,B:integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Clears the characters for a rectangular area on the screen');
- WriteAT(X,Y+3,C,black,' and displays background color B. The attribute for the ');
- WriteAT(X,Y+4,C,black,' foreground is set to F. Unaffected by Window setting. ');
- end;
- 6 : begin
- WriteAT(X,Y,C,black, 'Syntax : WriteCenter(Lineno,F,B:integer;ST:string80); ');
- WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen in the ');
- WriteAT(X,Y+3,C,black,' center of line Lineno in foreground color F and back- ');
- WriteAT(X,Y+4,C,black,' ground color B. The string may be concatenated. ');
- end;
- 7 : begin
- WriteAT(X,Y,C,black, 'Syntax : WriteBetween(X1,X2,Y,F,B:integer;ST:string80); ');
- WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen centered ');
- WriteAT(X,Y+3,C,black,' between X1 and X2 on line Y, in foreground F and back- ');
- WriteAT(X,Y+4,C,black,' ground color B. The string may be concatenated. ');
- end;
- 8 : begin
- WriteAT(X,Y,C,black, 'Syntax : WriteVert(X,Y,F,B;ST:string80); ');
- WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST vertically on the screen starting at ');
- WriteAT(X,Y+3,C,black,' coordinate (X,Y) and continuing down the screen, in fore- ');
- WriteAT(X,Y+4,C,black,' ground color F and background color B. ');
- end;
- 9 : begin
- WriteAT(X,Y,C,black, 'Syntax : FBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
- WriteAT(X,Y+3,C,black,' F and background color B. The boxtype indicates the line ');
- WriteAT(X,Y+4,C,black,' style. This is similar to Box except the box is cleared. ');
- end;
- 10: begin
- WriteAT(X,Y,C,black, 'Syntax : GrowFBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
- WriteAT(X,Y+3,C,black,' F and background color B. The boxtype indicates the line ');
- WriteAT(X,Y+4,C,black,' style. This is similar to FBox except the box explodes. ');
- end;
- 11: begin
- WriteAT(X,Y,C,black, 'Syntax : ClearLine(Y,F,B:integer); ');
- WriteAT(X,Y+2,C,black,'Purpose : All text on screen line Y is cleared. The actual display ');
- WriteAT(X,Y+3,C,black,' color of the line will be set to B. ');
- WriteAT(X,Y+4,C,black,' ');
- end;
- 12: begin
- WriteAT(X,Y,C,black, 'Syntax : Attr(F,B):byte; ');
- WriteAT(X,Y+2,C,black,'Purpose : Combines the foreground color F with the background ');
- WriteAT(X,Y+3,C,black,' color B and returns the resulting attribute byte. ');
- WriteAT(X,Y+4,C,black,' ');
- end;
- 13: begin
- WriteAT(X,Y,C,black, 'Syntax : Fastwrite(X,Y,F,B : byte; Str : string); ');
- WriteAT(X,Y+2,C,black,'Purpose : This is the core procedure used by the others in the ');
- WriteAT(X,Y+3,C,black,' Toolkit. String Str is written on the screen in foreground');
- WriteAT(X,Y+4,C,black,' F & background B at location (X,Y) el quicko. ');
- end;
- 14: begin
- WriteAT(X,Y,C,black, 'Syntax : PlainWrite(X,Y:byte; Str: string); ');
- WriteAT(X,Y+2,C,black,'Purpose : This is even quicker than FastWrite but it uses the ');
- WriteAT(X,Y+3,C,black,' default color attibute already assigned. ');
- WriteAT(X,Y+4,C,black,' ');
- end;
- end; {case}
- end; {DisplayDescription}
-
- Procedure Keystroke;
- const
- CursorUp = #200;
- CursorDown = #208;
- CursorLeft = #203;
- CursorRight = #205;
- EndKey = #207;
- var
- Allover : boolean;
- I,CurrentPick : integer;
- begin
- Allover := false;
- CurrentPick := 1;
- For I := 1 to Max_Picks do
- LoLite(I);
- HiLite(CurrentPick);
- Repeat
- Ch := getkey;
- Case upcase(Ch) of
- CursorUp : If CurrentPick > 4 then
- begin
- LoLite(CurrentPick);
- CurrentPick := CurrentPick - 4;
- HiLite(CurrentPick);
- end;
- CursorDown : If CurrentPick <= Max_Picks - 4 then
- begin
- LoLite(CurrentPick);
- CurrentPick := CurrentPick + 4;
- HiLite(CurrentPick);
- end;
- ' ',
- CursorRight : begin
- LoLite(CurrentPick);
- If CurrentPick < Max_Picks then
- CurrentPick := CurrentPick + 1
- else
- CurrentPick := 1;
- HiLite(CurrentPick);
- end;
- CursorLeft : begin
- LoLite(CurrentPick);
- If CurrentPick > 1 then
- CurrentPick := CurrentPick - 1
- else
- CurrentPick := Max_Picks;
- HiLite(CurrentPick);
- end;
- #027,
- EndKey : Allover := true;
- end; {case}
- DisplayDescription(CurrentPick);
- Until Allover;
- end; {Keystroke}
-
-
- begin {Explain_Fastwrite}
- SaveScreen(1);
- Clrscr;
- OffCursor;
- MainText;
- DisplayDescription(1);
- Keystroke;
- RestoreScreen(1);
- DisposeScreen(1);
- end; {proc Explain_Fastwrite}
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 3 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Explain_Windows;
- var
- I : integer;
- c1,c2,c3,c4,c5,c6: byte;
-
- begin
- If ColorScreen then
- begin
- C1 := yellow;
- C2 := green;
- C3 := white;
- C4 := white;
- C5 := red;
- C6 := magenta;
- end
- else
- begin
- C1 := black;
- C2 := lightgray;
- C3 := white;
- C4 := white;
- C5 := black;
- C6 := black;
- end;
- Savescreen(1);
- OffCursor;
- ClrScr;
- MkWin(1,1,35,14,c1,c2,2);
- WriteBetween(1,35,2,C1,c2,'WinTTT5');
- WriteAt(3,4,c3,c2,'The Window procedures provide');
- WriteAT(3,5,c3,c2,'tools for easily writing flash');
- WriteAT(3,6,c3,c2,'up window routines. ');
- WriteAT(3,8,c3,c2,'They also include procedures');
- WriteAT(3,9,c3,c2,'for saving and restoring screen');
- WriteAT(3,10,c3,c2,'images.');
- WriteAT(3,13,c3,c2,'... press any key.');
- DelayKey(4000);
- Mkwin(34,7,66,20,c4,c5,3);
- WriteAT(36,9,c4,c5, 'The windows can be placed any');
- WriteAT(36,10,c4,c5,'where on the screen and both');
- WriteAT(36,11,c4,c5,'the border style and colors ');
- WriteAT(36,12,c4,c5,'can be easily altered.');
- DelayKey(3000);
- Mkwin(20,13,68,25,c4,c6,1);
- WriteAT(22,15,c4,c6,'The WinTTT unit includes a host of Windowing ');
- WriteAT(22,16,c4,c6,'procedures, and a collection of fancy screen ');
- WriteAT(22,17,c4,c6,'restoring and sliding procedures. ');
- WriteAT(22,19,c4,c6,'As well as windows, the WinTTT5 unit includes');
- WriteAT(22,20,c4,c6,'full support for virtual screens, cursor con-');
- WriteAT(22,21,c4,c6,'trol, routines for the display of temporary ');
- WriteAT(22,22,c4,c6,'messages and much more. ');
- WriteAT(22,24,c4,c6,'Press any key to see some screen manipulation');
- Ch := getkey;
- Rmwin;
- Delay(300);
- Rmwin;
- Delay(300);
- Rmwin;
- Delay(300);
- Rmwin;
- SlideRestoreScreen(1,left);
- SlideRestoreScreen(1,up);
- SlideRestoreScreen(1,right);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 4 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Menu_Intro;
- {}
- var
- C1,C2,C3: byte;
- begin
- If ColorScreen then
- begin
- C1 := lightred;
- C2 := red;
- end
- else
- begin
- C1 := lightgray;
- C2 := lightgray;
- end;
- Savescreen(1);
- Clrscr;
- OffCursor;
- Box(1,1,80,25,C1,black,1);
- WriteCenter(3,c1,black,'The Toolkit Menu Units');
- WriteAT(3,5,white,black,
- 'The most appropriate style of menu for an application is very dependent upon');
- WriteAT(3,6,white,black,
- 'the primary purpose of the program. For example, a good menu for a database ');
- WriteAT(3,7,white,black,
- 'will not be suitable for a word processor. The Toolkit offers four different');
- WriteAT(3,8,white,black,
- 'menu systems so that you can select the most appropriate menu interface for');
- WriteAT(3,9,white,black,
- 'your application.');
- WriteAT(3,11,white,black,
- 'The four menuing units are MenuTTT5, PullTTT5, NestTTT5 and ListTTT5. Each');
- WriteAT(3,12,white,black,
- 'of the menus employs a set of default characteristics, e.g. menu position,');
- WriteAT(3,13,white,black,
- 'menu color, etc. The look and feel of the menu can be dramatically altered');
- WriteAT(3,14,white,black,
- 'by changing the default settings.');
- WriteAT(3,16,white,black,
- 'MenuTTT5 is the unit used to display the menus in this demo program. ');
- WriteAT(3,17,white,black,
- 'PullTTT5 provides a very easy way of implementing a pull down menu system');
- WriteAT(3,18,white,black,
- 'similar to the one used in the Turbo Environment. NestTTT5 is a very power-');
- WriteAT(3,19,white,black,
- 'ful and flexible menu modelled on Borland''s Sprint word processor. ListTTT5');
- WriteAT(3,20,white,black,
- 'is a generic listing program that can be used to display a list in a ');
- WriteAT(3,21,white,black,
- 'scrollable window. The list procedure is passed an array of strings that');
- WriteAT(3,22,white,black,
- 'define each of the topics in the list.');
- WriteAt(60,25,c1,black,' press any key .... ');
- Ch := getkey;
- RestoreScreen(1);
- DisposeSCreen(1);
- end; {of proc Menu_Intro}
-
- Procedure PullDemo;
- var
- TheMenu : Pull_array; {Array holding the menu definitions}
-
- Procedure Define_Demo_Menu;
- begin
- Fillchar(Themenu,sizeof(Themenu),#0);
- TheMenu[1] := '\File'; {menu definition for pull down menu}
- TheMenu[2] := 'Load ';
- TheMenu[2] := 'Pick ';
-
- TheMenu[3] := 'New ';
- TheMenu[4] := 'Save ';
- TheMenu[5] := 'Write to ';
- TheMenu[6] := 'Directory ';
- TheMenu[7] := 'Change dir ';
- TheMenu[8] := 'OS shell ';
- TheMenu[9] := 'Quit ';
-
- TheMenu[10] := '\Edit ';
-
- TheMenu[11] := '\Run ';
- TheMenu[12] := 'Program reset ';
- TheMenu[13] := 'Go to cursor ';
- TheMenu[14] := 'Trace into ';
- TheMenu[15] := ' Step Over ';
- TheMenu[16] := 'User Screen ';
-
- TheMenu[17] := '\Compile';
- TheMenu[18] := 'Compile ';
- TheMenu[19] := 'Make ';
- TheMenu[20] := 'Build ';
- TheMenu[21] := 'Destination ';
- TheMenu[22] := 'Find Error ';
- TheMenu[23] := 'Primary file ';
- TheMenu[24] := 'Get Info ';
-
- TheMenu[25] := '\Options';
- TheMenu[26] := 'Compiler ';
- TheMenu[27] := 'Linker ';
- TheMenu[28] := 'Environment ';
- TheMenu[29] := 'Directories ';
- TheMenu[30] := 'Parameters ';
- TheMenu[31] := 'Save Options ';
- TheMenu[32] := 'Retrieve Options';
-
- TheMenu[22] := '\Debug';
- TheMenu[23] := 'Evaluate ';
- TheMenu[23] := 'Call stack ';
- TheMenu[24] := 'Find procedure ';
- TheMenu[25] := 'Integrated debugging ';
- TheMenu[26] := 'Stand-alone debugging ';
- TheMenu[27] := 'Display Swapping ';
- TheMenu[28] := 'Refresh display ';
-
- TheMenu[29] := '\Break/Watch';
- TheMenu[30] := 'Add Watch ';
- TheMenu[31] := 'Delete Watch ';
- TheMenu[32] := 'Edit Watch ';
- TheMenu[33] := 'Remove all watches ';
- TheMenu[34] := 'Toggle breakpoint ';
- TheMenu[35] := 'Clear all breakpoints ';
- TheMenu[36] := 'View next breakpoint ';
- TheMenu[37] := '\\';
-
- end; {Proc Define demo menu}
-
- Procedure Fill_Screen_With_Junk;
- var I,J : integer;
- begin
- ClrScr;
- Box(1,2,80,25,cyan,black,2);
- ClearLine(1,white,blue);
- WriteCenter(2,yellow,cyan,'EDIT');
- Writecenter(15,lightgray,black,' Use the cursor keys... recognize the menu? ');
- WriteAT(3,3,lightgray,black,
- 'Line 1 Col 1 Insert Indent Unindent c:NONAME.PAS ');
- end;
-
- var
- Major,Minor : byte;
- Ch : char;
-
- begin
- Define_Demo_Menu;
- SaveScreen(1);
- Fill_Screen_With_Junk;
- Major := 1;
- Minor := 1;
- With PTTT do
- begin
- Style := 0; {0 no border, 1 single border, 2 double border}
- TopX := 1;
- TopY := 1;
- Gap := 5;
- RemoveMenu := false;
- end; {With}
- Pull_Menu(TheMenu,Major,Minor);
- GotoXY(1,20);
- If Major = 0 then
- WriteAt(15,17,white,black,'You escaped ')
- else
- WriteAt(15,17,white,black,'You selected main menu '+Int_to_Str(Major)+' and sub-topic '+Int_to_Str(Minor));
- WriteAt(15,18,yellow,black,'Press any key to return to the real menu.......');
- Ch := Getkey;
- RestoreScreen(1);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++}
- { }
- { N E S T D E M O }
- { }
- {+++++++++++++++++++++++}
- var
- Hyphens,
- EndProgram: Boolean;
- Main_Menu,
- Long_menu,
- File_Menu, {dummy menu is a short cut to represent}
- Utility_Menu, {all the other menus that would be used}
- Dummy_Menu:Nest_Menu; {in a large system. }
-
-
- Procedure Dummy_Activity(var Finish:byte);
- {Saves writing a lot of real life procedures for the demo}
- begin
- TempMessageBox(20,5,white,red,3,'Just imagine I did something!');
- Finish := DontClear; {return to same place in the menu}
- end; {of proc Dummy_Activity}
-
-
-
- {$F+}
- Procedure Action(Var Code: integer; var Finish:byte);
- {This is the main procedure the controls the execution of all
- the menu options.}
- begin
- Case Code of
- 902: begin
- If Hyphens then
- Modify_Topic_name(Utility_Menu,2,'Hyphenation * Off')
- else
- Modify_Topic_name(Utility_Menu,2,'Hyphenation * On ');
- Hyphens := not Hyphens;
- Finish := RefreshTopic;
- end;
- 910: begin
- TempMessageBox(20,5,white,red,3,'We will back up one level');
- Finish := ClearCurrent;
- end;
- 999: begin
- sound(1000);delay(2);nosound;
- Endprogram := true;
- Finish := ClearAll;
- end;
- else Dummy_Activity(Finish);
- end; {case}
- end; {of proc Action}
- {$F-}
-
-
-
- Procedure NestTTT5_Demo_1;
- {This section is a direct import of the file nestdem1.pas}
-
- Procedure SetUp_Menus;
- begin
- Initialize_Menu(Main_Menu,'Sprint',0,0); {14}
- Initialize_Menu(File_Menu,'File',22,12);
- Initialize_Menu(Utility_Menu,'Utility',19,13);
- Initialize_Menu(Long_Menu,'Potpourri',19,10);
- Initialize_Menu(Dummy_Menu,'A N Other',0,0);
- end; {of proc SetUp_Menus}
-
- Procedure Define_Main_Menu;
- {}
- begin
- Add_Topic(Main_Menu,'File * Alt-F',true,#161,101,@File_Menu);
- Add_Topic(Main_Menu,'Edit' ,true,#0 ,0,@Dummy_Menu);
- Add_Topic(Main_Menu,'-' ,true,#0 ,0 ,nil);
- Add_Topic(Main_Menu,'Insert' ,true,#0,103,@Dummy_Menu);
- Add_Topic(Main_Menu,'Typestyle' ,true,#0,104,@Dummy_Menu);
- Add_Topic(Main_Menu,'Style' ,true,#0,105,@Dummy_Menu);
- Add_Topic(Main_Menu,'Layout' ,true,#0,0,@Dummy_Menu);
- Add_Topic(Main_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Main_Menu,'Print' ,false,#0,107,@Dummy_Menu);
- Add_Topic(Main_Menu,'Window' ,true,#0,108,@Dummy_Menu);
- Add_Topic(Main_Menu,'Utilities * Alt-U' ,true,#150,109,@Utility_Menu);
- Add_Topic(Main_Menu,'Customize' ,true,#0,110,@Dummy_Menu);
- Add_Topic(Main_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Main_Menu,'Quit' ,true,#173,999,nil);
- end; {of proc Define_Main_Menu}
-
- Procedure Define_File_Menu;
- {}
- begin
- Add_Topic(File_Menu,'New' ,true,#0,201,nil);
- Add_Topic(File_Menu,'Open' ,true,#0,202,nil);
- Add_Topic(File_Menu,'Close' ,true,#0,203,nil);
- Add_Topic(File_Menu,'Insert' ,true,#0,204,nil);
- Add_Topic(File_Menu,'-' ,true,#0,0,nil);
- Add_Topic(File_Menu,'Save' ,true,#0,205,nil);
- Add_Topic(File_Menu,'Write As' ,true,#0,206,nil);
- Add_Topic(File_Menu,'Revert to Saved',true,#0,207,nil);
- Add_Topic(File_Menu,'-' ,true,#0,0,nil);
- Add_Topic(File_Menu,'Translate' ,true,#0,208,nil);
- Add_Topic(File_Menu,'File Manager' ,true,#0,209,nil);
- Add_Topic(File_Menu,'Pick from List' ,true,#0,210,nil);
- end; {of proc Define_File_Menu}
-
- Procedure Define_Long_Menu;
- {}
- begin
- Add_Topic(Long_Menu,'bottom of File' ,true,#0,71,nil);
- Add_Topic(Long_Menu,'Bottom of screen',true,#0,72,nil);
- Add_Topic(Long_Menu,'case Rotate' ,true,#0,73,nil);
- Add_Topic(Long_Menu,'case Switch' ,true,#0,74,nil);
- Add_Topic(Long_Menu,'center Tab' ,true,#0,75,nil);
- Add_Topic(Long_Menu,'Decimal tab' ,true,#0,76,nil);
- Add_Topic(Long_Menu,'delete Line' ,true,#0,77,nil);
- Add_Topic(Long_Menu,'delete Word' ,true,#0,78,nil);
- Add_Topic(Long_Menu,'delete Sentence',true,#0,79,nil);
- Add_Topic(Long_Menu,'delete Paragraph',true,#0,80,nil);
- Add_Topic(Long_Menu,'delete End of line' ,true,#0,81,nil);
- Add_Topic(Long_Menu,'reformat Document',true,#0,82,nil);
- Add_Topic(Long_Menu,'eXchange cases' ,true,#0,73,nil);
- Add_Topic(Long_Menu,'lookup Zip' ,true,#0,74,nil);
- Add_Topic(Long_Menu,'Underline' ,true,#0,75,nil);
- Add_Topic(Long_Menu,'Italicize' ,true,#0,76,nil);
- Add_Topic(Long_Menu,'go Home' ,true,#0,77,nil);
- Add_Topic(Long_Menu,'Cancel undo' ,true,#0,78,nil);
- end; {of proc Define_Long_Menu}
-
- Procedure Define_Utility_Menu;
- {}
- begin
- Hyphens := true;
- Add_Topic(Utility_Menu,'Spelling' ,true,#0,901,nil);
- Add_Topic(Utility_Menu,'Hyphenation * On ' ,true,#0,902,nil);
- Add_Topic(Utility_Menu,'Thesaurus' ,true,#0,903,nil);
- Add_Topic(Utility_Menu,'Glossary' ,true,#0,904,nil);
- Add_Topic(Utility_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Utility_Menu,'Arrange-Sort',true,#0,905,nil);
- Add_Topic(Utility_Menu,'Line Drawing',true,#0,906,nil);
- Add_Topic(Utility_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Utility_Menu,'Potpourri *',true,#0,907,@Long_Menu);
- Add_Topic(Utility_Menu,'QuickCard' ,true,#0,908,nil);
- Add_Topic(Utility_Menu,'Macros' ,true,#0,909,nil);
- Add_Topic(Utility_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Utility_Menu,'Back Up Demo *',true,#0,910,nil);
- end; {of proc Define_Utility_Menu}
-
- Procedure Define_Dummy_Menu;
- {}
- begin
- Add_Topic(Dummy_Menu,'Ignite' ,true,#0,801,nil);
- Add_Topic(Dummy_Menu,'Check Boosters',true,#0,802,nil);
- Add_Topic(Dummy_Menu,'Fire Retros' ,true,#0,803,nil);
- Add_Topic(Dummy_Menu,'Shutdown' ,true,#0,804,nil);
- Add_Topic(Dummy_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Dummy_Menu,'Launch' ,true,#0,805,nil);
- Add_Topic(Dummy_Menu,'Remove Suit',false,#0,806,nil);
- Add_Topic(Dummy_Menu,'-' ,true,#0,0,nil);
- Add_Topic(Dummy_Menu,'Abort Mission',true,#0,807,nil);
- Add_Topic(Dummy_Menu,'Panic' ,true,#0,808,nil);
- end; {of proc Define_Dummy_Menu}
-
- Procedure Paint_Screen;
- {makes the screen look like a word processor}
- begin
- ClearText(1,1,80,25,lightgray,blue);
- WriteAt(1,25,black,lightgray,
- Padleft('Press F10 or / for menu. Alt-X to quit to main demo',80,' '));
- Plainwrite(1,1,
- '[ T 1 2 3 4 5 6 7 ]');
- Plainwrite(5,3,'Imagine you have written a wordprocessing program and you want');
- PlainWrite(5,4,'to give the program a full and powerful menu system. The NestTTT');
- PlainWrite(5,5,'unit will give you all the power you need and more!');
- PlainWrite(5,7,'For starters, press the F10 key or the slash key, and roam around');
- Plainwrite(5,8,'the menu a little. Features include: capital letter selection, ');
- Plainwrite(5,9,'optional HotKey selection, point and shoot (with full mouse support),');
- Plainwrite(5,10,'non-selectable topics, line separators, auto positioning of menus and');
- PlainWrite(5,11,'sub menus. The list goes on and on...');
- PlainWrite(5,13,'When a menu "system" has been defined, it''s easy to call up any of the');
- PlainWrite(5,14,'nested menus and bypass all the parent menus. For example, press Alt-U');
- Plainwrite(5,15,'while no menu is on display - the Utility menu will automatically pop-up');
- Plainwrite(5,16,'at the top level.');
- PlainWrite(5,18,'All of the topics that are highlighted with an asterisk "*" are designed');
- Plainwrite(5,19,'to illustrate some of the features of the menu. For example, select the');
- Plainwrite(5,20,'Utility option from the main menu, or press Alt-U, and select the Potpourri');
- Plainwrite(5,21,'topic. This is a menu that exceeds the no. of display lines - the menu');
- Plainwrite(5,22,'will automatically scroll the topics. Also, select the Hyphenation topic');
- Plainwrite(5,23,'to see a topic that can switch between two or more displays.');
- end; {of proc Paint_Screen}
-
-
- Procedure Menu_Loop;
- {}
- var Ch : char;
- begin
- EndProgram := false;
- Repeat
- Ch := Getkey;
- Case Ch of
- #178, {Alt-M}
- '/',
- #196 : Show_Nest(Main_menu); {F10}
- #161 : Show_Nest(File_Menu); {Alt F}
- #150 : Show_Nest(Utility_menu); {Alt U}
- #027,
- #173 : Endprogram := true; {Alt X}
- end;
- Until EndProgram;
- end; {of proc Menu_Loop}
-
-
- begin {The main program}
- SaveScreen(1);
- ClearText(1,1,80,25,white,black);
- SetUp_menus;
- Define_Main_Menu;
- Define_File_menu;
- Define_Utility_Menu;
- Define_Dummy_Menu;
- Define_Long_Menu;
- Assign_Despatcher(Action);
- With NTTT do {optionally modify default colors etc.}
- begin
- AllowEsc := true;
- LeftSide := false;
- BoxFCol := black;
- BoxBCol := lightgray;
- CapFCol := white;
- BacCol := lightgray;
- NorFCol := Black;
- LoFCol := blue;
- HiFCol := Lightgray;
- HiBCol := blue;
- LeftChar := ' ';
- RightChar := ' ';
- end;
- Paint_Screen;
- Menu_Loop;
- Delete_All_Topics(Utility_Menu);
- Delete_All_Topics(File_Menu);
- Delete_All_Topics(Main_Menu);
- Delete_All_Topics(Dummy_Menu);
- RestoreScreen(1);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++}
- { }
- { L I S T D E M O }
- { }
- {+++++++++++++++++++++++}
- procedure Show_The_Girlfriends;
- const
- ListWidth = 60;
- type
- StrList = string[ListWidth];
-
- var
- MyList : array[1..30] of StrList;
-
- Procedure Fill_MyList;
- {}
- begin
- MyList[1] := 'Erica';
- MyList[2] := 'Alison';
- MyList[3] := 'Barbara';
- MyList[4] := 'Sarah';
- MyList[5] := 'Katy';
- MyList[6] := 'Janice';
- MyList[7] := 'Susan';
- MyList[8] := 'Serita';
- MyList[9] := 'Anne';
- MyList[10] := 'Michelle';
- MyList[11] := 'Theresa';
- MyList[12] := 'Shirley';
- MyList[13] := 'Sue';
- MyList[14] := 'Marianne';
- MyList[15] := 'Wilma';
- MyList[16] := 'Beatrice';
- MyList[17] := 'Regina';
- MyList[18] := 'Sudafed';
- MyList[19] := 'Trojan';
- MyList[20] := 'Whip';
- end; {of proc Fill_MyList}
-
- Procedure Display_Info;
- {}
- begin
- Box(1,1,40,21,lightred,black,1);
- FCol := yellow;
- BCol := black;
- Writebetween(1,40,2,white,black,'ListTTT5');
- ColWrite(3,4,'This unit is a generic list program ');
- ColWrite(3,5,'that can be used to display an array ');
- ColWrite(3,6,'of strings in a window. The user can ');
- ColWrite(3,7,'select one pick, or optionally more ');
- ColWrite(3,8,'than one pick, from the list. ');
- ColWrite(3,10,'All you have to do is pass the List ');
- ColWrite(3,11,'a string array and it will take care ');
- ColWrite(3,12,'of the rest! ');
- ColWrite(3,14,'The unit will return the topic(s) ');
- ColWrite(3,15,'selected by the user. The adjacent');
- ColWrite(3,16,'list was created with the ListTTT5');
- ColWrite(3,17,'unit. Use the cursor keys to move ');
- ColWrite(3,18,'around the menu, press the space ');
- ColWrite(3,19,'to (de)select and Enter to quit.');
- end; {of proc Display_Info}
-
-
- begin
- Fill_MyList;
- Savescreen(1);
- ClrScr;
- Display_Info;
- With LTTT do
- begin
- X := 50;
- Y := 9;
- end;
- Show_List(MyList,ListWidth,20);
- RestoreScreen(1);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++}
- { }
- { M E N U D E M O }
- { }
- {+++++++++++++++++++++++}
-
- Procedure Explain_Menu;
- var
- P,code : integer;
- C1,C2,C3: byte;
-
- Procedure Instructions(Number:integer);
- begin
- P := 1;
- Case Number of
- 1 : begin
- WriteAT(9,23,white,black,
- 'This is a mock up of the Main menu but changed to two picks per line,');
- WriteAT(9,24,white,black,
- 'and moved to the left. Play with the cursor and select an option. ');
- end;
- 2 : begin
- WriteAT(9,23,white,black,
- 'Now the menu has been changed back to one pick per line and the ');
- WriteAT(9,24,white,black,
- 'prefix has changed to a letter. Press a letter or move & Enter. ');
- end;
- 3 : begin
- WriteAT(9,23,white,black,
- 'Last one I promise! Now the prefix is a number and we''ve changed ');
- WriteAT(9,24,white,black,
- 'the colors. Select an option and press Enter. ');
- end;
- end; {case}
- end; {sub proc Instructions}
-
- begin
- If ColorScreen then
- begin
- C1 := lightred;
- C2 := red;
- end
- else
- begin
- C1 := lightgray;
- C2 := lightgray;
- end;
- SaveScreen(1);
- Clrscr;
- Offcursor;
- Box(1,22,80,25,c1,black,1);
- With M1 do
- begin
- PicksPerLine := 2;
- TopleftXY[1] := 1;
- end;
- Instructions(1);
- Displaymenu(M1,false,P,code);
- With M1 do
- begin
- PicksPerLine := 1;
- TopleftXY[1] := 55;
- TopleftXY[2] := 5;
- Addprefix := 2;
- end;
- Instructions(2);
- Displaymenu(M1,false,P,code);
- With M1 do
- begin
- TopleftXY[1] := 15;
- TopleftXY[2] := 4;
- Addprefix := 1;
- If ColorScreen then
- begin
- Colors[1] := yellow;
- Colors[2] := green;
- Colors[3] := lightgreen;
- Colors[4] := red;
- Colors[5] := white;
- end;
- end;
- Instructions(3);
- Displaymenu(M1,false,P,code);
- Mkwin(5,10,70,17,white,c2,2);
- Offcursor;
- WriteAT(15,12,white,c2,'All these modifications were effected by making');
- WriteAT(15,13,white,c2,'simple changes to the menu record. ');
- WriteAT(50,17,white,c2,' press any key .... ');
- Define_Menu1; {set it all back to normal}
- Ch := getkey;
- Rmwin;
- RestoreScreen(1);
- DisposeScreen(1);
- Offcursor;
- end;
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 5 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- {$F+}
- Procedure Help_EditKeys(var Ch:Char;var Fieldid : byte;var Refresh: byte);
- var C1,C2,c3 : byte;
- begin
- If ColorScreen then
- begin
- C1 := lightcyan;
- C2 := white;
- C3 := blue;
- end
- else
- begin
- C1 := white;
- C2 := black;
- C3 := lightgray;
- end;
- If Ch <> #187 then exit;
- Mkwin(40,1,80,25,C1,c3,2);
- WriteBetween(40,80,2,C1,c3,'IO Editing Keys');
- WriteAT(42,3,c2,c3,'The operative edit keys are defined');
- WriteAT(42,4,c2,c3,'in IOTTT5.pas. They may be modified to');
- WriteAT(42,5,c2,c3,'suit your needs. The defaults are: ');
- WriteAT(42,7,c2,c3, 'Move Up '+chr(024));
- WriteAT(42,8,c2,c3, 'Move Down '+chr(025));
- WriteAT(42,9,c2,c3,'Move Right Ctrl -'+chr(016)+', Tab or Enter');
- WriteAT(42,10,c2,c3,'Move Left Ctrl '+chr(017)+'- or ShiftTab');
- WriteAT(42,12,c2,c3,'Insert Press [Ins] to toggle');
- WriteAT(42,14,c2,c3,'Del Char [Del] or [Backspace]');
- WriteAT(42,15,c2,c3,'Del Field Alt-D');
- WriteAT(42,16,c2,c3,'Del Global Alt-E');
- WriteAT(42,18,c2,c3,'Update F10');
- WriteAT(42,19,c2,c3,'Abort [Esc]');
- WriteAT(42,21,c2,c3,'Note the abort key can be disabled,');
- WriteAT(42,22,c2,c3,'as it is in this example. Just press');
- WriteAT(42,23,c2,c3,'[F10] to finish the example.');
- Ch := getkey;
- Rmwin;
- end;
- {$F-}
-
- Procedure Explain_IO;
-
- Procedure Display_Text;
- var C1,C2 : byte;
- begin
- If ColorScreen then
- begin
- C1 := yellow;
- C2 := lightgreen;
- end
- else
- begin
- C1 := lightgray;
- C2 := white;
- end;
- Clrscr;
- Box(1,1,80,11,C1,black,3);
- WriteCenter(2,C1,black,'The IOTTT5 Unit');
- WriteAT(3,4,c2,black,
- 'One of the (few) short comings of Turbo Pascal is its very limited support');
- WriteAT(3,5,c2,black,
- 'for screen input that gives the user a chance to move around the screen and');
- WriteAT(3,6,c2,black,
- 'and edit the input. Thats why we developed the IOTTT5 unit.');
- WriteAT(3,8,c2,black,
- 'These IO procedures allow you to display input fields with format controls');
- WriteAT(3,9,c2,black,
- 'e.g. all capitals or only numbers. There are many features to the Kit. The');
- WriteAT(3,10,c2,black,
- 'example below illustrates some of the power of this easy to use Kit.');
- end;
-
- Procedure IO_Example;
- var
- s1,s2,s3,s4,s5,s6:string;
- retcode : integer;
- begin
- Box(3,13,78,25,white,black,1);
- Horizline(4,77,15,white,black,1);
- Textcolor(white);
- GotoXY(3,15);write(chr(195));
- GotoXY(78,15);write(chr(180));
- Textcolor(lightred);
- GotoXY(20,14);write(chr(004));
- GotoXY(57,14);write(chr(004));
- GotoXY(22,14);write(chr(004));
- GotoXY(59,14);write(chr(004));
- Textcolor(yellow);
- GotoXY(21,14);write(chr(004));
- GotoXY(58,14);write(chr(004));
- Offcursor;
- WriteCenter(14,Lightgray,black,'Technojock''s Inventory Control');
- WriteAt(22,17,white,black,'Catalogue/Part Number');
- WriteAT(10,19,white,black,'Description');
- WriteAT(10,21,white,black,'Quantity');
- WriteAT(50,21,white,black,'Units');
- WriteAT(10,23,white,black,'Shelf');
- WriteAT(50,23,white,black,'Bin No.');
- WriteAT(66,16,white,black,'F1 for HELP');
- WriteAT(6,16,white,black,'F10 for EXIT');
- S1 := '';
- S2 := '';
- S3 := '';
- S4 := '';
- S5 := '';
- S6 := '0001';
- Create_fields(6);
- Allow_Beep(false);
- Allow_Esc(true);
- Assign_CharHook(Help_Editkeys);
- Add_Field(1, 6,2,6,2, 45,17);
- String_Field(1, S1,'(####-###)/ ##');
- Add_Field(2, 1,3,1,3, 23,19);
- String_Field(2, S2,replicate(50,'*'));
- Add_field(3, 2,4,2,4, 23,21);
- String_Field(3, S3,'#####');
- Add_Field(4, 3,5,3,5, 60,21);
- String_Field(4, S4,'!!!!!!!!!!!!!');
- Add_Field(5, 4,6,4,6, 23,23);
- String_Field(5, S5,'@@ / @');
- Add_Field(6, 5,1,5,1, 60,23);
- String_Field(6, S6,'####');
- Add_Message(1, 13,25, 'Enter the TTT catalogue number (letters not accepted)');
- Add_Message(2, 15,25, 'Enter the item description from the Purchase Order');
- Add_Message(4, 25,25, '(note: Units converted to capitals)');
- Add_Message(5, 20,25, 'Only letters and punctuation chars allowed');
- Add_Message(6, 20,25, 'Check details and press F10 to update');
- OnCursor;
- Process_Input(1);
- OffCursor;
- Dispose_Fields;
- end;
-
- begin
- SaveScreen(1);
- Display_Text;
- IO_Example;
- RestoreScreen(1);
- DisposeScreen(1);
- end;
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 6 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Explain_Dir;
-
- Var
- StartPath, Path, Mask, Chosen_File : string;
- Ch : char;
- C1,C2,C3 : byte;
- Retcode : integer;
- begin
- If BaseOfScreen = $b800 then
- begin
- C1 := Yellow;
- C2 := lightgray;
- C3 := blue;
- end
- else
- begin
- C1 := white;
- C2 := black;
- C3 := lightgray;
- end;
- SaveScreen(1);
- ClrScr;
- FBox(1,15,80,25,C1,c3,2);
- WriteCenter(16,C1,C3,'The DirTTT Unit');
- WriteAT(5,17,c2,c3,
- ' The DirTTT5 unit provides a single procedure for displaying a directory');
- WriteAT(5,18,c2,c3,
- ' in a Sidekick Plus style dialogue box. The look and feel of the display');
- WriteAT(5,19,c2,c3,
- ' can be easily modified by changing the parameters in the DTTT variable.');
- WriteAT(5,21,c2,c3,
- ' Experiment with the directory listing above. Press F1 for Help. Use the');
- WriteAT(5,22,c2,c3,
- ' space bar to toggle the column display, Alt-N, Alt-D, etc. to change ');
- WriteAT(5,23,c2,c3,
- ' sorts, Alt-Z to expand the box, or just type in a new filename or file');
- WriteAT(5,24,c2,c3,' mask. Try It!');
-
- GetDir(0,StartPath);
- Path := StartPath;
- Mask := '*.*';
- With DTTT do
- begin
- ColsWide := 5;
- Rows := 8;
- TopY := 1;
- AllowEsc := false;
- end;
- Chosen_File := Display_Directory(Path+'\'+Mask,retcode);
- GotoXy(1,1);
- If retcode = 1 then
- Write('You escaped')
- else
- Write('You selected file ',Chosen_File);
- Write(' Press any key to return to the menu');
- {$I-}
- ChDir(StartPath);
- {$I+}
- Ch := Getkey;
- RestoreScreen(1);
- DisposeScreen(1);
- end;
-
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 7 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Printout;
- begin
- Mkwin(10,8,70,18,white,red,1);
- Offcursor;
- WriteAT(15,10,white,red,'The documentation is compressed in a file Manual.exe.');
- WriteAT(15,11,white,red,'Execute this file and the file Manual.TTT will self ');
- WriteAT(15,12,white,red,'extract. The manual contains no formatting chars, &');
- WriteAT(15,13,white,red,'is 80 characters wide by 66 lines per page.');
- WriteAT(15,15,white,red,'At the DOS prompt type Print Manual.TTT. Be warned');
- WriteAT(15,16,white,red,'the documentation is good but it''s more than 100 pages.');
- WriteAT(50,18,white,red,' press any key .... ');
- Ch := getkey;
- Rmwin;
- end;
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { O P T I O N 8 }
- {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- Procedure Unit_Summary;
- const
- X1 = 40;
- Y1 = 5;
- X2 = 80;
- Y2 = 25;
- var
- C1,C2,C3,C4 : byte;
- begin
- If ColorScreen then
- begin
- C1 := white;
- C2 := lightgray;
- C3 := yellow;
- C4 := blue;
- end
- else
- begin
- C1 := white;
- C2 := black;
- C3 := white;
- C4 := lightgray;
- end;
- SaveScreen(1);
- Fbox(1,1,80,24,C1,C4,1);
- WriteCenter(2,C3,C4,'A Summary of the Toolkit Units');
- WriteAt(3,4,c1,c4,
- 'There are twelve major units included in the Toolkit. This demonstration');
- WriteAt(3,5,c1,c4,
- 'program has only illustrated a few of the features and capabilities of the');
- WriteAt(3,6,c1,c4,
- 'Toolkit. The READTTT5, STRNTTT5 and MISCTTT5 units were not even mentioned!');
- WriteAt(3,7,c1,c4,
- 'The demo disk includes many smaller programs to illustrate Toolkit ');
- WriteAt(3,8,c1,c4,
- 'programming techniques. By way of a summary, the Toolkit units are:');
-
- WriteAT(3,10,c3,c4,'FastTTT5 ');
- WriteAT(12,10,c2,c4,'Ultra fast Screen writing routines including box drawing');
- WriteAT(3,11,c3,c4,'WinTTT5 ');
- WriteAT(12,11,c2,c4,'Windowing routines together with screen moves, copies & saves');
- WriteAT(3,12,c3,c4,'MenuTTT5 ');
- WriteAT(12,12,c2,c4,'Advanced, but easy to use, menu unit with auto-centering etc.');
- WriteAT(3,13,c3,c4,'KeyTTT5 ');
- WriteAT(12,13,c2,c4,'Full keyboard control and a host of mouse related procedures');
- WriteAT(3,14,c3,c4,'IOTTT5 ');
- WriteAT(12,14,c2,c4,'Form or full screen input procedues, with control of input');
- WriteAT(3,15,c3,c4,'StrnTTT5');
- WriteAT(12,15,c2,c4,'Suite of fast string handling procs, including word manipulation');
- WriteAT(3,16,c3,c4,'PullTTT5');
- WriteAT(12,16,c2,c4,'Easy to use procedure for displaying Pull down menus');
- WriteAT(3,17,c3,c4,'DirTTT5');
- WriteAT(12,17,c2,c4,'Sidekick Plus style directory listing procedures with sorting');
- WriteAT(3,18,c3,c4,'ReadTTT5');
- WriteAT(12,18,c2,c4,'Single line input control providing user with full editing');
- WriteAT(3,19,c3,c4,'NestTTT5');
- WriteAT(12,19,c2,c4,'A Sprint style nested menu system');
- WriteAT(3,20,c3,c4,'ListTTT5');
- WriteAT(12,20,c2,c4,'A generic list routine to list any string array in a window');
- WriteAT(3,21,c3,c4,'MiscTTT5');
- WriteAT(12,21,c2,c4,'A pot pourri of miscellaneous procedures and functions');
- WriteAT(50,23,c2,c4,'Press any key to continue....');
- Offcursor;
- Ch := getkey;
- SlideRestoreScreen(1,Up);
- DisposeScreen(1);
- end;
-
- Procedure Initialise;
- var X,Y : byte;
-
- Procedure Sparkle;
- {}
- var tempX,tempC:byte;
- I : integer;
- begin
- Delay(1000);
- For I := 8 to 13 do
- begin
- If keypressed then exit;
- Attrib(5,I,78,I,yellow,black);
- Delay(75);
- end;
- Delay(500);
- For I := 15 to 17 do
- begin
- If keypressed then exit;
- Attrib(5,I,78,I,lightgreen,black);
- Delay(75);
- end;
- For I := 1 to 80 do
- begin
- If keypressed then exit;
- Attrib(I,20,I,20,lightcyan,black);
- Delay(15);
- end;
- Repeat
- tempX := Random(26);
- TempC := Random(6);
- Inc(TempC,9);
- Attrib(27+tempX,2,27+tempX,2,TempC,black);
- TempX := Random(40);
- Attrib(20+tempX,20,20+tempX,20,TempC,black);
- Delay(50);
- Until keypressed;
- end; {of proc Sparkle}
-
- begin
- CreateScreen(2,25);
- Activate_Virtual_Screen(2);
- Box(25,1,55,4,white,black,1);
- WriteBetween(25,55,2,lightgray,black,'TechnoJock''s Turbo Toolkit');
- WriteBetween(25,55,3,lightgray,black,'v5.00');
- WriteAT(5,8,white,black,'This program demonstrates the power of TechnoJock''s Turbo Toolkit for');
- WriteAT(5,9,white,black,'Borland''s Turbo Pascal v4.0 and v5.0 (on IBM and true compatibles).');
- WriteAT(5,10,white,black,'The Toolkit is a professional ShareWare product, and if you use the');
- WriteAt(5,11,white,black,'Toolkit, you must register it. Included in the source code is a file');
- WriteAt(5,12,white,black,'Register.doc. Print this file and submit it together with a registration');
- WriteAt(5,13,white,black,'fee of $49.95 + shipping and handling to:');
- WriteAt(30,15,white,black,'TechnoJock Software, Inc.');
- WriteAt(30,16,white,black,'P.O. Box 820927');
- WriteAT(30,17,white,black,'Houston, TX 77282');
-
- WriteCenter(23,white,black,'Copyright (C) 1986, 1989 TechnoJock Software, Inc.');
- WriteCenter(24,white,black,'All Rights Reserved');
-
- Activate_Visible_Screen;
- SlideRestoreSCreen(2,Down);
- WriteAT(55,25,lightgray,black,'Press any key to continue');
- If not keypressed then
- ClickWrite(20,20,white,black,'"In the Software business since Tuesday"');
- If ColorScreen then
- Sparkle;
- Ch := getkey;
- Clrscr;
- FillScreen(1,1,80,24,white,black,chr(176));
- Findcursor(X,Y,ScanTop,ScanBot);
- OffCursor;
- WriteCenter(25,lightgray,black,'TechnoJock''s Turbo Toolkit v5.00 ');
- Main_Choice := 1;
- Define_Menu1;
- Define_menu_Menu;
- end;
-
- Procedure Menu_System;
- {}
- var
- Pick : integer;
- Error : integer;
- begin
- SaveScreen(9);
- Attrib(1,1,80,25,lightgray,black);
- Pick := 1;
- Repeat
- DisplayMenu(MM,false,Pick,Error);
- If Error = 0 then
- Case Pick of
- 1 :Menu_Intro;
- 2 :Explain_Menu;
- 3 :PullDemo;
- 4 :NestTTT5_Demo_1;
- 5 :Show_The_Girlfriends;
- end;
- Until (Pick = MM.TotalPicks) or (Error <> 0);
- RestoreScreen(9);
- DisposeScreen(9);
- end; {of proc MenuSystem}
-
-
- Procedure Finish;
- begin
- ClrScr;
- Reset_StartUp_Mode;
- writeln('TechnoJock''s Turbo Toolkit v5.0');
- writeln('Copyright (c) 1986, 1989 TechnoJock Software, Inc.');
- Halt;
- end;
-
- begin {main program}
- Initialise;
- repeat
- DisplayMenu(M1,false,Main_choice,Error);
- Case Main_Choice of
- 1 :Toolkit_Explained;
- 2 :Explain_Fastwrite;
- 3 :Explain_Windows;
- 4 :Menu_System;
- 5 :Explain_IO;
- 6 :Explain_Dir;
- 7 :PrintOut;
- 8 :Unit_Summary;
- 9 :Finish;
- end; {case}
- until true = false; {a very very very long time !}
- end.
-