home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Product / Product.zip / createdb.zip / CREATEDB.VRX < prev    next >
Text File  |  1995-08-26  |  6KB  |  278 lines
  1. /*:VRX         Main
  2. */
  3. /*  Main
  4. */
  5. Main:
  6. /*  Process the arguments.
  7.     Get the parent window.
  8. */
  9.     parse source . calledAs .
  10.     parent = ""
  11.     argCount = arg()
  12.     argOff = 0
  13.     if( calledAs \= "COMMAND" )then do
  14.         if argCount >= 1 then do
  15.             parent = arg(1)
  16.             argCount = argCount - 1
  17.             argOff = 1
  18.         end
  19.     end; else do
  20.         call VROptions 'ImplicitNames'
  21.         call VROptions 'NoEchoQuit'
  22.     end
  23.     InitArgs.0 = argCount
  24.     if( argCount > 0 )then do i = 1 to argCount
  25.         InitArgs.i = arg( i + argOff )
  26.     end
  27.     drop calledAs argCount argOff
  28.  
  29. /*  Load the windows
  30. */
  31.     call VRInit
  32.     parse source . . spec
  33.     _VREPrimaryWindowPath = ,
  34.         VRParseFileName( spec, "dpn" ) || ".VRW"
  35.     _VREPrimaryWindow = ,
  36.         VRLoad( parent, _VREPrimaryWindowPath )
  37.     drop parent spec
  38.     if( _VREPrimaryWindow == "" )then do
  39.         call VRMessage "", "Cannot load window:" VRError(), ,
  40.             "Error!"
  41.         _VREReturnValue = 32000
  42.         signal _VRELeaveMain
  43.     end
  44.  
  45. /*  Process events
  46. */
  47.     call Init
  48.     signal on halt
  49.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  50.         _VREEvent = VREvent()
  51.         interpret _VREEvent
  52.     end
  53. _VREHalt:
  54.     _VREReturnValue = Fini()
  55.     call VRDestroy _VREPrimaryWindow
  56. _VRELeaveMain:
  57.     call VRFini
  58. exit _VREReturnValue
  59.  
  60. VRLoadSecondary:
  61.     __vrlsWait = abbrev( 'WAIT', translate(arg(2)), 1 )
  62.     if __vrlsWait then do
  63.         call VRFlush
  64.     end
  65.     __vrlsHWnd = VRLoad( VRWindow(), VRWindowPath(), arg(1) )
  66.     if __vrlsHWnd = '' then signal __vrlsDone
  67.     if __vrlsWait \= 1 then signal __vrlsDone
  68.     call VRSet __vrlsHWnd, 'WindowMode', 'Modal' 
  69.     __vrlsTmp = __vrlsWindows.0
  70.     if( DataType(__vrlsTmp) \= 'NUM' ) then do
  71.         __vrlsTmp = 1
  72.     end
  73.     else do
  74.         __vrlsTmp = __vrlsTmp + 1
  75.     end
  76.     __vrlsWindows.__vrlsTmp = VRWindow( __vrlsHWnd )
  77.     __vrlsWindows.0 = __vrlsTmp
  78.     do while( VRIsValidObject( VRWindow() ) = 1 )
  79.         __vrlsEvent = VREvent()
  80.         interpret __vrlsEvent
  81.     end
  82.     __vrlsTmp = __vrlsWindows.0
  83.     __vrlsWindows.0 = __vrlsTmp - 1
  84.     call VRWindow __vrlsWindows.__vrlsTmp 
  85.     __vrlsHWnd = ''
  86. __vrlsDone:
  87. return __vrlsHWnd
  88.  
  89. /*:VRX         CreateBtn_Click
  90. */
  91. CreateBtn_Click: 
  92. FileName = VRFileDialog( VRWindow(), "Create Database", "Save", "", , ,  )
  93. if FileName = "" then
  94.     return
  95. ok = VRMethod( "FieldList", "GetStringList", "Fields." )
  96.  
  97.  
  98. status = RxViperCreateDatabase(FileName, '0', Fields.)
  99. if status = 1 then
  100. Do
  101.     Buttons.1 = "OK"
  102.     Buttons.0 = 1
  103.     id = VRMessage( VRWindow(), "Database created.", "Database creation status", "Information", "Buttons.", OK, OK )
  104.     ok = VRMethod( "FieldList", "Clear" )
  105.     ok = VRSet( "EF_1", "Value", "" )
  106.     ok = VRSet( "CreateBtn", "Enabled", 0 )
  107.     
  108.     return
  109. End
  110. Else
  111. Do
  112.    Buttons.1 = "OK"
  113.     Buttons.0 = 1
  114.  
  115.    id = VRMessage( VRWindow(), "Database creation failed.", "Database creation status", "Information", "Buttons.", OK, OK )
  116.     
  117.  
  118. End
  119.  
  120.  
  121. return
  122.  
  123. /*:VRX         EF_1_Change
  124. */
  125. EF_1_Change: 
  126. ok = VRMethod( "FieldList", "GetStringList", "FieldList." )
  127. if FieldList.0 = 0 then
  128.     ok = VRSet( "CreateBtn", "Enabled", 0 )
  129.     
  130. return
  131.  
  132. /*:VRX         EF_1_GotFocus
  133. */
  134. EF_1_GotFocus: 
  135.  
  136. return
  137.  
  138. /*:VRX         EF_1_KeyPress
  139. */
  140. EF_1_KeyPress: 
  141.  
  142. key = VRGet( "EF_1", "KeyString" )
  143.  if key = '{Newline}' then
  144. Do
  145.  
  146.   if Modify = 0 then
  147.   Do
  148.     newfield = VRGet( "EF_1", "Value" )
  149.     if newfield = "" then
  150.         return
  151.     else
  152.         ok = VRSet( "CreateBtn", "Enabled", 1 )
  153.         
  154.     ok = VRMethod( "FieldList", "GetStringList", "Fields." )
  155.     if Fields.0 = 0 then
  156.         Fields.0 = 1
  157.  
  158.     position = VRMethod( "FieldList", "AddString", newfield, ) 
  159.        
  160.     ok = VRSet( "EF_1", "Value", "" )
  161.     
  162.   End
  163.   Else
  164.   Do
  165.         modfield = VRGet( "EF_1", "Value" )
  166.         if modfield <> "" then
  167.         Do
  168.             selected = VRGet( "FieldList", "Selected" )
  169.             selectedstring = VRGet( "FieldList", "SelectedString" )
  170.             ok = VRMethod( "FieldList", "Deselect", selected )
  171.             
  172.             position = VRMethod( "FieldList", "AddString", modfield, selected )
  173.         End
  174.         Else
  175.             selectedstring = VRGet( "FieldList", "SelectedString" )
  176.              
  177.         ok = VRMethod( "FieldList", "DeleteString", selectedstring )
  178.         ok = VRSet( "EF_1", "Value", "" )
  179.  
  180.         Modify = 0
  181.   End
  182.  
  183.     ok = VRSet( "InsertBtn", "Enabled", 0 )
  184. End
  185.  
  186.  
  187. return
  188.  
  189. /*:VRX         EF_1_Verify
  190. */
  191. EF_1_Verify: 
  192.  
  193.  
  194. return
  195.  
  196. /*:VRX         FieldList_Click
  197. */
  198. FieldList_Click: 
  199.  
  200.     selectedfield = VRGet( "FieldList", "SelectedString" )
  201.  
  202.     ok = VRSet( "EF_1", "Value", selectedfield )
  203.     if selectedfield <> "" then
  204.     Modify = 1
  205.     ok = VRSet( "InsertBtn", "Enabled", 1 )
  206.     
  207.  
  208.  
  209. return
  210.  
  211. /*:VRX         Fini
  212. */
  213. Fini:
  214.     window = VRWindow()
  215.     call VRSet window, "Visible", 0
  216.     drop window
  217. return 0
  218.  
  219. /*:VRX         Halt
  220. */
  221. Halt:
  222.     signal _VREHalt
  223. return
  224.  
  225. /*:VRX         Init
  226. */
  227. Init:
  228.     window = VRWindow()
  229.     call VRMethod window, "CenterWindow"
  230.     call VRSet window, "Visible", 1
  231.     call VRMethod window, "Activate"
  232.     drop window
  233. return
  234.  
  235. /*:VRX         InsertBtn_Click
  236. */
  237. InsertBtn_Click: 
  238.  
  239. value = VRGet( "EF_1", "Value" )
  240. selected = VRGet( "FieldList", "Selected" )
  241. ok = VRMethod( "FieldList", "Deselect", selected )
  242. position = VRMethod( "FieldList", "AddString", value, selected )
  243. ok = VRSet( "EF_1", "Value", "" )
  244.  
  245. ok = VRMethod( "EF_1", "SetFocus" )
  246. Modify = 0
  247. ok = VRSet( "InsertBtn", "Enabled", 0 )
  248.  
  249.  
  250. return
  251.  
  252. /*:VRX         Quit
  253. */
  254. Quit:
  255.     window = VRWindow()
  256.     call VRSet window, "Shutdown", 1
  257.     drop window
  258. return
  259.  
  260. /*:VRX         Window1_Close
  261. */
  262. Window1_Close:
  263.     call SysDropFuncs
  264.     call Quit
  265. return
  266.  
  267. /*:VRX         Window1_Create
  268. */
  269. Window1_Create: 
  270.  
  271. /* Register the VIPER Database Engine functions... */
  272. rc = RxFuncAdd("SysLoadFuncs","Viper", "SysLoadFuncs")
  273. call SysLoadFuncs
  274.  
  275. Modify = 0
  276. return
  277.  
  278.