home *** CD-ROM | disk | FTP | other *** search
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ 12/15/92 ADDUSERS.PRG 12:44:08 ║
- * ║ ║
- * ╟─────────────────────────────────────────────────────────╢
- * ║ ║
- * ║ Microsoft FoxPro Application Development ║
- * ║ ║
- * ║ Copyright (c) 1992 Microsoft Corporation ║
- * ║ One Microsoft Way ║
- * ║ Redmond, WA 98052 ║
- * ║ ║
- * ║ Description: ║
- * ║ This program was automatically generated by GENSCRN. ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
-
- PARAMETERS m.cardid
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ ADDUSERS/Windows Setup Code - SECTION 1 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- #REGION 1
-
-
- #REGION 0
- REGIONAL m.currarea, m.talkstat, m.compstat
-
- IF SET("TALK") = "ON"
- SET TALK OFF
- m.talkstat = "ON"
- ELSE
- m.talkstat = "OFF"
- ENDIF
- m.compstat = SET("COMPATIBLE")
- SET COMPATIBLE FOXPLUS
-
- m.rborder = SET("READBORDER")
- SET READBORDER ON
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ Windows Window definitions ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- IF NOT WEXIST("_qbm0rap0q")
- DEFINE WINDOW _qbm0rap0q ;
- AT 0.000, 0.000 ;
- SIZE 17.692,61.167 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B" ;
- FLOAT ;
- NOCLOSE ;
- SHADOW ;
- NOMINIMIZE ;
- DOUBLE
- MOVE WINDOW _qbm0rap0q CENTER
- ENDIF
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ ADDUSERS/Windows Setup Code - SECTION 2 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- #REGION 1
- PRIVATE m.mover, m.user, m.allcnt, m.saverec, m.usrcnt, m.limit, ;
- allusers, m.status, m.savearea, m.userlast, m.userfirst
-
- SET EXACT ON
- m.user = 1
- m.userlast = ""
- m.status = .T.
- m.savearea = SELECT()
- DIMENSION allusers[1,3]
- allusers = ""
-
- IF NOT locatedb("carduser",1)
- RETURN
- ENDIF
-
- m.saverec = RECNO()
- SELECT DISTINCT lastname, firstname, ;
- ALLTRIM(firstname)+" "+ALLTRIM(lastname) ;
- FROM carduser ;
- INTO ARRAY allusers
-
- m.allcnt = ALEN(allusers,1)
-
- IF EMPTY(users)
- m.usrcnt = 0
- ELSE
- m.usrcnt = 1
- m.limit = ALEN(users,1)
- DO WHILE m.usrcnt <= m.limit
- IF EMPTY(users[m.usrcnt,1])
- EXIT
- ENDIF
- m.usrcnt = m.usrcnt + 1
- ENDDO
- m.usrcnt = m.usrcnt - 1
- ENDIF
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ ADDUSERS/Windows Screen Layout ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- #REGION 1
- IF WVISIBLE("_qbm0rap0q")
- ACTIVATE WINDOW _qbm0rap0q SAME
- ELSE
- ACTIVATE WINDOW _qbm0rap0q NOSHOW
- ENDIF
- @ 14.385,16.500 SAY "Last:" ;
- SIZE 1.000,4.833, 0.000 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B"
- @ 14.385,3.000 SAY "First:" ;
- SIZE 1.000,4.833, 0.000 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B"
- @ 2.308,23.667 GET m.mover ;
- PICTURE "@*VN \<Move =>;<= \<Remove;\\Remove \<All" ;
- SIZE 1.769,14.167,1.000 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B" ;
- VALID _qbm0rapvk()
- @ 1.923,2.000 GET m.alluser ;
- PICTURE "@&N" ;
- FROM allusers ;
- RANGE 3, m.allcnt ;
- SIZE 8.077,24.400 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- VALID _qbm0raq62()
- @ 1.923,39.167 GET m.user ;
- PICTURE "@&N" ;
- FROM users ;
- RANGE 3, usrcnt ;
- SIZE 8.077,24.400 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- VALID _qbm0raqcn()
- @ 14.538,43.000 GET m.gethelp ;
- PICTURE "@*HN \<Help" ;
- SIZE 1.769,10.500,1.000 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B" ;
- VALID _qbm0raqhd()
- @ 15.769,16.667 GET m.userlast ;
- SIZE 1.000,22.000 ;
- DEFAULT " " ;
- FONT "MS Sans Serif", 8 ;
- PICTURE "@K" ;
- WHEN _qbm0raql3() ;
- VALID _qbm0raqnt() ;
- ERROR "Blank entries are not allowed" ;
- DISABLE
- @ 15.769,3.167 GET m.userfirst ;
- SIZE 1.000,15.000 ;
- DEFAULT " " ;
- FONT "MS Sans Serif", 8 ;
- PICTURE "@K" ;
- WHEN _qbm0raqrv() ;
- VALID _qbm0raqw9() ;
- DISABLE
- @ 0.538,39.000 SAY "Authorized Users:" ;
- SIZE 1.000,16.833, 0.000 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B"
- @ 0.538,1.833 SAY "All Users:" ;
- SIZE 1.000,9.167, 0.000 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B"
- @ 11.538,3.833 GET zx ;
- PICTURE "@*HN \<New Name" ;
- SIZE 1.769,14.333,0.667 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B" ;
- VALID _qbm0rarcb()
- @ 11.769,43.000 GET zy ;
- PICTURE "@*HN \!\<OK" ;
- SIZE 1.769,10.500,0.667 ;
- DEFAULT 1 ;
- FONT "MS Sans Serif", 8 ;
- STYLE "B" ;
- VALID _qbm0rarga()
-
- IF NOT WVISIBLE("_qbm0rap0q")
- ACTIVATE WINDOW _qbm0rap0q
- ENDIF
-
- READ CYCLE MODAL ;
- WHEN _qbm0rark9() ;
- ACTIVATE _qbm0rarkc() ;
- SHOW _qbm0rarki()
-
- RELEASE WINDOW _qbm0rap0q
-
- #REGION 0
-
- SET READBORDER &rborder
-
- IF m.talkstat = "ON"
- SET TALK ON
- ENDIF
- IF m.compstat = "ON"
- SET COMPATIBLE ON
- ENDIF
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ ADDUSERS/Windows Cleanup Code ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- #REGION 1
- SET EXACT OFF
-
- ON KEY LABEL esc
- SELECT (m.savearea)
- RETURN m.status
-
- *
- * ALREADYIN - Check if name already in the list.
- *
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ ADDUSERS/Windows Supporting Procedures and Functions ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
-
- #REGION 1
- FUNCTION alreadyin
- PARAMETER m.newname
- SET EXACT OFF
- IF ASCAN(users, ALLTRIM(m.newname)) <> 0
- RETURN .T.
- ENDIF
- SET EXACT ON
- RETURN .F.
-
- *
- * ESCHANDLER - Handle ESC-aping out of a field.
- *
- PROCEDURE eschandler
- ON KEY LABEL esc
- m.userlast = SPACE(22)
- m.userfirst = SPACE(14)
- SHOW GET m.userlast DISABLE
- SHOW GET m.userfirst DISABLE
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAPVK m.mover VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 4 ║
- * ║ Variable: m.mover ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 1 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rapvk && m.mover VALID
- #REGION 1
- DO CASE
- CASE m.mover = 1
- IF alreadyin(allusers[m.alluser,3]))
- WAIT WINDOW "Duplicate entry" NOWAIT
- RETURN .F.
- ENDIF
- IF m.usrcnt+1 > ALEN(users,1)
- DIMENSION users[m.usrcnt+1,3]
- ENDIF
- users[m.usrcnt+1,1] = allusers[m.alluser,1]
- users[m.usrcnt+1,2] = allusers[m.alluser,2]
- users[m.usrcnt+1,3] = allusers[m.alluser,3]
- m.usrcnt = m.usrcnt + 1
- m.user = m.usrcnt
- SHOW GET m.mover, 2 ENABLE
- IF m.usrcnt > 1
- SHOW GET m.mover, 3 ENABLE
- ENDIF
- SHOW GET m.user
- CASE m.mover = 2
- = ADEL(users, m.user)
- m.usrcnt = m.usrcnt - 1
- m.user = m.usrcnt
-
- IF m.usrcnt = 0
- SHOW GET m.mover, 2 DISABLE
- SHOW GET m.mover, 3 DISABLE
- ENDIF
- SHOW GET m.user
- CASE m.mover = 3
- users = ""
- m.usrcnt = 0
- SHOW GET m.mover, 2 DISABLE
- SHOW GET m.mover, 3 DISABLE
- SHOW GET m.user
- CASE m.mover = 5
- CLEAR READ
- ENDCASE
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQ62 m.alluser VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 5 ║
- * ║ Variable: m.alluser ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 2 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raq62 && m.alluser VALID
- #REGION 1
- IF alreadyin(allusers[m.alluser,3])
- WAIT WINDOW "Duplicate entry" NOWAIT
- RETURN .F.
- ENDIF
- IF m.usrcnt+1 > ALEN(users,1)
- DIMENSION users[m.usrcnt+1,3]
- ENDIF
-
- users[m.usrcnt+1,1] = allusers[m.alluser,1]
- users[m.usrcnt+1,2] = allusers[m.alluser,2]
- users[m.usrcnt+1,3] = allusers[m.alluser,3]
- m.usrcnt = m.usrcnt + 1
- m.user = m.usrcnt
-
- SHOW GET m.mover, 2 ENABLE
- IF m.usrcnt > 1
- SHOW GET m.mover, 3 ENABLE
- ENDIF
- SHOW GET m.user
-
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQCN m.user VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 6 ║
- * ║ Variable: m.user ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 3 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raqcn && m.user VALID
- #REGION 1
- = ADEL(users, m.user)
- m.usrcnt = m.usrcnt - 1
- m.user = m.usrcnt
-
- IF m.usrcnt = 0
- SHOW GET m.mover, 2 DISABLE
- SHOW GET m.mover, 3 DISABLE
- ENDIF
- SHOW GET m.user
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQHD m.gethelp VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 7 ║
- * ║ Variable: m.gethelp ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 4 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raqhd && m.gethelp VALID
- #REGION 1
- HELP ■ Add/Modify card users
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQL3 m.userlast WHEN ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 8 ║
- * ║ Variable: m.userlast ║
- * ║ Called By: WHEN Clause ║
- * ║ Snippet Number: 5 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raql3 && m.userlast WHEN
- #REGION 1
- ON KEY LABEL esc DO eschandler
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQNT m.userlast VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 8 ║
- * ║ Variable: m.userlast ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 6 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raqnt && m.userlast VALID
- #REGION 1
- IF EMPTY(m.userlast)
- RETURN .F.
- ENDIF
-
- SHOW GET m.userfirst ENABLE
- _CUROBJ = OBJNUM(m.userfirst)
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQRV m.userfirst WHEN ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 9 ║
- * ║ Variable: m.userfirst ║
- * ║ Called By: WHEN Clause ║
- * ║ Snippet Number: 7 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raqrv && m.userfirst WHEN
- #REGION 1
- ON KEY LABEL esc DO eschandler
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RAQW9 m.userfirst VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 9 ║
- * ║ Variable: m.userfirst ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 8 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0raqw9 && m.userfirst VALID
- #REGION 1
- IF EMPTY(m.userfirst)
- WAIT WINDOW "Blank entries are not allowed" NOWAIT
- RETURN .F.
- ENDIF
- IF alreadyin(ALLTRIM(m.userfirst)+" "+ALLTRIM(m.userlast))
- WAIT WINDOW "Duplicate entry" NOWAIT
- RETURN .F.
- ENDIF
-
- IF m.usrcnt+1 > ALEN(users,1)
- DIMENSION users[m.usrcnt+1,3]
- ENDIF
-
- users[m.usrcnt+1,1] = m.userlast
- users[m.usrcnt+1,2] = m.userfirst
- users[m.usrcnt+1,3] = ALLTRIM(users[m.usrcnt+1,2])+;
- " "+ALLTRIM(users[m.usrcnt+1,1])
-
- m.usrcnt = m.usrcnt + 1
- m.user = m.usrcnt
-
- SHOW GET m.mover, 2 ENABLE
- IF m.usrcnt > 1
- SHOW GET m.mover, 3 ENABLE
- ENDIF
- SHOW GET m.user
-
- m.userlast = SPACE(22)
- m.userfirst = SPACE(14)
- SHOW GET m.userlast DISABLE
- SHOW GET m.userfirst DISABLE
-
- _CUROBJ = OBJNUM(m.mover)
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RARCB zx VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 12 ║
- * ║ Variable: zx ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 9 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rarcb && zx VALID
- #REGION 1
- m.userlast = SPACE(22)
- m.userfirst = SPACE(14)
- SHOW GET m.userlast ENABLE
- _CUROBJ = OBJNUM(m.userlast)
-
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RARGA zy VALID ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS, Record Number: 13 ║
- * ║ Variable: zy ║
- * ║ Called By: VALID Clause ║
- * ║ Snippet Number: 10 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rarga && zy VALID
- #REGION 1
- CLEAR READ
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RARK9 Read Level When ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS ║
- * ║ Called By: READ Statement ║
- * ║ Snippet Number: 11 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rark9 && Read Level When
- *
- * When Code from screen: ADDUSERS
- *
- #REGION 1
- IF EMPTY(m.cardid)
- WAIT WINDOW "You must enter card id first" NOWAIT
- m.status = .F.
- RETURN .F.
- ENDIF
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RARKC Read Level Activate ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS ║
- * ║ Called By: READ Statement ║
- * ║ Snippet Number: 12 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rarkc && Read Level Activate
- *
- * Activate Code from screen: ADDUSERS
- *
- #REGION 1
- SHOW GET m.mover, 1 PROMPT "\<Move =>"
- SHOW GET m.mover, 2 PROMPT "<= \<Remove"
-
- IF EMPTY(allusers)
- SHOW GET m.alluser DISABLE
- ENDIF
- IF m.usrcnt=0
- SHOW GET m.mover, 2 DISABLE
- ENDIF
-
- * ╓─────────────────────────────────────────────────────────╖
- * ║ ║
- * ║ _QBM0RARKI Read Level Show ║
- * ║ ║
- * ║ Function Origin: ║
- * ║ ║
- * ║ ║
- * ║ From Platform: Windows ║
- * ║ From Screen: ADDUSERS ║
- * ║ Called By: READ Statement ║
- * ║ Snippet Number: 13 ║
- * ║ ║
- * ╙─────────────────────────────────────────────────────────╜
- *
- FUNCTION _qbm0rarki && Read Level Show
- PRIVATE currwind
- STORE WOUTPUT() TO currwind
- *
- * Show Code from screen: ADDUSERS
- *
- #REGION 1
- IF m.usrcnt > 1
- SHOW GET m.mover, 3 ENABLE
- ENDIF
- IF NOT EMPTY(currwind)
- ACTIVATE WINDOW (currwind) SAME
- ENDIF