home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a084 / 2.ddi / CKSAMPLE / USEDB.SPR < prev    next >
Encoding:
Text File  |  1993-05-25  |  8.3 KB  |  276 lines

  1. *       *********************************************************
  2. *       *                                                         
  3. *       * 05/24/93              USEDB.SPR                08:41:46 
  4. *       *                                                         
  5. *       *********************************************************
  6. *       *                                                         
  7. *       * Steven Hsu, Wayne Lampel                                
  8. *       *                                                         
  9. *       * Copyright (c) 1993 Microsoft                            
  10. *       * One Microsoft Way                                       
  11. *       * Redmond, WA  98052                                      
  12. *       *                                                         
  13. *       * Description:                                            
  14. *       * This program was automatically generated by GENSCRN.    
  15. *       *                                                         
  16. *       *********************************************************
  17.  
  18. DO CASE
  19. CASE _WINDOWS
  20.  
  21.     
  22.     #REGION 0
  23.     REGIONAL m.currarea, m.talkstat, m.compstat
  24.     
  25.     IF SET("TALK") = "ON"
  26.         SET TALK OFF
  27.         m.talkstat = "ON"
  28.     ELSE
  29.         m.talkstat = "OFF"
  30.     ENDIF
  31.     m.compstat = SET("COMPATIBLE")
  32.     SET COMPATIBLE FOXPLUS
  33.     
  34.     m.rborder = SET("READBORDER")
  35.     SET READBORDER ON
  36.     
  37.     *       *********************************************************
  38.     *       *                                                         
  39.     *       *               Windows Window definitions                
  40.     *       *                                                         
  41.     *       *********************************************************
  42.     *
  43.     
  44.     IF NOT WEXIST("usedb") ;
  45.         OR UPPER(WTITLE("USEDB")) == "USEDB.PJX" ;
  46.         OR UPPER(WTITLE("USEDB")) == "USEDB.SCX" ;
  47.         OR UPPER(WTITLE("USEDB")) == "USEDB.MNX" ;
  48.         OR UPPER(WTITLE("USEDB")) == "USEDB.PRG" ;
  49.         OR UPPER(WTITLE("USEDB")) == "USEDB.FRX" ;
  50.         OR UPPER(WTITLE("USEDB")) == "USEDB.QPR"
  51.         DEFINE WINDOW usedb ;
  52.             AT  0.000, 0.000  ;
  53.             SIZE 7.923,48.400 ;
  54.             TITLE "Use Database" ;
  55.             FONT "MS Sans Serif", 8 ;
  56.             FLOAT ;
  57.             CLOSE ;
  58.             NOMINIMIZE ;
  59.             DOUBLE
  60.         MOVE WINDOW usedb CENTER
  61.     ENDIF
  62.     
  63.     
  64.     *       *********************************************************
  65.     *       *                                                         
  66.     *       *               USEDB/Windows Screen Layout               
  67.     *       *                                                         
  68.     *       *********************************************************
  69.     *
  70.     
  71.     #REGION 1
  72.     IF WVISIBLE("usedb")
  73.         ACTIVATE WINDOW usedb SAME
  74.     ELSE
  75.         ACTIVATE WINDOW usedb NOSHOW
  76.     ENDIF
  77.     @ 1.077,6.200 SAY "Enter name of database to use:"  ;
  78.         FONT "MS Sans Serif", 8 ;
  79.         STYLE "BT"
  80.     @ 2.846,2.800 GET m.dbname ;
  81.         SIZE 1.000,42.400 ;
  82.         DEFAULT " " ;
  83.         FONT "MS Sans Serif", 8 ;
  84.         PICTURE "@K"
  85.     @ 5.538,4.800 GET m.action ;
  86.         PICTURE "@*HN OK;Cancel" ;
  87.         SIZE 1.769,14.833,2.500 ;
  88.         DEFAULT 1 ;
  89.         FONT "MS Sans Serif", 8 ;
  90.         STYLE "B" ;
  91.         VALID _qg30in166()
  92.     
  93.     IF NOT WVISIBLE("usedb")
  94.         ACTIVATE WINDOW usedb
  95.     ENDIF
  96.     
  97.     READ CYCLE MODAL
  98.     
  99.     RELEASE WINDOW usedb
  100.     
  101.     #REGION 0
  102.     
  103.     SET READBORDER &rborder
  104.     
  105.     IF m.talkstat = "ON"
  106.         SET TALK ON
  107.     ENDIF
  108.     IF m.compstat = "ON"
  109.         SET COMPATIBLE ON
  110.     ENDIF
  111.     
  112.  
  113. CASE _DOS
  114.  
  115.     
  116.     #REGION 0
  117.     REGIONAL m.currarea, m.talkstat, m.compstat
  118.     
  119.     IF SET("TALK") = "ON"
  120.         SET TALK OFF
  121.         m.talkstat = "ON"
  122.     ELSE
  123.         m.talkstat = "OFF"
  124.     ENDIF
  125.     m.compstat = SET("COMPATIBLE")
  126.     SET COMPATIBLE FOXPLUS
  127.     
  128.     *       *********************************************************
  129.     *       *                                                         
  130.     *       *                MS-DOS Window definitions                
  131.     *       *                                                         
  132.     *       *********************************************************
  133.     *
  134.     
  135.     IF NOT WEXIST("usedb") ;
  136.         OR UPPER(WTITLE("USEDB")) == "USEDB.PJX" ;
  137.         OR UPPER(WTITLE("USEDB")) == "USEDB.SCX" ;
  138.         OR UPPER(WTITLE("USEDB")) == "USEDB.MNX" ;
  139.         OR UPPER(WTITLE("USEDB")) == "USEDB.PRG" ;
  140.         OR UPPER(WTITLE("USEDB")) == "USEDB.FRX" ;
  141.         OR UPPER(WTITLE("USEDB")) == "USEDB.QPR"
  142.         DEFINE WINDOW usedb ;
  143.             FROM INT((SROW()-9)/2),INT((SCOL()-47)/2) ;
  144.             TO INT((SROW()-9)/2)+8,INT((SCOL()-47)/2)+46 ;
  145.             TITLE "Use Database" ;
  146.             FLOAT ;
  147.             CLOSE ;
  148.             NOMINIMIZE ;
  149.             DOUBLE ;
  150.             COLOR SCHEME 5
  151.     ENDIF
  152.     
  153.     
  154.     *       *********************************************************
  155.     *       *                                                         
  156.     *       *               USEDB/MS-DOS Screen Layout                
  157.     *       *                                                         
  158.     *       *********************************************************
  159.     *
  160.     
  161.     #REGION 1
  162.     IF WVISIBLE("usedb")
  163.         ACTIVATE WINDOW usedb SAME
  164.     ELSE
  165.         ACTIVATE WINDOW usedb NOSHOW
  166.     ENDIF
  167.     @ 1,6 SAY "Enter name of database to use:" ;
  168.         SIZE 1,30, 0
  169.     @ 3,4 GET m.dbname ;
  170.         SIZE 1,35 ;
  171.         DEFAULT " " ;
  172.         PICTURE "@K"
  173.     @ 5,7 GET m.action ;
  174.         PICTURE "@*HN OK;Cancel" ;
  175.         SIZE 1,14,2 ;
  176.         DEFAULT 1 ;
  177.         VALID _qg30in1zz()
  178.     
  179.     IF NOT WVISIBLE("usedb")
  180.         ACTIVATE WINDOW usedb
  181.     ENDIF
  182.     
  183.     READ CYCLE MODAL
  184.     
  185.     RELEASE WINDOW usedb
  186.     
  187.     #REGION 0
  188.     IF m.talkstat = "ON"
  189.         SET TALK ON
  190.     ENDIF
  191.     IF m.compstat = "ON"
  192.         SET COMPATIBLE ON
  193.     ENDIF
  194.     
  195.  
  196. ENDCASE
  197.  
  198.  
  199. *       *********************************************************
  200. *       *                                                         
  201. *       * _QG30IN166           m.action VALID                     
  202. *       *                                                         
  203. *       * Function Origin:                                        
  204. *       *                                                         
  205. *       * From Platform:       Windows                            
  206. *       * From Screen:         USEDB,     Record Number:    4     
  207. *       * Variable:            m.action                           
  208. *       * Called By:           VALID Clause                       
  209. *       * Object Type:         Push Button                        
  210. *       * Snippet Number:      1                                  
  211. *       *                                                         
  212. *       *********************************************************
  213. *
  214. FUNCTION _qg30in166     &&  m.action VALID
  215. #REGION 1
  216. IF m.action = 1
  217.     if empty(dbname)
  218.         wait window "Database is required!" nowait
  219.         _CUROBJ = 1
  220.         return
  221.     endif
  222.     IF (m.asynch == 1) && Asynch
  223.         retcode = 0
  224.         DO WHILE (retcode == 0)
  225.             retcode = dbexec(ckhandle, "USE " + ALLTRIM(dbname))
  226.         ENDDO
  227.     ELSE
  228.         retcode = dbexec(ckhandle, "USE " + ALLTRIM(dbname))
  229.     ENDIF
  230.     IF (retcode < 0)
  231.         DO repoerro.spr WITH retcode
  232.         _CUROBJ = 1
  233.         RETURN
  234.     ELSE
  235.         SET MESSAGE TO mess_str + "          Database: "+ALLTRIM(dbname)
  236.         WAIT WINDOW "Database "+ALLTRIM(dbname)+" is now being used." NOWAIT
  237.     ENDIF
  238. ENDIF
  239. CLEAR READ
  240.  
  241.  
  242. *       *********************************************************
  243. *       *                                                         
  244. *       * _QG30IN1ZZ           m.action VALID                     
  245. *       *                                                         
  246. *       * Function Origin:                                        
  247. *       *                                                         
  248. *       * From Platform:       MS-DOS                             
  249. *       * From Screen:         USEDB,     Record Number:   10     
  250. *       * Variable:            m.action                           
  251. *       * Called By:           VALID Clause                       
  252. *       * Object Type:         Push Button                        
  253. *       * Snippet Number:      2                                  
  254. *       *                                                         
  255. *       *********************************************************
  256. *
  257. FUNCTION _qg30in1zz     &&  m.action VALID
  258. #REGION 1
  259. IF m.action = 1
  260.     if empty(dbname)
  261.         wait window "Database is required!" nowait
  262.         _CUROBJ = 1
  263.         return
  264.     endif
  265.     retcode = dbexec(ckhandle, "USE " + ALLTRIM(dbname))
  266.     IF (retcode < 0)
  267.         DO repoerro.spr WITH retcode
  268.         _CUROBJ = 1
  269.         RETURN
  270.     ELSE
  271.         SET MESSAGE TO mess_str + "          Database: "+ALLTRIM(dbname)
  272.         WAIT WINDOW "Database "+ALLTRIM(dbname)+" is now being used." NOWAIT
  273.     ENDIF
  274. ENDIF
  275. CLEAR READ
  276.