home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TTT510.ZIP / TTTDEM.ZIP / IODEM6.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-30  |  6.5 KB  |  229 lines
  1. Program Illustrating_Screen_Editing;
  2.  
  3. uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, MenuTTT5, ListTTT5, IOTTT5;
  4.  
  5. var
  6. Str1,
  7. Str2,
  8. Str3,
  9. Str4,
  10. Str5,
  11. Str6,
  12. Str7,
  13. Str8,
  14. Str9,
  15. Str10,
  16. Str11,
  17. Str12 : string;
  18. Code : integer;
  19. Ch : char;
  20.  
  21. Procedure Get_Order_Details;
  22. {This procedure illustrates how you can nest input screens. This is referred
  23.  to as having multiple input tables}
  24. const
  25.     X1 = 30;
  26.     Y1 = 16;
  27.     X2 = 76;
  28.     Y2 = 22;
  29. begin
  30.     AcTivate_Table(2);  {IMPORTANT set all Io Procs to operate on table 2}
  31.     Create_Fields(3);
  32.     Allow_Beep(False);
  33.     Add_Field(1,  3, 2, 3, 2, X1 +21, Y1+1);
  34.     String_Field(1,  Str10, '!!!!!!!!!!!!!!!!!!!!!!');
  35.     Add_Field(2, 1, 3, 1, 3,X1 +21, Y1+3);
  36.     String_Field(2, Str11, '###');
  37.     Add_Field(3,  2, 1, 2, 1, X1 +20, Y1+5);
  38.     String_field(3, Str12, '(##-###) ##');
  39.     SaveScreen(1);                     {save previous input screen}
  40.     Attrib(1,1,80,25,lightgray,black);  {darken the display but still visible}
  41.     FBox(X1,Y1,X2,Y2,blue,lightgray,1);
  42.     WriteAT(X1+2,Y1+1,blue,lightgray,'Order description:');
  43.     WriteAT(X1+2,Y1+3,blue,lightgray,'Quantity:');
  44.     WriteAT(X1+2,Y1+5,blue,lightgray,'Part No:');
  45.     Process_Input(1);
  46.     Dispose_Fields;
  47.     RestoreScreen(1);
  48.     DisposeScreen(1);
  49.     Activate_Table(1); {IMPORTANT set IO procs back to table 1}
  50. end;
  51.  
  52.  
  53. Procedure Display_Options;
  54. const
  55.     TotPicks = 4;
  56.     Width    = 10;
  57. var
  58.   T : array[1..TotPicks] of string[Width];
  59. begin
  60.     T[1] := 'Amoco';
  61.     T[2] := 'Conoco';
  62.     T[3] := 'Texaco';
  63.     T[4] := 'Technoco';
  64.     With LTTT do
  65.     begin
  66.         AllowToggle := false;
  67.         X := 65;
  68.         Y := 3;
  69.     end;
  70.     SaveScreen(1);
  71.     WriteAT(62,7,white,lightgray,'<--');
  72.     Attrib(1,1,80,25,lightgray,black);
  73.     Show_List(T,Width,TotPicks);
  74.     RestoreScreen(1);
  75.     If L_Char= #027 then
  76.        Str2 := ''
  77.     else
  78.        Case L_Pick of
  79.        1 : Str2 := T[1];
  80.        2 : Str2 := T[2];
  81.        3 : Str2 := T[3];
  82.        4 : Str2 := T[4];
  83.        end; {Case}
  84. end; {Proc Display_Options}
  85.  
  86. (*  An alternative using menu
  87. Procedure Display_Options(var Str :string);
  88. var
  89.   M : Menu_Record;
  90.   Pick, Retcode : integer;
  91. const
  92.     T1 = 'Amoco';
  93.     T2 = 'Conoco';
  94.     T3 = 'Texaco';
  95.     T4 = 'Technoco';
  96. begin
  97.     With M do
  98.     begin
  99.         Heading1 := '';
  100.         Heading2 := '';
  101.         Topic[1] := T1;
  102.         Topic[2] := T2;
  103.         Topic[3] := T3;
  104.         Topic[4] := T4;
  105.         TotalPicks := 4;
  106.         PicksperLine := 1;
  107.         Addprefix := 0;
  108.         Margins := 0;
  109.         TopLeftXY[1] := 65;
  110.         TopLeftXy[2] := 5;
  111.         BoxType := 1;
  112.         AllowEsc := true;
  113.         Colors[1] := lightgray;
  114.         Colors[2] := black;
  115.         Colors[3] := black;
  116.         Colors[4] := lightgray;
  117.         Colors[5] := white;
  118.     end; {with M}
  119.     Pick := 1;
  120.     WriteAT(62,7,white,lightgray,'<--');
  121.     DisplayMenu(M,false,Pick,retcode);
  122.     WriteAT(62,7,white,lightgray,'   ');
  123.     If Retcode <> 0 then
  124.        Str := ''
  125.     else
  126.        Case Pick of
  127.        1 : Str := T1;
  128.        2 : Str := T2;
  129.        3 : Str := T3;
  130.        4 : Str := T4;
  131.        end; {Case}
  132. end; {Proc Display_Options}
  133. *)
  134.  
  135.  
  136. {$F+}                      {must be defined as far}
  137. Procedure Special_Keys(var Ch : Char;var FieldID : Byte; var RefreshCode: byte);
  138. begin
  139.     If (CurrentTable = 1) and (Ch =  #187) and (FieldID = 2) then
  140.     begin
  141.        Display_Options;
  142.        RefreshCode := Refresh_All;
  143.     end;
  144.     If (CurrentTable = 1) and (Ch =  #187) and (FieldID = 9) then
  145.     begin
  146.        Get_Order_Details;
  147.        RefreshCode := Refresh_All;
  148.     end;
  149. end;
  150. {F-}
  151.  
  152. begin             {test program}
  153. Str1 := '';
  154. Str2 := '';
  155. Str3 := '';
  156. Str4 := '';
  157. Str5 := '';
  158. Str6 := 'TX';
  159. Str7 := '';
  160. Str8 := '';
  161. Str9 := '';
  162. Str10 := '';
  163. Str11 := '';
  164. Str12 := '';
  165.  
  166. Create_Tables(2);
  167. Create_Fields(9);
  168.  
  169. Assign_CharHook(Special_Keys);
  170. Define_Colors(15,4,11,1,14,4);
  171. Allow_Beep(false);
  172. Allow_Esc(True);
  173. Add_Field(1,  1,2,1,2, 30,6);
  174. String_Field(1,  Str1,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');{name}
  175. Add_Field(2,  1,3,1,3, 30,7);
  176. String_Field(2,  Str2,'*******************************');{Co.}
  177. Add_Field(3,  2,4,2,4, 30,8);
  178. String_Field(3,  Str3,'*******************************');{ad1}
  179. Add_Field(4,  3,5,3,5, 30,9);
  180. String_Field(4,  Str4,'*******************************');{ad2}
  181. Add_Field(5,  4,6,4,6, 30,10);
  182. String_Field(5,  Str5,'@@@@@@@@@@@@@@@@');{city}
  183. Add_Field(6,  4,7,5,7, 55,10);
  184. String_Field(6,  Str6,'!!');{state}
  185. Add_Field(7,  4,8,6,8, 65,10);
  186. String_Field(7,  Str7,'#####-####');{zip}
  187. Add_Field(8,  5,9,7,9, 30,12);
  188. String_Field(8,  Str8,'(###) ###-####'); {work Phone}
  189. Add_Field(9,  8,1,8,1, 30,14);
  190. String_Field(9,  Str9,'#####');  {order no.}
  191.  
  192. Add_Message(1, 0,25,'Name is automatically set to capitals');
  193. Add_Message(2, 0,25,'Enter Company Name, press F1 for a list of companies');
  194. Add_Message(5, 0,25,'Now you can only type alphas and punctuation');
  195. Add_Message(6, 0,25,'Default is set to Texas');
  196. Add_Message(7, 0,25,'Zip and phone number must be numeric');
  197. Add_Message(9, 0,25,'Press F1 to enter order details');
  198.  
  199. ClearText(1,1,80,25,red,lightgray);
  200. Box(1,1,80,25,red,lightgray,3);
  201. WriteCenter(2,blue,lightgray,'TechnoJocks Turbo Toolkit');
  202. WriteCenter(3,white,lightgray,'Screen Input Routines Demonstration');
  203. WriteAT(12,6,blue,lightgray,'Incumbents Name =>');
  204. WriteAT(20,7,blue,lightgray,'Company =>');
  205. WriteAT(20,8,blue,lightgray,'Address =>');
  206. WriteAT(23,10,blue,lightgray,'City =>');
  207. WriteAT(48,10,blue,lightgray,'State');
  208. WriteAT(60,10,blue,lightgray,'Zip');
  209. WriteAT(22,12,blue,lightgray,'Phone =>');
  210. WriteAT(19,14,blue,lightgray,'Order No =>');
  211. WriteAT(10,16,white,lightgray,'Instructions:   [End to quit]');
  212. WriteAT(10,17,blue,lightgray,'This is a mock up of a data entry screen. Simply');
  213. WriteAT(10,18,blue,lightgray,'enter some values and press enter. Use the arrow');
  214. WriteAT(10,19,blue,lightgray,'keys to move between fields. Note the following:');
  215. WriteAT(10,20,white,lightgray,'End    to finish entry           Ins    toggle insert on and off');
  216. WriteAT(10,21,white,lightgray,'Alt-D  delete current field      Alt-E  delete all fields');
  217. WriteAT(10,22,white,lightgray,'Ctrl-Right  shift right          Ctrl-Left shift left');
  218. WriteAT(10,23,white,lightgray,'Tab         shift right          Shift-Tab shift left');
  219.  
  220. Process_Input(1);
  221. Dispose_Fields;
  222. Clrscr;
  223. If I_Char <> #027 then
  224.    WriteAT(1,1,white,black,'You escaped!');
  225. WriteAT(1,24,white,black,'Run DemoTTT.exe for the main demo program');
  226. WriteAT(1,25,white,black,'Technojocks Turbo Toolkit v5.0');
  227. Ch := Readkey;
  228. end.
  229.