home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / frmwiz / dataform.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-01-28  |  29.2 KB  |  935 lines

  1. VERSION 2.00
  2. Begin Form DataForm
  3. HelpContextID = 73
  4. BackColor       =   &H00C0C0C0&
  5. Caption         =   "Form Wizard"
  6. ClientHeight    =   4950
  7. ClientLeft      =   765
  8. ClientTop       =   1485
  9. ClientWidth     =   8010
  10. Height          =   5355
  11. Icon            =   DATAFORM.FRX:0000
  12. Left            =   705
  13. LinkTopic       =   "Form1"
  14. ScaleHeight     =   4950
  15. ScaleWidth      =   8010
  16. Top             =   1140
  17. Width           =   8130
  18. Begin VideoSoftIndexTab VSIndexTab1
  19. Align           =   1  'Align Top
  20. BackSheets      =   0  'None
  21. BackTabColor    =   &H00FF0000&
  22. Caption         =   "Data Control|Fields|Form"
  23. CaptionStyle    =   1  'Raised
  24. ConvInfo        =   DATAFORM.FRX:0302
  25. FontBold        =   0   'False
  26. FontItalic      =   0   'False
  27. FontName        =   "MS Sans Serif"
  28. FontSize        =   13.5
  29. FontStrikethru  =   0   'False
  30. FontUnderline   =   0   'False
  31. FrontTabColor   =   &H00C0C0C0&
  32. Height          =   4995
  33. Left            =   0
  34. Position        =   0  'Top
  35. Style           =   5  'Chamfered 3D
  36. TabIndex        =   16
  37. Top             =   0
  38. Width           =   8010
  39. Begin VideoSoftElastic VSElastic2
  40. HelpContextID = 25
  41. BevelChildren   =   4  'Only Graphical
  42. ConvInfo        =   DATAFORM.FRX:030D
  43. Height          =   4455
  44. IntBkg          =   &H00C0C0C0&
  45. Left            =   9870
  46. TabIndex        =   20
  47. Top             =   495
  48. Width           =   7920
  49. Begin VideoSoftElastic VSElastic3
  50. BevelOuter      =   0  'None
  51. ConvInfo        =   DATAFORM.FRX:0318
  52. Height          =   3105
  53. IntBkg          =   &H00C0C0C0&
  54. Left            =   2760
  55. TabIndex        =   26
  56. Top             =   300
  57. Width           =   1110
  58. Begin SSCommand BtnAdd
  59. HelpContextID = 29
  60. AutoSize        =   2  'Adjust Button Size To Picture
  61. Caption         =   "&Add"
  62. Font3D          =   2  'Raised w/heavy shading
  63. Height          =   555
  64. Left            =   60
  65. Picture         =   DATAFORM.FRX:0323
  66. TabIndex        =   30
  67. Tag             =   "Add selected field(s) to the form"
  68. Top             =   240
  69. Width           =   915
  70. Begin SSCommand BtnRemove
  71. HelpContextID = 28
  72. AutoSize        =   2  'Adjust Button Size To Picture
  73. Caption         =   "&Remove"
  74. Font3D          =   2  'Raised w/heavy shading
  75. Height          =   555
  76. Left            =   60
  77. Picture         =   DATAFORM.FRX:0625
  78. TabIndex        =   29
  79. Tag             =   "Remove selected field(s) from the form"
  80. Top             =   840
  81. Width           =   915
  82. Begin SSCommand BtnCancel
  83. AutoSize        =   2  'Adjust Button Size To Picture
  84. Caption         =   "&Cancel"
  85. Font3D          =   2  'Raised w/heavy shading
  86. Height          =   615
  87. Index           =   1
  88. Left            =   60
  89. Picture         =   DATAFORM.FRX:0927
  90. TabIndex        =   28
  91. Tag             =   "Cancel building the form"
  92. Top             =   1500
  93. Width           =   915
  94. Begin SSCommand BtnHelp
  95. Caption         =   "&Help"
  96. Font3D          =   2  'Raised w/heavy shading
  97. Height          =   615
  98. Index           =   1
  99. Left            =   60
  100. Picture         =   DATAFORM.FRX:0C29
  101. TabIndex        =   27
  102. Top             =   2220
  103. Width           =   915
  104. Begin VideoSoftElastic cMsg
  105. Align           =   2  'Bottom
  106. BevelChildren   =   3  'No Graphical or Elastics
  107. BevelInner      =   0  'None
  108. BevelOuter      =   5  'Fillet
  109. BevelOuterWidth =   4
  110. ConvInfo        =   DATAFORM.FRX:0F2B
  111. ForeColor       =   &H00FF0000&
  112. Height          =   375
  113. Index           =   1
  114. IntBkg          =   &H00C0C0C0&
  115. Left            =   0
  116. TabIndex        =   25
  117. Top             =   4080
  118. Width           =   7920
  119. Begin SSFrame Frame3D1
  120. Alignment       =   2  'Center
  121. Caption         =   "Select Fields For Form"
  122. ForeColor       =   &H00FF0000&
  123. Height          =   3795
  124. Left            =   90
  125. TabIndex        =   23
  126. Top             =   90
  127. Width           =   2595
  128. Begin ListBox LstFields
  129. HelpContextID = 27
  130. BackColor       =   &H00C0C0C0&
  131. Height          =   3345
  132. Left            =   120
  133. MultiSelect     =   2  'Extended
  134. TabIndex        =   24
  135. Tag             =   "Select one or more fields to add to the form"
  136. Top             =   300
  137. Width           =   2355
  138. Begin SSFrame FramFldsOnForm
  139. Alignment       =   2  'Center
  140. Caption         =   "Fields On Form"
  141. ForeColor       =   &H00FF0000&
  142. Height          =   3765
  143. Left            =   3975
  144. TabIndex        =   21
  145. Top             =   90
  146. Width           =   3855
  147. Begin Grid GrdFields
  148. HelpContextID = 26
  149. Cols            =   4
  150. FixedRows       =   0
  151. Height          =   3315
  152. Left            =   120
  153. Rows            =   1
  154. TabIndex        =   22
  155. Tag             =   "Select one or more fields, right click to change attributes"
  156. Top             =   240
  157. Width           =   3555
  158. Begin VideoSoftElastic VSElastic1
  159. HelpContextID = 30
  160. ConvInfo        =   DATAFORM.FRX:0F36
  161. ForeColor       =   &H00FF0000&
  162. Height          =   4455
  163. IntBkg          =   &H00C0C0C0&
  164. Left            =   9945
  165. TabIndex        =   19
  166. TagSplit        =   -1  'True
  167. TagWidth        =   1500
  168. Top             =   495
  169. Width           =   7920
  170. Begin CommonDialog CMDialog2
  171. DefaultExt      =   "frm"
  172. DialogTitle     =   "Save Form As"
  173. Filter          =   "VB Forms|*.frm"
  174. Left            =   660
  175. Top             =   2280
  176. Begin SSCommand BtnFindForm
  177. HelpContextID = 35
  178. AutoSize        =   2  'Adjust Button Size To Picture
  179. Font3D          =   2  'Raised w/heavy shading
  180. Height          =   600
  181. Left            =   7020
  182. Picture         =   DATAFORM.FRX:0F41
  183. TabIndex        =   5
  184. Tag             =   "|Press to find the database"
  185. Top             =   1680
  186. Width           =   600
  187. Begin TextBox TxtFrmName
  188. HelpContextID = 34
  189. BackColor       =   &H00C0C0C0&
  190. Height          =   375
  191. Left            =   1920
  192. TabIndex        =   4
  193. Tag             =   "Form File Name|Name to save the form as"
  194. Top             =   1920
  195. Width           =   4995
  196. Begin SSCommand BtnCancel
  197. AutoSize        =   2  'Adjust Button Size To Picture
  198. Caption         =   "&Cancel"
  199. Font3D          =   2  'Raised w/heavy shading
  200. Height          =   615
  201. Index           =   2
  202. Left            =   3720
  203. Picture         =   DATAFORM.FRX:1243
  204. TabIndex        =   6
  205. Tag             =   "|Cancel building the form"
  206. Top             =   2400
  207. Width           =   915
  208. Begin SSCommand BtnFinish
  209. HelpContextID = 33
  210. AutoSize        =   2  'Adjust Button Size To Picture
  211. Caption         =   "&Finish"
  212. Enabled         =   0   'False
  213. Font3D          =   2  'Raised w/heavy shading
  214. Height          =   615
  215. Left            =   4620
  216. Picture         =   DATAFORM.FRX:1545
  217. TabIndex        =   7
  218. Tag             =   "|Generate the form code"
  219. Top             =   2400
  220. Width           =   915
  221. Begin SSCommand BtnFindTmplt
  222. HelpContextID = 32
  223. AutoSize        =   2  'Adjust Button Size To Picture
  224. Font3D          =   2  'Raised w/heavy shading
  225. Height          =   600
  226. Left            =   7020
  227. Picture         =   DATAFORM.FRX:1847
  228. TabIndex        =   3
  229. Tag             =   "|Press to find the database"
  230. Top             =   1020
  231. Width           =   600
  232. Begin TextBox TxtTmpltName
  233. HelpContextID = 31
  234. BackColor       =   &H00C0C0C0&
  235. Height          =   375
  236. Left            =   1920
  237. TabIndex        =   2
  238. Tag             =   "Form Template|Name of the form template"
  239. Top             =   1260
  240. Width           =   4995
  241. Begin SSCommand BtnHelp
  242. Caption         =   "&Help"
  243. Font3D          =   2  'Raised w/heavy shading
  244. Height          =   615
  245. Index           =   2
  246. Left            =   5520
  247. Picture         =   DATAFORM.FRX:1B49
  248. TabIndex        =   8
  249. Top             =   2400
  250. Width           =   915
  251. Begin VideoSoftElastic cMsg
  252. Align           =   2  'Bottom
  253. BevelChildren   =   3  'No Graphical or Elastics
  254. BevelInner      =   0  'None
  255. BevelOuter      =   5  'Fillet
  256. BevelOuterWidth =   4
  257. ConvInfo        =   DATAFORM.FRX:1E4B
  258. ForeColor       =   &H00FF0000&
  259. Height          =   375
  260. Index           =   2
  261. IntBkg          =   &H00C0C0C0&
  262. Left            =   0
  263. TabIndex        =   31
  264. Top             =   4080
  265. Width           =   7920
  266. Begin TextBox TxtFormCaption
  267. HelpContextID = 6
  268. BackColor       =   &H00C0C0C0&
  269. Height          =   375
  270. Left            =   1935
  271. TabIndex        =   0
  272. Tag             =   "Caption|Caption for the form you are building"
  273. Text            =   "Caption"
  274. Top             =   240
  275. Width           =   3675
  276. Begin TextBox TxtFormName
  277. HelpContextID = 5
  278. BackColor       =   &H00C0C0C0&
  279. Height          =   375
  280. Left            =   1920
  281. TabIndex        =   1
  282. Tag             =   "Name|Name for the form you are building"
  283. Text            =   "Name"
  284. Top             =   720
  285. Width           =   3675
  286. Begin VideoSoftElastic Page
  287. HelpContextID = 17
  288. BevelChildren   =   3  'No Graphical or Elastics
  289. CaptionPos      =   7  'Right Center
  290. ConvInfo        =   DATAFORM.FRX:1E56
  291. ForeColor       =   &H00FF0000&
  292. Height          =   4455
  293. Index           =   0
  294. IntBkg          =   &H00C0C0C0&
  295. Left            =   45
  296. PicturePos      =   0  'Left Top
  297. TabIndex        =   17
  298. TagSplit        =   -1  'True
  299. TagWidth        =   1500
  300. Top             =   495
  301. Width           =   7920
  302. Begin SSCommand BtnHelp
  303. Caption         =   "&Help"
  304. Font3D          =   2  'Raised w/heavy shading
  305. Height          =   615
  306. Index           =   0
  307. Left            =   5100
  308. Picture         =   DATAFORM.FRX:1E61
  309. TabIndex        =   15
  310. Top             =   2100
  311. Width           =   915
  312. Begin CommonDialog CMDialog1
  313. DialogTitle     =   "Select Database For Data Control"
  314. Filter          =   "Access Databases|*.mdb"
  315. Left            =   180
  316. Top             =   2220
  317. Begin ComboBox LstRecSrce
  318. HelpContextID = 19
  319. BackColor       =   &H00C0C0C0&
  320. Height          =   300
  321. Left            =   1620
  322. Sorted          =   -1  'True
  323. Style           =   2  'Dropdown List
  324. TabIndex        =   13
  325. Tag             =   "Record Source|Select or enter record source for the data control"
  326. Top             =   1680
  327. Width           =   4395
  328. Begin SSCommand BtnFindDB
  329. HelpContextID = 20
  330. AutoSize        =   2  'Adjust Button Size To Picture
  331. Font3D          =   2  'Raised w/heavy shading
  332. Height          =   600
  333. Left            =   5400
  334. Picture         =   DATAFORM.FRX:2163
  335. TabIndex        =   12
  336. Tag             =   "|Press to find the database"
  337. Top             =   960
  338. Width           =   600
  339. Begin TextBox TxtDBName
  340. HelpContextID = 21
  341. BackColor       =   &H00C0C0C0&
  342. Height          =   375
  343. Left            =   1620
  344. TabIndex        =   11
  345. Tag             =   "Database Name|Name of the database for the data control"
  346. Text            =   "Database Name"
  347. Top             =   1200
  348. Width           =   3675
  349. Begin TextBox TxtName
  350. HelpContextID = 22
  351. BackColor       =   &H00C0C0C0&
  352. Height          =   375
  353. Left            =   1620
  354. TabIndex        =   9
  355. Tag             =   "Name|Name for the data control"
  356. Text            =   "DataName"
  357. Top             =   240
  358. Width           =   3675
  359. Begin TextBox TxtCaption
  360. HelpContextID = 23
  361. BackColor       =   &H00C0C0C0&
  362. Height          =   375
  363. Left            =   1620
  364. TabIndex        =   10
  365. Tag             =   "Caption|Caption for the data control"
  366. Text            =   "Data Caption"
  367. Top             =   720
  368. Width           =   3675
  369. Begin SSCommand BtnCancel
  370. AutoSize        =   2  'Adjust Button Size To Picture
  371. Caption         =   "&Cancel"
  372. Font3D          =   2  'Raised w/heavy shading
  373. Height          =   615
  374. Index           =   0
  375. Left            =   4200
  376. Picture         =   DATAFORM.FRX:2465
  377. TabIndex        =   14
  378. Tag             =   "|Cancel building the form"
  379. Top             =   2100
  380. Width           =   915
  381. Begin VideoSoftElastic cMsg
  382. Align           =   2  'Bottom
  383. BevelChildren   =   3  'No Graphical or Elastics
  384. BevelInner      =   0  'None
  385. BevelOuter      =   5  'Fillet
  386. BevelOuterWidth =   4
  387. ConvInfo        =   DATAFORM.FRX:2767
  388. ForeColor       =   &H00FF0000&
  389. Height          =   375
  390. Index           =   0
  391. IntBkg          =   &H00C0C0C0&
  392. Left            =   0
  393. TabIndex        =   18
  394. Top             =   4080
  395. Width           =   7920
  396. Begin Image ImgTabPic
  397. Height          =   480
  398. Index           =   2
  399. Left            =   2280
  400. Picture         =   DATAFORM.FRX:2772
  401. Top             =   3180
  402. Visible         =   0   'False
  403. Width           =   480
  404. Begin Image ImgTabPic
  405. Height          =   480
  406. Index           =   1
  407. Left            =   1620
  408. Picture         =   DATAFORM.FRX:2A74
  409. Top             =   3180
  410. Visible         =   0   'False
  411. Width           =   480
  412. Begin Image ImgTabPic
  413. Height          =   480
  414. Index           =   0
  415. Left            =   840
  416. Picture         =   DATAFORM.FRX:2D76
  417. Top             =   3180
  418. Visible         =   0   'False
  419. Width           =   480
  420. Option Explicit
  421. Dim maxwidth(3) As Long
  422. Sub BtnAdd_Click ()
  423.     Dim i As Integer, fld As String
  424.     ' Add selected feilds to grid
  425.     For i = 0 To LstFields.ListCount - 1
  426.         If LstFields.Selected(i) Then
  427.             fld = LstFields.List(i)
  428.             GrdFields.AddItem fld & Chr$(9) & fld & Chr$(9) & "No" & Chr$(9) & Str$(aiFldSize(i))
  429.             If TextWidth(fld) + 150 > maxwidth(0) Then
  430.                 maxwidth(0) = TextWidth(fld) + 150
  431.                 GrdFields.ColWidth(0) = maxwidth(0)
  432.             End If
  433.             If TextWidth(fld) + 150 > maxwidth(1) Then
  434.                 maxwidth(1) = TextWidth(fld) + 150
  435.                 GrdFields.ColWidth(1) = maxwidth(1)
  436.             End If
  437.         End If
  438.     Next i
  439.     If GrdFields.Rows > 1 Then
  440.         GrdFields.FixedRows = 1
  441.         Mid(RequiredFieldsComplete, 2) = "Y"
  442.         Call SetFinishBtn
  443.     End If
  444. End Sub
  445. Sub BtnAdd_GotFocus ()
  446.     cMsg(1).Caption = BtnAdd.Tag
  447. End Sub
  448. Sub BtnAdd_LostFocus ()
  449.     cMsg(1).Caption = ""
  450. End Sub
  451. Sub BtnCancel_Click (Index As Integer)
  452.     EndItNow
  453. End Sub
  454. Sub BtnCancel_GotFocus (Index As Integer)
  455.     SetStatusBar BtnCancel(Index)
  456. End Sub
  457. Sub BtnCancel_LostFocus (Index As Integer)
  458.     ClearStatusBar
  459. End Sub
  460. Sub BtnFindDB_Click ()
  461.     CMDialog1.Flags = OFN_FILEMUSTEXIST
  462.     CMDialog1.Action = 1
  463.     If CMDialog1.Filename <> "" Then
  464.         TxtDBName = CMDialog1.Filename
  465.         GetTableNames
  466.     End If
  467. End Sub
  468. Sub BtnFindDB_GotFocus ()
  469.     SetStatusBar BtnFindDB
  470. End Sub
  471. Sub BtnFindDB_LostFocus ()
  472.     ClearStatusBar
  473. End Sub
  474. Sub BtnFindForm_Click ()
  475.     CMDialog2.DialogTitle = "Save Form As"
  476.     CMDialog2.Filename = TxtName & ".Frm"
  477.     CMDialog2.Flags = OFN_OVERWRITEPROMPT + OFN_PATHMUSTEXIST
  478.     CMDialog2.Action = 2
  479.     If CMDialog2.Filename <> "" Then
  480.         TxtFrmName.Text = CMDialog2.Filename
  481.         Mid(RequiredFieldsComplete, 4) = "Y"
  482.         Call SetFinishBtn
  483.     End If
  484. End Sub
  485. Sub BtnFindForm_GotFocus ()
  486.     SetStatusBar BtnFindForm
  487. End Sub
  488. Sub BtnFindForm_LostFocus ()
  489.     ClearStatusBar
  490. End Sub
  491. Sub BtnFindTmplt_Click ()
  492.     CMDialog2.DialogTitle = "Select Form Template"
  493.     CMDialog2.Filename = ""
  494.     CMDialog2.Flags = OFN_FILEMUSTEXIST
  495.     CMDialog2.Action = 1
  496.     If CMDialog2.Filename <> "" Then
  497.         TxtTmpltName = CMDialog2.Filename
  498.         Mid(RequiredFieldsComplete, 3) = "Y"
  499.         Call SetFinishBtn
  500.     End If
  501. End Sub
  502. Sub BtnFindTmplt_GotFocus ()
  503.     SetStatusBar BtnFindTmplt
  504. End Sub
  505. Sub BtnFindTmplt_LostFocus ()
  506.     ClearStatusBar
  507. End Sub
  508. Sub BtnFinish_Click ()
  509.     Dim msg As String, Char As String
  510.     On Error GoTo GenerateErr
  511.     mousepointer = HOURGLASS
  512.     ' Verify that file names are correct
  513.     stemplate = TxtTmpltName.Text
  514.     If Right$(UCase$(TxtFrmName.Text), 4) <> ".FRM" Then
  515.         TxtFrmName.Text = TxtFrmName.Text & ".FRM"
  516.     End If
  517.     sForm = TxtFrmName.Text
  518.     If stemplate = "" Then
  519.         Beep
  520.         mousepointer = DEFAULT
  521.         MsgBox "You must specify a form template or use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error"
  522.         TxtTmpltName.SetFocus
  523.         Exit Sub
  524.     End If
  525.     If Dir$(stemplate) = "" Then
  526.         Beep
  527.         mousepointer = DEFAULT
  528.         MsgBox "The form template you have specified does not exist!  Use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error"
  529.         TxtTmpltName.SetFocus
  530.         Exit Sub
  531.     End If
  532.     If sForm = "" Then
  533.         Beep
  534.         mousepointer = DEFAULT
  535.         MsgBox "You must specify a form name or use the file drawer button to locate a form.", 0 + 48 + 0 + 0, "Form Save Error"
  536.         TxtFrmName.SetFocus
  537.         Exit Sub
  538.     End If
  539.     If sForm = stemplate Then
  540.         Beep
  541.         mousepointer = DEFAULT
  542.         MsgBox "You cannot use the template as the output form.", 0 + 48 + 0 + 0, "Form Save Error"
  543.         TxtFrmName.SetFocus
  544.         Exit Sub
  545.     End If
  546.     On Error GoTo erropeningtemplate
  547.     Open stemplate For Input Access Read Lock Write As #1
  548.     On Error GoTo erropeningform
  549.     Open sForm For Output Access Write Lock Read Write As #2
  550.     On Error GoTo GenerateErr
  551.     indent = 0
  552.     Do While Not EOF(1)
  553.         sFormLine = ""
  554.         
  555.         Do
  556.             Char = Input$(1, #1)
  557.             sFormLine = sFormLine + Char
  558.         Loop While Char <> Chr$(10)
  559.         sFormLine = Left$(sFormLine, Len(sFormLine) - 2)
  560.         Select Case True
  561.         Case InStr(1, sFormLine, "Begin Form", 1) <> 0      ' Beginning of form
  562.             Print #2, "Begin Form " & DataForm.TxtFormName.Text
  563.             indent = 3
  564.         Case InStr(1, sFormLine, "Caption", 1) <> 0         ' Form Caption line
  565.             Print #2, Spc(indent); "Caption = " & Chr$(34) & DataForm.TxtFormCaption.Text & Chr$(34)
  566.         Case InStr(1, sFormLine, "Begin ", 1) <> 0    ' Beginning of control
  567.             Select Case True
  568.             Case InStr(1, sFormLine, " Lbl1", 1) <> 0   ' Beginning of label 1
  569.                 Call SaveLabel1
  570.             Case InStr(1, sFormLine, " Lbl2", 1) <> 0   ' Beginning of label 2
  571.                 Call SaveLabel2
  572.             Case InStr(1, sFormLine, " Fld1", 1) <> 0   ' Beginning of field 1
  573.                 Call SaveField1
  574.             Case InStr(1, sFormLine, " Fld2", 1) <> 0   ' Beginning of field 2
  575.                 Call SaveField2
  576.             Case InStr(1, sFormLine, " Data", 1) <> 0   ' Beginning of data control
  577.                 Call SaveDataCtrl
  578.             Case Else               ' Beginning of other control
  579.                 Call SaveControl
  580.             End Select
  581.         Case InStr(1, sFormLine, "End", 1) <> 0                 ' End of form
  582.             If Len(sFormLine) < InStr(1, sFormLine, "End", 1) + 4 Then
  583.                 Call GotEndOfForm
  584.             Else
  585.                 Print #2, Spc(indent); sFormLine        ' Output any unrecognized lines as is
  586.             End If
  587.         Case Else
  588.             Print #2, Spc(indent); sFormLine        ' Output any unrecognized lines as is
  589.         End Select
  590.     Loop
  591.     Close #1
  592.     Close #2
  593.     msg = "Form " & sForm & " generated."
  594.     Beep
  595.     mousepointer = DEFAULT
  596.     MsgBox msg, MB_ICONINFORMATION, "Form Wizard Generation"
  597.     db.Close        ' Close the database
  598.     MainForm.Show MODELESS
  599.     Unload DataForm
  600.     Exit Sub
  601. GenerateErr:
  602.     erraction = RB_ErrorHandler("GenForm", "BtnFinish_Click")
  603.     Select Case erraction
  604.     Case 1
  605.         Resume 0      ' Retry option selected
  606.     Case 2
  607.         Resume Next   ' Ignore option selected
  608.     End Select
  609.     On Error Resume Next
  610.     Close #1, #2
  611.     On Error GoTo GenerateErr
  612.     Exit Sub
  613. erropeningtemplate:
  614.         Beep
  615.         mousepointer = DEFAULT
  616.         msg = "A " & Error & " error has occurred opening the template file!  Please correct and retry the function"
  617.         MsgBox msg, 0 + 48 + 0 + 0, "Form Template Error"
  618.         TxtTmpltName.SetFocus
  619.         Close #1, #2
  620.         On Error GoTo GenerateErr
  621.         Exit Sub
  622. erropeningform:
  623.         Beep
  624.         mousepointer = DEFAULT
  625.         msg = "A " & Error & " error has occurred opening the output form file!  Please correct and retry the function"
  626.         MsgBox msg, 0 + 48 + 0 + 0, "Form Output Error"
  627.         TxtTmpltName.SetFocus
  628.         Exit Sub
  629. End Sub
  630. Sub BtnHelp_Click (Index As Integer)
  631.     SendKeys "{F1}"
  632. End Sub
  633. Sub BtnHelp_GotFocus (Index As Integer)
  634.     SetStatusBar BtnCancel(Index)
  635. End Sub
  636. Sub BtnHelp_LostFocus (Index As Integer)
  637.     ClearStatusBar
  638. End Sub
  639. Sub BtnRemove_Click ()
  640.     On Error GoTo removeerr
  641.     Dim i As Integer, i2 As Integer
  642.     ' Remove any selected rows except the last one
  643.     For i = GrdFields.Rows - 2 To 0 Step -1
  644.         GrdFields.Row = i
  645.         GrdFields.Col = 1
  646.         If GrdFields.CellSelected Then
  647.             GrdFields.RemoveItem i
  648.         End If
  649.     Next i
  650.     ' Check if last row is deleted and handle special to prevent error
  651.     ' caused by selection defaulting to the entire table when the last
  652.     ' row is removed
  653.     i = GrdFields.Rows - 1
  654.     GrdFields.Row = i
  655.     GrdFields.Col = 1
  656.     If GrdFields.CellSelected Then
  657.         GrdFields.FixedRows = 0
  658.         GrdFields.RemoveItem i
  659.     End If
  660.     GrdFields.Refresh
  661.     If GrdFields.Rows > 1 Then GrdFields.FixedRows = 1
  662.     Exit Sub
  663. removeerr:
  664.     erraction = RB_ErrorHandler("FieldFrm", "BtnRemove_Click")
  665.     Select Case erraction
  666.     Case 1
  667.         Resume 0      ' Retry option selected
  668.     Case 2
  669.         Resume Next   ' Ignore option selected
  670.     End Select
  671. End Sub
  672. Sub BtnRemove_GotFocus ()
  673.     cMsg(1).Caption = BtnRemove.Tag
  674. End Sub
  675. Sub BtnRemove_LostFocus ()
  676.     cMsg(1).Caption = ""
  677. End Sub
  678. Sub ClearStatusBar ()
  679.     cMsg(VsIndexTab1.CurrTab).Caption = ""
  680. End Sub
  681. Sub FldGotFocus (PControl As Control)
  682.     PControl.BackColor = BLUE
  683.     PControl.ForeColor = WHITE
  684.     If TypeOf PControl Is TextBox Then
  685.         PControl.SelStart = 0
  686.         PControl.SelLength = 1000
  687.     End If
  688.     If InStr(PControl.Tag, "|") = 0 Then
  689.         cMsg(VsIndexTab1.CurrTab).Caption = PControl.Tag
  690.     Else
  691.         cMsg(VsIndexTab1.CurrTab).Caption = Mid$(PControl.Tag, InStr(PControl.Tag, "|") + 1)
  692.     End If
  693. End Sub
  694. Sub FldLostFocus (PControl As Control)
  695.     PControl.BackColor = RB_GRAY
  696.     PControl.ForeColor = BLACK
  697.     cMsg(VsIndexTab1.CurrTab).Caption = ""
  698. End Sub
  699. Sub Form_Load ()
  700.     On Error GoTo loaderr
  701.     ' Set up grid headings
  702.     GrdFields.Row = 0
  703.     GrdFields.Col = 0
  704.     GrdFields.Text = "Field"
  705.     GrdFields.ColWidth(0) = TextWidth(" Field ")
  706.     maxwidth(0) = GrdFields.ColWidth(0)
  707.     GrdFields.Col = 1
  708.     GrdFields.Text = "Label"
  709.     GrdFields.ColWidth(1) = TextWidth(" Label ")
  710.     maxwidth(1) = GrdFields.ColWidth(1)
  711.     GrdFields.Col = 2
  712.     GrdFields.Text = "Same" & Chr$(13) & "Line"
  713.     GrdFields.ColWidth(2) = TextWidth(" Same ")
  714.     maxwidth(2) = GrdFields.ColWidth(2)
  715.     GrdFields.Col = 3
  716.     GrdFields.Text = "Size"
  717.     GrdFields.ColWidth(3) = TextWidth(" Size ")
  718.     GrdFields.RowHeight(0) = 2 * TextHeight("Same")
  719.     VsIndexTab1.TabEnabled(1) = False
  720.     VsIndexTab1.TabPicture(0) = ImgTabPic(0)
  721.     VsIndexTab1.TabPicture(1) = ImgTabPic(1)
  722.     VsIndexTab1.TabPicture(2) = ImgTabPic(2)
  723.     Exit Sub
  724. loaderr:
  725.     erraction = RB_ErrorHandler("FieldFrm", "Form_Load")
  726.     Select Case erraction
  727.     Case 1
  728.         Resume 0      ' Retry option selected
  729.     Case 2
  730.         Resume Next   ' Ignore option selected
  731.     End Select
  732. End Sub
  733. Sub Form_Resize ()
  734.     If DataForm.WindowState <> 1 Then       ' If not minimized
  735.         If VsIndexTab1.CurrTab = 1 Then     ' If field tab is current
  736.             FramFldsOnForm.Width = DataForm.Width - FramFldsOnForm.Left - 250
  737.             GrdFields.Width = FramFldsOnForm.Width - GrdFields.Left - 150
  738.         End If
  739.     End If
  740. End Sub
  741. Sub GetTableNames ()
  742.     ' Get names of tables in selected database
  743.     Dim sstables As snapshot, msg As String
  744.     On Error GoTo GetTablesErr
  745.     mousepointer = HOURGLASS
  746.     If TxtDBName.Text = "" Then Exit Sub
  747.     On Error GoTo OpenDBErr
  748.     If Dir$(TxtDBName.Text) = "" Then
  749.         Beep
  750.         MsgBox "The database name you have specified does not exist!  Use the file drawer button to locate a database.", 0 + 48 + 0 + 0, "Database Selection Error"
  751.         TxtDBName.SetFocus
  752.         mousepointer = DEFAULT
  753.         Exit Sub
  754.     End If
  755.     LstRecSrce.Clear
  756.     Set db = OpenDatabase(TxtDBName.Text)
  757.     On Error GoTo GetTablesErr
  758.     Set sstables = db.ListTables()
  759.     Do While Not sstables.EOF
  760.         If sstables!Attributes And DB_SYSTEMOBJECT Then
  761.         Else
  762.             LstRecSrce.AddItem sstables!Name
  763.         End If
  764.         sstables.MoveNext
  765.     Loop
  766.     sstables.Close
  767.     LstRecSrce.ListIndex = 0
  768.     Mid(RequiredFieldsComplete, 1, 1) = "Y"
  769.     Call SetFinishBtn
  770.     mousepointer = DEFAULT
  771.     Exit Sub
  772. OpenDBErr:
  773.     Beep
  774.     mousepointer = DEFAULT
  775.     msg = "A " & Error & " error has occurred opening the database!  Please correct and retry the function"
  776.     MsgBox msg, 0 + 48 + 0 + 0, "Database Specification Error"
  777.     TxtDBName.SetFocus
  778.     On Error GoTo GetTablesErr
  779.     mousepointer = DEFAULT
  780.     Exit Sub
  781. GetTablesErr:
  782.     mousepointer = DEFAULT
  783.     erraction = RB_ErrorHandler("DataSpec", "GetTableNames")
  784.     Select Case erraction
  785.     Case 1
  786.         Resume 0      ' Retry option selected
  787.     Case 2
  788.         Resume Next   ' Ignore option selected
  789.     End Select
  790. End Sub
  791. Sub GrdFields_GotFocus ()
  792.     cMsg(1).Caption = GrdFields.Tag
  793. End Sub
  794. Sub GrdFields_LostFocus ()
  795.     cMsg(1).Caption = ""
  796. End Sub
  797. Sub GrdFields_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  798.     Dim i As Integer, istart As Integer, iend As Integer
  799.     If Button = RIGHT_BUTTON Then
  800.         istart = GrdFields.SelStartRow
  801.         If istart = 0 Then istart = 1
  802.         iend = GrdFields.SelEndRow
  803.         For i = istart To iend
  804.             GrdFields.Row = i
  805.             GrdFields.Col = 0
  806.             ChngFld.LblField.Caption = GrdFields.Text
  807.             GrdFields.Col = 1
  808.             ChngFld.TxtLabel = GrdFields.Text
  809.             GrdFields.Col = 2
  810.             If GrdFields.Text = "Yes" Then
  811.                 ChngFld.ChkSameLine.Value = True
  812.             Else
  813.                 ChngFld.ChkSameLine.Value = False
  814.             End If
  815.             ChngFld.LblRow.Caption = Str$(i)
  816.             ChngFld.Show MODAL
  817.         Next i
  818.     End If
  819. End Sub
  820. Sub LstFields_GotFocus ()
  821.     cMsg(1).Caption = LstFields.Tag
  822. End Sub
  823. Sub LstFields_LostFocus ()
  824.     cMsg(1).Caption = ""
  825. End Sub
  826. Sub LstRecSrce_Click ()
  827.     Dim ds As dynaset, ssfields As snapshot
  828.     Dim iNumFlds As Integer
  829.     On Error GoTo LoadListErr
  830.     ' Load list of fields in record source
  831.     mousepointer = HOURGLASS
  832.     Set ds = db.CreateDynaset(LstRecSrce.Text)
  833.     Set ssfields = ds.ListFields()
  834.     ds.Close
  835.     LstFields.Clear
  836.     ReDim aiFldSize(1)
  837.     iNumFlds = -1
  838.     Do While Not ssfields.EOF
  839.         LstFields.AddItem ssfields!Name
  840.         iNumFlds = iNumFlds + 1
  841.         ReDim Preserve aiFldSize(iNumFlds)
  842.         aiFldSize(iNumFlds) = ssfields!Size
  843.         ssfields.MoveNext
  844.     Loop
  845.     ssfields.Close
  846.     NewRecordSource = False
  847.     ' Clear the grid of fields
  848.     GrdFields.Rows = 1
  849.     VsIndexTab1.TabEnabled(1) = True    ' Enable the Fields tab
  850.     mousepointer = DEFAULT
  851.     Exit Sub
  852. LoadListErr:
  853.     erraction = RB_ErrorHandler("FieldFrm", "Form_Activate")
  854.     Select Case erraction
  855.     Case 1
  856.         Resume 0      ' Retry option selected
  857.     Case 2
  858.         Resume Next   ' Ignore option selected
  859.     End Select
  860. End Sub
  861. Sub LstRecSrce_GotFocus ()
  862.     FldGotFocus LstRecSrce
  863. End Sub
  864. Sub LstRecSrce_LostFocus ()
  865.     FldLostFocus LstRecSrce
  866. End Sub
  867. Sub SetFinishBtn ()
  868.     ' Check if Finish Button should be enabled
  869.     If RequiredFieldsComplete = "YYYY" Then
  870.         BtnFinish.Enabled = True
  871.     Else
  872.         BtnFinish.Enabled = False
  873.     End If
  874. End Sub
  875. Sub SetStatusBar (PControl As Control)
  876.     If InStr(PControl.Tag, "|") = 0 Then
  877.         cMsg(VsIndexTab1.CurrTab).Caption = PControl.Tag
  878.     Else
  879.         cMsg(VsIndexTab1.CurrTab).Caption = Mid$(PControl.Tag, InStr(PControl.Tag, "|") + 1)
  880.     End If
  881. End Sub
  882. Sub TxtCaption_GotFocus ()
  883.     FldGotFocus TxtCaption
  884. End Sub
  885. Sub TxtCaption_LostFocus ()
  886.     FldLostFocus TxtCaption
  887. End Sub
  888. Sub TxtDBName_GotFocus ()
  889.     FldGotFocus TxtDBName
  890. End Sub
  891. Sub TxtDBName_LostFocus ()
  892.     FldLostFocus TxtDBName
  893.     If TxtDBName.DataChanged Then
  894.         GetTableNames
  895.     End If
  896. End Sub
  897. Sub TxtFormCaption_GotFocus ()
  898.     FldGotFocus TxtFormCaption
  899. End Sub
  900. Sub TxtFormCaption_LostFocus ()
  901.     FldLostFocus TxtFormCaption
  902. End Sub
  903. Sub TxtFormName_GotFocus ()
  904.     FldGotFocus TxtFormName
  905. End Sub
  906. Sub TxtFormName_LostFocus ()
  907.     FldLostFocus TxtFormName
  908. End Sub
  909. Sub TxtFrmName_GotFocus ()
  910.     FldGotFocus TxtFrmName
  911. End Sub
  912. Sub TxtFrmName_LostFocus ()
  913.     FldLostFocus TxtFrmName
  914.     If TxtFrmName.Text <> "" Then
  915.         Mid(RequiredFieldsComplete, 4) = "Y"
  916.         Call SetFinishBtn
  917.     End If
  918. End Sub
  919. Sub TxtName_GotFocus ()
  920.     FldGotFocus TxtName
  921. End Sub
  922. Sub TxtName_LostFocus ()
  923.     FldLostFocus TxtName
  924. End Sub
  925. Sub TxtTmpltName_GotFocus ()
  926.     FldGotFocus TxtTmpltName
  927. End Sub
  928. Sub TxtTmpltName_LostFocus ()
  929.     FldLostFocus TxtTmpltName
  930.     If TxtTmpltName.Text <> "" Then
  931.         Mid(RequiredFieldsComplete, 3) = "Y"
  932.         Call SetFinishBtn
  933.     End If
  934. End Sub
  935.