home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a039 / 1.ddi / VIDEO.ZIP / VID-PAL.SC < prev    next >
Encoding:
Text File  |  1992-08-08  |  7.3 KB  |  189 lines
  1. ; Vid-PAL.SC -  Script to generate VIDEO.LIB containing the following
  2. ;               procedures, which are part of the Video Store example
  3. ;               application.
  4. ;
  5. ; Chime()           - Play a 3-note musical alarm.
  6. ;
  7. ; VideoStartup()    - Ask for a password before continuing.
  8. ;
  9. ; ShowVideoStatus() - Display statistics about the size of the video
  10. ;                     store's database (number of customers on file,
  11. ;                     etc.)  This procedure is used to demonstrate
  12. ;                     the Workshop's ability to call a user-defined
  13. ;                     proc from the application menu.
  14. ;
  15. ; SetCustNo()       - Assign a customer number to a new customer.  This
  16. ;                     is an example of a user-defined procedure called
  17. ;                     during the execution of an edit session.
  18. ;
  19. ; CalcCharge()      - Extend the rental fee amount while processing a
  20. ;                     return.
  21.  
  22.  
  23. CreateLib "Video" Size 50             ; (50 is the min. number of procs/lib)
  24.  
  25. ;--------------------------------------------------------------------
  26. Proc Chime()                          ; Sound off a 3-note "chime"
  27.                                       ; used by VideoStartup() (below)
  28. Private G,Middle_C,High_G,
  29.         Quarter_Note,Half_Note
  30.    G        = Int(440*Pow(2,-2/12))
  31.    Middle_C = Int(440*Pow(2,3/12))
  32.    High_G   = Int(440*Pow(2,10/12))
  33.    Quarter_Note = 337
  34.    Half_Note    = 675
  35.  
  36.    Sound Middle_C Quarter_Note
  37.    Sound G        Quarter_Note
  38.    Sound High_G   Half_Note
  39. EndProc
  40. WriteLib "Video" Chime
  41. Release Procs Chime
  42.  
  43.  
  44. ;--------------------------------------------------------------------
  45. Proc VideoStartup()                   ; Proc to control initializtion of
  46.                                       ; the video application
  47. Private StatWindow,StatWindowSpecs,EventBag,
  48.         AuthCode,TimeofDay,Okay,Authorized,Hour,ValidTime
  49.    ClearAll
  50.    AuthCode = ""
  51.    ShowDialog "Video Application Startup"
  52.    @ 17,5 Height 7 Width 69
  53.      @ 1,2 ?? "Please Enter Your Authorization Code (\"BORLAND\"):"
  54.      Accept @1,52 Width 13 "A10" Picture "*!" Tag "Auth" to AuthCode
  55.      ;Note: the accept statement above could have included the Hidden keyword
  56.      Pushbutton @3,27 Width 12 "~O~K" OK Default Value True Tag "OK" to Okay
  57.    EndDialog
  58.    Authorized = (AuthCode="BORLAND")  ; Check password (true/false)
  59.    If Authorized then                 ; okay to continue with application
  60.      Return True
  61.    EndIf
  62.  
  63.    DynArray StatWindowSpecs[]           ; (used in following Window Create)
  64.    StatWindowSpecs["HasFrame"] = False  ; No Frame
  65.    StatWindowSpecs["Width"]    = 60     ; Viewport Size
  66.    StatWindowSpecs["Height"]   =  9
  67.    StatWindowSpecs["CanvasWidth"]    = 60 ; Canvas Size
  68.    StatWindowSpecs["CanvasHeight"]   =  9
  69.    Window Create Floating
  70.      @ 1,10                           ; where to place the window
  71.      Attributes StatWindowSpecs       ; (from above) no border around window
  72.      To StatWindow                    ; window handle
  73.    Text
  74.  
  75.    Unauthorized Access
  76.    ─────────────────────────────────────────────────────
  77.    A proper authorization code is required to run this
  78.    application.
  79.  
  80.    Press any key to abort...
  81.  
  82.    EndText
  83.    Chime()                            ; alert user of a problem
  84.    GetEvent Key "ALL" Mouse "DOWN" To EventBag; wait for a keypress or mouse click
  85.    Window Close
  86.    Return False                       ; tell the Workshop to exit to DOS
  87. EndProc
  88. WriteLib "Video" VideoStartup
  89. Release Procs VideoStartup
  90.  
  91.  
  92. ;--------------------------------------------------------------------
  93. Proc ShowVideoStatus()                ; Proc to display statistics
  94.                                       ; about the Video Store database.
  95. Private StatWindow,StatWindowSpecs,EventBag
  96.    ClearAll
  97.    DynArray StatWindowSpecs[]         ; (used in following Window Create)
  98.    StatWindowSpecs["HasFrame"] = False
  99.    StatWindowSpecs["Width"]    = 60     ; Viewport Size
  100.    StatWindowSpecs["Height"]   = 15
  101.    StatWindowSpecs["CanvasWidth"]    = 60 ; Canvas Size
  102.    StatWindowSpecs["CanvasHeight"]   = 15
  103.    Window Create Floating
  104.      @ 5,10                           ; where to place the window
  105.      Attributes StatWindowSpecs       ; (from above) no border around window
  106.      To StatWindow                    ; window handle
  107.    Text
  108.  
  109.    Current status of the Video Store database
  110.    ────────────────────────────────────────────────────
  111.    Customers on file ............................
  112.    Number of film titles in the catalog .........
  113.    Total tape inventory .........................
  114.    Tapes currently rented out ...................
  115.  
  116.  
  117.  
  118.  
  119.    Press any key to continue...
  120.  
  121.    EndText
  122.    @ 3,50 ?? NRecords("Customer")
  123.    @ 4,50 ?? NRecords("Films")
  124.    FilmCount = CSum("Films","# of Copies")
  125.    @ 5,50 ?? FilmCount
  126.    @ 6,50 ?? FilmCount - CSum("Films","# in Stock")
  127.    Message "Press any key to continue."
  128.    GetEvent Key "ALL" Mouse "DOWN" To EventBag; wait for a keypress or mouse click
  129.    Window Close
  130.    Message ""; clear the message
  131.    Window Close
  132. EndProc
  133. WriteLib "Video" ShowVideoStatus
  134. Release Procs ShowVideoStatus
  135.  
  136.  
  137. ;--------------------------------------------------------------------
  138. Proc SetCustNo()                      ; Proc to assign a customer no.
  139.                                       ; This proc is attached to the
  140.                                       ; "ADDCUST" edit session as an
  141.                                       ; arrive-record event proc.
  142.                                       ; It finds the highest number
  143.                                       ; used so far and a increments
  144.                                       ; it by one.  While we're at it,
  145.                                       ; we'll establish a membership
  146.                                       ; expiration date.
  147. Private CustNo
  148.   If IsBlank([Customer #]) Then       ; customer record needs a number
  149.     CustNo = CMax("Customer","Customer #"); find highest number assigned so far
  150.     If CustNo = "Error" Then CustNo = 0 EndIf
  151.     [Customer #] = Int(CustNo+1)        ; set the next number
  152.   EndIf
  153.   If IsBlank([Expiration]) Then       ; establish an expiration date
  154.     [Expiration] = Today()+364
  155.   EndIf
  156.   Return 0                            ; 0 = okay to proceed
  157. EndProc
  158. WriteLib "Video" SetCustNo
  159. Release Procs SetCustNo
  160.  
  161.  
  162. ;--------------------------------------------------------------------
  163. Proc CalcCharge()                     ; Proc to extend the rental fee.
  164.                                       ; This proc is attached to the
  165.                                       ; "RETURNS" edit session as a
  166.                                       ; leave-field event proc.
  167. Private CustNo
  168.   If Field() = "Return Date" Then     ; (try to) calculate days out
  169.     If IsBlank([]) or [Date]>[] Then  ; can't calculate days out yet
  170.       [Days Out] = 0
  171.     Else
  172.       [Days Out] = Max(1,[Return Date]-[Date]) ; same-day counts as 1 day
  173.     EndIf
  174.   EndIf
  175.  
  176.   If (Field() = "Return Date" or Field() = "Rewound?")
  177.   And Not IsBlank([Days Out])
  178.   And Not IsBlank([Rental Rate]) Then    ; extend the charges
  179.     [Total Due] = [Rental Rate]*[Days Out]
  180.       +IIf(Upper([Rewound?])="Y",0,1) ; add $1 rewinding charge
  181.   EndIf
  182.  
  183.   Return 0                            ; 0 = okay to proceed
  184. EndProc
  185. WriteLib "Video" CalcCharge
  186. Release Procs CalcCharge
  187.  
  188.  
  189.