home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PROG / CUACLIP.ZIP / EX5.PRG < prev    next >
Encoding:
Text File  |  1993-06-01  |  9.7 KB  |  446 lines
  1. /*********************************************************************
  2.  
  3.     EX5.PRG - CUA-Clip Library examples.
  4.  
  5.     This file contains sample code combining STDBrowse, GETs and
  6.     the Event system in one module.
  7.  
  8.     Author: Dave Rooney
  9.     Date  : Feb. 23, 1993
  10.  
  11. *********************************************************************/
  12.  
  13. #include "Demo.CH"
  14.  
  15.  
  16. //
  17. // Example 5 - STDBrowse with a menu.
  18. //
  19.  
  20. FUNCTION TheWholeThing
  21.  
  22. LOCAL cScreen,    ; // Screen on entry
  23.         bInterrupt, ; // Interrupt code block on entry
  24.         aFields,    ; // Fields array for the browse
  25.         aMenu,      ; // Menu array for the browse
  26.         cColor,     ; // Colour string for the browse
  27.         cTitle,     ; // Title text
  28.         i             // Loop counter
  29.  
  30. //
  31. // Ensure Printer.DBF/.NTX are there.  If not, make 'em!
  32. //
  33. IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
  34.     _BuildPrinter()
  35. ENDIF
  36.  
  37. //
  38. // Open the printer file.
  39. //
  40. IF DBNetUse( .T., "DBFNTX", "Printer" )
  41.     DBSETINDEX( "Printer" )
  42. ELSE
  43.     RETURN NIL
  44. ENDIF
  45.  
  46. cScreen := SAVESCREEN()
  47.  
  48. //
  49. // Set an interrupt function to be called during wait states,
  50. // i.e. InterruptKey().  Note that we're saving the current
  51. // interrupt code block which we'll restore later.
  52. //
  53. bInterrupt := SetInterrupt( {|| MyInterrupt() } )
  54.  
  55. //
  56. // Build the menu array...
  57. //
  58. aMenu := {;
  59.     { "~Add",      {|| AddModPrinter(.T.) } }, ;
  60.     { "~Modify",   {|| AddModPrinter(.F.) } }, ;
  61.     { "~Delete",   {|| DeletePrinter() } }, ;
  62.     { "E~xit",     {|oB| oB:cargo[ B_LMORE ] := .F. } } }
  63.  
  64. //
  65. // Fields array for the STDBrowse...
  66. //
  67. aFields := { ;
  68.     { "Printer Name", {|| FIELD->PrnName } }, ;
  69.     { "Port",         {|| PADC( FIELD->Port, 6 ) } }, ;
  70.     { "PostScript",   {|| PADC( IF( FIELD->PostScript, "Yes", "No" ), 10 ) } } }
  71.  
  72. cColor := "B/BG,GR+/BG,W+/BG,W+/R"
  73. cTitle := " Printer File "
  74.  
  75. //
  76. // Browse it!!
  77. //
  78. STDBrowse( 5, 3, MAXROW() - 5, MAXCOL() - 3, aFields, cTitle,, ;
  79.                 cColor, .F., aMenu )
  80.  
  81. //
  82. // Close the printer file...
  83. //
  84. DBNetClose( "Printer" )
  85.  
  86. //
  87. // Reset the interrupt code block...
  88. //
  89. SetInterrupt( bInterrupt )
  90.  
  91. RESTSCREEN(,,,, cScreen )
  92.  
  93. RETURN NIL
  94. //
  95. // That's all folks!
  96. //
  97.  
  98.  
  99. /*******************************************************************
  100.  
  101.     FUNCTION AddModPrinter
  102.  
  103.     This function is used to add a new printer to the list, or
  104.     modify an existing one.
  105.  
  106.     Parameters: lAddFlag - .T. if adding, .F. if modifying.
  107.  
  108.         Returns: .T.
  109.  
  110. *******************************************************************/
  111.  
  112. STATIC FUNCTION AddModPrinter ( lAddFlag )
  113.  
  114. LOCAL cScreen,       ; // Screen behind the dialog box
  115.         cOldColor,     ; // Colour on entry
  116.         GetList,       ; // Local GetList array
  117.         cPrinter,      ; // Name of the printer
  118.         cPort,         ; // Printer port selected
  119.         lPostScript,   ; // .T. if the printer is PostScript
  120.         aPrinters,     ; // DBLIST array for the Printer lookup
  121.         aPorts,        ; // Radio button array for the Printer port
  122.         lProceed         // .T. if proceeding with the Add/Modify
  123.  
  124. //
  125. // Initialize the variables...
  126. //
  127. cOldColor := SETCOLOR()
  128. GetList   := {}
  129. lProceed  := .F.
  130.  
  131. //
  132. // Radio button array for the printer port...
  133. //
  134. aPorts := { { { "LPT1", "LPT1" }, { "LPT2", "LPT2" }, { "LPT3", "LPT3" } } }
  135.  
  136. IF lAddFlag
  137.     cPrinter    := SPACE(30)
  138.     cPort       := "LPT1"
  139.     lPostScript := .F.
  140. ELSE
  141.     IF RLOCK()
  142.         cPrinter    := Printer->PrnName
  143.         cPort       := Printer->Port
  144.         lPostScript := Printer->PostScript
  145.     ELSE
  146.         TONE( 250, 1 )
  147.         ALERT( "Could not lock record!" )
  148.         RETURN .T.
  149.     ENDIF
  150. ENDIF
  151.  
  152. //
  153. // Display the dialog box
  154. //
  155. cScreen := ShadowBox( 2, 12, 13, 68, 2, "GR+/B" )
  156.  
  157. SETCOLOR( "W+/B" )
  158.  
  159. @ 2,15 SAY "[ CUA-Clip Interface Library - GET System Examples ]"
  160.  
  161. SETCOLOR( "BG+/B" )
  162.  
  163. @  4,15 SAY "      Name:"
  164. @  6,15 SAY "      Port:"
  165. @  8,15 SAY "PostScript:"
  166.  
  167. //
  168. // Standard GET with a database list.  Note the use of Monitor() to
  169. // refresh all of the GETs after a printer name has been entered.
  170. // This will change the colour of the radio buttons and check box
  171. // from dimmed to normal.
  172. //
  173. @ 4,27 GET cPrinter ;
  174.             VALID V_Printer( cPrinter, lAddFlag ) ;
  175.             COLOR "W+/N, W+/R, W/N" ;
  176.             MESSAGE "Enter the name of the printer"
  177.  
  178. //
  179. // Radio buttons - nothing too fancy here!
  180. //
  181. @ 6,27 GET cPort USING RADIO WITH aPorts ;
  182.             WHEN !EMPTY( cPrinter ) ;
  183.             VALID cPort $ "LPT1|LPT2|LPT3" ;
  184.             COLOR "W+/B, W+/R, W/B" ;
  185.             MESSAGE "Select the port for the printer"
  186.  
  187. //
  188. // Check box - piece of cake!
  189. //
  190. @ 8,27 GET lPostScript USING CHECK ;
  191.             WHEN !EMPTY( cPrinter ) ;
  192.             COLOR "W+/B, W+/R, W/B" ;
  193.             MESSAGE "Is it a PostScript printer?"
  194.  
  195. //
  196. // Push buttons - code 'em in your sleep!  Note that the ACTION expression
  197. // returns a logical value: .T. means end the READ, .F. means continue.
  198. //
  199. @ 10,25 BUTTON "  ~Save  " ;
  200.             WHEN Updated() ;
  201.             ACTION ( lProceed := ( ValidGets() == 0 ) ) ;
  202.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  203.  
  204. @ 10,43 BUTTON " ~Abort " ;
  205.             ACTION !( lProceed := .F. ) ;
  206.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  207.  
  208. READ
  209.  
  210. //
  211. // Is the user selected 'Save', write the changes to the file.
  212. //
  213. IF lProceed
  214.     IF lAddFlag
  215.         //
  216.         // Add a new record...
  217.         //
  218.         DBAPPEND()
  219.     ENDIF
  220.  
  221.     REPLACE Printer->PrnName      WITH cPrinter
  222.     REPLACE Printer->Port         WITH cPort
  223.     REPLACE Printer->PostScript   WITH lPostScript
  224.  
  225.     //
  226.     // Unlock the record & flush the buffers to disk.
  227.     //
  228.     DBUNLOCK()
  229.     DBCOMMIT()
  230. ENDIF
  231.  
  232. //
  233. // Get rid of the dialog box...
  234. //
  235. KillBox( cScreen )
  236.  
  237. SETCOLOR( cOldColor )
  238.  
  239. RETURN .T.
  240. //
  241. // EOP: AddModPrinter
  242. //
  243.  
  244.  
  245. /*******************************************************************
  246.  
  247.     FUNCTION DeletePrinter
  248.  
  249.     This function is used to delete a printer from the list.
  250.  
  251.     Parameters: None.
  252.  
  253.         Returns: .T.
  254.  
  255. *******************************************************************/
  256.  
  257. STATIC FUNCTION DeletePrinter
  258.  
  259. LOCAL cScreen,       ; // Screen behind the dialog box
  260.         cOldColor,     ; // Colour on entry
  261.         GetList,       ; // Local GetList array
  262.         cPrinter,      ; // Name of the printer
  263.         lProceed         // .T. if proceeding with the Add/Modify
  264.  
  265. //
  266. // Initialize the variables...
  267. //
  268. cOldColor := SETCOLOR()
  269. GetList   := {}
  270. cPrinter  := ALLTRIM( Printer->PrnName )
  271. lProceed  := .F.
  272.  
  273. //
  274. // Display the dialog box
  275. //
  276. cScreen := ShadowBox( 5, 12, 14, 68, 2, "GR+/B" )
  277.  
  278. SETCOLOR( "W+/B" )
  279.  
  280. @ 7,14 SAY "Delete this printer from the file?"
  281.  
  282. SETCOLOR( "GR+/B" )
  283.  
  284. @ 9,14 SAY cPrinter
  285.  
  286. @ 11,25 BUTTON "  Delete  " ;
  287.             ACTION ( lProceed := .T. ) ;
  288.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  289.  
  290. @ 11,43 BUTTON " Cancel " ;
  291.             ACTION !( lProceed := .F. ) ;
  292.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  293.  
  294. READ
  295.  
  296. //
  297. // Is the user selected 'Delete', turf that record!
  298. //
  299. IF lProceed
  300.     IF RLOCK()
  301.         //
  302.         // Mark the record for deletion!
  303.         //
  304.         DBDELETE()
  305.  
  306.         //
  307.         // Unlock the record & flush the buffers to disk.
  308.         //
  309.         DBUNLOCK()
  310.         DBCOMMIT()
  311.     ELSE
  312.         TONE( 250, 1 )
  313.         ALERT( "Could not lock record!" )
  314.     ENDIF
  315. ENDIF
  316.  
  317. //
  318. // Get rid of the dialog box...
  319. //
  320. KillBox( cScreen )
  321.  
  322. SETCOLOR( cOldColor )
  323.  
  324. RETURN .T.
  325. //
  326. // EOP: DeletePrinter
  327. //
  328.  
  329.  
  330. /*******************************************************************
  331.  
  332.     FUNCTION V_Printer
  333.  
  334.     This function is used to validate the printer name entered.
  335.  
  336.     If the user is adding a new printer, the function ensures that
  337.     the printer name has not already been used.  If the user is modifying,
  338.     ensure that the name has not been used for another printer.
  339.  
  340.     Parameters: cPrinter - The name of the printer to validate.
  341.                     lAddFlag - .T. if adding, .F. if modifying.
  342.  
  343.         Returns: .T. if valid, .F. otherwise.
  344.  
  345. *******************************************************************/
  346.  
  347. STATIC FUNCTION V_Printer ( cPrinter, lAddFlag )
  348.  
  349. LOCAL lRetCode,   ; // Function's return code
  350.         nRecNo,     ; // Record number on entry
  351.         x
  352.  
  353. lRetCode := .F.         // I'm a pessimist!
  354. nRecNo   := RECNO()
  355.  
  356. IF lAddFlag
  357.     //
  358.     // Adding a printer, so simply check for an existing printer
  359.     // of the same name. If one is there, the name is invalid!
  360.     //
  361.     lRetCode := !DBSEEK( UPPER( cPrinter ), .F. )
  362. ELSE
  363.     //
  364.     // Modifying is a bit different.  If the printer name is found in
  365.     // the file, it could simply be the same record that we're
  366.     // modifying!!  Soooo, compare the record number with that on
  367.     // entry.  If they're different, then there's another printer
  368.     // with the same name - the entry is then invalid.
  369.     //
  370.     IF DBSEEK( UPPER( cPrinter ), .F. )
  371.         lRetCode := ( RECNO() == nRecNo )   // Is it the same record?
  372.     ELSE
  373.         lRetCode := .T.
  374.     ENDIF
  375. ENDIF
  376.  
  377. IF !lRetCode
  378.     TONE( 250, 1 )
  379.  
  380.     IF EMPTY( cPrinter )
  381.         ALERT( "You must enter a printer name!" )
  382.     ELSE
  383.         ALERT( "That printer already exists!" )
  384.     ENDIF
  385. ENDIF
  386.  
  387. //
  388. // Reset the record pointer.
  389. //
  390. DBGOTO( nRecNo )
  391.  
  392. RETURN lRetCode
  393. //
  394. // EOP: V_Printer
  395. //
  396.  
  397.  
  398. /*******************************************************************
  399.  
  400.     FUNCTION MyInterrupt
  401.  
  402.     This is our background function that will be called during the
  403.     InterruptKey wait state.
  404.  
  405. NOTE: You must remember that this function will be called many times!
  406.         As such its processing must be kept to a minimum.  In this case
  407.         we will only redisplay the time if it has changed.
  408.  
  409.     Parameters: None.
  410.  
  411.         Returns: NIL
  412.  
  413. *******************************************************************/
  414.  
  415. STATIC FUNCTION MyInterrupt
  416.  
  417. STATIC cOldTime
  418.  
  419. LOCAL cOldColor,     ; // Colour on entry
  420.         cCurTime,      ; // Current time
  421.         nRow, nCol       // Position on entry
  422.  
  423. IF cOldTime == NIL
  424.     cOldTime := TIME()
  425. ENDIF
  426.  
  427. cCurTime := TIME()
  428.  
  429. IF !( cCurTime == cOldTime )
  430.     cOldColor := SETCOLOR( "W+/B" )
  431.     nRow      := ROW()
  432.     nCol      := COL()
  433.  
  434.     @ 0,MAXCOL() - 9 SAY cCurTime
  435.  
  436.     cOldTime := cCurTime
  437.  
  438.     SETPOS( nRow, nCol )
  439.     SETCOLOR( cOldColor )
  440. ENDIF
  441.  
  442. RETURN NIL
  443. //
  444. // EOP: MyInterrupt
  445. //
  446.