home *** CD-ROM | disk | FTP | other *** search
/ HomeWare 14 / HOMEWARE14.bin / windows / database / apd40ulb.arj / APD40ULB.SC < prev    next >
Text File  |  1993-06-17  |  111KB  |  3,640 lines
  1. ;****************************************************
  2. ;
  3. ;  A PARADOX 4.O UTILITY LIBRARY (APD40ULB.SC)
  4. ;
  5. ;  THIS FREEWARE HAS BEEN PREPARED BY:
  6. ;
  7. ;  MICHAEL MAKLER
  8. ;  10221 SLATER AVE
  9. ;  #103-315
  10. ;  FOUNTAIN VALLEY, CA 92708
  11. ;  (714) 571-8510
  12. ;
  13. ;   IF YOU FIND IT USEFUL A DONATION OF $29.95 WOULD BE
  14. ;   APPRECIATED.
  15. ;
  16. ;   FEEL FREE TO USE AND DISTRIBUTE THIS CODE OR ANY PORTIONS OF IT
  17. ;   WITH YOUR APPLICATION.  IF YOU USE IT PLEASE RETAIN MY COPYRIGHT
  18. ;   IF YOU PLACE IT ON BBS OR DISTRIBUTE IT PLEASE DELIVER
  19. ;   THE FULL PACKAGE.
  20. ;
  21. ;   EVERY EFFORT HAS BEEN MADE TO TEST AND VALIDATE THIS SYSTEM
  22. ;   HOWEVER NO GUARANTEES OR WARRANTIES FOR FITNESS OF USE ARE
  23. ;   EXPRESSED OR IMPLIED.
  24. ;
  25. ;   IF YOU FIND ANY BUGS OR ADD FEATURES PLEASE LET ME KNOW.
  26. ;   IF YOU HAVE ANY SUGGESTIONS OR CRITICISMS PLEASE LET ME KNOW.
  27. ;
  28. ;   THANK YOU,
  29. ;   MIKE MAKLER
  30. ;
  31. ;   FILES.DOC CONTAINS A LISTING OF ALL FILES REQUIRED
  32. ;   IF ANY ARE MISSING PLEASE CONTACT ME AT PHONE OR
  33. ;   ADDRESS ABOVE.
  34. ;
  35. ;  COPYRIGHT (C) 1993 MICHAEL MAKLER
  36. ;
  37. ;****************************************************
  38.  
  39.  
  40.  
  41.  
  42. ;********************************************************************
  43. ;  FILE: APD40ULB.SC
  44. ;
  45. ;  NOTES: THESE ARE THE PROCEDURE FILES FOR THE
  46. ;         PARADOX 4.0 UTILITY LIBRARY
  47. ;
  48. ;*******************************************************************
  49.  
  50. ;****************************************************************
  51. ; Name:  DEMO.A
  52. ; Notes: DEMONSTRATE THE PARDOX 4.0 UTILITY LIBRARY
  53. ;        THIS DEMO RUNS MY PRINTER UTILITIES WHICH IT TURNS OUT
  54. ;        USES A LARGE MAJORITY OF THE UTILITY LIBRARY
  55. ;
  56. ; Copyright (c) 1993 Mike MAKLER
  57. ;
  58. ;****************************************************************
  59. PROC DEMO.A ()
  60.  
  61.    CLEAR
  62.  
  63.    InitGlobalVar.v ()  ; INITIALIZE LOCAL VARIABLES
  64.                        ; THESE MAY NEED TO CHANGE OR BE ADDED TO
  65.                        ; FOR YOUR SPECIFIC APPLICATION
  66.  
  67.    REPORT_GL        = "PRINTER DEFINITION REPORT" ;NAME OF ACTIVE REPORT
  68.  
  69.    Printit_UT(PRINTTAB_GL,  1) ;CALL THE PRINT ROUTINE MAIN MENU
  70.                                ;FOR THE PRINTER TABLE REPORT SCRIPT
  71.  
  72. ENDPROC ;**** DEMO ***
  73. WriteLib Libname.a  DEMO.A
  74. Release Procs DEMO.A
  75.  
  76. ;****************************************************************
  77. ; Name:  BeepIt_UT
  78. ; Notes: Beeps alot
  79. ;
  80. ; Inputs:
  81. ;    Seconds - is Number of seconds in Milliseconds to pause
  82. ;              between beeps
  83. ;    Count   - Is number of times to beep;
  84. ;
  85. ; Outputs:     N/A
  86. ;
  87. ; Local Variables:     I loop index
  88. ;
  89. ; Global Variables: N/A
  90. ;
  91. ; Routines Called : N/A
  92. ;
  93. ; Code Segment: Beepit (2000,5) ; This will beep 5 times with a 2 second
  94. ;                               ;Pause between beeps
  95. ;
  96. ; Error Conditions : N/A
  97. ;
  98. ; Other  :       N/A
  99. ;
  100. ; Limitations  :  N/A
  101. ;
  102. ; Copyright (c) 1993 Mike MAKLER
  103. ;
  104. ;*****************************************************************************
  105. Proc BeepIt_UT (Seconds, Count)
  106.     ;*************************
  107.     ;*  locals
  108.     ;**************************
  109.     Private I ;Loop index
  110.  
  111.     ; seconds is number of miliseconds
  112.     ; count is number of times to beep
  113.  
  114.     For I From 1 To Count Step 1
  115.         Beep
  116.         Sleep Seconds
  117.     EndFor
  118.  
  119. EndProc ;**** BeepIt_UT ****
  120. WriteLib Libname.a BeepIt_UT
  121. Release Procs BeepIt_UT
  122.  
  123. ;****************************************************************
  124. ; Name:  Check_Drive_Ready_UT
  125. ;
  126. ; Notes: This module merely gives the user an oppurtunity
  127. ;        To Insert a disk. The Calling Module should
  128. ;        Check the Drive status before and after calling
  129. ;        This module.  The calling module should also call
  130. ;        Loc_err to put up an apprioate message before calling
  131. ;        This Module.
  132. ;
  133. ;
  134. ; Inputs:  DriveName - Name of Disk Drive to Check
  135. ;
  136. ; Outputs:  N/A
  137. ;
  138. ; Local Variables:    Count ; number of times to loop currently 5
  139. ;
  140. ; Global Variables: N/A
  141. ;
  142. ; Routines Called : N/A
  143. ;
  144. ; Code Segment:
  145. ;                       IF Not DriveStatus (DriveName)
  146. ;                          Then  Loc_err ("Drive Is Not Ready",
  147. ;                                         "Called By Format")
  148. ;                                 Check_Drive_Ready_UT (DriveName)  
  149. ;                                                          ;give user chance
  150. ;                                                          ;to insert Disk
  151. ;                       Endif
  152. ;
  153. ;                       If Not DriveStatus (DriveName)  
  154. ;                                                ; Has user Inserted Disk
  155. ;                                                ; Note that if Drive is
  156. ;                                                ; ready then an
  157. ;                                                ; extra call to DriveStatus
  158. ;                                                ; is made <No Big Deal>
  159. ;                          then Loc_err ("Drive not Ready",
  160. ;                                     "Opertion Aboterted" )
  161. ;                          Else Drivespace (DriveName)
  162. ;                       Endif
  163. ;
  164. ; Error Conditions : N/A
  165. ;
  166. ; Other  :   Algorithm
  167. ;            Start Check_Drive_Ready_UT  ()
  168. ;                  Count = 0
  169. ;                  While Count is less then 5 and Drive not ready
  170. ;                     If Drive ready
  171. ;                        Then Quitloop
  172. ;                        Else PlaceMsg ("Printer Not Ready")
  173. ;                     Endif
  174. ;                     Increment Count
  175. ;                     Pause 1.5 seconds
  176. ;                     Loop
  177. ;                  EndWhile
  178. ;            End Check_Drive_Ready_UT ***
  179. ;
  180. ; Limitations  :  N/A
  181. ;
  182. ; Copyright (c) 1993 Mike Makler
  183. ;
  184. ;*****************************************************************************
  185. Proc Check_Drive_Ready_UT (DriveName.S)
  186.     ;*********************************
  187.     ; Locals
  188.     ;*********************************
  189.     Private ButtonValue.S
  190.  
  191.     Showdialog "Disk Drive "  + DriveName.S + " Not Ready"
  192.                @8, 5
  193.                height 13
  194.                width  70
  195.                @2,8 ?? "Disk Drive "  + DriveName.S + " Not Ready"
  196.  
  197.  
  198.    Pushbutton  @8,9 width 10
  199.                "~O~K"
  200.                 OK
  201.                 Default
  202.                 value "Yes"
  203.                 Tag "YES"
  204.                 To ButtonValue.s
  205.    EndDialog
  206.  
  207.  
  208.     Return
  209. EndProc ;*** Check_Drive_Ready_UT ***
  210. WriteLib Libname.a Check_Drive_Ready_UT
  211. Release Procs Check_Drive_Ready_UT
  212.  
  213. ;****************************************************************
  214. ; Name:  Check_Print_ready_UT
  215. ;
  216. ; Notes: This module merely gives the user an oppurtunity
  217. ;        To Turn On The Printer. The Calling Module should
  218. ;        Check the Printer status before and after calling
  219. ;        This module.  The calling module should also call
  220. ;        Loc_err to put up an apprioate message before calling
  221. ;        This Module.
  222. ;
  223. ;
  224. ; Inputs:  N/A
  225. ;
  226. ; Outputs:  N/A
  227. ;
  228. ; Local Variables:    Count ; number of times to loop currently 5
  229. ;
  230. ; Global Variables: N/A
  231. ;
  232. ; Routines Called : N/A
  233. ;
  234. ; Code Segment:
  235. ;                       IF Not PrinterStatus ()
  236. ;                          Then  Loc_err ("Printer Is Not Ready",
  237. ;                                         "Called By Print Report")
  238. ;                                 Check_Print_Ready_UT ()  ;give user chance
  239. ;                                                          ;to turn on printer
  240. ;                       Endif
  241. ;
  242. ;                       If Not PrinterStatus ()  ; Has user turned on printer
  243. ;                                                ; Note that if printer is
  244. ;                                                ; already online then an
  245. ;                                                ; extra call to print status
  246. ;                                                ; is made <No Big Deal>
  247. ;                          then Loc_err ("Printer was not Ready",
  248. ;                                     "Report Can't Be Printed" )
  249. ;                          Else Print_The_Report ()
  250. ;                       Endif
  251. ;
  252. ; Error Conditions : N/A
  253. ;
  254. ; Other  :   Algorithm
  255. ;            Start Check_Print_ready_UT  ()
  256. ;                  Count = 0
  257. ;                  While Count is less then 5 and printer not ready
  258. ;                     If Printer ready
  259. ;                        Then Quitloop
  260. ;                        Else PlaceMsg ("Printer Not Ready")
  261. ;                     Endif
  262. ;                     Increment Count
  263. ;                     Pause 1.5 seconds
  264. ;                     Loop
  265. ;                  EndWhile
  266. ;            End Check_Print_ready_UT ***
  267. ;
  268. ; Limitations  :  N/A
  269. ;
  270. ; Copyright (c) 1993 Mike Makler
  271. ;
  272. ;*****************************************************************************
  273. Proc Check_Print_Ready_UT ()
  274.     ;*********************************
  275.     ; Locals
  276.     ;*********************************
  277.     ;Private Count
  278.  
  279.  
  280.     Showdialog "Printer Not Ready"
  281.                @8, 5
  282.                height 13
  283.                width  70
  284.                @2,8 ?? "Printer is Not Ready"
  285.  
  286.  
  287.    Pushbutton  @8,9 width 10
  288.                "~O~K"
  289.                 OK
  290.                 Default
  291.                 value "Yes"
  292.                 Tag "YES"
  293.                 To ButtonValue.s
  294.  
  295.    EndDialog
  296.  
  297.  
  298.     Return
  299.  
  300. EndProc ;*** Check_Print_Ready_UT ***
  301. WriteLib Libname.a Check_print_Ready_UT
  302. Release Procs Check_print_Ready_UT
  303.  
  304.  
  305.  
  306. ;****************************************************************
  307. ; Name: clearwindow.v
  308. ;
  309. ; Notes: This Routine WILL clear a window from the screen
  310. ;
  311. ; Outputs: N/A
  312. ;
  313. ; Copyright (c) 1993 Mike Makler
  314. ;****************************************************************************
  315. PROC clearwindow.v (WinHand.H)
  316.      Private isvalue.l
  317.  
  318.     isvalue.l = Isassigned (WinHand.H)
  319.     if Isvalue.l
  320.        then if Iswindow (winhand.h)
  321.                then window select winhand.h
  322.                     window move winhand.h to -200,-200
  323.             endif
  324.     endif
  325.     echo off
  326.  
  327. ENDPROC ;**** clearwindow.v  ****
  328. WRITELIB LibName.a clearwindow.v
  329. RELEASE PROCS      clearwindow.v
  330.  
  331.  
  332. PROC CLOSEWINDOW.N (WIN.H)
  333.   IF ISASSIGNED (WIN.H)
  334.      THEN IF ISWINDOW (WIN.H)
  335.              THEN  WINDOW SELECT WIN.H
  336.                    WINDOW CLOSE
  337.           ENDIF
  338.  
  339.   ENDIF
  340. RETURN
  341. ENDPROC ;**** clOSEwindow.N  ****
  342. WRITELIB LibName.a clOSEwindow.N
  343. RELEASE PROCS      clOSEwindow.N
  344.  
  345. ;****************************************************************
  346. ; Name:  EditRec_UT
  347. ; Notes: allows user to edit a  record (table_in) using
  348. ;        form (formNum)
  349. ;
  350. ; Input: Table_in - Name of table to edit
  351. ;        FORMNUM  - form to use for editing
  352. ;
  353. ; Outputs: Retval (Paradox Global Variable)
  354. ;
  355. ; Local Variables:
  356. ;               L    - CancelEdit Yes/No Prompt Variable
  357. ;               Msg1 - User Message
  358. ;               Msg2 - User Message
  359. ;
  360. ; Global Variables: RetVal - Paradox WaitKey Variable
  361. ;
  362. ; Routines Called : NotCode_UT
  363. ;                   YesNo_Ut
  364. ;
  365. ; Code Segment: View Table_In
  366. ;               Moveto Field Xfield
  367. ;               Locate Xstring
  368. ;               If Retval
  369. ;                  Then EditTable_UT (Table_in,formNum)
  370. ;                       ;Depending on Aplication you may want to test
  371. ;                       ; Retval after returning from EditTable_UT
  372. ;                  Else ; error Logic
  373. ;               Endif
  374. ;
  375. ; Error Conditions : N/A
  376. ;
  377. ; Other  :       N/A
  378. ;
  379. ; Limitatiions :  This routine will not allow Dos, Dosbig, Zoom or ZoomNext
  380. ;                 Keys to be Entered.
  381. ;                 You Must Supply your own Help_Me (PRocName) Routine.
  382. ;                 If you want Help.  I have Supplied one that does nothing.
  383. ;                 You Can use EditTableNoHelp_Ut if help is not Needed.
  384. ;
  385. ; Copyright (c) 1993 Mike Makler
  386. ;
  387. ;*****************************************************************************
  388. Proc EditRec_UT (Table_in.s, FormNum.s,Field.s,Value.a)
  389.     ;*************************
  390.     ;*  locals
  391.     ;**************************
  392.     Private L,
  393.             Msg1,
  394.             Msg2,
  395.             Formv.l,
  396.             Empty.L,
  397.             TABVIEW.H,
  398.             FORMVIEW.H
  399.  
  400.  
  401.     Msg1 = "Editing Record --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
  402.  
  403.     View Table_in.s
  404.     TABVIEW.H = GETWINDOW()
  405.     Moveto Field field.s
  406.     Locate Value.a
  407.     if retval
  408.       then EditKey
  409.            CURSOR NORMAL
  410.            Formv.l = IsFormView ()
  411.            Empty.L = IsEmpty (Table_IN.s)
  412.            If Not Formv.l and Not Empty.l
  413.                Then  PickForm FormNum.s
  414.                      FORMVIEW.H = GETWINDOW()
  415.            EndIf
  416.  
  417.  
  418.            While True
  419.                Wait Record
  420.                    Prompt  Msg1
  421.                    Message "Begin Editing Record."
  422.                Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
  423.  
  424.                Switch
  425.                    Case RetVal = "F1":
  426.                        ;help_me("EditTable_UT")
  427.                        If helpmode() = "LookupHelp"
  428.                           then Keypress "F1"
  429.                           else  Message "LookUp Help Not Available for This Field"
  430.                        Endif
  431.                        Loop
  432.                    Case RetVal = "F2":
  433.                        Do_it!
  434.                        QuitLoop
  435.                    Case Retval = "F7" : Formv.l = IsFormView ()
  436.                                         Empty.L = IsEmpty (Table_IN.s)
  437.                                         If Not Formv.l
  438.                                            Then  If Not Empty.L
  439.                                                     then PickForm FormNum.S
  440.                                                  endif
  441.                                            Else KeyPress "F7"
  442.                                         Endif
  443.  
  444.  
  445.                    Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
  446.                                                               Loop
  447.                    Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
  448.                                                                 Loop
  449.                    Case RetVal = "Esc":
  450.                        L=YesNo_UT("YES Leave The Edit Session ALL CHANGES WILL BE LOST",
  451.                        "No Return to THE EDIT SESSION To Save Changes","no")
  452.  
  453.                        If Upper(L) = Upper("Yes")
  454.                            Then CancelEdit
  455.                            RetVal = "Esc"
  456.                            QuitLoop
  457.                        Else
  458.                            Loop
  459.                        EndIf
  460.                    OtherWise: NotCode_UT ()
  461.                        Loop
  462.                EndSwitch
  463.            EndWhile
  464.       else ;record not found error
  465.            M1.s = "Record not found for table : " + Table_in.s
  466.            m2.s = "Field                      : " + field.s
  467.            m3.s = "Value                      : " + strval (Value.a)
  468.            Loc_err_Pause_UT (M1.s, M2.s, M3.s)
  469.  
  470.     endif
  471.     CLOSEWINDOW.N (TABVIEW.H)
  472.     CLOSEWINDOW.N (FORMVIEW.H)
  473.     ;CURSOR OFF
  474. EndProc ;*** Editrec_UT ***
  475. WriteLib Libname.a Editrec_UT
  476. Release Procs Editrec_UT
  477.  
  478. ;****************************************************************
  479. ; Name:  EditTable_UT
  480. ; Notes: allows user to edit a  table (table_in) using
  481. ;        form (formNum)
  482. ;
  483. ; Input: Table_in - Name of table to edit
  484. ;        FORMNUM  - form to use for editing
  485. ;
  486. ; Outputs: Retval (Paradox Global Variable)
  487. ;
  488. ; Local Variables:
  489. ;               L    - CancelEdit Yes/No Prompt Variable
  490. ;               Msg1 - User Message
  491. ;               Msg2 - User Message
  492. ;
  493. ; Global Variables: RetVal - Paradox WaitKey Variable
  494. ;
  495. ; Routines Called : NotCode_UT
  496. ;                   YesNo_Ut
  497. ;
  498. ; Code Segment: View Table_In
  499. ;               Moveto Field Xfield
  500. ;               Locate Xstring
  501. ;               If Retval
  502. ;                  Then EditTable_UT (Table_in,formNum)
  503. ;                       ;Depending on Aplication you may want to test
  504. ;                       ; Retval after returning from EditTable_UT
  505. ;                  Else ; error Logic
  506. ;               Endif
  507. ;
  508. ; Error Conditions : N/A
  509. ;
  510. ; Other  :       N/A
  511. ;
  512. ; Limitatiions :  This routine will not allow Dos, Dosbig, Zoom or ZoomNext
  513. ;                 Keys to be Entered.
  514. ;                 You Must Supply your own Help_Me (PRocName) Routine.
  515. ;                 If you want Help.  I have Supplied one that does nothing.
  516. ;                 You Can use EditTableNoHelp_Ut if help is not Needed.
  517. ;
  518. ; Copyright (c) 1993 Mike Makler
  519. ;
  520. ;*****************************************************************************
  521. Proc EditTable_UT (Table_in, FormNum)
  522.     ;*************************
  523.     ;*  locals
  524.     ;**************************
  525.     Private L,
  526.             Msg1,
  527.             Msg2,
  528.             Formv.l,
  529.             Empty.L
  530.  
  531.  
  532.     Msg1 = "Editing TABLE --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
  533.  
  534.     View Table_in
  535.     TABVIEW.H = GETWINDOW()
  536.     EditKey
  537.     CURSOR NORMAL
  538.     Formv.l = IsFormView ()
  539.     Empty.L = IsEmpty (Table_IN)
  540.     If Not Formv.l and Not Empty.l
  541.         Then  PickForm FormNum
  542.               FORMVIEW.H = GETWINDOW()
  543.     EndIf
  544.  
  545.  
  546.     While True
  547.         Wait Table
  548.             Prompt  Msg1
  549.             Message "Begin Editing TABLE."
  550.         Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
  551.  
  552.         Switch
  553.             Case RetVal = "F1":
  554.                 ;help_me("EditTable_UT")
  555.                 If helpmode() = "LookupHelp"
  556.                    then Keypress "F1"
  557.                    else  Message "LookUp Help Not Available for This Field"
  558.                 Endif
  559.                 Loop
  560.             Case RetVal = "F2":
  561.                 Do_it!
  562.                 QuitLoop
  563.             Case Retval = "F7" : Formv.l = IsFormView ()
  564.                                  Empty.L = IsEmpty (Table_IN)
  565.                                  If Not Formv.l
  566.                                     Then  If Not Empty.L
  567.                                              then PickForm FormNum
  568.                                           endif
  569.                                     Else KeyPress "F7"
  570.                                  Endif
  571.  
  572.  
  573.             Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
  574.                                                        Loop
  575.             Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
  576.                                                          Loop
  577.             Case RetVal = "Esc":
  578.                 L=YesNo_UT("YES Leave The Edit Session ALL CHANGES WILL BE LOST",
  579.                 "No Return to THE EDIT SESSION To Save Changes","no")
  580.  
  581.                 If Upper(L) = Upper("Yes")
  582.                     Then CancelEdit
  583.                     RetVal = "Esc"
  584.                     QuitLoop
  585.                 Else
  586.                     Loop
  587.                 EndIf
  588.             OtherWise: NotCode_UT ()
  589.                 Loop
  590.         EndSwitch
  591.     EndWhile
  592.  
  593.     CLOSEWINDOW.N (TABVIEW.H)
  594.     CLOSEWINDOW.N (FORMVIEW.H)
  595. EndProc ;*** EditTable_UT ***
  596. WriteLib Libname.a EditTable_UT
  597. Release Procs EditTable_UT
  598.  
  599. ;****************************************************************
  600. ; Name:  GetDate_PromptString_UT
  601. ;
  602. ; Notes: Prompt User To enter Date.
  603. ;
  604. ; Inputs: Date.d         - Default Value Of Date
  605. ;         StartLine.s    - Line to prompt From
  606. ;         ClearFlag.l    - If True Then Clear Screen Before Prompting
  607. ;         PromptString.s - String To show User (Ie "Please Enter Submission Date - ")
  608. ;
  609. ; OutPuts:VarOut.d - User Entered Data
  610. ;
  611. ; Code Segment:  Date = GetDate_promptString_UT (D1,10,true,"Please enter Date: ")
  612. ;
  613. ;
  614. ; Local Variables: MonitorType - Monitor Type (COLOR, B&W, MONO)
  615. ;                  VarOut      - User Selected Date
  616. ;
  617. ; Global Variables: N/A
  618. ;
  619. ; Routines Called : GetMonitorType_UT
  620. ;
  621. ; Code Segment:  Date = GetDate_promptString_UT (D1,10,true,
  622. ;                                                "Please enter Date: ")
  623. ;
  624. ; Error Conditions : N/A
  625. ;
  626. ; Other  :       N/A
  627. ;
  628. ; Limitations  :  N/A
  629. ;
  630. ; Copyright (c) 1993 MIKE MAKLER
  631. ;
  632. ;*****************************************************************************
  633. Proc GetDate_PromptString_UT  (date.d,StartLine.s,ClearFlag.l,PromptString.s)
  634. ;*************************
  635. ;*  locals
  636. ;**************************
  637. Private MonitorType.s,
  638.         Varout.d,
  639.         len.n,
  640.         Entry.n,
  641.         ButtonValue.s
  642.  
  643.    MonitorType.s = GetMonitorType_UT ()
  644.    len.n = len (promptstring.s)
  645.    entry.n = len.n + 2 + 2
  646.  
  647.  
  648.    Varout.d = date.d
  649.    ButtonValue.S = "NO"
  650.  
  651.    Showdialog "DATE SELECTION"
  652.                @Startline.s, 5
  653.                height 10
  654.                width  60
  655.                @2,2 ?? Promptstring.s
  656.  
  657.        Accept  @2, entry.n
  658.                width 10 "D"
  659.                tag "date"
  660.                to varout.d
  661.  
  662.    Pushbutton  @5,9 width 10
  663.                "~O~K"
  664.                 OK
  665.                 Default
  666.                 value "Yes"
  667.                 Tag "YES"
  668.                 To ButtonValue.s
  669.  
  670.    Pushbutton  @5,29 width 10
  671.                "~C~ancel"
  672.                 CANCEL
  673.                 value "No"
  674.                 Tag "No"
  675.                 To ButtonValue.s
  676.    EndDialog
  677.  
  678.    If ButtonValue.S = "NO"
  679.       Then Varout.d = Date.d
  680.            RETVAL = FALSE
  681.       ELSE RETVAL = TRUE
  682.    Endif
  683.  
  684.    Return Varout.d
  685.  
  686. EndProc ;*** GetDate_PromptString_UT ***
  687. WriteLib LIBNAME.A GetDate_PromptString_UT
  688. Release Procs GetDate_PromptString_UT
  689.  
  690.  
  691. ;****************************************************************
  692. ; Name: GetDirName_Ut
  693. ;
  694. ; Notes: This routine will Prompt the user to enter a Path Name
  695. ;
  696. ;
  697. ; Inputs:
  698. ;       N1        - Default Directory Name
  699. ;       StartLine - Line to start User Prompt On
  700. ;       ClearFlag - If True then Clear screen before displaying user Prompt
  701. ;       Msg       - Message to display to user
  702. ;       Pic       - Paradox Variable Type
  703. ;       Edtfield  - Paradox input Format
  704. ;
  705. ;
  706. ; Outputs: DirName - Directory Name
  707. ;
  708. ; Local Variables:
  709. ;              Arg1     - Directory Name input to accept1arg_ut
  710. ;              c        - Value Returned From accept1arg_ut
  711. ;              DirFlag  - True if Directory Exists
  712. ;              Message1 - User Message Text
  713. ;              Message2 - User Message Text
  714. ;              Prompt1  - Prompt value input to accept1arg_ut
  715. ;              SaveDir  - Save Value of current Directory
  716. ;              Title    - title for accept1arg_ut Prompt Screen
  717. ;
  718. ; Global Variables: N/A
  719. ;
  720. ; Routines Called : Accept1Arg_UT
  721. ;                   GetStringEdtField_UT
  722. ;                   Loc_Err_UT
  723. ;
  724. ; Code Segment:
  725. ;              NewDir = GetDirName_Ut
  726. ;                           ("C:\\INV\\DB\\",12, True,
  727. ;                           "Enter Name of New Directory - ",
  728. ;                            "A45","!*!")
  729. ;              If NewDir = "NONE"
  730. ;                 Then ;Invalid Directory Name Eror Logic
  731. ;              Endif
  732. ;
  733. ; Error Conditions :   Directory Does Not Exist
  734. ;
  735. ; Other  :       N/A
  736. ;
  737. ; Limitations  :  N/A
  738. ;
  739. ; Copyright (c) 1993 MIKE MAKLER
  740. ;
  741. ;*****************************************************************************
  742. Proc GetDirName_Ut(N1,StartLine, ClearFlag, Msg,Pic,Edtfield)
  743.     ;*************************
  744.     ;*  locals
  745.     ;**************************
  746.      Private Arg1,
  747.              C,
  748.              DirFlag,
  749.              DirName,
  750.              Message1,
  751.              Message2,
  752.              Prompt1,
  753.              SaveDir,
  754.              Title
  755.  
  756.  
  757.     SaveDir = Directory ()
  758.     If N1 = ""
  759.     Then
  760.        N1        = SaveDir
  761.     Endif
  762.     While True
  763.        DirName   = GetStringEDTField_ut  (n1,StartLine,ClearFlag,msg,pic,EDTFIELD)
  764.        N1 = DirName
  765.  
  766.        Arg1      = DirName
  767.        Prompt1   = "Directory Name"
  768.        Title     = "Data Dictionary Directory Name Acceptance Menu"
  769.        C         = Accept1arg_ut (arg1,Prompt1,title)
  770.  
  771.        C         = Upper(C)
  772.  
  773.        If C = "YES"
  774.           Then DirFlag = DirExists(DirName)
  775.                If Dirflag = 1
  776.                   then  QuitLoop
  777.                    Else Message1 = "No Dir Found"
  778.                         Message2 = "Better Luck Next Time"
  779.                         Loc_err_UT (Message1, Message2)
  780.                         DirName = "NONE"
  781.                         Quitloop ; *** Not DirFlag ***
  782.                 Endif ;**** DirFlag *****
  783.           else loop ; *** C <> Yes ***
  784.        EndIf ; *** C = Yes ***
  785.     EndWhile
  786.     Return DirName
  787. EndProc ;**** GetDirName_Ut ****
  788. WriteLib LIBNAME.A GetDirName_Ut
  789. Release Procs GetDirName_Ut
  790.  
  791. ;****************************************************************
  792. ; Name: GetMask_UT
  793. ;
  794. ; Notes: This routine will get a Dos Style File Mask
  795. ;        (I.E.  *.*, C:\Lib\????.Lib   ....)
  796. ;
  797. ; Inputs: DefMak   - Default Mask types
  798. ;
  799. ; Outputs: Varout  - Output Mask Type
  800. ;
  801. ; Local Variables:  Msg - user Prompt String
  802. ;
  803. ; Global Variables: N/A
  804. ;
  805. ; Routines Called : GetStringzedtField_UT
  806. ;
  807. ; Code Segment:  FileListMask = GetMask_UT ("*.*")
  808. ;
  809. ; Error Conditions : N/A
  810. ;
  811. ; Other  :       N/A
  812. ;
  813. ; Limitations  :  N/A
  814. ;
  815. ; Copyright (c) 1993 MIKE MAKLER
  816. ;
  817. ;*****************************************************************************
  818. Proc GetMask_UT(DefMask)
  819.  
  820.     ;*************************
  821.     ;*  locals
  822.     ;**************************
  823.     Private Msg,
  824.             Varout
  825.  
  826.  
  827.     MSG       = "Enter a File Mask (i.e. C:\*.Lib) - "
  828.     Varout    = GetStringEDTField_UT(DefMask,12,True,msg,"A30","!*!")
  829.  
  830.     Return Varout
  831. EndProc ;*** GetMask_UT
  832. WriteLib LIBNAME.A GetMask_UT
  833. Release Procs GetMask_UT
  834.  
  835. ;****************************************************************
  836. ; Name: GetMonitorType_UT
  837. ;
  838. ; Notes: This Will return the Monitor Type as an Upper Case String
  839. ;
  840. ; Inputs: N/A
  841. ;
  842. ; Outputs: MonitorType - Contains Monitor Type String
  843. ;                        ("MONO", "B&W", "COLOR")
  844. ;
  845. ; Local Variables: N/A
  846. ;
  847. ; Global Variables: N/A
  848. ;
  849. ; Routines Called : N/A
  850. ;
  851. ; Code Segment:  MonitorType = GetMonitorType_UT ()
  852. ;
  853. ; Error Conditions :
  854. ;
  855. ; Other  :       N/A
  856. ;
  857. ; Limitations  :  N/A
  858. ;
  859. ; Copyright (c) 1993 MIKE MAKLER
  860. ;
  861. ;*****************************************************************************
  862. Proc GetMonitorType_UT ()
  863.  
  864.     MonitorType = Monitor()            ; Monitor Type for screen displays
  865.     Monitortype = Upper (Monitortype)
  866.  
  867.     Return MonitorType
  868.  
  869. EndProc ;**** GetMonitorType_UT ****
  870. WriteLib Libname.a GetMonitorType_UT
  871. Release Procs GetMonitorType_UT
  872.  
  873. Proc Getpromptyesno_UT (m1.s, m2.s,m3.s)
  874.  
  875.  
  876.     ButtonValue.s=""
  877.     MonitorType.s = GetMonitorType_UT ()
  878.     Showdialog "Go To Dos Prompt"
  879.                @8, 5
  880.                height 14
  881.                width  60
  882.                @2,8 ?? m1.s
  883.                @3,8 ?? m2.s
  884.                @4,8 ?? m3.s
  885.  
  886.    Pushbutton  @8,9 width 10
  887.                "~O~K"
  888.                 OK
  889.                 Default
  890.                 value "Yes"
  891.                 Tag "YES"
  892.                 To ButtonValue.s
  893.  
  894.    Pushbutton  @8,29 width 10
  895.                "~C~ancel"
  896.                 CANCEL
  897.                 value "No"
  898.                 Tag "No"
  899.                 To ButtonValue.s
  900.    EndDialog
  901.  
  902.    If ButtonValue.s = "Yes"
  903.        Then buttonvalue.s = "YES"
  904.        else buttonvalue.s = "NO"
  905.    EndIf
  906.  
  907.    Return buttonvalue.s
  908.  
  909. EndProc ;**** Getpromptyesno_UT ***
  910. WriteLib LIBNAME.A Getpromptyesno_UT
  911. Release Procs    Getpromptyesno_UT
  912.  
  913.  
  914. ;****************************************************************
  915. ; Name:  GetStringEDTField_UT
  916. ;
  917. ; Note:  Prompt User To input a string
  918. ;
  919. ; Inputs: N1        - Default Value
  920. ;         StartLine - Line to prompt From
  921. ;         ClearFlag - If True Then Clear Screen Before Prompting
  922. ;         Msg       - String To show User (Ie "Please Enter Value For Process Yields - ")
  923. ;         Pic       - Format data is sored in (I.E. "A6", "D")
  924. ;         EdtField  - Format Of User Input ("###.#[#]")
  925. ;
  926. ; OutPuts:VarOut - User Entered Data
  927. ;
  928. ; Local Variables:  MonitorType - Contains Monitor Type String
  929. ;                                 ("MONO", "B&W", "COLOR")
  930. ;
  931. ; Global Variables: Retval - Paradox defined Global Variable
  932. ;
  933. ; Routines Called : GetMonitorType_UT
  934. ;
  935. ; Code Segment:  Inv_Tab = GetStringEDTField_UT(InvDefTab,12,True,
  936. ;                           "Please Enter Inventory Table Name - ",
  937. ;                            "A53","!*!")
  938. ;
  939. ; Error Conditions : None
  940. ;
  941. ; Other  :       N/A
  942. ;
  943. ; Limitations  :  N/A
  944. ;
  945. ; Copyright (c) 1993 MIKE MAKLER
  946. ;
  947. ;*****************************************************************************
  948. Proc GetStringEDTField_UT(n1.v,StartLine.n,ClearFlag.l,msg.s,pic.s,EDTFIELD.s)
  949.  
  950.     ;*************************
  951.     ;*  locals
  952.     ;**************************
  953.     Private Monitortype.s,
  954.             Varout.v
  955.  
  956.     MonitorType.s = GetMonitorType_UT ()
  957.     If startline.n >9
  958.        then startline.n = 9
  959.     Endif
  960.     Varout.v = n1.v
  961.     ButtonValue.s ="No"
  962.     Showdialog "USER SELECTION BOX"
  963.                @Startline.n, 5
  964.                height 12
  965.                width  60
  966.                @2,2 ?? Msg.s
  967.  
  968.        Accept  @3, 2
  969.                width 70 pic.s
  970.                Picture EDTFIELD.s
  971.                ;Required
  972.                tag "Typein"
  973.                to varout.V
  974.  
  975.     Pushbutton  @7,9 width 10
  976.                "~O~K"
  977.                 OK
  978.                 Default
  979.                 value "Yes"
  980.                 Tag "YES"
  981.                 To ButtonValue.s
  982.  
  983.     Pushbutton  @7,29 width 10
  984.                "~C~ancel"
  985.                 CANCEL
  986.                 value "No"
  987.                 Tag "No"
  988.                 To ButtonValue.s
  989.     EndDialog
  990.  
  991.    If ButtonValue.s = "No"
  992.        Then Varout.v = n1.v
  993.             RETVAL = FALSE
  994.        ELSE RETVAL = TRUE
  995.    EndIf
  996.  
  997.  
  998.     Return Varout.v
  999. EndProc ;*** GetStringEDTField_UT ***
  1000. WriteLib LIBNAME.A GetStringEDTField_UT
  1001. Release Procs GetStringEDTField_UT
  1002.  
  1003. ;****************************************************************
  1004. ; Name:  GetStringHideField_UT
  1005. ;
  1006. ; Note:  Prompt User To input a string
  1007. ;
  1008. ; Inputs: N1        - Default Value
  1009. ;         StartLine - Line to prompt From
  1010. ;         ClearFlag - If True Then Clear Screen Before Prompting
  1011. ;         Msg       - String To show User (Ie "Please Enter Value For Process Yields - ")
  1012. ;         Pic       - Format data is sored in (I.E. "A6", "D")
  1013. ;         EdtField  - Format Of User Input ("###.#[#]")
  1014. ;
  1015. ; OutPuts:VarOut - User Entered Data
  1016. ;
  1017. ; Local Variables:  MonitorType - Contains Monitor Type String
  1018. ;                                 ("MONO", "B&W", "COLOR")
  1019. ;
  1020. ; Global Variables: Retval - Paradox defined Global Variable
  1021. ;
  1022. ; Routines Called : GetMonitorType_UT
  1023. ;
  1024. ; Code Segment:  Inv_Tab = GetStringEDTField_UT(InvDefTab,12,True,
  1025. ;                           "Please Enter Inventory Table Name - ",
  1026. ;                            "A53","!*!")
  1027. ;
  1028. ; Error Conditions : None
  1029. ;
  1030. ; Other  :       N/A
  1031. ;
  1032. ; Limitations  :  N/A
  1033. ;
  1034. ; Copyright (c) 1993 MIKE MAKLER
  1035. ;
  1036. ;*****************************************************************************
  1037. Proc GetStringHideField_UT(n1.v,StartLine.n,ClearFlag.l,msg.s,pic.s,EDTFIELD.s)
  1038.  
  1039.     ;*************************
  1040.     ;*  locals
  1041.     ;**************************
  1042.     Private Monitortype.s,
  1043.             Varout.v,
  1044.             ButtonValue.s
  1045.  
  1046.     MonitorType.s = GetMonitorType_UT ()
  1047.     If Startline.n > 9
  1048.        Then Startline.N = 9
  1049.     Endif
  1050.  
  1051.     Varout.v = n1.v
  1052.     ButtonValue.s = "No"
  1053.     Showdialog "USER SELECTION BOX"
  1054.                @Startline.n, 5
  1055.                height 12
  1056.                width  60
  1057.                @2,2 ?? msg.s
  1058.  
  1059.        Accept  @3, 2
  1060.                width 20 pic.s
  1061.                Picture EDTFIELD.s
  1062.                ;Required
  1063.                Hidden
  1064.                tag "Typein"
  1065.                to varout.V
  1066.  
  1067.    Pushbutton  @7,9 width 10
  1068.                "~O~K"
  1069.                 OK
  1070.                 Default
  1071.                 value "Yes"
  1072.                 Tag "YES"
  1073.                 To ButtonValue.s
  1074.  
  1075.    Pushbutton  @7,29 width 10
  1076.                "~C~ancel"
  1077.                 CANCEL
  1078.                 value "No"
  1079.                 Tag "No"
  1080.                 To ButtonValue.s
  1081.    EndDialog
  1082.  
  1083.    If ButtonValue.s = "No"
  1084.        Then Varout.v = n1.v
  1085.             RETVAL = FALSE
  1086.        ELSE RETVAL = TRUE
  1087.    EndIf
  1088.  
  1089.    Return Varout.v
  1090. EndProc ;*** GetStringHideField_UT ***
  1091. WriteLib LIBNAME.A GetStringHideField_UT
  1092. Release Procs GetStringHideField_UT
  1093.  
  1094. ;****************************************************************
  1095. ; Name:  Getusername_UT
  1096. ;
  1097. ; Note:  Prompt User To enter a user name
  1098. ;
  1099. ; Inputs: N1.v        - Default Value
  1100. ;         Line.n      - Line to prompt From
  1101. ;         Clear.l     - If True Then Clear Screen Before Prompting
  1102. ;         Pic.s       - Format data is sored in (I.E. "A6", "D")
  1103. ;         Edt.s        - Format Of User Input ("###.#[#]")
  1104. ;
  1105. ; OutPuts:VarOut - User Entered Data
  1106. ;
  1107. ; Local Variables:  MonitorType - Contains Monitor Type String
  1108. ;                                 ("MONO", "B&W", "COLOR")
  1109. ;
  1110. ; Global Variables: Retval - Paradox defined Global Variable
  1111. ;
  1112. ; Routines Called : GetMonitorType_UT
  1113. ;
  1114. ; Code Segment:  Inv_Tab = Getusername_UT(InvDefTab,12,True,
  1115. ;                           "Please Enter Inventory Table Name - ",
  1116. ;                            "A53","!*!")
  1117. ;
  1118. ; Error Conditions : None
  1119. ;
  1120. ; Other  :       N/A
  1121. ;
  1122. ; Limitations  :  N/A
  1123. ;
  1124. ; Copyright (c) 1993 MIKE MAKLER
  1125. ;
  1126. ;*****************************************************************************
  1127. Proc Getusername_UT(n1.v,Line.n,Clear.l,pic.s,EDT.s)
  1128.      Private un1.s,
  1129.              un2.s,
  1130.              msg.s,
  1131.              m1.s,
  1132.              m2.s,
  1133.              m3.s
  1134.  
  1135.  
  1136. PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
  1137. n1.v = ""
  1138. msg.s = "Enter User Name : "
  1139. UN1.s = GetStringHideField_UT(n1.v,line.n,clear.l,msg.s,pic.s,EDT.s)
  1140.  
  1141. if UN1.S = n1.v
  1142.    Then Un2.s = "ZNUN"
  1143.    Else msg.s = "Confirm User Name : "
  1144.         UN2.s = GetStringHideField_UT(n1.v,line.n,clear.l,msg.s,pic.s,EDT.s)
  1145. endif
  1146.  
  1147. If un1.s = un2.s and un1.s <> ""
  1148.    then UserName_GL = un2.s
  1149.         SetUserName UserName_GL
  1150.    else M1.S = "Confirmation Failed"
  1151.         M2.S = "USER NAME NOT SET"
  1152.         M3.s = ""
  1153.         Loc_err_Pause_UT (M1.s, M2.s, M3.s)
  1154.         username_gl = "No User"
  1155. endif
  1156. @19,0
  1157. clear EOS
  1158. return
  1159.  
  1160. EndProc ;*** Getusername_UT ***
  1161. WriteLib LIBNAME.A Getusername_UT
  1162. Release Procs Getusername_UT
  1163.  
  1164.  
  1165.  
  1166. ;***************************************************************
  1167. ; Name: GoToDOS_UT
  1168. ;
  1169. ; Notes: This will exit to DOS
  1170. ;
  1171. ; Inputs: N/A
  1172. ;
  1173. ; Outputs: N/A
  1174. ;
  1175. ; Local Variables: M1 - User Prompt String
  1176. ;                  M2 - User Prompt String
  1177. ;                  M3 - User Prompt String
  1178. ;
  1179. ; Global Variables: N/A
  1180. ;
  1181. ; Routines Called : PlaceMsgPause_ut
  1182. ;
  1183. ; Code Segment:  Switch
  1184. ;                   :
  1185. ;                   :
  1186. ;                   Case MenSel = "DOS" : GoToDOS_UT()
  1187. ;                   :
  1188. ;                   :
  1189. ;                EndSWitch
  1190. ;
  1191. ; Error Conditions :
  1192. ;
  1193. ; Other  :       N/A
  1194. ;
  1195. ; Limitations  :  N/A
  1196. ;
  1197. ; Copyright (c) 1993 MiKE MAKLER
  1198. ;
  1199. ;*****************************************************************************
  1200. Proc GoToDOS_UT()
  1201.  
  1202.     ;*************************
  1203.     ;*  locals
  1204.     ;**************************
  1205.     Private M1.s,
  1206.             M2.s,
  1207.             M3.s,
  1208.             ButtonValue.s
  1209.  
  1210.      M1.s = "You Are About To Exit To DOS"
  1211.      M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
  1212.      M3.s = "Type [Exit] to return to Aplication"
  1213.  
  1214.     ButtonValue.s=""
  1215.     MonitorType.s = GetMonitorType_UT ()
  1216.     Showdialog "Go To Dos Prompt"
  1217.                @8, 5
  1218.                height 14
  1219.                width  60
  1220.                @2,8 ?? m1.s
  1221.                @3,8 ?? m2.s
  1222.                @4,8 ?? m3.s
  1223.  
  1224.    Pushbutton  @8,9 width 10
  1225.                "~O~K"
  1226.                 OK
  1227.                 Default
  1228.                 value "Yes"
  1229.                 Tag "YES"
  1230.                 To ButtonValue.s
  1231.  
  1232.    Pushbutton  @8,29 width 10
  1233.                "~C~ancel"
  1234.                 CANCEL
  1235.                 value "No"
  1236.                 Tag "No"
  1237.                 To ButtonValue.s
  1238.    EndDialog
  1239.  
  1240.    If ButtonValue.s = "Yes"
  1241.        Then Dos
  1242.    EndIf
  1243.  
  1244.    Return
  1245.  
  1246. EndProc ;**** GoToDOS_UT ****
  1247. WriteLib LIBNAME.A GoToDOS_UT
  1248. Release Procs    GoToDOS_UT
  1249.  
  1250. ;****************************************************************
  1251. ; Name: GoToDOSBig_UT
  1252. ;
  1253. ; Notes: This will exit to DOS with Maximum available Memory
  1254. ;        (i.e. It will swap as much of the Paradox stuff to disk as
  1255. ;         Possible)
  1256. ;
  1257. ; Inputs: N/A
  1258. ;
  1259. ; Outputs: N/A
  1260. ;
  1261. ; Local Variables: M1 - User Prompt String
  1262. ;                  M2 - User Prompt String
  1263. ;                  M3 - User Prompt String
  1264. ;
  1265. ; Global Variables: N/A
  1266. ;
  1267. ; Routines Called : PlaceMsgPause_ut
  1268. ;
  1269. ; Code Segment:  Switch
  1270. ;                   :
  1271. ;                   :
  1272. ;                   Case MenSel = "DOS" : GoToDOSBig_UT()
  1273. ;                   :
  1274. ;                   :
  1275. ;                EndSWitch
  1276. ;
  1277. ; Error Conditions :
  1278. ;
  1279. ; Other  :       N/A
  1280. ;
  1281. ; Limitations  :  N/A
  1282. ;
  1283. ; Copyright (c) 1993 Mike Makler
  1284. ;
  1285. ;*****************************************************************************
  1286. Proc GoToDOSBIG_UT()
  1287.     ;*************************
  1288.     ;*  locals
  1289.     ;**************************
  1290.     Private M1.s,
  1291.             M2.s,
  1292.             M3.s,
  1293.             ButtonValue.s,
  1294.             Monitortype.s
  1295.  
  1296.      M1.s = "You Are About To Exit To DOS"
  1297.      M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
  1298.      M3.s = "Type [Exit] to return to Aplication"
  1299.  
  1300.     ButtonValue.S = "No"
  1301.     MonitorType.s = GetMonitorType_UT ()
  1302.     Showdialog "Go To Dos Prompt"
  1303.                @5, 3
  1304.                height 14
  1305.                width  70
  1306.                @2,2 ?? m1.s
  1307.                @3,2 ?? m2.s
  1308.                @4,2 ?? m3.s
  1309.  
  1310.    Pushbutton  @8,9 width 10
  1311.                "~O~K"
  1312.                 OK
  1313.                 Default
  1314.                 value "Accept"
  1315.                 Tag "YES"
  1316.                 To ButtonValue.s
  1317.  
  1318.    Pushbutton  @8,29 width 10
  1319.                "~C~ancel"
  1320.                 CANCEL
  1321.                 value "No"
  1322.                 Tag "No"
  1323.                 To ButtonValue.s
  1324.    EndDialog
  1325.  
  1326.    If ButtonValue.s = "Accept"
  1327.        Then DosBIG
  1328.    EndIf
  1329.  
  1330.    Return
  1331.  
  1332.  
  1333. EndProc ;**** GoToDOSBIG_UT ****
  1334. WriteLib LIBNAME.A GoToDOSBIG_UT
  1335. Release Procs    GoToDOSBIG_UT
  1336.  
  1337. ;****************************************************************
  1338. ; Name:  InitColors.S
  1339. ; Notes: Sets up values of global Variables
  1340. ;        (most are really Parameters)
  1341. ;****************************************************************
  1342. Proc InitColors.s ()
  1343.     ; Private None
  1344.  
  1345.     ;*********************************************
  1346.     ; Set Up Default Colors
  1347.     ;*********************************************
  1348.     Sc_Gl = 112                                       ; User Messages Color
  1349.     Linechar_gl = chr (205)                           ; Line Drawing Characters
  1350.     LineColor_Gl = 31          ;White on Blue         ;
  1351.     DataEntryColor_GL = 112    ;Black on Grey         ;
  1352.     ErrorColor_Gl = 79         ;White on Red          ; User Error Message Color
  1353.     ReportInfoColor_GL  = 112  ;Black On Grey         ;
  1354.     pcolor_gl = 29                                    ;sYSCOLOR(4)
  1355. ENDPROC ;**** InitColors.s   ****
  1356. WRITELIB LibName.a  InitColors.s
  1357. RELEASE PROCS       InitColors.s
  1358.  
  1359. ;****************************************************************
  1360. ; Name:  InitGlobalVar.v
  1361. ; Notes: Sets up values of global Variables
  1362. ;        (most are really Parameters)
  1363. ;****************************************************************
  1364. Proc InitGlobalVar.v ()
  1365.  
  1366.    PrintMode_GL     = "Reset"             ; SET THE PRINTER MODE
  1367.    PrinTTab_GL      = "Printset"          ; NAME OF PRINTER TABLE
  1368.    PrintPort_GL     = "LPT1"              ; NAME OF PRINTER PORT
  1369.    PortTab_GL       = "PortTab"           ; NAME OF PRINTER PORT TABLE
  1370.    PRINTER_GL       = "HPLJet"            ; NAME OF PRINTER
  1371.    REPORT_GL        = "" ;NAME OF ACTIVE REPORT
  1372.    PlaceMsg_gl      = BLANKNUM()          ; WINDOW HANDLE
  1373.    MenuTree_gl.S    = ""                  ; KEEP TRACK OF MENU SELECTED
  1374.    Journalflag_GL   = TRUE                ; IF TRUE WRITE MENU SELECTED TO FILE
  1375.    JOURNAL_GL       = "JOURNAL.SC"        ; NAME OF FILE TO TRACK MENU SELECTIONS
  1376.    InitPromptMsg.S ()                     ; INITIALIZE PROMPT MESSAGES
  1377.    InitColors.s ()                        ; INITIALIZE COLORS TO USE
  1378.  
  1379. EndProc ;*** InitGlobalVar.v ***
  1380. Writelib libname.a  InitGlobalVar.v
  1381. Release Procs       InitGlobalVar.v
  1382.  
  1383. ;****************************************************************
  1384. ; Name: InitPrinter
  1385. ;
  1386. ; Notes:  This Routine will Initialze the Printer
  1387. ;
  1388. ; Inputs: Mode.s - This is :
  1389. ;                           Pica  - print 10 cpi
  1390. ;                           Elite - Print 12 cpi
  1391. ;                           Compressed - Print 17 cpi
  1392. ;                           Compoff - Turn off 17 Cpi or 12 cpi revert to 10 cpi
  1393. ;                           Reset - Printer power on defaults)
  1394. ;                           User - User String - Set In Global UserprintString_Gl
  1395. ;
  1396. ;
  1397. ; Outputs:   N/a
  1398. ;
  1399. ; Other  :   These setup strings are for Epson MX/FX/RX and IBM graphics
  1400. ;            printers and other printers that mimic these.  If this is not
  1401. ;            the case then change these strings or use the user option and
  1402. ;            set UserprintString_GL to the string you want.
  1403. ;
  1404. ; Copyright (c) 1993 Mike Makler
  1405. ;****************************************************************************
  1406. PROC InitPrinter(Mode.S)
  1407.    PRIVATE        MODE.S,
  1408.                     MSG1,
  1409.                     MSG2,
  1410.                     MSG3,
  1411.               PRINTSET.S,
  1412.                  RESET.S
  1413.  
  1414.    PrinTTab_GL      = "Printset"
  1415.    PortTab_GL       = "PortTab"
  1416.    View PrintTab_GL
  1417.    Moveto [PrinterName]
  1418.    Locate Printer_GL
  1419.    Reset.S    = ""
  1420.    PrintSet.S = ""
  1421.    If Retval
  1422.       then MoveTo Field Mode.S
  1423.            PrintSet.S = []
  1424.            Reset.S    = [Reset]
  1425.  
  1426.            If Printer_GL =  "*Custom-1" or Printer_GL = "*Custom-2"
  1427.               then Msg1 = "For Custom Printer Setup"
  1428.                    Msg2 = " Please Call MIKE MAKLER"
  1429.                    Msg3 =     "(714) 571-8510"
  1430.                    PlaceMsgPause_UT (Msg1, Msg2, Msg3)
  1431.                    Reset.S    = ""
  1432.                    PrintSet.S = ""
  1433.            Endif
  1434.  
  1435.            If Printer_GL = "HPQuiet"
  1436.               then  Menu {Report} {SetPrinter} {Override} {Setup} Select "\\027%@"
  1437.            Endif
  1438.  
  1439.       Else  Msg1 = "No Printer Specified"
  1440.             Msg3 = "Select Printer and Retry"
  1441.             Msg2 =     ""
  1442.             PlaceMsgPause_UT (Msg1, Msg2, Msg3)
  1443.             clearimage
  1444.             return
  1445.    Endif
  1446.  
  1447.    ;*********   Set Printer to Formfeed **********************
  1448.    Menu {Report} {SetPrinter} {Override} {EndOfPage} {FormFeed}
  1449.  
  1450.    ;********   Reset Printer Power on Defaults *************
  1451.    If Reset.s <> ""
  1452.       THEN Menu {Report} {SetPrinter} {Override} {Setup} Select Reset.S
  1453.    Endif
  1454.  
  1455.  
  1456.    ;************ Set Print Size **********************************
  1457.    If PrintSet.S <>""
  1458.        Then Menu {Report} {SetPrinter} {Override} {Setup} Select PrintSet.S
  1459.    Endif
  1460.  
  1461.    clearimage
  1462.    Return
  1463.  
  1464. ENDPROC ;**** InitPrinter ****
  1465. WRITELIB LibName.a InitPrinter
  1466. RELEASE PROCS      InitPrinter
  1467.  
  1468. ;****************************************************************
  1469. ; Name: InitPromptMsg.S
  1470. ;
  1471. ; Notes: This Routine Is used to Set up Default Prompt Messages
  1472. ;
  1473. ; Inputs:  N/a
  1474. ;
  1475. ; Outputs:   N/A
  1476. ;
  1477. ;
  1478. ; Copyright (c) 1993 Mike Makler
  1479. ;****************************************************************************
  1480. Proc InitPromptMsg.S ()
  1481.     Private          FILLT,
  1482.                       LENT
  1483.  
  1484.  
  1485.     PMenu1_GL = "Use Arrow Keys to Highlight choice and <ENTER> to select."
  1486.     PMenu2_GL = "<F1>=MenuHelp, <ESC>=Previous Menu, <ENTER>=Perform Action"
  1487.  
  1488.     PromptTitle_GL = "Data Input Operation"
  1489.     Lent = Len(PromptTitle_Gl)
  1490.     Ia.L = Isassigned (LENRS_GL)
  1491.     If Not Ia.L
  1492.        Then LENRS_GL = 0
  1493.     Endif
  1494.     Fillt = 80 - (Lent+Lenrs_GL)
  1495.     PromptTitle_GL = PromptTitle_Gl
  1496.     PTMsg1_GL = "<BKSP> -Delete Character By Character, <CTRL-BKSP> - Clear Current Setting"
  1497.     PTMsg2_GL = "<ENTER> - To Accept Current Setting, <ESC> - To go Back"
  1498.  
  1499. ENDPROC ;**** InitPromptMsg.S ****
  1500. WRITELIB LibName.a InitPromptMsg.S
  1501. RELEASE PROCS      InitPromptMsg.S
  1502.  
  1503.  
  1504. ;****************************************************************
  1505. ; Name  : Loc_err_UT
  1506. ;
  1507. ; Notes : Displays a 2 line error message
  1508. ;
  1509. ; Inputs: MSG1  - line 1 of error message
  1510. ;         MSG2  - line 2 of error message
  1511. ;
  1512. ; Outputs: N/A
  1513. ;
  1514. ; Local Variables: MonitorType - Contains Monitor Type String
  1515. ;                                 ("MONO", "B&W", "COLOR")
  1516. ;                  ScreenBlink -  Screen Blink Attribute
  1517. ;                  ScreenColor -  Screen color attribute
  1518. ;                  Secs        -  Milliseconds Passed to Beepit_ut
  1519. ;                  Times       -  Number of times to loop passed to Beepit_ut
  1520. ;
  1521. ; Global Variables: N/A
  1522. ;
  1523. ; Routines Called : Beepit_UT
  1524. ;                   GetMonitorType_UT
  1525. ;
  1526. ; Code Segment:  Loc_err_UT ("Error Error Error", "Fix It ")
  1527. ;
  1528. ; Error Conditions : N/A
  1529. ;
  1530. ; Other  :       N/A
  1531. ;
  1532. ; Limitations  :  N/A
  1533. ;
  1534. ; Copyright (c) 1993 Mike Makler
  1535. ;
  1536. ;*****************************************************************************
  1537. Proc Loc_err_UT (Msg1, Msg2)
  1538.     ;*************************
  1539.     ;*  locals
  1540.     ;**************************
  1541.     Private Monitortype,
  1542.             ScreenBlink,
  1543.             ScreenColor,
  1544.             Secs,
  1545.             Times
  1546.  
  1547.     MonitorType = GetMonitorType_UT ()
  1548.     ScreenColor = ErrorColor_GL
  1549.     ScreenBlink = ScreenColor + 128
  1550.     OldCanvas_GL = GetCanvas()
  1551.     Window Create
  1552.            Floating
  1553.            @9,0
  1554.            Height 7
  1555.            Width 80
  1556.            to loc_err_ut.win
  1557.  
  1558.     Window Echo loc_err_ut.win  False
  1559.  
  1560.     @3,10
  1561.     ??   "Error ....."
  1562.     @4,10
  1563.     ??    Msg1
  1564.     @5,10
  1565.     ??    Msg2
  1566.     Window Echo loc_err_ut.win  True
  1567.     Secs = 1000
  1568.     Times = 2
  1569.     Beepit_UT (Secs,Times)
  1570.     Window close
  1571.  
  1572. EndProc ;**** Loc_Err_UT ****
  1573. WriteLib LIBNAME.A Loc_err_UT
  1574. Release Procs Loc_err_UT
  1575.  
  1576.  
  1577. ;****************************************************************
  1578. ; Name  : Loc_err_Pause_UT
  1579. ;
  1580. ; Notes : Displays a 3 line error message and pauses until user
  1581. ;         enters a Key
  1582. ;
  1583. ; Inputs: MSG1  - line 1 of error message
  1584. ;         MSG2  - line 2 of error message
  1585. ;         MSG3  - line 3 of error message
  1586. ;
  1587. ; Outputs: N/A
  1588. ;
  1589. ; Local Variables: Char1       - User enter Character
  1590. ;                  MonitorType - Contains Monitor Type String
  1591. ;                                 ("MONO", "B&W", "COLOR")
  1592. ;                  ScreenBlink -  Screen Blink Attribute
  1593. ;                  ScreenColor -  Screen color attribute
  1594. ;                  Secs        -  Milliseconds Passed to Beepit_ut
  1595. ;                  Times       -  Number of times to loop passed to Beepit_ut
  1596. ;
  1597. ; Global Variables: N/A
  1598. ;
  1599. ; Routines Called : Beepit_UT
  1600. ;                   GetMonitorType_UT
  1601. ;
  1602. ; Code Segment:  Loc_err_Pause_UT ("Error Error Error", "Fix It Please",
  1603. ;                                  "Pretty please")
  1604. ;
  1605. ; Error Conditions : N/A
  1606. ;
  1607. ; Other  :       N/A
  1608. ;
  1609. ; Limitations  :  N/A
  1610. ;
  1611. ; Copyright (c) 1993 Mike Makler
  1612. ;
  1613. ;*****************************************************************************
  1614. Proc Loc_err_Pause_UT (M1.s, M2.s, M3.s)
  1615.     ;*************************
  1616.     ;*  locals
  1617.     ;**************************
  1618.     Private Char1,
  1619.             Monitortype,
  1620.             ScreenBlink,
  1621.             ScreenColor,
  1622.             Secs,
  1623.             Times
  1624.  
  1625.     MonitorType = GetMonitorType_UT ()
  1626.     ScreenColor = ERRORCOLOR_GL
  1627.     ScreenBlink = ScreenColor + 128
  1628.  
  1629.     MonitorType.s = GetMonitorType_UT ()
  1630.     Showdialog "User Error"
  1631.                @5, 0
  1632.                height 10
  1633.                width  75
  1634.                @2,8 ??   "Warning ....."
  1635.                @4,8 ?? m1.s
  1636.                @5,8 ?? m2.s
  1637.                @6,8 ?? m3.s
  1638.  
  1639.    Pushbutton  @8,9 width 10
  1640.                "~O~K"
  1641.                 OK
  1642.                 Default
  1643.                 value "Yes"
  1644.                 Tag "YES"
  1645.                 To ButtonValue.s
  1646.    EndDialog
  1647.    Return
  1648. EndProc ;**** Loc_Err_Pause_UT ****
  1649. WriteLib LIBNAME.A Loc_err_Pause_UT
  1650. Release Procs Loc_err_Pause_UT
  1651.  
  1652.  
  1653. ;****************************************************************
  1654. ; Name: NotCode_UT
  1655. ;
  1656. ; Notes:  This Module will Produce a Message  -
  1657. ;         "This Option Has Not Been Coded Yet"
  1658. ;
  1659. ; Inputs: N/A
  1660. ;
  1661. ; Outputs: N/A
  1662. ;
  1663. ; Local Variables: N/A
  1664. ;
  1665. ; Global Variables: N/A
  1666. ;
  1667. ; Routines Called : N/A
  1668. ;
  1669. ; Code Segment: N/A
  1670. ;
  1671. ; Error Conditions : N/A
  1672. ;
  1673. ; Other  :       N/A
  1674. ;
  1675. ; Limitations  :  N/A
  1676. ;
  1677. ; Copyright (c) 1993 Mike Makler
  1678. ;
  1679. ;*****************************************************************************
  1680. Proc NotCode_UT ()
  1681.     Clear
  1682.     Beep sleep 100 Beep
  1683.     Message "This Option Has Not Been Coded Yet"
  1684.     Sleep 1000
  1685.     Beep sleep 200 Beep
  1686.     Sleep 1000
  1687.     Clear
  1688. EndProc ;***** NotCode_UT *****
  1689. WriteLib LIBNAME.A NotCode_UT
  1690. Release Procs NotCode_UT
  1691.  
  1692.  
  1693. ;****************************************************************
  1694. ; Name:  PlaceMsg_Bottom_ut
  1695. ; Notes: Places a user Message on the Screen without clearing screen
  1696. ; Inputs: MSG1        - line 1 of message
  1697. ;         MSG2        - line 2 of message
  1698. ;         Screencolor - foreground and background color of boxed 
  1699. ;                       error message
  1700. ;                       for a red backround on a white forground pass 89
  1701. ;                       64+15  (64 = red backround, 15 = white forground)
  1702. ;                       See appendix A of Paradox User Guide 
  1703. ;                       for Complete list of colors
  1704. ;         Startline   - Line to start message on
  1705. ;****************************************************************
  1706. Proc PlaceMsg_Bottom_ut (Btitle,Message1, Message2, ScreenColor, StartLine)
  1707.     ;*************************
  1708.     ;*  locals
  1709.     ;**************************
  1710.     Private Endline
  1711.  
  1712.     isval.L = Isassigned (Placeline.Win)
  1713.  
  1714.     If Isval.L
  1715.        then iswin.l = IsWindow (placeline.win)
  1716.        else iswin.l = False
  1717.     EndIf
  1718.  
  1719.     if iswin.l
  1720.        then window select placeline.win
  1721.             window close
  1722.     endif
  1723.  
  1724.     Endline = StartLine + 2
  1725.  
  1726.     setcanvas default
  1727.     canvas off
  1728.     @ STARTLINE,0
  1729.     Clear Eos
  1730.     MonitorType = GetMonitorType_UT ()
  1731.     If Monitortype = "COLOR"
  1732.        Then   PaintCanvas  Attribute ScreenColor
  1733.                            StartLine,0 ,EndLine,79
  1734.               Style Attribute ScreenColor
  1735.        Else   PaintCanvas Border fill chr(254)
  1736.                           Intense
  1737.                           StartLine,0 ,EndLine,79
  1738.               Style Intense
  1739.     Endif ;**** Monitortype = "COLOR" ****
  1740.     LineChar.c = LineChar_gl;
  1741.     Drawline.s = fill(linechar.c,80)
  1742.     Style attribute LineColor_gl
  1743.     @StartLine-1,00
  1744.     ?? DrawLine.s
  1745.     style attribute screencolor
  1746.     @Startline,00
  1747.     ??    Btitle
  1748.     @StartLine+1,00
  1749.     ??    Message1
  1750.     @Endline, 00
  1751.     ??    Message2
  1752.     canvas on
  1753. EndProc ;*** PlaceMsg_Bottom_ut ***
  1754. WriteLib Libname.a PlaceMsg_Bottom_ut
  1755. Release Procs PlaceMsg_Bottom_ut
  1756.  
  1757.  
  1758. ;****************************************************************
  1759. ; Name:  PlaceMsg_UT
  1760. ;
  1761. ; Notes: Places a user Message on the Screen
  1762. ;
  1763. ; Inputs: Message1    - line 1 of message
  1764. ;         Message2    - line 2 of message
  1765. ;         Screencolor - foreground and background color of boxed
  1766. ;                       error message
  1767. ;                       for a red backround on a white forground pass 89
  1768. ;                       64+15  (64 = red backround, 15 = white forground)
  1769. ;
  1770. ;                       See appendix A of Paradox User Guide
  1771. ;                       for Complete list of colors
  1772. ;
  1773. ; Outputs:  N/A
  1774. ;
  1775. ; Local Variables: MonitorType - Contains Monitor Type String
  1776. ;                                 ("MONO", "B&W", "COLOR")
  1777. ;
  1778. ; Global Variables: N/A
  1779. ;
  1780. ; Routines Called : GetMonitorType_UT
  1781. ;
  1782. ; Code Segment:  PlaceMsg_UT("Loadiding Table", "Please Wait", 48)
  1783. ;
  1784. ; Error Conditions :
  1785. ;
  1786. ; Other  :       N/A
  1787. ;
  1788. ; Limitations  :  N/A
  1789. ;
  1790. ; Copyright (c) 1993 Mike Makler
  1791. ;
  1792. ;*****************************************************************************
  1793. Proc PlaceMsg_UT(Message1.s, Message2.s, ScreenColor.s)
  1794.     Private Monitortype.s,
  1795.              placemsg.da,
  1796.              placemsg.win
  1797.  
  1798.     dynarray placemsg.da[]
  1799.              isval.L = Isassigned (placemsg.win)
  1800.              If Isval.L
  1801.                 then iswin.l = IsWindow (placemsg.win)
  1802.                 else iswin.l = False
  1803.              EndIf
  1804.              echo normal
  1805.              if not iswin.l
  1806.                 then placemsg.da ["CanClose"]    = false
  1807.                      placemsg.da ["canmaximize"] = false
  1808.                      placemsg.da ["canmove"]     = true
  1809.                      placemsg.da ["canresize"]   = false
  1810.                      placemsg.da ["canvas"]      = true
  1811.                      placemsg.da ["echo"]        = false
  1812.                      placemsg.da ["Floating"]    = false
  1813.                      placemsg.da ["hasframe"]    = true
  1814.                      placemsg.da ["Maximized"]   = False
  1815.                      placemsg.da ["TITLE"]      = "User Prompt Message"
  1816.                      placemsg.da ["hasshadow"]   = true
  1817.                      placemsg.da ["height"]      = 11
  1818.                      placemsg.da ["margin"]      = "off"
  1819.                      placemsg.da ["origincol"]   = 0
  1820.                      placemsg.da ["originrow"]   = 7
  1821.                      placemsg.da ["Width"]       = 80
  1822.                      placemsg.da ["style"]       = ScreenColor.S
  1823.                      window create
  1824.                      attributes placemsg.da
  1825.                      to placemsg.win
  1826.                      placemsg_gl = placemsg.win
  1827.              endif
  1828.     window select placemsg_gl
  1829.     setcanvas placemsg_gl
  1830.     window move placemsg_gl to 7,0
  1831.     MonitorType.s = GetMonitorType_UT ()
  1832.     If Monitortype.s = "COLOR"
  1833.        Then   Style Attribute ScreenColor.s
  1834.        Else   Style Intense
  1835.     Endif ;**** Monitortype = "COLOR" ****
  1836.  
  1837.     Window Echo placemsg_gl false
  1838.     @3,10
  1839.     ??    Message1.s
  1840.     @5,10
  1841.     ??    Message2.s
  1842.     Window Echo placemsg_gl  true
  1843.     echo off
  1844. EndProc ;*** PlaceMsg_UT ***
  1845. WriteLib Libname.a PlaceMsg_UT
  1846. Release Procs PlaceMsg_UT
  1847.  
  1848.  
  1849. ;****************************************************************
  1850. ; Name:  PlaceMsg_noClear_ut
  1851. ; Notes: Places a user Message on the Screen without clearing screen
  1852. ; Inputs: MSG1        - line 1 of message
  1853. ;         MSG2        - line 2 of message
  1854. ;         Screencolor - foreground and background color of boxed 
  1855. ;                       error message
  1856. ;                       for a red backround on a white forground pass 89
  1857. ;                       64+15  (64 = red backround, 15 = white forground)
  1858. ;                       See appendix A of Paradox User Guide 
  1859. ;                       for Complete list of colors
  1860. ;         Startline   - Line to start message on
  1861. ;****************************************************************
  1862. Proc PlaceMsg_NoClear_ut (Message1.s, Message2.s, ScreenColor.s, StartLine.n)
  1863.     ;*************************
  1864.     ;*  locals
  1865.     ;**************************
  1866.     Private NextLine.n
  1867.  
  1868.     setcanvas default
  1869.     Nextline.n = StartLine.n + 2
  1870.     canvas off
  1871.     @ sTARTLINE.n-1,0
  1872.     Clear Eos
  1873.     MonitorType.s = GetMonitorType_UT ()
  1874.     If Monitortype.s = "COLOR"
  1875.        Then   PaintCanvas  Attribute ScreenColor.s
  1876.                            StartLine.n-1,0 ,NextLine.n+1,79
  1877.               Style Attribute ScreenColor.S
  1878.        Else   PaintCanvas Border fill chr(254)
  1879.                           Intense
  1880.                           StartLine.n-1,0 ,NextLine.n+1,79
  1881.               Style Intense
  1882.     Endif ;**** Monitortype = "COLOR" ****
  1883.  
  1884.  
  1885.     @Startline.n,10
  1886.     ??    Message1.s
  1887.     @NextLine.n,10
  1888.     ??    Message2.s
  1889.  
  1890.     canvas on
  1891. EndProc ;*** PlaceMsg_noclear_ut ***
  1892. WriteLib Libname.a PlaceMsg_NoClear_ut
  1893. Release Procs PlaceMsg_NoClear_ut
  1894.  
  1895. ;****************************************************************
  1896. ; Name:  PlaceMsgPause_UT
  1897. ;
  1898. ; Notes: Places a user Message on the Screen  and Pauses until user
  1899. ;        Strikes a key
  1900. ;
  1901. ; Inputs: Msg1    - line 1 of message
  1902. ;         Msg2    - line 2 of message
  1903. ;         Msg3    - Line 3 of message
  1904. ;         Screencolor - foreground and background color of boxed
  1905. ;                       error message
  1906. ;                       for a red backround on a white forground pass 89
  1907. ;                       64+15  (64 = red backround, 15 = white forground)
  1908. ;
  1909. ;                       See appendix A of Paradox User Guide
  1910. ;                       for Complete list of colors
  1911. ;
  1912. ; Outputs:  N/A
  1913. ;
  1914. ; Local Variables: MonitorType - Contains Monitor Type String
  1915. ;                                 ("MONO", "B&W", "COLOR")
  1916. ;
  1917. ; Global Variables: N/A
  1918. ;
  1919. ; Routines Called : GetMonitorType_UT
  1920. ;
  1921. ; Code Segment:  PlaceMsgPause_UT("Editing Table", "message more",
  1922. ;                              "message Even More", 48)
  1923. ;
  1924. ; Error Conditions :
  1925. ;
  1926. ; Other  :       N/A
  1927. ;
  1928. ; Limitations  :  N/A
  1929. ;
  1930. ; Copyright (c) 1993 Mike Makler
  1931. ;
  1932. ;*****************************************************************************
  1933. Proc PlaceMsgPause_UT (M1.s, M2.s, M3.s)
  1934.     ;*************************
  1935.     ;*  locals
  1936.     ;**************************
  1937.     Private Char1.c,
  1938.             Monitortype.s,
  1939.             ScreenBlink.n,
  1940.             ScreenColor.s
  1941.             ;Secs.n,
  1942.             ;Times.n
  1943.  
  1944.     MonitorType.s = GetMonitorType_UT ()
  1945.     ScreenColor.s = ERRORCOLOR_GL
  1946.     ScreenBlink.n = ScreenColor.s + 128
  1947.  
  1948.     MonitorType.s = GetMonitorType_UT ()
  1949.     Showdialog "User Message"
  1950.                @5, 0
  1951.                height 12
  1952.                width  75
  1953.                @2,8 ??   "Take Note ....."
  1954.                @4,8 ?? m1.s
  1955.                @5,8 ?? m2.s
  1956.                @6,8 ?? m3.s
  1957.  
  1958.    Pushbutton  @8,9 width 10
  1959.                "~O~K"
  1960.                 OK
  1961.                 Default
  1962.                 value "Say Yes"
  1963.                 Tag "YES"
  1964.                 To ButtonValue.s
  1965.    EndDialog
  1966.  
  1967.  
  1968. EndProc ;**** PlaceMsgPause_UT ****
  1969. WriteLib Libname.a PlaceMsgPause_UT
  1970. Release Procs      PlaceMsgPause_UT
  1971.  
  1972. ;****************************************************************
  1973. ; Name:  PrinterConfig_UT
  1974. ;
  1975. ; Notes:  This routine displays information about the currently
  1976. ;         active printer configuratio
  1977. ;
  1978. ; Inputs: n/a
  1979. ;
  1980. ; Outputs: N/A
  1981. ;
  1982. ; Global Variables:  Report_GL     - Discription of currently active report
  1983. ;                    Printer_GL    - Name of currently active printer
  1984. ;                    PrintPort_GL  - Name of currently active printer port
  1985. ;
  1986. ; Routines Called :  none
  1987. ;
  1988. ; Code Segment: PrinterConfigUT()
  1989. ;
  1990. ; Error Conditions :  None
  1991. ;
  1992. ; Other  :       N/A
  1993. ;
  1994. ; Limitations  :  N/A
  1995. ;
  1996. ; Copyright (c) 1993 Mike Makler
  1997. ;
  1998. ;*****************************************************************************
  1999. Proc PrinterConfig_UT ()
  2000.      Private M0.s,   ; message text
  2001.              M1.S,   ; message text
  2002.              M2.S,   ; message text
  2003.              M3.S,   ; message text
  2004.              M4.S,   ; message text
  2005.              M5.s,   ; message text
  2006.              buutonvalue.s    ;user dialogue box keypress
  2007.  
  2008.  
  2009.       m0.s =  "Report                               - " + Report_GL
  2010.       M1.S =  "The Currently Active Printer is      - " + Printer_GL
  2011.       M2.s =  "The Currently Active Printer Port is - " + PrintPort_GL
  2012.       M3.S = "TO CHANGE THESE VALUES CHOOSE:"
  2013.       M4.S = "Select Printer or Select Printer Port"
  2014.       m5.s = "From the Printer Selection Menu"
  2015.  
  2016.       Showdialog "Display Printer Configuration"
  2017.                    @3, 3
  2018.                    height 16
  2019.                    width  70
  2020.                    @2,2 ?? m0.s
  2021.                    @3,2 ?? m1.s
  2022.                    @4,2 ?? m2.s
  2023.                    @6,2 ?? m3.s
  2024.                    @7,2 ?? m4.s
  2025.                    @8,2 ?? m5.s
  2026.  
  2027.          Pushbutton  @11,9 width 10
  2028.                      "OK"
  2029.                       OK
  2030.                       Default
  2031.                       value "Accept"
  2032.                       Tag "YES"
  2033.                       To ButtonValue.s
  2034.       EndDialog
  2035.  
  2036.      Return
  2037. EndProc ;*** PrinterConfig_UT ***
  2038. WriteLib LibNAME.A PrinterConfig_UT
  2039. Release Procs      PrinterConfig_UT
  2040.  
  2041.  
  2042. ;****************************************************************
  2043. ; Name:  PrinterDefine_UT
  2044. ;
  2045. ; Notes: this routine is used to define a new printer,
  2046. ;        edit an existing printer,
  2047. ;        view all printers,
  2048. ;        delete a printer
  2049. ;
  2050. ; Inputs: n/a
  2051. ;
  2052. ; Outputs: N/A
  2053. ;
  2054. ; Global Variables:  placemsg_gl   ; window message handle
  2055. ;
  2056. ; Routines Called :  Printer_defnewprt_ut ()
  2057. ;                    Printer_ViewPrt_ut ()
  2058. ;                    Printer_EditPrt_ut ()
  2059. ;                    Printer_DELPrt_ut ()
  2060. ;                    PRINTERCONFIG_UT ()
  2061. ;                    clearwindow.v ()
  2062. ;                    showtree.s (MTree.S)
  2063. ;
  2064. ; Code Segment: PrinterDefine_UT()
  2065. ;
  2066. ; Error Conditions :  None
  2067. ;
  2068. ; Other  :       N/A
  2069. ;
  2070. ; Limitations  :  N/A
  2071. ;
  2072. ; Copyright (c) 1993 Mike Makler
  2073. ;
  2074. ;*****************************************************************************
  2075. Proc PrinterDefine_UT()
  2076.      Private mtree.s,    ; menu tree calling sequance
  2077.              PDest.S     ; menu selected variable
  2078.  
  2079.      While True
  2080.        ShowPopUP "Printer UTILITIES" Centered
  2081.                  "~N~ew"     : "Define New Printer"          : "New",
  2082.                  "~V~iew"    : "View printer configurations" : "View",
  2083.                  "~E~dit"    : "Edit Printer Configurations" : "Edit",
  2084.                  "~D~elete"  : "Delete a Printer"            : "Delete",
  2085.                   SEPARATOR,
  2086.                   "D~I~splay" : "Display active printer"      : "Display",
  2087.                   SEPARATOR,
  2088.                  "~L~eave"   : "Exit Printer Utilities Menu" : "Leave"
  2089.                      Submenu
  2090.                          "~N~o"  : "Stay in Printer Destination Menu" : "NO",
  2091.                          "~Y~es" : "Leave Printer Destination Menu"   : "YES"
  2092.                      EndSubMenu
  2093.        EndMenu
  2094.        to Pdest.s
  2095.  
  2096.        MTree.S =  MenuTree_gl.S + "/" + Pdest.S
  2097.        Pdest.s = Upper (pdest.s)
  2098.  
  2099.        Switch
  2100.             Case Pdest.s = "NEW"     :  showtree.s (MTree.S)
  2101.                                         Printer_defnewprt_ut ()
  2102.                                         SHOWPULLDOWN ENDMENU
  2103.                                         ALTSPACE {DESKTOP} {EMPTY}
  2104.  
  2105.             Case Pdest.s = "VIEW"    : showtree.s (MTree.S)
  2106.                                        Printer_ViewPrt_ut ()
  2107.                                        ALTSPACE {DESKTOP} {EMPTY}
  2108.  
  2109.             Case Pdest.s = "EDIT"    : showtree.s (MTree.S)
  2110.                                        Printer_EditPrt_ut ()
  2111.                                        SHOWPULLDOWN ENDMENU
  2112.                                        ALTSPACE {DESKTOP} {EMPTY}
  2113.  
  2114.             CASE PDEST.S = "DELETE"  : showtree.s (MTree.S)
  2115.                                        Printer_DELPrt_ut ()
  2116.                                        ALTSPACE {DESKTOP} {EMPTY}
  2117.  
  2118.             case Pdest.s = "DISPLAY" : showtree.s (MTree.S)
  2119.                                        PRINTERCONFIG_UT ()
  2120.  
  2121.             Case Pdest.s = "YES"     : showtree.s (MTree.S)
  2122.                                        clearwindow.v (PlaceMsg_Gl)
  2123.                                        QuitLoop
  2124.  
  2125.             Case Pdest.s = "NO"      : showtree.s (MTree.S)
  2126.                                        clearwindow.v (PlaceMsg_Gl)
  2127.                                        loop
  2128.  
  2129.             OtherWIse                : clearwindow.v (PlaceMsg_Gl)
  2130.                                        QUITLOOP
  2131.        EndSwitch
  2132.        clearwindow.v (PlaceMsg_gl)
  2133.     EndWhile
  2134.  
  2135.     Return
  2136. EndProc ;*** PrinterDEFINE_UT ***
  2137. WriteLib LibNAME.A PrinterDEFINE_UT
  2138. Release Procs      PrinterDEFINE_UT
  2139.  
  2140. ;****************************************************************
  2141. ; Name:  Printer_defnewprt_ut
  2142. ;
  2143. ; Notes: define a new printer
  2144. ;
  2145. ; Inputs:  n/a
  2146. ;
  2147. ; Outputs: N/A
  2148. ;
  2149. ; Global Variables: PrinTTab_GL ;name of printer definition table
  2150. ;
  2151. ; Routines Called : GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
  2152. ;                   EditRec_UT (PrinTTab_GL, "1","printername",pname.s)
  2153. ;
  2154. ; Code Segment: Printer_defnewprt_ut ()
  2155. ;
  2156. ; Error Conditions :  None
  2157. ;
  2158. ; Other  :       N/A
  2159. ;
  2160. ; Limitations  :  N/A
  2161. ;
  2162. ; Copyright (c) 1993 Mike Makler
  2163. ;
  2164. ;*****************************************************************************
  2165. Proc Printer_defnewprt_ut()
  2166.      private Msg.s,   ; disaplay message
  2167.              pname.s, ; name of printer
  2168.              pnum.n   ; number of printer
  2169.  
  2170.      MSG.S   = "ENTER THE NAME OF THE PRINTER TO DEFINE : "
  2171.      PNAME.s = GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
  2172.      VIEW PrinTTab_GL
  2173.      MOVETO [PRINTERNAME]
  2174.      LOCATE PNAME.s
  2175.      IF NOT RETVAL
  2176.         THEN PNUM.N = CMAX (PRINTTAB_GL,"PRINTNUM") + 1
  2177.              EDITKEY
  2178.              INS
  2179.              [PRINTNUM] = PNUM.N
  2180.              [PRINTERNAME] = PNAME.s
  2181.              DO_IT!
  2182.         ELSE ;ERROR MESSAGE OR JUST LET EM EDIT IT ANYHOW
  2183.      ENDIF
  2184.      EditRec_UT (PrinTTab_GL, "1","printername",pname.s)
  2185.      Return
  2186. EndProc ;*** Printer_defnewprt_ut ***
  2187. WriteLib LibNAME.A Printer_defnewprt_ut
  2188. Release Procs      Printer_defnewprt_ut
  2189.  
  2190. ;****************************************************************
  2191. ; Name:  Printer_delprt_ut
  2192. ;
  2193. ; Notes: delete a printer from the printer table
  2194. ;
  2195. ; Inputs: n/a
  2196. ;
  2197. ; Outputs: N/A
  2198. ;
  2199. ; Global Variables:
  2200. ;
  2201. ; Routines Called : Loc_err_Pause_ut (M1.s,M2.s,m3.s)
  2202. ;                   GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
  2203. ;                   Getpromptyesno_UT (m1.s, m2.s,m3.s)
  2204. ;
  2205. ; Code Segment: Printer_delprt_ut ()
  2206. ;
  2207. ; Error Conditions :  None
  2208. ;
  2209. ; Other  :       N/A
  2210. ;
  2211. ; Limitations  :  N/A
  2212. ;
  2213. ; Copyright (c) 1993 Mike Makler
  2214. ;
  2215. ;*****************************************************************************
  2216. Proc Printer_delprt_ut()
  2217.      private pname.s,          ; printer name
  2218.              msg.s,            ; display message
  2219.              m1.s,             ; display message
  2220.              m2.s,             ; display messagr
  2221.              m3.s,             ; display message
  2222.              yes.no.confirm,   ; yes/no user prompt
  2223.              yes.no            ;  ditto
  2224.  
  2225.      MSG.S   = "ENTER THE NAME OF THE PRINTER TO DEFINE : "
  2226.      PNAME.s = GetStringEDTField_UT("",6,TRUE,msg.s,"A20","!*@")
  2227.      VIEW PrinTTab_GL
  2228.      MOVETO [PRINTERNAME]
  2229.      LOCATE PNAME.s
  2230.      IF RETVAL
  2231.         THEN m1.s = "Printer - " + Pname.s + " will be deleted"
  2232.              m2.s = "Yes/no Delete Printer - " + Pname.S
  2233.              m3.s = "...."
  2234.              YES.NO = Getpromptyesno_UT (m1.s, m2.s,m3.s)
  2235.              If yes.no = "YES"
  2236.                 then m3.s = "CONFIRM DELETION OF PRINTER - " + PNAME.S
  2237.                      yes.no.confirm = Getpromptyesno_UT (m1.s, m2.s,m3.s)
  2238.                 else yes.no.confirm = "NO"
  2239.              endif
  2240.         ELSE m1.s = "Printer - " + Pname.s + " not defined"
  2241.              m2.s = "Printer not deleted"
  2242.              m3.s = "...."
  2243.              Loc_err_Pause_ut (M1.s,M2.s,m3.s)
  2244.      ENDIF
  2245.      editkey
  2246.      moveto [printername]
  2247.      locate pname.s
  2248.      del
  2249.      do_it!
  2250.      Return
  2251. EndProc ;*** Printer_delprt_ut ***
  2252. WriteLib LibNAME.A Printer_delprt_ut
  2253. Release Procs      Printer_delprt_ut
  2254.  
  2255. ;****************************************************************
  2256. ; Name:  Printer_EditPrt_ut
  2257. ;
  2258. ; Notes: edit printer definition table
  2259. ;
  2260. ; Inputs:
  2261. ;
  2262. ; Outputs: N/A
  2263. ;
  2264. ; Global Variables:  menutree.win ; window message handle
  2265. ;                    printtab_gl  ; name of printer definition table
  2266. ;
  2267. ; Routines Called :  clearwindow.v (menutree.win)
  2268. ;                    editTable_UT (Printtab_gl, 1)
  2269. ;                    Windowmove.v (menutree.win,21,2)
  2270. ;
  2271. ; Code Segment: Printer_editPrt_ut ()
  2272. ;
  2273. ; Error Conditions :  None
  2274. ;
  2275. ; Other  :       N/A
  2276. ;
  2277. ; Limitations  :  N/A
  2278. ;
  2279. ; Copyright (c) 1993 Mike Makler
  2280. ;
  2281. ;*****************************************************************************
  2282. Proc Printer_EditPrt_ut()
  2283.  
  2284.      clearwindow.v (menutree.win)
  2285.      editTable_UT (Printtab_gl, 1)
  2286.      Windowmove.v (menutree.win,21,2)
  2287.      Return
  2288. EndProc ;*** Printer_EditPrt_ut
  2289. WriteLib LibNAME.A Printer_EditPrt_ut
  2290. Release Procs      Printer_EditPrt_ut
  2291.  
  2292.  
  2293. ;***********************************
  2294. ; Name:  Printer_ViewPrt_ut
  2295. ;
  2296. ; Notes: View Printer Definition Table
  2297. ;
  2298. ; Inputs: na/
  2299. ;
  2300. ; Outputs: N/A
  2301. ;
  2302. ; Global Variables: menutree.win   ; window message handle
  2303. ;                   printtab_gl    ; name of printer definition table
  2304. ;
  2305. ; Routines Called : clearwindow.v (menutree.win)
  2306. ;                   ViewTable_UT (Printtab_gl, "1", "Printer Definition Table")
  2307. ;                   Windowmove.v (menutree.win,21,2)
  2308. ;
  2309. ;
  2310. ; Code Segment: Printer_ViewPrt_ut ()
  2311. ;
  2312. ; Error Conditions :  None
  2313. ;
  2314. ; Other  :       N/A
  2315. ;
  2316. ; Limitations  :  N/A
  2317. ;
  2318. ; Copyright (c) 1993 Mike Makler
  2319. ;
  2320. ;*****************************************************************************
  2321. Proc Printer_ViewPrt_ut()
  2322.  
  2323.      clearwindow.v (menutree.win)
  2324.      ViewTable_UT (Printtab_gl, "1", "Printer Definition Table")
  2325.      Windowmove.v (menutree.win,21,2)
  2326.  
  2327.      Return
  2328. EndProc ;*** Printer_ViewPrt_ut
  2329. WriteLib LibNAME.A Printer_ViewPrt_ut
  2330. Release Procs      Printer_ViewPrt_ut
  2331.  
  2332. ;****************************************************************
  2333. ; Name:  Printit_UT
  2334. ;
  2335. ; Notes: If printer is ready Prints report for table (totable,
  2336. ;        using report form .  If printer is not ready
  2337. ;        sounds alarm to user and gives time to get printer
  2338. ;        ready.
  2339. ;
  2340. ; Inputs: FromTable - Name of table to copy report specification from
  2341. ;         FromRpt   - Number of Report specification to copy from
  2342. ;
  2343. ; Outputs: N/A
  2344. ;
  2345. ; Global Variables: screen_gl  ; true if report displayed to screen
  2346. ;
  2347. ; Routines Called : PrinttoPrinter_UT (Fromtable.s,fromrpt.s)
  2348. ;                   PrintToFile_UT   (FromTable.S, FromRpt.S)
  2349. ;                   Printtoscreen_ut (fromtable.s, fromrpt.s)
  2350. ;                   SelPrintPopMen(8,8)
  2351. ;                   SelPortPopMen(8,8)
  2352. ;                   PrinterDefine_UT ()
  2353. ;                   PRINTERCONFIG_UT ()
  2354. ;                   clearwindow.v (PlaceMsg_gl)
  2355. ;                   PlaceMsg_UT("Preparing Report ", "Processing...", Sc_gl)
  2356. ;                   showtree.s (MTree.S)
  2357. ;
  2358. ; Code Segment: Printit_UT(FromTable,  FromRpt)
  2359. ;
  2360. ; Error Conditions :  None
  2361. ;
  2362. ; Other  :       N/A
  2363. ;
  2364. ; Limitations  :  N/A
  2365. ;
  2366. ; Copyright (c) 1993 Mike Makler
  2367. ;
  2368. ;*****************************************************************************
  2369. Proc Printit_UT(FromTable.s,  FromRpt.s)
  2370. private pdest.s,
  2371.         MTree.S
  2372.  
  2373.     Screen_GL = False
  2374.     While True
  2375.        clearwindow.v (PlaceMsg_gl)
  2376.        ALTSPACE {DESKTOP} {EMPTY}
  2377.        CLEAR
  2378.        ShowPopUP "Printer Destination Selection Menu" Centered
  2379.                  "~P~rinter" : "Send Report to Printer"        : "Printer",
  2380.                  "~S~creen"  : "Display Report on Screen"      : "Screen",
  2381.                  "~F~ile"    : "Send Report to File"           : "File",
  2382.                   SEPARATOR,
  2383.                  "S~E~LECT Printer" : "Select Printer"         : "Select Printer",
  2384.                  "SELE~C~T Printer Port" : "Select Printer Port" : "Select Printer Port",
  2385.                  "Define Printer"        : "Define New Printer" : "Define Printer",
  2386.                  "D~I~splay Configuration" : "Display Report Configuration": "Display Configuration",
  2387.                   SEPARATOR,
  2388.                  "~L~eave"   : "Exit Printer Destination Menu" : "Leave"
  2389.                      Submenu
  2390.                          "~Y~es" : "Leave Printer Destination Menu"   : "YES",
  2391.                          "~N~o"  : "Stay in Printer Destination Menu" : "NO"
  2392.                      EndSubMenu
  2393.        EndMenu
  2394.        to Pdest.s
  2395.  
  2396.        MTree.S =  MenuTree_gl.S + "/" + Pdest.S
  2397.        Pdest.s = Upper (pdest.s)
  2398.        PlaceMsg_UT("Preparing Report ", "Processing...", Sc_gl)
  2399.  
  2400.        Switch
  2401.             Case Pdest.s = "SCREEN" :  showtree.s (MTree.S)
  2402.                                        Printtoscreen_ut (fromtable.s, fromrpt.s)
  2403.                                        Screen_GL = True
  2404.  
  2405.             Case Pdest.s = "PRINTER" : showtree.s (MTree.S)
  2406.                                        PrinttoPrinter_UT (Fromtable.s,fromrpt.s)
  2407.  
  2408.             Case Pdest.s = "FILE"    : showtree.s (MTree.S)
  2409.                                        PrintToFile_UT   (FromTable.S, FromRpt.S)
  2410.  
  2411.             CASE PDEST.S = "SELECT PRINTER"      : showtree.s (MTree.S)
  2412.                                                    SelPrintPopMen(8,8)
  2413.  
  2414.             CASE PDEST.S = "SELECT PRINTER PORT" : showtree.s (MTree.S)
  2415.                                                    SelPortPopMen(8,8)
  2416.  
  2417.             case Pdest.s = "DEFINE PRINTER"      : showtree.s (MTree.S)
  2418.                                                    PrinterDefine_UT ()
  2419.  
  2420.             case Pdest.s = "DISPLAY CONFIGURATION": showtree.s (MTree.S)
  2421.                                                     PRINTERCONFIG_UT ()
  2422.  
  2423.  
  2424.             Case Pdest.s = "YES"     : showtree.s (MTree.S)
  2425.                                        clearwindow.v (PlaceMsg_Gl)
  2426.                                        QuitLoop
  2427.  
  2428.             Case Pdest.s = "NO"      : showtree.s (MTree.S)
  2429.                                        clearwindow.v (PlaceMsg_Gl)
  2430.                                        loop
  2431.  
  2432.             OtherWIse                : clearwindow.v (PlaceMsg_Gl)
  2433.                                     QUITLOOP
  2434.        EndSwitch
  2435.     EndWhile
  2436.  
  2437. Return
  2438. EndProc ;*** Printit_UT ***
  2439. WriteLib Libname.a Printit_UT
  2440. Release Procs Printit_UT
  2441.  
  2442. ;****************************************************************
  2443. ; Name:  PrintReport_UT
  2444. ;         ToTable is usually the result of a query and is only
  2445. ;         the portion of to Fromtable we are interested in.
  2446. ;
  2447. ; Notes: If printer is ready Prints report for table (totable,
  2448. ;        using report form (toRpt).  If printer is not ready
  2449. ;        sounds alarm to user and gives time to get printer
  2450. ;        ready.
  2451. ;
  2452. ; Inputs: FromTable - Name of table to copy report specification from
  2453. ;         ToTable   - Name of table to copy to
  2454. ;         FromRpt   - Number of Report specification to copy from
  2455. ;         ToRpt     - Report number to copy to
  2456. ;
  2457. ; Outputs: N/A
  2458. ;
  2459. ;
  2460. ; Global Variables: N/A
  2461. ;
  2462. ; Routines Called : Printit_UT(ToTable.s,  ToRpt.s)
  2463. ;
  2464. ; Code Segment: PrintReport_UT(FromTable, ToTable, FromRpt, ToRpt)
  2465. ;
  2466. ; Error Conditions :  None
  2467. ;
  2468. ; Other  :       N/A
  2469. ;
  2470. ; Limitations  :  N/A
  2471. ;
  2472. ; Copyright (c) 1993 Mike Makler
  2473. ;
  2474. ;*****************************************************************************
  2475. Proc PrintReport_UT(FromTable.s, ToTable.s, FromRpt.s, ToRpt.s)
  2476.  
  2477.     CopyReport FromTable.s FromRpt.s ToTable.s ToRpt.s
  2478.  
  2479.     Printit_UT(ToTable.s,  ToRpt.s)
  2480.  
  2481. Return
  2482. EndProc ;*** PrintReport_UT ***
  2483. WriteLib Libname.a PrintReport_UT
  2484. Release Procs PrintReport_UT
  2485.  
  2486.  
  2487. ;****************************************************************
  2488. ; Name:  PrintToFile_UT
  2489. ;
  2490. ; Notes: Places A report specification in a file
  2491. ;
  2492. ; Inputs: ToTable - Name of table to whose report geets routed to file
  2493. ;         ToRpt   - Report number to route to file
  2494. ;
  2495. ; Outputs:  PrintFile
  2496. ;
  2497. ; Local Variables:  PrintFileExt - Print File with ".Rpt" extension
  2498. ;                                  concatenated
  2499. ;                   YesNo        - OverWrite Yes/No Prompt Variable
  2500. ;
  2501. ; Global Variables: N/A
  2502. ;
  2503. ; Routines Called : PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
  2504. ;
  2505. ; Code Segment: PrintToFile_UT(ToTable, ToRpt)
  2506. ;               GetStringEDTField_UT(n1.v,15,False,"Enter FILE NAME for report ", "A8","!*!")
  2507. ;               DriveStatus(DriveName.S)
  2508. ;               Loc_err_UT ( "Drive Not Ready", "Process Aborted...")
  2509. ;               clearwindow.v (PlaceMsg_Gl)
  2510. ;
  2511. ; Error Conditions : N/A
  2512. ;
  2513. ; Other  :       N/A
  2514. ;
  2515. ; Limitations  :  N/A
  2516. ;
  2517. ; Copyright (c) 1993 Mike Makler
  2518. ;
  2519. ;*****************************************************************************
  2520. Proc PrintToFile_UT(ToTable.s, ToRpt.s)
  2521.     ;*********************************
  2522.     ; Locals
  2523.     ;*********************************
  2524.     Private drive.l,
  2525.             Drivename.S,
  2526.             N,
  2527.             PrintFile,
  2528.             PrintFileExt,
  2529.             YesNo,
  2530.             print.l ,
  2531.             isfile.l
  2532.  
  2533.     While True
  2534.         PlaceMsg_Bottom_ut (PromptTitle_GL,PTMsg1_GL, PTMsg2_GL, pcolor_gl, 22)
  2535.         n1.v =""
  2536.         PrintFile = GetStringEDTField_UT(n1.v,15,False,"Enter FILE NAME for report ", "A8","!*!")
  2537.         PrintFileExt = PrintFile + ".RPT"
  2538.         PrintFile =  PrintFile
  2539.  
  2540.         if printfile=n1.v
  2541.            then print.l = false
  2542.                 QuitLoop
  2543.            else print.l = true
  2544.         Endif
  2545.  
  2546.         Isfile.L = IsFile (PrintfileExt)
  2547.         If IsFile.L
  2548.             Then YesNo = GetStringedtfield_UT ("",17,False, "File Already Exists OverWrite it (Y/N) : ", "A1","!")
  2549.                  If  YesNo = "Y"
  2550.                      Then Run "Del " + PrintFileEXT
  2551.                           QuitLoop
  2552.                      Else @ 17,0
  2553.                           Clear Eol
  2554.                           Loop
  2555.                  EndIf   ;***** Yesno = yes ****
  2556.             Else QuitLoop
  2557.         EndIf  ;*** IsFile (PrintFileExt) ***
  2558.     EndWhile
  2559.  
  2560.     If print.l
  2561.        then N = search (printfileext,":")
  2562.             If N > 0
  2563.                 then drivename.S = substr (printfileext,n-1,1)
  2564.                      Drive.L = DriveStatus(DriveName.S)
  2565.                 else drive.l = true
  2566.             Endif
  2567.  
  2568.             If Drive.L
  2569.                Then  Menu
  2570.                     {Report}
  2571.                     {Output}
  2572.                     Select Totable.s
  2573.                     Select ToRpt.s
  2574.                     {File}
  2575.                     TypeIn PrintFile
  2576.                Else Loc_err_UT ( "Drive Not Ready", "Process Aborted...")
  2577.             Endif
  2578.     Endif
  2579.     clearwindow.v (PlaceMsg_Gl)
  2580.     Return
  2581. EndProc ;*** PrintToFile_UT
  2582. WriteLib LibName.A PrintToFile_UT
  2583. Release Procs PrintToFile_UT
  2584.  
  2585. ;****************************************************************
  2586. ; Name:  PrintToPrinter_UT
  2587. ;
  2588. ; Notes: Prints A report
  2589. ;
  2590. ; Inputs: ToTable - Name of table to whose report geets routed to file
  2591. ;         ToRpt   - Report number to route to file
  2592. ;
  2593. ; Outputs:
  2594. ;
  2595. ; Global Variables: N/A
  2596. ;
  2597. ; Routines Called : Check_Print_Ready_UT ()
  2598. ;
  2599. ;
  2600. ; Code Segment: PrintToPrinter_UT(ToTable, ToRpt)
  2601. ;               SetPrinter.A("Reset")
  2602. ;               Loc_err_UT ("Printer Is Not Ready","Printer Is Not Ready")
  2603. ;               clearwindow.v (PlaceMsg_Gl)
  2604. ;
  2605. ; Error Conditions : N/A
  2606. ;
  2607. ; Other  :       N/A
  2608. ;
  2609. ; Limitations  :  N/A
  2610. ;
  2611. ; Copyright (c) 1993 Mike Makler
  2612. ;
  2613. ;*****************************************************************************
  2614. Proc PrintToPrinter_UT(ToTable.s, ToRpt.s)
  2615.      Private Pstat.L
  2616.  
  2617.      Pstat.l = PrinterStatus ()
  2618.      IF Not PStat.l
  2619.         Then  Loc_err_UT ("Printer Is Not Ready",
  2620.               "Printer Is Not Ready")
  2621.               Check_Print_Ready_UT ()
  2622.      Endif
  2623.  
  2624.      Pstat.l = PrinterStatus ()
  2625.      If Pstat.l
  2626.         Then SetPrinter.A(PrintMode_GL)
  2627.              Report ToTable.s ToRpt.s
  2628.              SetPrinter.A("Reset")
  2629.      Endif
  2630.      clearwindow.v (PlaceMsg_Gl)
  2631.  
  2632. EndProc ;*** PrintToPrinter_UT ****
  2633. WriteLib LibName.A PrintToPrinter_UT
  2634. Release Procs PrintToPrinter_UT
  2635.  
  2636. ;****************************************************************
  2637. ; Name:  PrintToScreen_UT
  2638. ;
  2639. ; Notes: Places A report specification on the screen
  2640. ;
  2641. ; Inputs: ToTable - Name of table to whose report geets routed to file
  2642. ;         ToRpt   - Report number to route to file
  2643. ;
  2644. ; Outputs:
  2645. ;
  2646. ; Global Variables: placemsg_gl
  2647. ;
  2648. ; Routines Called : clearwindow.v (PlaceMsg_Gl)
  2649. ;
  2650. ; Code Segment: PrintToScreen_UT(ToTable, ToRpt)
  2651. ;
  2652. ; Error Conditions : N/A
  2653. ;
  2654. ; Other  :       N/A
  2655. ;
  2656. ; Limitations  :  N/A
  2657. ;
  2658. ; Copyright (c) 1993 Mike Makler
  2659. ;
  2660. ;*****************************************************************************
  2661. Proc PrintToScreen_UT(ToTable.s, ToRpt.s)
  2662.  
  2663.    clearwindow.v (PlaceMsg_Gl)
  2664.    Clearpulldown
  2665.    Menu
  2666.    {Report}
  2667.    {Output}
  2668.    Select totable.s
  2669.    Select toRpt.s
  2670.    {screen}
  2671.    SHOWPULLDOWN ENDMENU
  2672.    clearwindow.v (PlaceMsg_Gl)
  2673.  
  2674. EndProc ;*** PrintToScreen_UT ****
  2675. WriteLib LibName.A PrintToScreen_UT
  2676. Release Procs PrintToScreen_UT
  2677.  
  2678. ;****************************************************************
  2679. ; Name:  RunBatch_UT
  2680. ;
  2681. ; Notes: Prompts User to enter a Name of A batch File to Run
  2682. ;
  2683. ; Inputs: N/A
  2684. ;
  2685. ; Outputs: N/A
  2686. ;
  2687. ;
  2688. ; Other  :       N/A
  2689. ;          
  2690. ; Limitations  :  N/A
  2691. ;
  2692. ; Copyright (c) 1991 Michael Makler
  2693. ;
  2694. ;*****************************************************************************
  2695. Proc RunBatch_UT ()
  2696. Private Bat.S,
  2697.         Msg.S,
  2698.         Search.N,
  2699.         Ifile.L,
  2700.         m1.s,
  2701.         m2.s,
  2702.         m3.s,
  2703.         Msg.s,
  2704.         yesno.s,
  2705.         buttonvalue.s,
  2706.         X
  2707.  
  2708.  
  2709.  
  2710.      M1.s = "You Are About To Run A DOS Batch File"
  2711.      M2.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
  2712.      M3.s = "Enter Full Path Name of DOS Batch File"
  2713.  
  2714.     bat.s=""
  2715.     ButtonValue.S = "Say No"
  2716.     MonitorType.s = GetMonitorType_UT ()
  2717.     Showdialog "Run a BATCH File"
  2718.                @3, 3
  2719.                height 14
  2720.                width  70
  2721.                @2,2 ?? m1.s
  2722.                @3,2 ?? m2.s
  2723.                @4,2 ?? m3.s
  2724.  
  2725.    Accept      @6,2
  2726.                 width 70
  2727.                 "A60"
  2728.                 tag "batchfile"
  2729.                 to bat.s
  2730.  
  2731.    Pushbutton  @8,9 width 10
  2732.                "OK"
  2733.                 OK
  2734.                 Default
  2735.                 value "Accept"
  2736.                 Tag "YES"
  2737.                 To ButtonValue.s
  2738.  
  2739.    Pushbutton  @8,29 width 10
  2740.                "Cancel"
  2741.                 CANCEL
  2742.                 value "Say No"
  2743.                 Tag "No"
  2744.                 To ButtonValue.s
  2745.    EndDialog
  2746.  
  2747.    Search.N = Search (".Bat",Bat.S)
  2748.    If Search.N = 0
  2749.       then Bat.S = Bat.s + ".BAT"
  2750.    Endif
  2751.  
  2752.    If ButtonValue.S = "Accept"
  2753.       then Ifile.L = IsFile (Bat.S)
  2754.            If Ifile.L
  2755.               then Run Big Sleep 5000 Bat.S
  2756.                    WHILE CHARWAITING ()
  2757.                       X = GETCHAR ()
  2758.                    ENDWHILE
  2759.  
  2760.               Else M1.S = "Batch File Not Found"
  2761.                    M2.S = "Try Using Full Path Name"
  2762.                    M3.S = "(I.E. C:\\Batch\\Backup)"
  2763.                    Loc_err_Pause_ut (M1.s,M2.s,m3.s)
  2764.            Endif
  2765.    Endif
  2766.    Return
  2767. EndProc ;*** RunBatch_UT ***
  2768. WriteLib LibNAME.A RunBatch_UT
  2769. Release Procs RunBatch_UT
  2770.  
  2771. ;****************************************************************
  2772. ; Name:  runbatchparm_UT
  2773. ;
  2774. ; Notes: Prompts User to enter a Name of A batch File to Run
  2775. ;
  2776. ; Inputs: N/A
  2777. ;
  2778. ; Outputs: N/A
  2779. ;
  2780. ;
  2781. ; Other  :       N/A
  2782. ;          
  2783. ; Limitations  :  N/A
  2784. ;
  2785. ; Copyright (c) 1991 Michael Makler
  2786. ;
  2787. ;*****************************************************************************
  2788. Proc runbatchparm_UT (bat.s)
  2789. Private Msg.S,
  2790.         Search.N,
  2791.         Ifile.L,
  2792.         m1.s,
  2793.         m2.s,
  2794.         m3.s,
  2795.         Msg.s,
  2796.         yesno.s,
  2797.         buttonvalue.s,
  2798.         batrun.n,
  2799.         X
  2800.  
  2801.  
  2802.  
  2803.      M1.s = "You Are About To Run A DOS Batch File: "
  2804.      M3.s = "Do Not Load any TSR's and Do Not Modify any Paradox Files"
  2805.      M2.s =  bat.s
  2806.  
  2807.     Batrun.n = 0
  2808.     ButtonValue.S = "Say No"
  2809.     MonitorType.s = GetMonitorType_UT ()
  2810.     Showdialog "Run a BATCH File"
  2811.                @3, 3
  2812.                height 14
  2813.                width  70
  2814.                @2,2 ?? m1.s
  2815.                @3,2 ?? m2.s
  2816.                @4,2 ?? m3.s
  2817.  
  2818.    Pushbutton  @8,9 width 10
  2819.                "OK"
  2820.                 OK
  2821.                 Default
  2822.                 value "Accept"
  2823.                 Tag "YES"
  2824.                 To ButtonValue.s
  2825.  
  2826.    Pushbutton  @8,29 width 10
  2827.                "Cancel"
  2828.                 CANCEL
  2829.                 value "Say No"
  2830.                 Tag "No"
  2831.                 To ButtonValue.s
  2832.    EndDialog
  2833.  
  2834.    Search.N = Search (".Bat",Bat.S)
  2835.    If Search.N = 0
  2836.       then Bat.S = Bat.s + ".BAT"
  2837.    Endif
  2838.  
  2839.    If ButtonValue.S = "Accept"
  2840.       then Ifile.L = IsFile (Bat.S)
  2841.            If Ifile.L
  2842.               then Run Big Sleep 5000 Bat.S
  2843.                    batrun.n = 1
  2844.                    WHILE CHARWAITING ()
  2845.                       X = GETCHAR ()
  2846.                    ENDWHILE
  2847.  
  2848.               Else M1.S = "Batch File Not Found"
  2849.                    M2.S = "Try Using Full Path Name"
  2850.                    M3.S = "(I.E. C:\\Batch\\Backup)"
  2851.                    Loc_err_Pause_ut (M1.s,M2.s,m3.s)
  2852.            Endif
  2853.    Endif
  2854.    Return  batrun.n
  2855. EndProc ;*** runbatchparm_UT ***
  2856. WriteLib LibNAME.A runbatchparm_UT
  2857. Release Procs runbatchparm_UT
  2858.  
  2859. ;****************************************************************
  2860. ; Name: SelPortPopMen
  2861. ;
  2862. ; Notes: This Routine allows the User to select a default Printer
  2863. ;
  2864. ; Inputs: N/A
  2865. ;
  2866. ; Outputs: Printer_Gl
  2867. ;
  2868. ; Other  :   N/A
  2869. ;
  2870. ; Copyright (c) 1993 MIKE MAKLER
  2871. ;****************************************************************************
  2872. Proc SelPortPopMen(Rw,CL)
  2873.  
  2874.   ;*************************
  2875.   ;*  locals
  2876.   ;**************************
  2877.   Private            C,
  2878.             DEFITEM.PP,
  2879.                 HELPID,
  2880.                   IA.L,
  2881.                PROMPT1,
  2882.                PROMPT2,
  2883.                 PTITLE,
  2884.                      R,
  2885.                  REC.N,
  2886.              TABDESC.S,
  2887.                  TITLE,
  2888.                   VNUM
  2889.  
  2890. ;  Global ;Item,        ;Array of items of menu
  2891.           ;Width        ;Width of widest item
  2892.  
  2893. Rec.N = Nrecords ( PortTab_GL  )
  2894. If Rec.n < 2
  2895.    then PlaceMsgPause_UT ("Only one Port Defined","","")
  2896.         Return
  2897. endif
  2898.  
  2899. Ia.l = IsAssigned (PortItem_GL)
  2900. If Ia.l
  2901.    then Defitem.PP = PortItem_GL
  2902.    Else Defitem.PP = 1
  2903. Endif
  2904. While True
  2905.    VNum = 10
  2906.    Title = "Printer Port Selection"
  2907.    Prompt1 =""
  2908.    Prompt2 =""
  2909.  
  2910.    SetPopup2(PortTab_gl,"PortName")
  2911.    ClearImage
  2912.    Ptitle = "Printer Port Selection Menu"
  2913.    PlaceMsg_Bottom_ut (Ptitle,PMenu1_GL, PMenu2_GL, pcolor_gl, 22)
  2914.    TabDesc.s =  Popup2(Rw,Cl,VNum,DefItem.PP,Title,Prompt1,Prompt2)
  2915.    cLEARiMAGE
  2916.    Switch
  2917.         Case TabDesc.S = "RemF3"   : DefItem.PP = 1
  2918.                                      Loop
  2919.  
  2920.         Case TabDesc.s = "Help"    : R=16  ;[F1]
  2921.                              C=0
  2922.                              Size=6
  2923.                              HelpId  = "PORT01"
  2924.                              Pophelp(R,C,helptab_gl,Size,Helpid)
  2925.                              @R-2,C
  2926.                              Clear eos
  2927.  
  2928.  
  2929.  
  2930.         Case TabDesc.s = "Esc" : Quitloop
  2931.  
  2932.         OtherWise : View PortTab_GL
  2933.                     Moveto Field "PortName"
  2934.                     Locate TabDESc.S
  2935.                     If Retval
  2936.                        Then PRINTPORT_Gl = TabDesc.S
  2937.                             PortItem_GL = RecNo()
  2938.                             DefItem.PP = POrtItem_GL
  2939.                             SetPrinter PRINTPort_GL
  2940.                             message "Printer Port Set to: " + TabDesc.S
  2941.                        else
  2942.                            message "Error Printer Port Not Set"
  2943.                     Endif
  2944.                     ClearaLL
  2945.                     Clear
  2946.                     Quitloop
  2947.    EndSwitch
  2948.  
  2949. EndWhile
  2950. @rw,cl
  2951. Clear eos
  2952. Return
  2953. EndProc ;***  SelPortPopMen ***
  2954. WriteLib LibNAME.A SelPortPopMen ;***
  2955. Release Procs    SelPortPopMen  ;***
  2956.  
  2957. ;****************************************************************
  2958. ; Name: SelPrintPopMen
  2959. ;
  2960. ; Notes: This Routine allows the User to select a default Printer
  2961. ;
  2962. ; Inputs: N/A
  2963. ;
  2964. ; Outputs: Printer_Gl
  2965. ;
  2966. ; Other  :   N/A
  2967. ;
  2968. ; Copyright (c) 1993 MIKE MAKLER
  2969. ;****************************************************************************
  2970. Proc SelPrintPopMen(Rw,CL)
  2971.  
  2972.   ;*************************
  2973.   ;*  locals
  2974.   ;**************************
  2975.   Private            C,
  2976.              DEFITEM.P,
  2977.                 HELPID,
  2978.                   IA.L,
  2979.                PROMPT1,
  2980.                PROMPT2,
  2981.                 PTITLE,
  2982.                      R,
  2983.                  REC.N,
  2984.              TABDESC.S,
  2985.                  TITLE,
  2986.                   VNUM
  2987.  
  2988. ;  Global ;Item,        ;Array of items of menu
  2989.           ;Width        ;Width of widest item
  2990.  
  2991. Rec.N = Nrecords ( PrintTab_GL  )
  2992. If Rec.n < 2
  2993.    then PlaceMsgPause_UT ("Only one Printer Defined","","")
  2994.            Return
  2995. endif
  2996.  
  2997. Ia.l = IsAssigned (PrintItem_GL)
  2998. If Ia.l
  2999.    then Defitem.P = PrintItem_GL
  3000.    Else Defitem.P = 1
  3001. Endif
  3002. While True
  3003.    VNum = 10
  3004.    Title = "Report Printer Selection"
  3005.    Prompt1 =""
  3006.    Prompt2 =""
  3007.  
  3008.    SetPopup2(PrintTab_gl,"PrinterName")
  3009.    ClearImage
  3010.    Ptitle = "Report Printer Selection Menu"
  3011.    PlaceMsg_Bottom_ut (Ptitle,PMenu1_GL, PMenu2_GL, pcolor_gl, 22)
  3012.    TabDesc.s =  Popup2(Rw,Cl,VNum,DefItem.P,Title,Prompt1,Prompt2)
  3013.    cLEARiMAGE
  3014.    Switch
  3015.         Case TabDesc.S = "RemF3"   : DefItem.P = 1
  3016.                                      Loop
  3017.  
  3018.         Case TabDesc.s = "Help"    : R=16  ;[F1]
  3019.                              C=0
  3020.                              Size=6
  3021.                              HelpId  = "PRNT01"
  3022.                              Pophelp(R,C,helptab_gl,Size,Helpid)
  3023.                              @R-2,C
  3024.                              Clear eos
  3025.  
  3026.  
  3027.  
  3028.         Case TabDesc.s = "Esc" : Quitloop
  3029.  
  3030.         OtherWise : View PrintTab_GL
  3031.                     Moveto Field "PrinterName"
  3032.                     Locate TabDESc.S
  3033.                     If Retval
  3034.                        Then Printer_Gl = TabDesc.S
  3035.                             PrintItem_GL = RecNo()
  3036.                             DefItem.P = PrintItem_GL
  3037.                             SetPrinter.A("PICA")
  3038.                             message "Printer Set to: " + TabDesc.S
  3039.                        Else Message "Error Printer Not Set"
  3040.                     Endif
  3041.                     ClearaLL
  3042.                     ;@9,0
  3043.                     Clear
  3044.                     quitloop
  3045.    EndSwitch
  3046.  
  3047. EndWhile
  3048. @rw,cl
  3049. Clear eos
  3050. Return
  3051. EndProc ;***  SelPrintPopMen ***
  3052. WriteLib LIBNAME.A SelPrintPopMen ;***
  3053. Release Procs    SelPrintPopMen  ;***
  3054.  
  3055. ;****************************************************************
  3056. ; Name: SetPrinter.A
  3057. ;
  3058. ; Notes:  This Routine will Initialze the Printer
  3059. ;
  3060. ; Inputs: Mode.s - This is :
  3061. ;                           Pica  - print 10 cpi
  3062. ;                           Elite - Print 12 cpi
  3063. ;                           Compressed - Print 17 cpi
  3064. ;                           Compoff - Turn off 17 Cpi or 12 cpi revert to 10 cpi
  3065. ;                           Reset - Printer power on defaults)
  3066. ;                           User - User String - Set In Global UserprintString_Gl
  3067. ;
  3068. ;         PORT.S - This is:
  3069. ;                          LPT1 - Printer Port 1
  3070. ;                          LPT2 - Printer Port 2
  3071. ;
  3072. ; Outputs:   N/a
  3073. ;
  3074. ; Other  :   These setup strings are for Epson MX/FX/RX and IBM graphics
  3075. ;            printers and other printers that mimic these.  If this is not
  3076. ;            the case then change these strings or use the user option and
  3077. ;            set UserprintString_GL to the string you want.
  3078. ;
  3079. ; Copyright (c) 1993 Mike Makler
  3080. ;****************************************************************************
  3081. PROC SetPrinter.A (Mode.S)
  3082.    PRIVATE Msg1,
  3083.            msg2,
  3084.            msg3
  3085.  
  3086.    View PrintTab_GL
  3087.    Moveto [PrinterName]
  3088.    Locate Printer_GL
  3089.    PrintSet.S = ""
  3090.    If Retval
  3091.       then MoveTo Field Mode.S
  3092.            PrintSet.S = []
  3093.  
  3094.            If Printer_GL =  "*Custom-1" or Printer_GL = "*Custom-2"
  3095.               then Msg1 = "For Custom Printer Setup"
  3096.                    Msg2 = " Call Mike Makler "
  3097.                    Msg3 =     "(714) 571-8510"
  3098.                    PlaceMsgPause_UT (Msg1, Msg2, Msg3)
  3099.                    PrintSet.S = ""
  3100.            Endif
  3101.  
  3102.            If Printer_GL = "HPQuiet"
  3103.               then  Menu {Report} {SetPrinter} {Override} {Setup} Select "\\027%@"
  3104.            Endif
  3105.  
  3106.       Else  Msg1 = "No Printer Specified"
  3107.             Msg3 = "Select Printer and Retry"
  3108.             Msg2 =     ""
  3109.             PlaceMsgPause_UT (Msg1, Msg2, Msg3)
  3110.             clearimage
  3111.             return
  3112.    Endif
  3113.  
  3114.    ;************ Set Print Mode **********************************
  3115.    If PrintSet.S <>""
  3116.        Then Menu {Report} {SetPrinter} {Override} {Setup} Select PrintSet.S
  3117.    Endif
  3118.    clearimage
  3119.    Return
  3120.  
  3121. ENDPROC ;**** SetPrinter.A ****
  3122. WRITELIB LibName.a SetPrinter.A
  3123. RELEASE PROCS      SetPrinter.A
  3124.  
  3125. Proc ShowTree.S (MenuTree.S)
  3126.      private menutree.da,
  3127.              Memleft.m,
  3128.              date.d,
  3129.              time.a,
  3130.              version.n,
  3131.              runtime.a
  3132.  
  3133.      DynArray Menutree.DA []
  3134.            isval.l = Isassigned (menutree.win)
  3135.            if isval.l
  3136.               then iswin.l = IsWinDow (MenuTree.win)
  3137.               else iswin.l = false
  3138.            endif
  3139.  
  3140.            if not iswin.l
  3141.               then Menutree.DA ["CanClose"]    = false
  3142.                    Menutree.DA ["canmaximize"] = false
  3143.                    Menutree.DA ["canmove"]     = FALSE
  3144.                    Menutree.DA ["canresize"]   = false
  3145.                    ;Menutree.DA ["canvas"]      = true
  3146.                    ;Menutree.DA ["echo"]        = false
  3147.                    Menutree.DA ["Floating"]    = TRUE
  3148.                    Menutree.DA ["hasframe"]    = FALSE
  3149.                    menutree.da ["Maximized"]   = False
  3150.                   ; menutree.da ["TITLE"]       = "LAST Menu Tree Selected"
  3151.                    Menutree.DA ["hasshadow"]   = false
  3152.                    Menutree.DA ["height"]      = 1
  3153.                    Menutree.DA ["margin"]      = "off"
  3154.                    Menutree.DA ["origincol"]   = 2
  3155.                    Menutree.DA ["originrow"]   = 21
  3156.                    Menutree.DA ["Width"]       = 80
  3157.                    ;menutree.da ["style"]       = 30
  3158.                    window create
  3159.                    attributes menutree.da
  3160.                    to menutree.win
  3161.                    SETCANVAS MENUTREE.WIN
  3162.                    WINDOW ECHO MENUTREE.WIN TRUE
  3163.                     @0,0 ?? "LAST MENU SELECTED - " + Menutree.s
  3164.               Else window select menutree.win
  3165.                    setcanvas menutree.win
  3166.                    WINDOW ECHO MENUTREE.WIN TRUE
  3167.                    clear
  3168.                     @0,0 ?? "LAST MENU SELECTED - " + Menutree.s
  3169.            endif
  3170.  
  3171.            if Journalflag_GL
  3172.               then
  3173.               If Isassigned (Write_gl)
  3174.                  Then memleft.m = MEMLEFT()
  3175.                       version.n = VERSION()
  3176.                       runtime.a = FORMAT("LY",ISRUNTIME())
  3177.                       PRINT FILE JOURNAL_GL    ; In the current directory (appends if one exists).
  3178.                       "\n\n" ,                    ; "\n" is linefeed  "\f"  is formfeed.
  3179.                       "    Memory left: ", memleft.m, "\n",
  3180.                       "         Action: ", menutree.s, "\n"
  3181.  
  3182.                  Else write_gl=true
  3183.                       memleft.m = MEMLEFT()
  3184.                       date.D = TODAY()
  3185.                       time.a = TIME()
  3186.                       version.n = VERSION()
  3187.                       runtime.a = FORMAT("LY",ISRUNTIME())
  3188.                       PRINT FILE JOURNAL_GL    ; In the current directory (appends if one exists).
  3189.                       "\n\n" ,                    ; "\n" is linefeed  "\f"  is formfeed.
  3190.                       "===========================================================\n",
  3191.                       "           Date: ", date.D, "\n",
  3192.                       "           Time: ", time.a, "\n",
  3193.                       "        Version: ", version.n, "\n",
  3194.                       "        Runtime: ", runtime.a, "\n",
  3195.                       "    Memory left: ", memleft.m, "\n",
  3196.                       "         Action: ", menutree.s, "\n"
  3197.               Endif
  3198.             Endif
  3199. Return
  3200. EndProc
  3201. WRITELIB LibName.a ShowTree.S
  3202. RELEASE PROCS      ShowTree.S
  3203.  
  3204.  
  3205. ;****************************************************************
  3206. ; Name:  viewrec_UT
  3207. ; Notes: allows user to VIEW a  record (table_in) using
  3208. ;        form (formNum)
  3209. ;
  3210. ; Input: Table_in - Name of table to edit
  3211. ;        FORMNUM  - form to use for editing
  3212. ;
  3213. ; Outputs: Retval (Paradox Global Variable)
  3214. ;
  3215. ; Local Variables:
  3216. ;               L    - CancelEdit Yes/No Prompt Variable
  3217. ;               Msg1 - User Message
  3218. ;               Msg2 - User Message
  3219. ;
  3220. ; Global Variables: RetVal - Paradox WaitKey Variable
  3221. ;
  3222. ; Routines Called : NotCode_UT
  3223. ;                   YesNo_Ut
  3224. ;
  3225. ;
  3226. ; Error Conditions : N/A
  3227. ;
  3228. ; Other  :       N/A
  3229. ;
  3230. ; Limitatiions :  This routine will not allow Dos, Dosbig, Zoom or ZoomNext
  3231. ;                 Keys to be Entered.
  3232. ;                 You Must Supply your own Help_Me (PRocName) Routine.
  3233. ;                 If you want Help.  I have Supplied one that does nothing.
  3234. ;                 You Can use EditTableNoHelp_Ut if help is not Needed.
  3235. ;
  3236. ; Copyright (c) 1993 Mike Makler
  3237. ;
  3238. ;*****************************************************************************
  3239. Proc viewrec_UT (Table_in.s, FormNum.s,Field.s,Value.a)
  3240.     ;*************************
  3241.     ;*  locals
  3242.     ;**************************
  3243.     Private L,
  3244.             Msg1,
  3245.             Msg2,
  3246.             Formv.l,
  3247.             Empty.L
  3248.  
  3249.  
  3250.     Msg1 = "Viewing Record --- Enter [F2] - Save, [Esc] - Cancel, [F1] - Help"
  3251.  
  3252.     View Table_in.s
  3253.     Moveto Field field.s
  3254.     Locate Value.a
  3255.     if retval
  3256.       then ;EditKey
  3257.            ;CURSOR NORMAL
  3258.            Formv.l = IsFormView ()
  3259.            Empty.L = IsEmpty (Table_IN.s)
  3260.            If Not Formv.l and Not Empty.l
  3261.                Then  PickForm FormNum.s
  3262.            EndIf
  3263.  
  3264.  
  3265.            While True
  3266.                Wait Record
  3267.                    Prompt  Msg1
  3268.                    Message "Begin viewing Record."
  3269.                Until "F1","F2", "Esc","DOS","DOSBIG","ZOOM","ZOOMNEXT","F7"
  3270.  
  3271.                Switch
  3272.                    Case RetVal = "F1":
  3273.                        ;help_me("EditTable_UT")
  3274.                        If helpmode() = "LookupHelp"
  3275.                           then Keypress "F1"
  3276.                           else  Message "LookUp Help Not Available for This Field"
  3277.                        Endif
  3278.                        Loop
  3279.                    Case RetVal = "F2":
  3280.                        Do_it!
  3281.                        QuitLoop
  3282.                    Case Retval = "F7" : Formv.l = IsFormView ()
  3283.                                         Empty.L = IsEmpty (Table_IN.s)
  3284.                                         If Not Formv.l
  3285.                                            Then  If Not Empty.L
  3286.                                                     then PickForm FormNum
  3287.                                                  endif
  3288.                                            Else KeyPress "F7"
  3289.                                         Endif
  3290.  
  3291.  
  3292.                    Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
  3293.                                                               Loop
  3294.                    Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
  3295.                                                                 Loop
  3296.                    Case RetVal = "Esc": quitloop
  3297.                    OtherWise: NotCode_UT ()
  3298.                        Loop
  3299.                EndSwitch
  3300.            EndWhile
  3301.       else ;record not found error
  3302.            M1.s = "Record not found for table : " + Table_in.s
  3303.            m2.s = "Field                      : " + field.s
  3304.            m3.s = "Value                      : " + strval (Value.a)
  3305.            Loc_err_Pause_UT (M1.s, M2.s, M3.s)
  3306.  
  3307.     endif
  3308.     ClearImage ;*** Table ***
  3309.     CURSOR OFF
  3310. EndProc ;*** viewrec_UT ***
  3311. WriteLib Libname.a viewrec_UT
  3312. Release Procs viewrec_UT
  3313.  
  3314.  
  3315. ;****************************************************************
  3316. ; Name:  ViewTable_UT
  3317. ;
  3318. ; Notes: allows user to View a  table (table_in) using
  3319. ;        form (formNum)
  3320. ;
  3321. ; Inputs:Table_in - Name of Table to View
  3322. ;        FormNum  - Name of Form to use To View Table With
  3323. ;        TabName  - Informative Text that gives Table Name or Purpose or....
  3324. ;
  3325. ; Outputs: N/A 
  3326. ;
  3327. ; Local Variables: Msg1 - User Prompt Text
  3328. ;                  Msg2 - User Prompt Text 
  3329. ;
  3330. ; Global Variables: N/A  
  3331. ;
  3332. ; Routines Called : Loc_err_UT
  3333. ;
  3334. ; Code Segment:  ViewTable_UT (EmpId, "3", "Employee Id Table")
  3335. ;
  3336. ; Error Conditions : Cannot Toggle Formview table is empty  
  3337. ;
  3338. ; Other  :       N/A
  3339. ;          
  3340. ; Limitations  :  N/A
  3341. ;
  3342. ; Copyright (c) 1993 Mike Makler
  3343. ;
  3344. ;*****************************************************************************
  3345. Proc ViewTable_UT (Table_in, FormNum, TabName)
  3346.     ;*************************
  3347.     ;*  locals
  3348.     ;**************************
  3349.     Private Msg1,
  3350.             Msg2,
  3351.             Eflag.L
  3352.  
  3353.     If TabName = " "
  3354.         Then TabName = Table_in
  3355.     EndIf
  3356.  
  3357.    Eflag.L = IsEmpty (Table_in)
  3358.    If Eflag.L
  3359.       Then loc_err_ut ("No Records Found For - " + Tabname, " ")
  3360.            Return
  3361.    Endif
  3362.  
  3363.     Msg1 = "Viewing TABLE --- " + TabName
  3364.     Msg2 = "Enter [F7] To Toggle Form , [ESC] or [F2] When Done"
  3365.  
  3366.     View Table_in
  3367.     If Not IsFormView ()
  3368.         Then
  3369.         If FormNum = " "
  3370.             Then FormKey
  3371.                  formnum = Form ()
  3372.             Else PickForm FormNum
  3373.         EndIf
  3374.     EndIf
  3375.     WINMAX
  3376.     While True
  3377.         Wait Table
  3378.             Prompt  Msg1, Msg2
  3379.             Message "Begin Viewing TABLE " + TabName
  3380.         Until "F2", "Esc" , "F7","DOS","DOSBIG","ZOOM","ZOOMNEXT"
  3381.  
  3382.         Switch
  3383.             Case RetVal = "F2" Or RetVal = "Esc" : QuitLoop
  3384.             Case RetVal = "F7" : If IsFormView()
  3385.                                     Then FormKey
  3386.                                     Else  If Not Isempty (Table_in)
  3387.                                              Then PickForm FormNum
  3388.                                              Else Loc_err_UT ("We Cannot Enter Form Mode",
  3389.                                                               "Table" + Table_IN + "Does Not Contain Records")
  3390.                                           Endif
  3391.                                  EndIf
  3392.                                  Loop
  3393.  
  3394.             Case RetVal = "DOS" or RetVal = "DOSBIG" : Beep
  3395.                                                        Loop
  3396.  
  3397.             Case RetVal ="ZOOM" or Retval = "ZOOMNEXT" : Beep
  3398.                                                          Loop
  3399.  
  3400.             OtherWise : Beep
  3401.                         loop
  3402.         EndSwitch
  3403.  
  3404.     EndWhile
  3405.  
  3406.  
  3407.     ClearImage ;*** Table ***
  3408.  
  3409. EndProc ;*** ViewTable_UT*
  3410. WriteLib  Libname.a ViewTable_UT
  3411. Release Procs ViewTable_UT
  3412.  
  3413.  
  3414.  
  3415.  
  3416.  
  3417. ;****************************************************************
  3418. ; Name: windowmove.v
  3419. ;
  3420. ; Notes: This Routine WILL move a window.
  3421. ;
  3422. ; Outputs: N/A
  3423. ;
  3424. ; Copyright (c) 1993 Mike Makler
  3425. ;****************************************************************************
  3426. PROC Windowmove.v (WinHand.H,rw.n,cl.n)
  3427.      Private isvalue.l
  3428.  
  3429.     isvalue.l = Isassigned (WinHand.H)
  3430.     if Isvalue.l
  3431.        then if Iswindow (winhand.h)
  3432.                then window select winhand.h
  3433.                     window move winhand.h to RW.N,CL.N
  3434.             endif
  3435.     endif
  3436.  
  3437. ENDPROC ;**** windowmove.v  ****
  3438. WRITELIB LibName.a windowmove.v
  3439. RELEASE PROCS      windowmove.v
  3440.  
  3441.  
  3442.  
  3443. ;****************************************************************
  3444. ; Name:  YesNo_UT
  3445. ;
  3446. ; Notes: Displays a yes/no Menu and Returns user selection to
  3447. ;        Calling Routine.
  3448. ;
  3449. ; Inputs: YesMsg - Yes Message String
  3450. ;         noMsg  - no  Message String
  3451. ;         Def    - Default Selection (Yes, Or No)
  3452. ;
  3453. ; Output Selection - user Selection (YES, NO)
  3454. ;
  3455. ; Local Variables:  N/A
  3456. ;
  3457. ; Global Variables: N/A  
  3458. ;
  3459. ; Routines Called : N/A
  3460. ;
  3461. ; Code Segment:  While True
  3462. ;                   Switch
  3463. ;                      :
  3464. ;                      :
  3465. ;                      Case MenSel = Leave :L= YesNo_UT ("Yes leave DOS Menu",
  3466. ;                                           "No Return to The DOS Menu","YES")
  3467. ;                                            If Upper(L) = "YES"
  3468. ;                                              Then QuitLoop
  3469. ;                                              Else Loop
  3470. ;                                           EndIf
  3471. ;                      :
  3472. ;                      :
  3473. ;                      Otherwise : ;********
  3474. ;                   EndSwitch
  3475. ;                EndWhile
  3476. ; Error Conditions :  N/A 
  3477. ;
  3478. ; Other  :       N/A
  3479. ;          
  3480. ; Limitations  :  N/A
  3481. ;
  3482. ; Copyright (c) 1993 MIKE MAKLER
  3483. ;
  3484. ;*****************************************************************************
  3485. Proc YesNo_UT (YesMsg, NoMSG, Def)
  3486.     ;*************************
  3487.     ;*  locals
  3488.     ;**************************
  3489.     Private Selection,
  3490.             ButtonValue.s,
  3491.             Startline.n
  3492.  
  3493.  
  3494.     ;setcanvas default
  3495.     StartLine.N = 9
  3496.     ButtonValue.s ="No"
  3497.     Showdialog "Cancel Edit Session"
  3498.                  @Startline.n, 5
  3499.                  height 9
  3500.                  width  60
  3501.                  @3,2 ??  "Leave Current Edit Session"
  3502.                  @4,2 ?? "Yes - Changes will be lost"
  3503.                  @5,2 ?? "No - Continue Editing Save Changes"
  3504.  
  3505.      Pushbutton  @7,9 width 10
  3506.                  "~O~K"
  3507.                   OK
  3508.                   Default
  3509.                   value "Yes"
  3510.                   Tag "YES"
  3511.                   To ButtonValue.s
  3512.  
  3513.      Pushbutton  @7,29 width 10
  3514.                  "~C~ancel"
  3515.                   CANCEL
  3516.                   value "No"
  3517.                   Tag "No"
  3518.                   To ButtonValue.s
  3519.      EndDialog
  3520.  
  3521.     Return ButtonValue.s
  3522. EndProc ;***** YesNo_UT *******
  3523. WriteLib LibNAME.A YesNo_UT
  3524. Release Procs YesNo_UT
  3525.  
  3526. ;****************************
  3527. ;****************************
  3528. ; Borlands PopUp Menu Code
  3529. ;****************************
  3530. ;****************************
  3531.  
  3532. ; Copyright (c) 1988, 1989 Borland International.  All Rights Reserved.
  3533. ;
  3534. ; General permission to re-distribute all or part of this script is granted,
  3535. ; provided that this statement, including the above copyright notice, is not
  3536. ; removed.  You may add your own copyright notice to secure copyright
  3537. ; protection for new matter that you add to this script, but Borland
  3538. ; International will not support, nor assume any legal responsibility for,
  3539. ; material added or changes made to this script.
  3540. ;
  3541. ; Revs.:  DCY 12/15/88
  3542. ; ****************************************************************************
  3543. ; SetPopup2 initializes variables required by Popup2 from data stored in a
  3544. ; table.  It requires a table name and a field name from which to read menu
  3545. ; item information.  Basically, it views and scans the given table, defining
  3546. ; menu items as elements within an array.  It also determines the widest
  3547. ; element of the array (not necessarily the width_gl of the field), assigning it
  3548. ; to another variable also required by Popup2.
  3549. ;
  3550. Proc SetPopup2(PopTbl,Fld)
  3551. ;  Private;PopTbl,      ;Source table for items of menu
  3552.           ;Fld,         ;Source field for items of menu
  3553. ;  Global ;Item,        ;Array of items of menu
  3554.           ;width_gl        ;Width of widest item
  3555.  
  3556.    Array Item[NRecords(PopTbl)]    ;Dimension Item array.  One item per record
  3557.    View PopTbl                     ;  in PopTbl.
  3558.    MoveTo Field Fld
  3559.    width_gl = 0
  3560.    If Search("A",FieldType()) = 0  ;If field is non-alphanumeric, convert it
  3561.       Then Scan                    ; to a string value before assigning it
  3562.               Item[[#]] = Strval([])
  3563.               width_gl = Max(Len(Item[[#]]),width_gl)  ;Update max. width
  3564.            Endscan
  3565.       Else Scan
  3566.               Item[[#]] = []
  3567.               width_gl = Max(Len([]),Width_gl)
  3568.            Endscan
  3569.    Endif
  3570.  
  3571. Endproc
  3572. WriteLib LIBNAME.A SetPopup2
  3573. Release Procs    Setpopup2
  3574.  
  3575. Proc Popup2(R,C,VNum,DefItem,Title,Prompt1,Prompt2)
  3576.    Private;R,           ;Row position of upper-left corner of menu box
  3577.           ;C,           ;Column position of upper-left corner menu box
  3578.           ;VNum,        ;Number of items to be displayed in one menu image
  3579.           ;DefItem,     ;Item (number) to show
  3580.           ;Title,       ;Title of popup box
  3581.           ;Prompt1,     ;First prompt line
  3582.           ;Prompt2,     ;Second prompt line
  3583.            NItems,      ;Number of items in menu list
  3584.            Char,        ;Keycode of last key pressed
  3585.            MenuPos,     ;Current (row image) position within menu
  3586.            CIndex,      ;Current choice index into Item
  3587.            X,           ;Counter variable
  3588.            PrmptColr,   ;Color attribute for prompt
  3589.            BrdrColr,    ;Color attribute for box border
  3590.            ListColr,    ;Color attribute for menu item list
  3591.            SlctColr,    ;Color attribute for current menu selection
  3592.            Promptit
  3593. ;  Global ;Item,        ;Array of items of menu
  3594.           ;width_gl        ;Width of widest item
  3595.  
  3596.     H.s = Vnum + 6
  3597.  
  3598.     ok.s = ""
  3599.  
  3600.     ltitle.n = len (title) +6
  3601.     width_gl = max (width_gl, ltitle.n)
  3602.  
  3603.     ShowDialog title
  3604.              @R-2, C-2
  3605.              Height H.s
  3606.              width width_gl + 10
  3607.  
  3608.     Pickarray @1,2
  3609.               height Vnum  width width_gl +2
  3610.               Item
  3611.               Tag "PickArray.A"
  3612.               to Menu.S
  3613.  
  3614.     Pushbutton  @vnum+3,10 width 10
  3615.                 "~O~K"
  3616.                 OK
  3617.                 DEFAULT
  3618.                 Value "Accept"
  3619.                 Tag "Yes"
  3620.                 to ok.s
  3621.  
  3622.     Pushbutton @vnum+3,21 width 10
  3623.                "~C~ANCEL"
  3624.                CANCEL
  3625.                Value "Cancel"
  3626.                Tag "Cancel"
  3627.                to ok.s
  3628.  
  3629.     Enddialog
  3630.  
  3631.     If Ok.s = "Accept"
  3632.        then MenuPick.S = Item [menu.s]
  3633.        else MenuPick.S = "Esc"
  3634.     endif
  3635.     Return Menupick.S
  3636.  
  3637. Endproc ;*** Popup2 *
  3638. WriteLib LIBNAME.A  Popup2
  3639. Release Procs       Popup2
  3640.