home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / DBTALK.ZIP / DBTALK / SOURCE / LASER.PRG < prev    next >
Encoding:
Text File  |  1993-06-02  |  11.2 KB  |  388 lines
  1. *****************************************************************************
  2. *                                                                           *
  3. * dbTALK Laser Disk Sample Application                                      *
  4. * Adapted by Dele Olajide                                                   *
  5. * January 1993                                                              *
  6. *                                                                           *
  7. *****************************************************************************
  8.  
  9. * Define Compiler Constants
  10.  
  11. #DEFINE HELP    28
  12. #DEFINE K_ESC   27
  13. #DEFINE K_DOWN  24
  14. #DEFINE K_UP    5
  15. #DEFINE K_RIGHT 4
  16. #DEFINE K_LEFT  19
  17. #DEFINE K_HOME  1
  18. #DEFINE K_END   6
  19. #DEFINE K_PGUP  18
  20. #DEFINE K_PGDN  3
  21. #DEFINE BROWSE  98
  22. #DEFINE REPORT  114
  23. #DEFINE CATEGORY 99
  24. #DEFINE ABOUT   1203
  25. #DEFINE CHART   -5
  26. #DEFINE LINE    -10
  27. #DEFINE BAR2D   -11
  28. #DEFINE BAR3D   -12
  29. #DEFINE PRINT_WP  1301
  30. #DEFINE PRINT_TXT 1302
  31. #DEFINE PRINT_123 1303
  32. #DEFINE PRINT_PRN 1304
  33.  
  34.  
  35. * Main Program Starts
  36.  
  37. FUNCTION Main
  38.    PRIVATE oLaserScrn, oDbView, oBrowseScrn, oLaserTab, oLaserHelp, oDesc
  39.    PRIVATE oLaserRep, oLaserChart, HelpText, nHelp
  40.    PRIVATE nEvent, lRefresh, aButts, aCateg, nMemory, LaserRep
  41.    PRIVATE oPrintScrn, oLaserWP, oLaserLST, oLaser123, oLaserTXT
  42.  
  43. *  Declare Menu Structure
  44.    PRIVATE mtext   := {"File",  "Edit", "About"}
  45.    PRIVATE mkey    := { 289,     274,   286}
  46.    PRIVATE mfile_t := {{"Browse", "Chart", "Report", "Exit"}, {"Next","Previous"}, {"About"}}
  47.    PRIVATE mfile_k := {{BROWSE, CATEGORY, REPORT, K_ESC},{K_RIGHT, K_LEFT}, {ABOUT}}
  48.  
  49. *  Declare Browse GETSET Blocks
  50.    PRIVATE catnoblk:={|| laser->catno}
  51.    PRIVATE titleblk:={|| left(laser->title, 25)}
  52.    PRIVATE priceblk:={|| transform(laser->price, '##.##')}
  53.  
  54. *  Declare Browse Skip Blocks
  55.    PRIVATE bblk:={||  oDbView:Send('GoBottom','LASER')}
  56.    PRIVATE tblk:={||  oDbView:Send('GoTop','LASER')}
  57.    PRIVATE sblk:={|n| oDbView:Send('Skip','LASER',n)}
  58.  
  59. *  Declare Browse Action Block
  60.    PRIVATE ablk:={|nkey|  self:Send('NoEdits', nkey)}
  61.  
  62. *  Declare Browse Structure
  63.    PRIVATE bcols:={{'CATLOG NO', catnoblk}, {'TITLE', titleblk}, {'PRICE', priceblk}}
  64.  
  65. *  Declare Report Field Blocks
  66.    PRIVATE bFld1:={||laser->catno}
  67.    PRIVATE bFld2:={||laser->title}
  68.    PRIVATE bFld3:={||acateg[laser->ncat]}
  69.  
  70. *  Declare Report Field Structures
  71.    PRIVATE aFld1:={bFld1, 'laser->catno', 'C', {'Catalog Number'}, 10, 0, .F., '@!'}
  72.    PRIVATE aFld2:={bFld2, 'laser->title', 'C', {'Film Title'}, 50, 0, .F., '@!'}
  73.    PRIVATE aFld3:={bFld3, 'acateg[laser->ncat]', 'C', {'Category'}, 18, 0, .F., '@!'}
  74.  
  75. *  Declare Report Structure
  76.    Laserrep:={{'Laser Collection','Listing of Films'},80,0,0,66,1,.f.,.f.,.f.,.f.,{afld1,afld2,afld3},{},''}   
  77.  
  78. *  Declare Film Category Descriptions
  79.    aCateg = {'Action','Mystery','Suspense','Childrens','Comedy','Documentery',;
  80.              'Drama','Foreign','Horror','Music','Musical','Sci-fiction'}
  81.  
  82. *  Declare all ADLClass Objects
  83.    oDbView =     ADLClass('DBF', laservew)
  84.    oDbView:Send('Open') 
  85.    oDbView:Send('SetOrder',1)    // Open Creates MEM variables for SCN Classes
  86.    
  87.    oBrowseScrn:= ADLClass('SCN', laserbrw)
  88.    oLaserScrn:=  ADLClass('SCN', laserscr)
  89.    oLaserChart:= ADLClass('SCN', lasercht)
  90.    oLaserHelp:=  ADLClass('SCN', laserhlp)
  91.    oPrintScrn:=  ADLClass('SCN', laserprn)
  92.    oLaserRep:=   ADLClass('REP', laserrep)
  93.    oLaserTab :=  ADLClass('TAB', {bcols, bblk, tblk, sblk, ablk})
  94.    oLaserWp:=    ADLClass('WP', {'WP', 'laser.doc', ''} )
  95.    oLaserTxt:=   ADLClass('TXT', 'laser.doc')
  96.    oLaserLST:=   ADLClass('PRN')
  97.    oLaser123:=   ADLClass('WP', {'123', 'laser.wk1', ''} )
  98.  
  99.    SetTimer(750)    // Setup Timer Event after 750 keyboard scans
  100.  
  101.    oDbView:Send('Read','LASER')    // Process First Record
  102.    nCat = pad(aCateg [nCat], 15)
  103.  
  104.    oLaserScrn:Send('AttachMenu', {'Laser Disk Collection System',mtext,mkey,mfile_t,mfile_k})
  105.    oLaserScrn:Send('Bar')
  106.    oLaserScrn:Send('Display',sanserif)
  107.    oDesc = oLaserScrn:Send('Object', 'DESC')     // Setup Main Screen
  108.  
  109.    lRefresh = .F.
  110.    nHelp = 1              // Setup Default help screen
  111.    nEvent = oLaserScrn:Send('Read')
  112.  
  113. *  Enter Main Event Loop
  114.    DO WHILE .T.
  115.  
  116.       DO CASE
  117.       CASE nEvent = K_ESC                           // End of Application
  118.   
  119.            IF YESNOBOX ('Warning', 'Do you wish to Quit')
  120.               EXIT
  121.            ENDIF
  122.       
  123.       CASE nEvent = K_RIGHT                         // Next Record
  124.            IF ! oDbView:Send('Skip', 'LASER', 1) = 0
  125.               lRefresh = .T.
  126.            ENDIF
  127.  
  128.       CASE nEvent = K_LEFT                          // Previous Record
  129.            IF ! oDbView:Send('Skip', 'LASER', -1) = 0
  130.               lRefresh = .T.
  131.            ENDIF
  132.  
  133.       CASE nEvent = K_PGUP                           // 10 recs backward
  134.            IF ! oDbView:Send('Skip', 'LASER', -10) = 0
  135.               lRefresh = .T.
  136.            ENDIF
  137.  
  138.       CASE nEvent = K_PGDN                           // 10 recs forward
  139.            IF ! oDbView:Send('Skip', 'LASER', 10) = 0
  140.               lRefresh = .T.
  141.            ENDIF
  142.  
  143.       CASE nEvent = K_HOME                          // First Record
  144.            oDbView:Send('GoTop', 'LASER')
  145.            lRefresh = .T.
  146.  
  147.       CASE nEvent = K_END                           // Last Record
  148.            oDbView:Send('GoBottom', 'LASER')
  149.            lRefresh = .T.
  150.  
  151.       CASE nEvent = BROWSE
  152.            nHelp = 2
  153.            self:Send('BrowseLaser')
  154.  
  155.       CASE nEvent = REPORT
  156.            self:Send('LaserList')
  157.  
  158.       CASE nEvent = CATEGORY
  159.            IF YESNOBOX('Chart Categories','Do you wish to continue')
  160.               nHelp = 3          // Set help Context
  161.               oLaserScrn:Send('Message', 'Please Wait...')
  162.               self:Send('LaserChart')
  163.            ENDIF
  164.    
  165.       CASE nEvent = ABOUT
  166.            nMemory = memory(0)
  167.            MsgBox('About', ExpandText(GetPointer(aboutmsg)), drawer)
  168.       ENDCASE
  169.  
  170.  
  171.       IF lRefresh .and. ! oDbView:Send('eof', 'LASER') .and. ! oDbView:Send('bof', 'LASER')
  172.  
  173.          BEGIN                          
  174.           oDbView:Send('Read', 'LASER') // Different Record  Refresh Screen
  175.           nCat = pad(aCateg [nCat], 15)
  176.           oLaserScrn:Send('Refresh')
  177.           oLaserScrn:Send('Message', space(50))
  178.          END
  179.       ENDIF
  180.  
  181.       lRefresh = .F.              // Reset for Next Record
  182.       nHelp = 1
  183.       nEvent = oLaserScrn:Send('Read')
  184.    ENDDO
  185.  
  186.    oLaserScrn:Send('Clear')           
  187.    QUIT()
  188.    RETURN
  189.  
  190.  
  191.  
  192. * Routine called everytime a field is selected
  193.  
  194. FUNCTION Select
  195.    PARAMETER cFld, oFld, oScr
  196.    PRIVATE lSelect:=.F.
  197.  
  198.    IF cFld = 'OLASERTAB' .or. cFld = 'DESC'  // allow desc & browse to
  199.       lSelect = .T.                          // be selected
  200.    ENDIF
  201.    RETURN lSelect
  202.  
  203.  
  204.  
  205. * Routine called everytime a field is de-selected
  206.  
  207. FUNCTION Unselect
  208.    PARAMETER cFld, oFld, oScr
  209.    PRIVATE lValid:=.T.
  210.  
  211.    IF cFld = 'DESC'             // Update Database with desc changes
  212.       oDesc:Send('Refresh')
  213.       laser->desc = m->desc
  214.       oLaserScrn:Send('Message', 'Comments have been updated')
  215.    ENDIF
  216.  
  217.    RETURN lValid
  218.  
  219.  
  220.  
  221. * Routine called everytime a hotspot is clicked on a screen
  222.  
  223. FUNCTION Click
  224.    PARAMETER nEvent
  225.    RETURN nEvent
  226.  
  227.  
  228.  
  229. * Routine called everytime an event a received
  230.  
  231. FUNCTION Handle
  232.    PARAMETER nEvent
  233.  
  234.    IF nEvent = HELP
  235.       HelpText = HelpText (nHelp)  
  236.       oLaserHelp:Send('Display',sanserif)
  237.       oLaserHelp:Send('Wait')
  238.       oLaserHelp:Send('Clear')
  239.    ENDIF
  240.  
  241.    oLaserScrn:Send('Message', 'Time '+time())
  242.    RETURN nEvent
  243.  
  244.  
  245.  
  246. * Routine to Browse laser Collection
  247.  
  248. FUNCTION BrowseLaser
  249.    BEGIN                                     
  250.     oBrowseScrn:Send('Display',courier)   
  251.     nEvent = oBrowseScrn:Send('Wait')   // Handle within Click
  252.     oDbView:Send('Read', 'LASER')
  253.     nCat = pad(aCateg [nCat], 15)
  254.     oBrowseScrn:Send('Clear')           
  255.     oLaserScrn:Send('Message', space(50))
  256.    END
  257.    RETURN
  258.  
  259.  
  260.  
  261. * Routine to Disable editing in browse called by browse Action parameter
  262.  
  263. FUNCTION NoEdits
  264.    PARAMETER nKey
  265.  
  266.    IF nKey = 13
  267.       nKey = 0
  268.       oLaserScrn:Send('Message', 'No Editing Allowed')
  269.    ENDIF
  270.    RETURN nKey
  271.  
  272.  
  273.  
  274. FUNCTION LaserList
  275.    PRIVATE oLaserPrn
  276.  
  277.    oPrintScrn:Send('Display',courier)   // Get Destination Device
  278.    nEvent = oPrintScrn:Send('Read')
  279.    
  280.    WHILE ! nEvent = K_ESC         // User cancels print
  281.  
  282.    DO CASE                   
  283.       CASE nEvent = PRINT_WP    // Assign Print Object
  284.              oLaserPrn = oLaserWp
  285.              EXIT
  286.         CASE nEvent = PRINT_TXT
  287.              oLaserPrn = oLaserTxt
  288.              EXIT
  289.         CASE nEvent = PRINT_123
  290.              oLaserPrn = oLaser123
  291.              EXIT
  292.         CASE nEvent = PRINT_PRN
  293.              oLaserPrn = oLaserLST
  294.              EXIT
  295.         ENDCASE
  296.  
  297.         nEvent = oPrintScrn:Send('Read')
  298.    ENDDO
  299.  
  300.    IF ! nEvent = K_ESC        // User Selects Print device
  301.         BEGIN
  302.           oLaserPrn:Send('Open')                          // Start Printing
  303.           oLaserRep:Send('Initiate', oLaserPrn, '')
  304.           oDbView:Send('Gotop','LASER')
  305.         END
  306.  
  307.  
  308.         DO WHILE ! oDbView:Send('eof', 'LASER')          // Until last record
  309.            BEGIN
  310.              oLaserRep:Send('Generate')
  311.              oLaserScrn:Send('Message', laser->title+' has been printed')
  312.              oDbView:Send('skip','LASER',1)
  313.            END
  314.         ENDDO
  315.  
  316.  
  317.         BEGIN
  318.          oDbView:Send('Gotop','LASER')     // Reset to first rec  
  319.          oLaserRep:Send('Terminate')           
  320.          oLaserPrn:Send('Close')
  321.         END
  322.  
  323.    ENDIF
  324.  
  325.    BEGIN
  326.     oPrintScrn:Send('Clear')               // Tidup, restore screen
  327.     oLaserScrn:Send('Message', space(50))
  328.    END
  329.    RETURN NIL
  330.  
  331.  
  332.  
  333.  
  334. FUNCTION LaserChart
  335.    PRIVATE oChart, aChart
  336.    PRIVATE aChartXaxis, aChartVals, aChartValBlk:={|| aChartVals}
  337.  
  338.    aChartVals  = {{ 0,0,0,0,0,0,0,0,0,0,0,0 }}
  339.    aChartXaxis = {'ACT','MYS','SUS','CHI','COM','DOC','DRA','FOR','NOR','MUS','MSC','SCF'}
  340.  
  341.    oDbView:Send('Gotop','LASER')
  342.  
  343.    DO WHILE ! oDbView:Send('eof', 'LASER') 
  344.       BEGIN
  345.         aChartVals[1, laser->nCat] = aChartVals[1, laser->nCat] + 1
  346.         oDbView:Send('skip','LASER',1)
  347.       END
  348.    ENDDO
  349.  
  350.    BEGIN
  351.     oLaserScrn:Send('Message', space(50))
  352.     oLaserChart:Send('Display',courier)
  353.     aChart = oLaserChart:Send('Attributes', CHART)
  354.     oChart = ADLClass('CHT', {aChart, aChartValBlk, aChartXaxis, 'Distribution of Film Categories'} )
  355.     oChart:Send('LineGraph')
  356.     nEvent = oLaserChart:Send('Read')
  357.    END
  358.  
  359.    DO WHILE nEvent <> 27        // Until user requests end, select
  360.       DO CASE                   // Graph and print it. generate PIC files
  361.       CASE nEvent = LINE
  362.         oChart:Send('LineGraph','LINEGRPH.PIC')
  363.  
  364.       CASE nEvent = BAR2D
  365.         oChart:Send('Bar2D', 'BAR2GRPH.PIC')
  366.  
  367.       CASE nEvent = BAR3D
  368.         oChart:Send('Bar3D', 'BAR3GRPH.PIC')
  369.       ENDCASE
  370.  
  371.       nEvent = oLaserChart:Send('Read')
  372.    ENDDO
  373.  
  374.    BEGIN
  375.     oDbView:Send('Gotop', 'LASER')       // Reset to First Record
  376.     oDbView:Send('Read', 'LASER')
  377.     nCat = pad(aCateg [nCat], 15)
  378.     oLaserChart:Send('Clear')           
  379.     oLaserScrn:Send('Message', space(50))
  380.    END
  381.    RETURN
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.