CONTROL.TPL 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169
  1. >>FILE NAME =@TABLENAME@.MOD
  2. MODULE @TABLENAME@;
  3. FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec,
  4. AppendBlank;
  5. FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame;
  6. FROM PosUtils IMPORT Equal;
  7. FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr;
  8. FROM M2Strings IMPORT Length;
  9. FROM LowLevel IMPORT Fill;
  10. FROM StringIO IMPORT PrintMessage;
  11. FROM Drectory IMPORT SetDefaultDrive,ChDir,GetCurrentDir;
  12. FROM EnvironUtils IMPORT ReadEnvironment;
  13. FROM SmartScreen IMPORT ClearScreen;
  14. FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
  15. FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName;
  16. FROM FramePainter IMPORT ShowDisplayFrame;
  17. FROM InputManager IMPORT ControlFrame;
  18. FROM FrameManager IMPORT EraseFrame;
  19. FROM Prompts IMPORT Prompt,PromptStr;
  20. FROM SYSTEM IMPORT ADR,SIZE;
  21. FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control;
  22. FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
  23. FROM HandleIO IMPORT FileExists;
  24. FROM Prompts IMPORT Prompt;
  25. FROM LowLevel IMPORT Fill;
  26. FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt;
  27. FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile;
  28. FROM DBF@TABLENAME@ IMPORT @TABLENAME@DBF, Open@TABLENAME@DBF,
  29. Close@TABLENAME@DBF,
  30. >>FOR EACH IDX<<
  31. Find@TABLENAME@By@IDX@,
  32. >>END IDX<<
  33. Next@TABLENAME@,Prev@TABLENAME@,First@TABLENAME@,Last@TABLENAME@;
  34. IMPORT InitCompilerMods;
  35. VAR
  36. Status : INTEGER;
  37. Environ : ARRAY [0..60] OF CHAR;
  38. J : CARDINAL;
  39. TopMenu : GenList;
  40. FirstTime: BOOLEAN;
  41. NextFrame,EndingFrame : AFrameName;
  42. SelChar : CHAR;
  43. NoData : BOOLEAN; (* true when no data is on the screen *)
  44. @TABLENAME@DF : DisplayFrame;
  45. DSPFile : DisplayFile;
  46. PullDnMenu : GenList;
  47. PROCEDURE FileMenu(SelChar: CHAR);
  48. VAR
  49. B : BOOLEAN;
  50. Str : ARRAY [0..80] OF CHAR;
  51. BEGIN
  52. CASE SelChar OF
  53. 'A' : ReadDisplayFrame(DSPFile,@TABLENAME@DF,'@TABLENAME@'); (*Clear out any of the fields *)
  54. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  55. Control(@TABLENAME@DF); (* alow user input *)
  56. AppendBlank(@TABLENAME@DBF);
  57. B := FrameToDBF(@TABLENAME@DBF,@TABLENAME@DF); (* do something if couldn't add*)
  58. WriteDBRec(@TABLENAME@DBF);
  59. |'F' : First@TABLENAME@();
  60. DBFToFrame(@TABLENAME@DBF,@TABLENAME@DF);
  61. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  62. |'L' : Last@TABLENAME@();
  63. DBFToFrame(@TABLENAME@DBF,@TABLENAME@DF);
  64. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  65. |'N' : IF Next@TABLENAME@()
  66. THEN
  67. DBFToFrame(@TABLENAME@DBF,@TABLENAME@DF);
  68. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  69. END;
  70. |'P' : IF Prev@TABLENAME@()
  71. THEN
  72. DBFToFrame(@TABLENAME@DBF,@TABLENAME@DF);
  73. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  74. END;
  75. >>FOR EACH IDX<<
  76. |'@IDXCHAR@' : (* The first unused letter in the index name or 'Q' *)
  77. Fill(ADR(Str),SIZE(Str),0);
  78. >>IF INDEX = C
  79. PromptStr('Enter @TABLENAME@ @IDX@ ',Str);
  80. >>END IF<<
  81. >>IF INDEX = N
  82. PromptNum('Enter @TABLENAME@ @IDX@, Str);
  83. >>END IF<<
  84. CrunchBlanks(Str);
  85. IF NOT Find@TABLENAME@By@IDX@(Str)
  86. THEN
  87. Prompt('@TABLENAME@ Not Found');
  88. ELSE
  89. DBFToFrame(@TABLENAME@DBF,@TABLENAME@DF);
  90. ShowDisplayFrame(@TABLENAME@DF,0,0,0,0);
  91. END;
  92. >>END IDX<<
  93. END; (* end of case *)
  94. END FileMenu;
  95. PROCEDURE EditMenu(SelChar : CHAR);
  96. VAR
  97. B:BOOLEAN;
  98. BEGIN
  99. CASE SelChar OF
  100. 'U' : Control(@TABLENAME@DF);
  101. B:=FrameToDBF(@TABLENAME@DBF,@TABLENAME@DF);
  102. WriteDBRec(@TABLENAME@DBF);
  103. |'D' : DeleteRecord(@TABLENAME@DBF);
  104. NoData := TRUE;
  105. END;
  106. END EditMenu;
  107. BEGIN
  108. (* if there is an environment variable set to m2test=path *)
  109. (* the program will set the default drive and path *)
  110. (* this is needed because running under the debuggers the *)
  111. (* debugger will start the program with the default drive *)
  112. (* and path = c:\ - aint nothing gona work if looking for *)
  113. (* files there *)
  114. ReadEnvironment('M2TEST', Environ);
  115. CrunchBlanks(Environ);
  116. IF Length(Environ) > 0
  117. THEN
  118. CAPstr(Environ);
  119. IF Environ[1] = ':'
  120. THEN SetDefaultDrive(Environ[0]);
  121. DeleteRightJustified(Environ,0,2);
  122. END;
  123. IF 0#ChDir(Environ)
  124. THEN (* this is bullet proof code here *)
  125. END;
  126. END;
  127. PrintMessage(GetCurrentDir('z',Environ)); (* check *)
  128. IF NOT OpenDisplayFile(DSPFile,'@TABLENAME@.DSP')
  129. THEN
  130. Prompt('Could not open @TABLENAME@.dsp file');
  131. HALT;
  132. END;
  133. ClearScreen();
  134. InitDisplayFrame(@TABLENAME@DF,CurrentWindow);
  135. NewList(PullDnMenu);
  136. LoadFrameList(DSPFile,'TopMenu',PullDnMenu);
  137. NoData := TRUE;
  138. Open@TABLENAME@DBF(TRUE);
  139. ReadDisplayFrame(DSPFile,@TABLENAME@DF,'@TABLENAME@');
  140. REPEAT
  141. NextFrame := 'TopMenu';
  142. ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
  143. IF Equal(EndingFrame,'FileMenu')
  144. THEN FileMenu(SelChar);
  145. ELSIF Equal(EndingFrame,'EditMenu')
  146. THEN EditMenu(SelChar);
  147. END;
  148. UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *)
  149. Close@TABLENAME@DBF();
  150. ClearScreen();
  151. END @TABLENAME@.
  152.