Shareware Overload/ShartewareOverload.cdr/database/members.zip/MDPROC.PRG

Text File | 1986-10-21 | 5KB | 212 lines

*----------------------------------------------------------------------
* Program : Membership Database
* File    : MDPROC
* Function: Resident Procedures.
* Author  : J. North
* Version : (AT contest)
* Date    : 10/15/86
*----------------------------------------------------------------------
*
PROCEDURE set_dim
    if iscolor()
        set color to bg/n,+g/n
    else
        set color to w/n,w/n
    endif
RETURN
*
PROCEDURE set_brt
    if iscolor()
        set color to +bg/n,+g/n
    else
        set color to w/n,w/n
    endif
RETURN
*
PROCEDURE set_rv
    if iscolor()
        set color to +g/n,+g/n
    else
        set color to i,i
    endif
RETURN
*
PROCEDURE clwait
    clear
    if iscolor()
        set color to w*+/r
    else
        set color to i,i
    endif
    @ 1, 73 say "WAIT"
    do set_dim
RETURN
*
PROCEDURE dialog
    parameters line,msg
    private mc
    mc=int((80-len(msg))/2)
    @ line-1,mc-2 to line+1,mc+len(msg)+1 double
    @ line,mc say msg
    ? chr(7)
RETURN
*
PROCEDURE not_imp
    @ 19, 10 say "The selection you chose is not implemented in this version."
    ? chr(7)
    mn_draw=.F.
RETURN
*
PROCEDURE clr_imp
    @ 19,0 clear to 19,79
RETURN
*
PROCEDURE show_dev
    do case
        case m_device=0
            @ 8,67 say "Printer"
        case m_device=1
            @ 8,67 say "Screen "
    endcase
RETURN
*
PROCEDURE put_mgrp
    dm="dm_"+ltrim(str(m_grp,2,0))
    do &dm
RETURN
*
PROCEDURE put_main
    clear
    @  0,  0  to  2, 79    DOUBLE
    @  4,  0  to  4, 79
    @ 20,  0  to 24, 79    DOUBLE
    @  1,  2  say "MEMBERS -- Membership Database Package                    Main Function Menu"
    @ 21,  2  say "Use the function keys (F1-F10) to make a selection from the displayed menu."
    @ 22,  2  say "Display other menus by pressing the first letter of the menu name, or by"
    @ 23,  2  say "using the right & left arrow keys.  Press Ctrl-End to exit the program."
RETURN
*
PROCEDURE dm_1
    @  5,  0  clear to 19,79
    @  5,  0  to 10, 29 double
    @  7,  1  to  7, 28
    do set_brt
    @  3,  1  say "*  Edit  Setup  Reports  Help"
    @  6,  2  say 'F1 - About "*" ...'
    @  8,  2  say "F2 - Set Function Key Text"
    @  9,  2  say "F3 - List Field Names"
    do set_rv
    @  3,  1  say "*"
    do set_dim
    mk_min=-2
RETURN
*
PROCEDURE dm_2
    @  5,  0  clear to 19,79
    @  5,  3  to 12, 35 double
    @  7,  4  to  7, 34
    do set_brt
    @  3,  1  say "*  Edit  Setup  Reports  Help"
    @  6,  5  say 'F1 - About "Edit" ...'
    @  8,  5  say "F2 - Edit Membership Database"
    @  9,  5  say "F3 - Recall Deleted Members"
    @ 10,  5  say "F4 - Remove Deleted Members"
    @ 11,  5  say "F5 - Re-Index Database"
    do set_rv
    @  3,  4  say "Edit"
    do set_dim
    mk_min=-4
RETURN
*
PROCEDURE dm_3
    @  5,  0  clear to 19,79
    @  5,  9  to  11, 51 double
    @  7, 10  to  7, 50
    do set_brt
    @  3,  1  say "*  Edit  Setup  Reports  Help"
    @  6, 11  say 'F1 - About "Setup" ...'
    @  8, 11  say "F2 - Create/Modify Query Specification"
    @  9, 11  say "F3 - Create/Modify Report Specification"
    @ 10, 11  say "F4 - Create/Modify Label Specification"
    do set_rv
    @  3, 10  say "Setup"
    do set_dim
    mk_min=-3
RETURN
*
PROCEDURE dm_4
    @  5,  0  clear to 19,79
    @  5, 16  to 10, 47 double
    @  7, 17  to  7, 46
    do set_brt
    @  3,  1  say "*  Edit  Setup  Reports  Help"
    @  6, 18  say 'F1 - About "Reports" ...'
    @  8, 18  say "F2 - List Member Information"
    @  9, 18  say "F3 - Print Mailing Labels"
    do set_rv
    @  3, 17  say "Reports"
    do set_dim
    mk_min=-2
RETURN
*
PROCEDURE dm_5
    @  5,  0  clear to 19,79
    @  5, 25  to 10, 54 double
    @  7, 26  to  7, 53
    do set_brt
    @  3,  1  say "*  Edit  Setup  Reports  Help"
    @  6, 27  say 'F1 - About "MEMBERS" ...'
    @  8, 27  say "F2 - Display Documentation"
    @  9, 27  say "F3 - Print Documentation"
    do set_rv
    @  3, 26  say "Help"
    do set_dim
    mk_min=-2
RETURN
*
PROCEDURE set_mgrp
    do case
        case chr(mn_key)$"*8" .and. m_grp#1
            m_grp=1
            do dm_1
        case chr(mn_key)$"Ee" .and. m_grp#2
            m_grp=2
            do dm_2
        case chr(mn_key)$"Ss" .and. m_grp#3
            m_grp=3
            do dm_3
        case chr(mn_key)$"Rr" .and. m_grp#4
            m_grp=4
            do dm_4
        case chr(mn_key)$"Hh" .and. m_grp#5
            m_grp=5
            do dm_5
        case mn_key=4
            m_grp=iif(m_grp=5,1,m_grp+1)
            do put_mgrp
        case mn_key=19
            m_grp=iif(m_grp=1,5,m_grp-1)
            do put_mgrp
    endcase
RETURN
*
PROCEDURE d_mbr
    clear gets
    @  2, 11  say  recno() picture "99999"
    @  4, 13  get  FIRST_NAME
    @  4, 42  get  LAST_NAME
    @  6, 12  get  COMPANY
    @  7, 12  get  ADDRESS_1
    @  8, 12  get  ADDRESS_2
    @  9, 12  get  CITY
    @ 10, 12  get  STATE  picture "!!"
    @ 10, 29  get  ZIP  picture "99999"
    @  6, 61  get  HOME_PHONE  picture "[phone]"
    @  8, 61  get  WORK_PHONE  picture "[phone]"
    @ 10, 61  get  EXP_DATE
    @ 12, 18  get  MEMBR_TYPE  picture "!!"
    @ 12, 38  get  CHAPTER  picture "!!"
    @ 12, 62  get  OCCUPATION  picture "!!,!!,!!"
    @ 21, 39  get  DISTRIBUTE  picture "@R Y"
RETURN