home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SAMPLES.EXE / T_AEDBAR.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  8.1 KB  |  329 lines
  1. *****************************************************************
  2. * Test program for AEDBAR function -  FILE T_AEDBAR.PRG
  3. *****************************************************************
  4.  
  5. * Copyright(c) 1991 -- James Occhiogrosso
  6.  
  7. # include "inkey.ch"
  8.  
  9. * Menubar key definitions
  10. # define KEY_Q  81
  11. # define KEY_q  113
  12. # define KEY_A  65
  13. # define KEY_a  97
  14. # define KEY_E  69
  15. # define KEY_e  101
  16. # define KEY_F  70
  17. # define KEY_f  102
  18. # define KEY_D  68
  19. # define KEY_d  100
  20.  
  21. * Initialize global variables and overall conditions
  22. INITGLOBAL()
  23. DEVELOP()
  24. SETCOLOR(colstd)
  25. CLEAR SCREEN
  26. SET DELETED ON
  27. SET SOFTSEEK ON
  28.  
  29. PRIVATE apphelp := 'SYSHELP', fkeySet := 'HOTKEYS'
  30.  
  31. SET KEY K_F1 TO &apphelp
  32. SET KEY K_F2 TO HOTKEY_2
  33. SET KEY K_F3 TO HOTKEY_3
  34.  
  35. * Display screen text
  36. @  4, 20 TO 15, 60 DOUBLE
  37. @  6, 23 SAY 'Enter order number: '
  38. @  8, 24 SAY  'Customer account : '
  39. @ 10, 30 SAY        'Part Number: '
  40. @ 12, 31 SAY         'Price Each: '
  41. CENTERON(18, 'Press F1, F2, F3 for simulated HOTKEY functions')
  42. CENTERON(19, 'Press ALT-G, ALT-V or ALT-H for GRID and RULERS')
  43.  
  44. * Open database, initialize field variables, display first record
  45. USE orders INDEX orders NEW
  46. INITVARS()
  47. EQUVARS()
  48. GET_FUNC()
  49. CLEAR GETS
  50.  
  51. * Set initial position to ADD option
  52. position = 2
  53.  
  54. DO WHILE .T.
  55.  
  56.    * Call AEDBAR with predefined browsing and position variables
  57.    browsing = .F.
  58.    keyhit = AEDBAR(@position)
  59.  
  60.    * AEDBAR sets browsing = .T. on up or down arrow
  61.    IF browsing
  62.        * Equate memory variables to fields
  63.        EQUVARS()
  64.        * Display record and return.
  65.        GET_FUNC()
  66.        CLEAR GETS
  67.        LOOP
  68.    ELSE
  69.        * Test operator selection and call appropriate function(s)
  70.        DO CASE
  71.  
  72.            * Operator selected "QUIT"
  73.            CASE (position = 1 .and. keyhit = K_ENTER) .OR. ;
  74.                    keyhit = KEY_Q .OR. keyhit = KEY_q .OR. ;
  75.                    keyhit = K_ESC
  76.  
  77.               EXIT
  78.  
  79.            * Operator selected "ADD"
  80.            CASE (position = 2 .AND. keyhit = K_ENTER) .OR. ;
  81.                  keyhit = KEY_A .OR. keyhit = KEY_a
  82.  
  83.               AEDMSG('mw_pgdn')
  84.               mw_update = .T.
  85.               helpcode = 'ADD'
  86.               EDIT_FUNC()
  87.               helpcode = ''
  88.  
  89.            * Operator selected "EDIT"
  90.            CASE (position = 3 .AND. keyhit = K_ENTER) .OR. ;
  91.                  keyhit = KEY_E .OR. keyhit = KEY_e
  92.  
  93.               AEDMSG('mw_pgdn')
  94.               mw_update = .T.
  95.               helpcode = 'EDIT'
  96.               EDIT_FUNC()
  97.               helpcode = ''
  98.  
  99.            * Operator selected "FIND"
  100.            CASE (position = 4 .AND. keyhit = K_ENTER) .OR. ;
  101.                  keyhit = KEY_F .OR. keyhit = KEY_f
  102.  
  103.               helpcode = 'FIND'
  104.               FIND_FUNC()
  105.               helpcode = ''
  106.  
  107.            * Operator selected "DELETE"
  108.            CASE (position = 5 .AND. keyhit = K_ENTER) .OR. ; 
  109.                  keyhit = KEY_D .OR. keyhit = KEY_d
  110.  
  111.               mw_update = .T.
  112.               DELE_FUNC()
  113.         ENDCASE
  114.     ENDIF
  115. ENDDO WHILE .T.
  116.  
  117. * Release field memory variables before returning
  118. FREEVARS()
  119. RETURN NIL
  120.  
  121.  
  122. ********************** Internal functions ***********************
  123. *                                                               *
  124. * Note: The procedures below demonstrate concept only.          *
  125. *       In practice they would be much more comprehensive.      *
  126. *                                                               *
  127. *                                                               *
  128. *****************************************************************
  129. STATIC FUNCTION GET_FUNC
  130. *****************************************************************
  131.  
  132. * This procedure issues GETS for field variables
  133.  
  134. @  6, 43 GET morderno PICTURE '@Z 999999' VALID ;
  135.          REQDDATA(morderno) .AND. NODUPL(morderno, 1, orderno)
  136.                        
  137. @  8, 43 GET mcustid  VALID REQDDATA(mcustid)
  138. @ 10, 43 GET mpartno  VALID REQDDATA(mpartno)
  139. @ 12, 43 GET mprice PICTURE '@Z 99.99'
  140.  
  141. RETURN NIL
  142.  
  143.  
  144. *****************************************************************
  145. STATIC FUNCTION EDIT_FUNC
  146. *****************************************************************
  147.  
  148. * Adds or edits a record
  149.  
  150. LOCAL add_flag := IF(helpcode == 'ADD', .T., .F.)
  151.  
  152. IF add_flag
  153.     * If adding records, clear field variables
  154.     CLRVARS()
  155. ELSE
  156.     * Otherwise, we are editing, equate them to fields
  157.     EQUVARS()
  158. ENDIF
  159.  
  160. * Get data to field variables
  161. GET_FUNC()
  162. READ
  163.  
  164.  
  165. IF LASTKEY() != K_ESC
  166.  
  167.     * If we are in add mode add a record
  168.     IF add_flag
  169.        APPEND BLANK
  170.     ENDIF
  171.  
  172.     * Replace record with field variables
  173.     DONEBEEP()
  174.     REPLVARS()
  175.  
  176. ENDIF
  177. RETURN NIL
  178.  
  179. *****************************************************************
  180. STATIC FUNCTION FIND_FUNC
  181. *****************************************************************
  182.  
  183. * Locates and displays a record
  184.  
  185. local find_var := 0
  186.  
  187. SETCOLOR(colhelp1)
  188. @ 21, 20 SAY " Enter number of order to find: " ;
  189.                GET find_var PICTURE '@Z 999999'
  190. READ
  191. SETCOLOR(colstd)
  192.  
  193. * Locate record
  194. SEEK find_var
  195. IF EOF()
  196.     * If it does not exist, reset pointer
  197.     SKIP -1
  198. ELSE
  199.     AEDMSG('mw_pgdn')
  200. ENDIF
  201.  
  202. * Display next logical record (SOFTSEEK is on)
  203. EQUVARS()
  204. GET_FUNC()
  205. CLEAR GETS
  206.  
  207. @ 21, 0
  208. RETURN NIL
  209.  
  210.  
  211. *****************************************************************
  212. STATIC FUNCTION DELE_FUNC
  213. *****************************************************************
  214.  
  215. * Deletes a record
  216.  
  217. AEDMSG('Delete this record? ')
  218. IF OPCONFIRM()
  219.  
  220.     * Delete and move pointer to next logical record
  221.     DELETE
  222.  
  223.     * Display message and wait for 1 second
  224.     AEDMSG('Record deleted')
  225.     DONEBEEP()
  226.     PAUSE(1)
  227.  
  228.     * Move to next or bottom record
  229.     IF ! EOF()
  230.         SKIP
  231.     ELSE
  232.         GO BOTTOM
  233.     ENDIF
  234.     AEDMSG('mw_pgdn')
  235. ENDIF
  236.  
  237. * Display record
  238. EQUVARS()
  239. GET_FUNC()
  240. CLEAR GETS
  241. RETURN NIL
  242.  
  243.  
  244. *****************************************************************
  245. FUNCTION HOTKEYS (callproc, linenum, inputvar, keypress)
  246. *****************************************************************
  247.  
  248. * Process function key (hot key) calls for non-wait states
  249.  
  250. * HOTKEYS is called by all Developer's Library functions that
  251. * simulate wait states. It calls the procedure named in the 
  252. * variable "apphelp" if the F1 key is pressed. For all other
  253. * special keys, you can call your own "hotkey" procedure from
  254. * HOTKEYS. Your procedure can be passed additional parameters.
  255.  
  256. * The code below calls some dummy functions contained in this
  257. * file.
  258.  
  259. IF keypress = K_F1
  260.      &apphelp(callproc, linenum, inputvar)
  261.  
  262. ELSEIF keypress = K_F2
  263.      HOTKEY_2()
  264.  
  265. ELSEIF keypress = K_F3
  266.      HOTKEY_3()
  267.  
  268. ELSEIF TYPE('DEVELOP()') == 'UI'
  269.  
  270.     * DEVELOP function is linked, set its hotkeys
  271.  
  272.     IF keypress = 303         && --- Alt-V key
  273.        VRULER()
  274.     ELSEIF keypress = 291     && --- Alt-H key
  275.        HRULER()
  276.     ELSEIF keypress = 290     && --- Alt-G key
  277.        GRID()
  278.     ENDIF
  279.  
  280. ENDIF
  281.  
  282. RETURN
  283.  
  284. *****************************************************************
  285. FUNCTION SYSHELP
  286. *****************************************************************
  287.  
  288. * Note: This function is called by F1 instead of the library 
  289. *       SYSHELP function for demonstration only.
  290.  
  291.  
  292. LOCAL old_screen := SCRNSAVE(21,0,21,79)
  293.  
  294. CENTERON(21, 'This is a simulated call to SYSHELP from key F1')
  295. ERRORBEEP(1)
  296. PAUSE(2)
  297. SCRNREST(old_screen)
  298. RETURN NIL
  299.  
  300.  
  301. *****************************************************************
  302. FUNCTION HOTKEY_2
  303. *****************************************************************
  304.  
  305. * Dummy hot key function called by F2
  306.  
  307. LOCAL old_screen := SCRNSAVE(21,0,21,79)
  308. CENTERON(21, 'This is the hotkey function called by F2')
  309. ERRORBEEP(2)
  310. PAUSE(1.5)
  311. SCRNREST(old_screen)
  312. RETURN NIL
  313.  
  314.  
  315. *****************************************************************
  316. FUNCTION HOTKEY_3
  317. *****************************************************************
  318.  
  319. * Dummy hot key function called by F3
  320.  
  321. LOCAL old_screen := SCRNSAVE(21,0,21,79)
  322. CENTERON(21, 'This is the hotkey function called by F3')
  323. ERRORBEEP(3)
  324. PAUSE(1.5)
  325. SCRNREST(old_screen)
  326. RETURN NIL
  327.  
  328.  
  329.