home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1996-07-08 | 129.7 KB | 3,968 lines
Type DatabaseConstants From Globals Dim DBC_READ_ONLY As Integer Dim DBC_READ_WRITE As Integer Dim DBC_LABEL As Integer Dim DBC_NO_CHANGE As Long Dim DBC_ALL As Integer ' METHODS for object: DatabaseConstants Function DeSpace(ByVal OldStr as String) As String Dim i as integer i = 0 While i <= Len(OldStr) If Mid$(OldStr, i, 1) = " " Then OldStr = Left$(OldStr, i - 1) & Right$(OldStr, Len(OldStr) - i) Else i = i + 1 End If Wend DeSpace = OldStr End Function End Type Type DataBaseFormMaker Dim DBFMForm As Form Dim DBFMRecordSet As RecordSet Dim CurrentY As Long Dim Margin As Long Declare Function GetTabbedTextExtent Lib "User32.dll" Alias "GetTabbedTextExtentA" (ByVal hdc As Long, ByVal lpsz As String, ByVal cchString As Long, ByVal nTabPos As Long, ByVal lpnTabStopPos As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hFont As Long) As Long Declare Function GetStockObject Lib "gdi32" (ByVal fnObject) As Long Type FieldOptions Dim CanEdit As Boolean Dim FieldName As String Dim MaxLength As Integer Dim Width As Integer Dim Caption As String ' METHODS for object: DataBaseFormMaker.FieldOptions Sub Report Debug.Print "-----------------------------------------------" Debug.Print "CanEdit ---- " & IIf(CanEdit, "True", "False") Debug.Print "Caption ---- " & Caption Debug.Print "FieldName -- " & FieldName Debug.Print "MaxLength -- " & MaxLength Debug.Print "Width ------ " & Width Debug.Print "-----------------------------------------------" End Sub End Type Type OptionGroup From Group ' METHODS for object: DataBaseFormMaker.OptionGroup Function Report(pos as integer) As String Dim StackString, endl as string endl = "^J^M" StackString = "Report for position " & pos & endl If pos >= Count Then StackString = StackString & "Out of range " & endl Else StackString = StackString & "CanEdit: " & IIf(ObjectAt(pos).CanEdit, "True", "False") & endl StackString = StackString & "Include: " & IIf(ObjectAt(pos).Include, "True", "False") & endl StackString = StackString & "FieldName: " & ObjectAt(pos).FieldName & endl End If Report = StackString End Function Function SpecialField(pos as integer) As Object Dim i as integer If Count Then For i = 0 To Count - 1 If ObjectAt(i).Position = pos Then SpecialField = ObjectAt(i) Exit Function End If Next i End If SpecialField = Nothing End Function End Type Dim DBLblFont As Font Dim DBRWFont As Font Dim DBROFont As Font Dim LblBackColor As Long Dim LblForeColor As Long Dim DBROForeColor As Long Dim DBROBackColor As Long Dim DBRWBackColor As Long Dim DBRWForeColor As Long Dim DefaultFont As New Font Dim SystemFont As Long Dim LabelWidth As Integer Dim LabelHeight As Integer Dim DBFieldHeight As Integer Dim DBROMaxCharWidth As Integer Dim DBRWMaxCharWidth As Integer Dim HyperWidth As Long Dim LblFldHeight As Long ' METHODS for object: DataBaseFormMaker Sub GetFontDims(ByVal TForm as Form, ByVal TFont as Font, ByVal Tstr as string, wid as integer, hei as integer) ' WARNING: This method will do the SelectObject with on the Form with the ' font, and not restore the original font. BE WARNED If TForm && TForm.hDC Then SelectObject(TForm.hDC, IIF(TFont && TFont.HFont, TFont.HFont, SystemFont)) GetTextExtent(TForm.hDC, Tstr, wid, hei) End If End Sub Function SetReferences(o as RecordSet) As Long Dim flag as Boolean Dim Pointer as Object DBFMRecordSet = o Pointer = o While Pointer && Not(TypeOf Pointer is Form) Pointer = HostObject(Pointer) Wend If Pointer then DBFMForm = IIF(TypeOf Pointer is DataControl, HostObject(Pointer), Pointer) SetReferences = True Else SetReferences = False End If If DBFMForm && DBFMForm.Font && DBFMForm.Font.HFont Then SystemFont = DBFMForm.Font.HFont Else SystemFont = GetStockObject(13) 'SYSTEM_FONT = 13 If SystemFont = 0 Then SystemFont = DefaultFont.HFont End If End Function Sub BuildGroup Dim i as integer OptionGroup.Clear If DBFMRecordSet && DBFMRecordSet.FieldCount Then With DBFMRecordSet For i = 0 To .FieldCount - 1 Dim Blank as DataBaseFormMaker.FieldOptions Blank = CopyObject(DataBaseFormMaker.FieldOptions, "") Blank.CanEdit = True Blank.Include = True .FieldIndex = i Blank.FieldName = .FieldName Blank.MaxLength = .FieldMaxLength Blank.Position = i OptionGroup.Append(Blank) Next i End With End If End Sub Function CalculateWidth(OldObj as Control, NewObj as Control) As Long If OldObj.MaxLength = 0 Then CalculateWidth = OldObj.Width Else If TypeOf NewObj Is DatabaseReadOnlyField Then CalculateWidth = (OldObj.MaxLength + 2) * DBROMaxCharWidth Else CalculateWidth = (OldObj.MaxLength + 2) * DBRWMaxCharWidth End If End If End Function Sub ClearColors LblBackColor = -1 LblForeColor = -1 DBROBackColor = RGB(255, 255, 255) DBROForeColor = -1 DBRWBackColor = -1 DBRWForeColor = -1 End Sub Sub CreateSet(pos as integer) Dim Opts as DataBaseFormMaker.FieldOptions Dim Lbl, Tb as Object Opts = OptionGroup(pos) If Opts.CanEdit Then Tb = EmbedObject(DBFMForm, DatabaseReadWriteField, UniqueEmbedName(DBFMForm, "DBRW" & DeSpace(Opts.FieldName))) Else Tb = EmbedObject(DBFMForm, DatabaseReadOnlyField, UniqueEmbedName(DBFMForm, "DBRO" & DeSpace(Opts.FieldName))) End If ' If Width is specified, use it, otherwise use old methods If Opts.Width Then Tb.Move(LabelWidth + (2 * Margin), CurrentY + ((LblFldHeight - DBFieldHeight) / 2) + Margin, Opts.Width, DBFieldHeight) Else If Opts.MaxLength Then Tb.Move(LabelWidth + (2 * Margin), CurrentY + ((LblFldHeight - DBFieldHeight) / 2) + Margin, ((Opts.MaxLength + 2) * IIf(Opts.CanEdit, DBRWMaxCharWidth, DBROMaxCharWidth)), DBFieldHeight) Else Tb.Move(LabelWidth + (2 * Margin), CurrentY + ((LblFldHeight - DBFieldHeight) / 2) + Margin, HyperWidth - Margin - LabelWidth, DBFieldHeight) End If End If If Opts.Caption <> "" Then Lbl = EmbedObject(DBFMForm, DatabaseLabel, UniqueEmbedName(DBFMForm, "DBLbl" & DeSpace(Opts.FieldName))) Lbl.Move(Margin, CurrentY + Margin + ((LblFldHeight - LabelHeight) / 2) , LabelWidth, LabelHeight) Lbl.Caption = Opts.Caption & ":" End If Tb.MaxLength = Opts.MaxLength CurrentY = CurrentY + LblFldHeight + Margin Tb.DataField = Opts.FieldName Tb.IndexPosition = pos Tb.ZOrder = 32767 End Sub Sub DestroyControls Dim o as Control If DBFMRecordSet = Nothing Then Exit Sub For Each o In DBFMRecordSet.Controls DestroyObject(o) Next o End Sub Sub GetTextExtent(dc As Long, s As String, width, height as Integer) dim result as long result = GetTabbedTextExtent(dc, s, Len(s), 0, 0) ' The results are stored in the upper word and lower word of return value as pixels, ' convert these numbers to twips before returning. width = (result And &Hffff) * Screen.TwipsPerPixelX height = ((result And &Hffff0000) / &H10000) * Screen.TwipsPerPixelY End Sub Sub Go Dim i as integer Dim OldSMode, OldSHeight, OldSLeft, OldSTop, OldSWidth as single ' Verify the existence of the Form and the RecordSet If Not DBFMForm Then InfoBox.SetIconStop InfoBox.Message("Fatal Error", "You must have the DBFMForm reference set") Exit Sub End If If Not DBFMRecordSet Then InfoBox.SetIconStop InfoBox.Message("Fatal Error", "You must have the DBFMRecordSet reference set") Exit Sub End If ' Cache away the old ScaleMode With DBFMForm OldSMode = .ScaleMode If OldSMode = 0 then OldSLeft = .ScaleLeft OldSTop = .ScaleTop OldSWidth = .ScaleWidth OldSHeight = .ScaleHeight End If ' Set ScaleMode to twips, and set the top left corner to avoid bevels .ScaleMode = "Twip" If .BevelInner <> 0 Then .ScaleLeft = .ScaleLeft + (.BevelWidth * Screen.TwipsPerPixelX) .ScaleTop = .ScaleTop + (.BevelWidth * Screen.TwipsPerPixelY) End If If .BevelOuter <> 0 Then .ScaleLeft = .ScaleLeft + (.BevelWidth * Screen.TwipsPerPixelX) .ScaleTop = .ScaleTop + (.BevelWidth * Screen.TwipsPerPixelY) End If .ScaleLeft = .ScaleLeft + (.BorderWidth * Screen.TwipsPerPixelX) .ScaleTop = .ScaleTop + (.BorderWidth * Screen.TwipsPerPixelY) End With ' Whatever CurrentY is initialized to is where the layout will begin (top) ' (Although a margin will be added above the first control) CurrentY = 0 ' HyperWidth will be the MAXIMUM TOTAL Width of the layout from the left of the labels ' To the right of any Fields with no MaxChar and no specified width ' For now, we're using the ScaleWidth of the form (which we just set to twips twips) ' Then subtract Double the BevelWidth if BevelInner or Outer is set, double the ' BorderWidth, and two margins DBFMForm.Show With DBFMForm HyperWidth = .ScaleWidth - 2 * Margin HyperWidth = HyperWidth - IIF(.BevelInner > 0, (2 * .BevelWidth * Screen.TwipsPerPixelX), 0) HyperWidth = HyperWidth - IIF(.BevelOuter > 0, (2 * .BevelWidth * Screen.TwipsPerPixelX), 0) HyperWidth = HyperWidth - (2 * .BorderWidth * Screen.TwipsPerPixelX) End With ' Figure out Label and Textbox Widths SetLabelDims SetTemplate For i = 0 To OptionGroup.Count - 1 CreateSet(i) Next i ResetTemplates RecordSet.MoveLast RecordSet.MoveFirst ' Restore the ScaleMode DBFMForm.ScaleMode = OldSMode If OldSMode = 0 then DBFMForm.ScaleLeft = OldSLeft DBFMForm.ScaleTop = OldSTop DBFMForm.ScaleWidth = OldSWidth DBFMForm.ScaleHeight = OldSHeight End If End Sub Function LocateObjectByField(field as string) As Object Dim o as Control For Each o EmbeddedIn DBFMForm If DBFMRecordSet = o.DataSource && o.DataField = field Then LocateObjectByField = o Exit Function End If Next o Throw CouldNotFindField End Function Sub Modify(ByVal element as integer, ByVal NewBackColor as long, ByVal NewForeColor as long, NewFont as Font) ' This algorithm is designed so that if Nothing is passed as the ' last parameter, the font will not be changed. Also if DBC_NO_CHANGE ' is passed for NewBackColor or NewForeColor, those values will ' not be changed ' The algorithm will only change controls embedded in the form ' pointed to by the DBFMForm reference who's DataSource is set to ' the DBFMRecordSet pointed at by the DBFMRecordSet reference Select Case element Case DBC_READ_ONLY Dim o as DatabaseReadOnlyField For Each o EmbeddedIn DBFMForm UpdateElement(o, NewBackColor, NewForeColor, NewFont) Next o Case DBC_READ_WRITE Dim o as DatabaseReadWriteField For Each o EmbeddedIn DBFMForm UpdateElement(o, NewBackColor, NewForeColor, NewFont) Next o Case DBC_LABEL Dim o as DatabaseLabel For Each o EmbeddedIn DBFMForm UpdateElement(o, NewBackColor, NewForeColor, NewFont) Next o Case Else Throw InvalidElement End Select End Sub Sub ReconstructGroup() Dim i as integer Dim DataField, DataLabel as object Dim o(100) as object Dim OldSMode, OldSHeight, OldSLeft, OldSTop, OldSWidth as single If Not DBFMRecordSet Then Throw NoDBFMRecordSet If DBFMRecordSet.Controls.Count = 0 Then Throw EmptyDBFMRecordSet If DBFMRecordSet.FieldCount > 100 then Redim o(DBFMRecordSet.FieldCount) ' Cache away the old ScaleMode OldSMode = DBFMForm.ScaleMode If OldSMode = 0 then OldSLeft = DBFMForm.ScaleLeft OldSTop = DBFMForm.ScaleTop OldSWidth = DBFMForm.ScaleWidth OldSHeight = DBFMForm.ScaleHeight End If ' Set ScaleMode to twips DBFMForm.ScaleMode = "Twip" OptionGroup.Clear For i = 0 To DBFMRecordSet.Controls.Count - 1 Dim FO as DataBaseFormMaker.FieldOptions FO = CopyObject(DataBaseFormMaker.FieldOptions, "") ' I'm depending on FieldOptions Defaults as CanEdit = True, and MaxLength = 0 (unlimited) DataField = DBFMRecordSet.Controls(i) ' We're building the list based on the Field controls, not the labels (We get the label from the Fields) If Not TypeOf DataField Is DatabaseLabel Then If DataField.Parent Then DataLabel = FindEmbed(DataField.Parent, "DBLbl" & Right$(DataField.Name, Len(DataField.Name) - 4)) If TypeOf DataField Is DatabaseReadOnlyField Then FO.CanEdit = False FO.MaxLength = DataField.MaxLength ' Need to make a "guess" at width here as follows: If FO.MaxLength <> 0 Then If DataField.Width <> (IIf(FO.CanEdit, DBRWMaxCharWidth, DBROMaxCharWidth) * (FO.MaxLength + 2)) Then FO.Width = DataField.Width Else FO.Width = 0 End If Else ' MaxLength = 0, ' This part is left out until I decide where/if I want to store HyperWidth If DataField.Width <> HyperWidth - LabelWidth - Margin Then FO.Width = DataField.Width Else FO.Width = 0 ' 'I think End If End If FO.Caption = IIf(DataLabel <> Nothing, Left$(DataLabel.Caption, Len(DataLabel.Caption) - 1), "*~!~*") FO.FieldName = DataField.DataField o(DataField.IndexPosition) = FO End If Next i For i = 0 to DBFMRecordSet.FieldCount If o(i) then OptionGroup.Append(o(i)) Next i ' Restore the ScaleMode DBFMForm.ScaleMode = OldSMode If OldSMode = 0 then DBFMForm.ScaleLeft = OldSLeft DBFMForm.ScaleTop = OldSTop DBFMForm.ScaleWidth = OldSWidth DBFMForm.ScaleHeight = OldSHeight End If End Sub Sub Refresh(element As Integer) Select Case element Case DBC_READ_ONLY Modify(element, DBROBackColor, DBROForeColor, DBROFont) Case DBC_READ_WRITE Modify(element, DBRWBackColor, DBRWForeColor, DBRWFont) Case DBC_LABEL Modify(element, LblBackColor, LblForeColor, DBLblFont) Case DBC_ALL Modify(DBC_READ_ONLY, DBROBackColor, DBROForeColor, DBROFont) Modify(DBC_READ_WRITE, DBRWBackColor, DBRWForeColor, DBRWFont) Modify(DBC_LABEL, LblBackColor, LblForeColor, DBLblFont) End Select End Sub Sub ResetTemplates With DatabaseReadOnlyField .BackColor = RGB(255, 255, 255) .ForeColor = -1 .Font = Nothing .DataSource = Nothing End With With DatabaseReadWriteField .BackColor = -1 .ForeColor = -1 .Font = Nothing .DataSource = Nothing End With With DatabaseLabel .BackColor = -1 .ForeColor = -1 .Font = Nothing .DataSource = Nothing End With End Sub Sub SetLabelDims Dim i as integer Dim x,y as integer Dim OldSMode, OldSHeight, OldSLeft, OldSTop, OldSWidth as single Dim junk as integer ' Cache away the old ScaleMode OldSMode = DBFMForm.ScaleMode If OldSMode = 0 then OldSLeft = DBFMForm.ScaleLeft OldSTop = DBFMForm.ScaleTop OldSWidth = DBFMForm.ScaleWidth OldSHeight = DBFMForm.ScaleHeight End If ' Set ScaleMode to twips DBFMForm.ScaleMode = "Twip" If DBLblFont Then SelectObject(DBFMForm.hDC, DBLblFont.HFont) Else SelectObject(DBFMForm.hDC, SystemFont) End If LabelWidth = 0 LabelHeight = 0 DBFieldHeight = 0 LblFldHeight = 0 With OptionGroup For i = 0 To .Count - 1 GetTextExtent(DBFMForm.hDC, .ObjectAt(i).Caption & ":", x, y) x = x + (Margin) If LabelWidth < x Then LabelWidth = x Next i ' Set defaults for MaxCharWidth and LabelHeight GetTextExtent(DBFMForm.hDC, "M", x, LabelHeight) GetTextExtent(DBFMForm.hDC, "hj", junk, LabelHeight) LblFldHeight = LabelHeight End With ' Insure that we're large enough for DataLabels If DBROFont Then SelectObject(DBFMForm.hDC, DBROFont.HFont) GetTextExtent(DBFMForm.hDC, "M", x, y) GetTextExtent(DBFMForm.hDC, "hj", junk, y) Else SelectObject(DBFMForm.hDC, SystemFont) GetTextExtent(DBFMForm.hDC, "M", DBROMaxCharWidth, y) GetTextExtent(DBFMForm.hDC, "hj", junk, y) End If DBFieldHeight = IIf(DBFieldHeight < y, y, DBFieldHeight) DBROMaxCharWidth = x ' Insure that we're large enough for TextBoxes If DBRWFont Then SelectObject(DBFMForm.hDC, DBRWFont.HFont) GetTextExtent(DBFMForm.hDC, "M", x, y) GetTextExtent(DBFMForm.hDC, "hj", junk, y) Else SelectObject(DBFMForm.hDC, SystemFont) GetTextExtent(DBFMForm.hDC, "M", DBRWMaxCharWidth, y) GetTextExtent(DBFMForm.hDC, "hj", junk, y) End If DBFieldHeight = IIf(DBFieldHeight < y, y, DBFieldHeight) DBRWMaxCharWidth = x ' For our fudge factor, tack on 6 extra pixels DBFieldHeight = DBFieldHeight + 6 * Screen.TwipsPerPixelY LblFldHeight = IIf(DBFieldHeight > LblFldHeight, DBFieldHeight, LblFldHeight) ' Restore the ScaleMode DBFMForm.ScaleMode = OldSMode If OldSMode = 0 then DBFMForm.ScaleLeft = OldSLeft DBFMForm.ScaleTop = OldSTop DBFMForm.ScaleWidth = OldSWidth DBFMForm.ScaleHeight = OldSHeight End If End Sub Sub SetTemplate With DatabaseReadOnlyField .BackColor = DBROBackColor .ForeColor = DBROForeColor .Font = DBROFont .DataSource = DBFMRecordSet End With With DatabaseReadWriteField .BackColor = DBRWBackColor .ForeColor = DBRWForeColor .Font = DBRWFont .DataSource = DBFMRecordSet End With With DatabaseLabel .BackColor = LblBackColor .ForeColor = LblForeColor .Font = DBLblFont .DataSource = DBFMRecordSet End With End Sub Function SwapName(OldName as string) As String Dim StackString as string StackString = "DBR" StackString = StackString & IIf(Mid$(OldName, 4, 1) = "O", "W", "O") SwapName = StackString & Right$(OldName, Len(OldName) - 4) End Function Sub ToggleReadOnly(pos as integer) Dim OldObj, NewObj as Object Dim OldName as string Dim OldZOrder as Integer SetTemplate OldObj = LocateObjectByField(OptionGroup(pos).FieldName) OldZOrder = OldObj.ZOrder If TypeOf OldObj Is DatabaseReadOnlyField Then NewObj = EmbedObject(DBFMForm, DatabaseReadWriteField, UniqueEmbedName(DBFMForm, "Temp")) Else NewObj = EmbedObject(DBFMForm, DatabaseReadOnlyField, UniqueEmbedName(DBFMForm, "Temp")) End If NewObj.DataSource = DBFMRecordSet NewObj.DataField = OldObj.DataField NewObj.MaxLength = OldObj.MaxLength NewObj.IndexPosition = OldObj.IndexPosition NewObj.Move(OldObj.Left, OldObj.Top, OldObj.Width, OldObj.Height) OldName = OldObj.Name DestroyObject(OldObj) NewObj.Name = SwapName(OldName) NewObj.ZOrder = OldZOrder ResetTemplates End Sub Sub UpdateElement(o as Object, NewBackColor as long, NewForeColor as long, NewFont as Object) If o.DataSource = DBFMRecordSet Then With o If NewBackColor <> DBC_NO_CHANGE Then .BackColor = NewBackColor If NewForeColor <> DBC_NO_CHANGE Then .ForeColor = NewForeColor If NewFont Then .Font = NewFont End With End If End Sub End Type Type QBEDataSourceName From Form Dim DataSourceList As New ListBox Dim CancelBttn As New Button Dim ConnectButton As New Button Dim TablesButton As New Button Dim TableList As New ListBox Dim QueryObject As Database Dim ConnectTextBox As New TextBox Dim ConnectLabel As New Label Dim DataSourceLabel As New Label Dim TableListLabel As New Label Dim Processing As Integer Dim Canceled As Integer ' METHODS for object: QBEDataSourceName Sub CancelBttn_Click() Canceled = 1 QueryObject.Close() Processing = 0 Hide End Sub Sub Connect(q as Database) dim i as integer Processing = 1 Canceled = 0 Show DataSourceList.Clear TableList.Clear ConnectTextBox.Text = "" q.UpdateDataSources() While (i < q.DataSourceCount) q.DataSourceIndex = i DataSourceList.AddItem(q.DataSourceName) i = i + 1 Wend DataSourceList.Refresh() QueryObject = q End Sub Sub ConnectButton_Click() QueryObject.Connect = ConnectTextBox.Text Hide Processing = 0 End Sub Sub ConnectModal(q as Database) dim i as integer DataSourceList.Clear While (i < q.DataSourceCount) DataSourceIndex = i DataSourceList.AddItem(q.DataSourceName) i = i + 1 Wend QueryObject = q End Sub Sub DataSourceList_Click() dim connectString as string connectString = "dsn=" & DataSourceList.Text ConnectTextBox.Text = connectString End Sub Sub TablesButton_Click() dim i as integer TableList.Clear ' If there is a current selection, find available tables If DataSourceList.ListIndex <> -1 Then QueryObject.ConnectString = ConnectTextBox.Text While (i < QueryObject.TableCount) QueryObject.TableIndex = i TableList.AddItem(QueryObject.TableName) i = i + 1 Wend End If End Sub End Type Type QBETableData From Form Dim FieldsList As New ListBox Dim TablesList As New ComboBox Dim DB As ODBC ' METHODS for object: QBETableData Sub GetTables() dim i as integer TablesList.Clear For i = 0 To DB.TableCount - 1 DB.TableIndex = i TablesList.InsertItem(DB.TableName, TablesList.ListCount) Next i TablesList.ListIndex = 0 End Sub Sub MoveLeft() Left = Left - ScaleWidth End Sub Sub MoveRight() Left = Left + ScaleWidth End Sub Sub Resize() TablesList.Move(0, 0, ScaleWidth, TablesList.Height) FieldsList.Move(0, TablesList.Height, ScaleWidth, ScaleHeight - TablesList.Height) End Sub Sub ScrollPosition(amt as Integer) Left = Left + amt End Sub Sub TablesList_Click() dim i as integer FieldsList.Clear DB.TableIndex = TablesList.ListIndex FieldsList.InsertItem("*", FieldsList.ListCount) For i = 0 To DB.FieldCount - 1 DB.FieldIndex = i FieldsList.InsertItem(DB.FieldName, FieldsList.ListCount) Next i FieldsList.ListIndex = 0 End Sub End Type Type PickDatabaseDriver From Form Dim btnOK As New Button Dim btnCancel As New Button Dim lbDrivers As New ListBox Dim Label1 As New Label Dim Label2 As New Label Dim EnvelopFont As New Font ' METHODS for object: PickDatabaseDriver Sub btnCancel_Click() ModalResult(False) : Hide End Sub Sub btnOK_Click() ModalResult(True) : Hide End Sub Function Execute(db as ODBC) As String Execute = "" If db Then dim i as integer db.UpdateDrivers ' Make sure the form is created before filling the list. LoadForm lbDrivers.Clear For i = 0 To db.DriverCount - 1 db.DriverIndex = i lbDrivers.AddItem(db.DriverName) Next i If ShowModal() Then Execute = lbDrivers.Text End If End Function Sub Resize() const margin = 120 btnOK.Left = ScaleWidth - btnOK.Width - margin btnCancel.Left = btnOK.Left lbDrivers.Move(lbDrivers.Left, lbDrivers.Top, btnOK.Left - margin - lbDrivers.Left, ScaleHeight - margin - lbDrivers.Top) End Sub End Type Type QBEFieldData From Form Dim Table As New Label Dim Field As New Label Dim SortOrder As New ComboBox Dim CriteriaAnd As New TextBox Dim CriteriaOr As New TextBox ' METHODS for object: QBEFieldData Sub CriteriaAnd_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) DragAndDrop(source, x, y, state, effect) End Sub Sub CriteriaOr_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) DragAndDrop(source, x, y, state, effect) End Sub Sub DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) SendEvent Parent.DragAndDrop(source, x, y, state, effect) End Sub Sub Field_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) DragAndDrop(source, x, y, state, effect) End Sub Sub Load() SortOrder.InsertItem("None", 0) SortOrder.InsertItem("Ascending", 1) SortOrder.InsertItem("Descending", 2) SortOrder.ListIndex = 0 End Sub Sub MoveLeft() Left = Left - ScaleWidth End Sub Sub MoveRight() Left = Left + ScaleWidth End Sub Sub Resize() Table.Move(0, 0, ScaleWidth, Table.Height) Field.Move(0, Table.Height, ScaleWidth, Field.Height) SortOrder.Move(0, Field.Height + Field.Top, ScaleWidth, SortOrder.Height) CriteriaAnd.Move(0, SortOrder.Height + SortOrder.Top, ScaleWidth, CriteriaAnd.Height) CriteriaOr.Move(0, CriteriaAnd.Height + CriteriaAnd.Top, ScaleWidth, CriteriaOr.Height) End Sub Sub ScrollPosition(amt as Integer) Left = Left + amt End Sub Sub SortOrder_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) DragAndDrop(source, x, y, state, effect) End Sub Sub Table_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) DragAndDrop(source, x, y, state, effect) End Sub End Type Type QBE From Form Dim Spacing As Integer Dim Execute As New Button Dim SQLText As New TextBox Dim Dismiss As New Button Dim DataConnection As ODBC Dim LabelTable As New Label Dim LabelField As New Label Dim LabelSort As New Label Dim LabelAnd As New Label Dim LabelOr As New Label Dim BuildSql As New Button Type DeleteTable From Image Dim pict As New Bitmap End Type Type TablesScroll From ScrollBar Dim OldValue As Long End Type Dim FieldsCount As Long Dim TablesCount As Long Dim NewTable As New Button Dim TablesContainer As New Form Type FieldsContainer From Form ' METHODS for object: QBE.FieldsContainer Sub AppendItem(s as string, item as string) If s = "" Then s = item Else s = s & ", " & item End If End Sub Sub BuildCriteriaString(criteria as string, t as string, item as string, criteriaString as String) If criteria = "" Then Exit Sub If criteriaString <> "" Then criteriaString = criteriaString & t Else criteriaString = "WHERE " End If If criteria <> "" Then criteriaString = criteriaString & " " & item & " " & criteria End Sub Sub BuildSortString(sortOrder as string, item as string, sortString as String) dim sortOrderString as String If sortOrder = "None" Then Exit Sub If item = "*" Then Exit Sub If sortOrder = "Ascending" Then sortOrderString = "Asc" ElseIf sortOrder = "Descending" Then sortOrderString = "Desc" End If If sortString <> "" Then sortString = sortString & ", " Else sortString = " ORDER BY " End If sortString = sortString & item & " " & sortOrderString End Sub Function BuildSqlString() as String dim i as integer dim qry as string dim item as string dim tableString as string dim fieldString as string dim sortOrder as string dim criteria as string dim q as QBEFieldData For i = 0 To Controls.Count - 1 q = Controls(i) item = q.Table.Text If UniqueTable(item, i) Then AppendItem(tableString, item) item = q.Field.Text If item = "*" Then fieldString = "*" If fieldString <> "*" And UniqueField(item, i) Then AppendItem(fieldString, item) BuildSortString(q.SortOrder.Text, item, sortOrder) BuildCriteriaString(q.CriteriaAnd.Text, " AND ", item, criteria) BuildCriteriaString(q.CriteriaOr.Text, " OR ", item, criteria) Next i If fieldString = "" Then BuildSqlString = "" Else BuildSqlString = "SELECT " & fieldString & " FROM " & tableString & " " & criteria & " " & sortOrder End If End Function Function UniqueField(fieldName as string, i as integer) as Integer dim j as integer UniqueField = 1 If i <> 0 Then For j = 0 To i - 1 If Controls(j).Field.Text = fieldName Then UniqueField = 0 Next j End If End Function Function UniqueTable(tableName as string, i as integer) as Integer dim j as integer UniqueTable = 1 If i <> 0 Then For j = 0 To i - 1 If Controls(j).Table.Text = tableName Then UniqueTable = 0 Next j End If End Function End Type Dim FieldsScroll As New QBE.TablesScroll ' METHODS for object: QBE Function BuildQuery(db as Database) as String dim i, res as integer If db.Connected = False Then QBEDataSourceName.Connect(db) While QBEDataSourceName.Processing Application.DoEvents() Wend If QBEDataSourceName.Canceled Then Exit Function End If Initialize(db) res = ShowModal() If (res = True) Then BuildQuery = SQLText.Text Else BuildQuery = "" End If CleanUp End Function Sub BuildSql_Click() SQLText.Text = FieldsContainer.BuildSqlString() End Sub Sub CleanUp() While TablesContainer.Controls.Count DestroyObject(TablesContainer.Controls(0)) Wend While FieldsContainer.Controls.Count DestroyObject(FieldsContainer.Controls(0)) Wend End Sub Sub CreateFieldData(ByVal table as String, ByVal field as String) dim ind as Integer dim newObj as QBEFieldData With FieldsContainer ind = .Controls.Count newObj = EmbedObject(FieldsContainer, QBEFieldData, UniqueEmbedName(FieldsContainer, QBEFieldData)) newObj.Table.Text = table newObj.Field.Text = field If (ind) Then newObj.Move(.Controls(ind - 1).Left + .Controls(ind - 1).Width, 0, newObj.ScaleWidth, newObj.ScaleHeight) Else newObj.Move(0, 0, newObj.ScaleWidth, newObj.ScaleHeight) End If End With End Sub Sub DeleteTable_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) If TypeOf source.ObjectRef Is QBEFieldData Then effect = 1 If state = 3 Then RemoveColumn(source.ObjectRef) End If ElseIf TypeOf source.ObjectRef Is Control And TypeOf source.ObjectRef.Parent Is QBEFieldData Then effect = 1 If state = 3 Then RemoveColumn(source.ObjectRef.Parent) End If ElseIf TypeOf source.ObjectRef Is QBETableData Then effect = 1 If state = 3 Then RemoveTable(source.ObjectRef) End If ElseIf TypeOf source.ObjectRef Is Control And TypeOf source.ObjectRef.Parent Is QBETableData Then effect = 1 If state = 3 Then RemoveTable(source.ObjectRef.Parent) End If End If Refresh End Sub Sub Dismiss_Click() Hide() ModalResult(False) End Sub Sub Execute_Click() Hide() BuildSql_Click() ModalResult(True) End Sub Sub FieldsContainer_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) dim o as QBETableData effect = 0 If TypeOf source.ObjectRef Is QBETableData Then effect = 1 If state = 3 Then o = source.ObjectRef CreateFieldData(o.TablesList.Text, o.FieldsList.Text) End If ElseIf TypeOf source.ObjectRef Is Control And TypeOf source.ObjectRef.Parent Is QBETableData Then effect = 1 If state = 3 Then o = source.ObjectRef.Parent CreateFieldData(o.TablesList.Text, o.FieldsList.Text) End If End If End Sub Sub FieldsScroll_Change() dim cnt as Integer With FieldsContainer If FieldsScroll.Value = FieldsScroll.OldValue Then Exit Sub cnt = .Controls.Count If cnt Then If FieldsScroll.OldValue > FieldsScroll.Value Then .Controls.ScrollPosition(FieldsScroll.OldValue - FieldsScroll.Value) Else If cnt And .Controls(cnt - 1).Left + .Controls(cnt - 1).Width > .ScaleWidth Then .Controls.ScrollPosition(FieldsScroll.OldValue - FieldsScroll.Value) Else FieldsScroll.Value = FieldsScroll.OldValue End If End If Else FieldsScroll.Value = FieldsScroll.OldValue End If End With FieldsScroll.OldValue = FieldsScroll.Value End Sub Function FieldsShownCount() as Integer FieldsShownCount = FieldsContainer.Controls.Count End Function Sub Initialize(db as Database) SQLText.Text = "" DataConnection = db NewTable_Click End Sub Function IsFieldShown(field as Integer) as Integer If FieldsCount = 0 Then IsFieldShown = False Else IsFieldShown = True End If End Function Sub NewTable_Click() dim ind as Integer dim newObj as QBETableData LoadForm() With TablesContainer ind = .Controls.Count newObj = EmbedObject(TablesContainer, QBETableData, UniqueEmbedName(TablesContainer, QBETableData)) newObj.DB = DataConnection newObj.GetTables() If (ind) Then newObj.Move(.Controls(ind - 1).Left + .Controls(ind - 1).Width, 0, newObj.ScaleWidth, newObj.ScaleHeight) Else newObj.Move(0, 0, newObj.ScaleWidth, newObj.ScaleHeight) End If End With End Sub Sub RemoveColumn(item as QBEFieldData) dim i, done as Integer While (i < FieldsContainer.Controls.Count) And Not done If (item = FieldsContainer.Controls(i)) Then done = True Else i = i + 1 End If Wend If (i < FieldsContainer.Controls.Count) Then DestroyObject(item) While (i < FieldsContainer.Controls.Count) FieldsContainer.Controls(i).MoveLeft() i = i + 1 Wend End Sub Sub RemoveTable(item as QBETableData) dim i, done as Integer While (i < TablesContainer.Controls.Count) And Not done If (item = TablesContainer.Controls(i)) Then done = True Else i = i + 1 End If Wend If (i < TablesContainer.Controls.Count) Then DestroyObject(item) While (i < TablesContainer.Controls.Count) TablesContainer.Controls(i).MoveLeft() i = i + 1 Wend End Sub Sub Resize() End Sub Sub Setup() End Sub Sub TablesScroll_Change() dim cnt as Integer With TablesContainer If TablesScroll.Value = TablesScroll.OldValue Then Exit Sub cnt = .Controls.Count If cnt Then If TablesScroll.OldValue > TablesScroll.Value Then .Controls.ScrollPosition(TablesScroll.OldValue - TablesScroll.Value) Else If cnt And .Controls(cnt - 1).Left + .Controls(cnt - 1).Width > .ScaleWidth Then .Controls.ScrollPosition(TablesScroll.OldValue - TablesScroll.Value) Else TablesScroll.Value = TablesScroll.OldValue End If End If Else TablesScroll.Value = TablesScroll.OldValue End If End With TablesScroll.OldValue = TablesScroll.Value End Sub End Type Type DataConConfigureWizard From WizardMaster.Wizard Dim DATASET As Object Type Branch From WizardMaster.FrmStep Dim OBAuto As New OptionButton Dim OBManual As New OptionButton ' METHODS for object: DataConConfigureWizard.Branch Sub ValidateDisplay(ok As Boolean) If Not initialized Then OBAuto.Value = True initialized = True Else If NextStep = wizard.ConfigCtrls Then OBManual.Value = True Else OBAuto.Value = True End If End If End Sub Sub ValidateNext(ok As Boolean) With wizard If OBAuto.Value then NextStep = .SelectFields .FormMaker.SetReferences(.DATASET) Else NextStep = .ConfigCtrls End If ' NextStep = IIf(OBAuto.Value, wizard.SelectFields, wizard.ConfigCtrls) End With End Sub End Type Type ConfigureFields From WizardMaster.FrmStep Dim Frame2 As New Frame Type LBLFieldName7 From Label Property NextField Get getNextField As Object Property Position Get getPosition As Integer ' METHODS for object: DataConConfigureWizard.ConfigureFields.LBLFieldName7 Function getNextField As Object Dim TempStr as string TempStr = "TBFieldLabel" & Position getNextField = FindEmbed(Parent, TempStr) End Function Function getPosition As Integer getPosition = Right$(Name, 1) End Function Sub HandOff(obj as object) If obj Then Visible = True Caption = obj.FieldName Else Visible = False Caption = "" End If NextField.HandOff(obj) End Sub End Type Type TBFieldLabel7 From TextBox Property Position Get getPosition As Integer Property NextField Get getNextField As Object ' METHODS for object: DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Function getNextField As Object Dim TempStr as string TempStr = "CHKField" & Position getNextField = FindEmbed(Parent, TempStr) End Function Function getPosition As Integer getPosition = Right$(Name, 1) End Function Sub HandOff(obj as object) If obj Then Visible = True If Caption = "*~!~*" Then Caption = "NO LABEL" Enabled = False Else Caption = obj.Caption Enabled = True End If Else Visible = False Caption = "" End If NextField.HandOff(obj) End Sub Sub LostFocus With Parent.wizard.FormMaker If Parent.Editing Then Dim o as Object Dim n as Object o = .LocateObjectByField(Parent.GetField(Position)).Label If o Then o.Caption = Text & ":" Else ' This object wasn't created... ' This algorithm is NOT complete Dim o as DatabaseLabel Dim l, t, w, h as Single w = 0 For Each o EmbeddedIn .DBFMForm l = o.Left w = IIF(o.Width = 0, 15, o.Width) h = o.Height Exit For Next o if w = 0 then Throw NoLabels ' Need to figure out the top n = EmbedObject(.DBFMForm, DatabaseLabel, UniqueEmbedName("HookMeUp")) n.Move(l, t, w, h) ' n.DataControl hookup End If Else .OptionGroup(Position + Parent.ScrollBar1.Value - 1).Caption = Text End If End With End Sub End Type Type CHKField7 From CheckBox Dim SuppressClicks As Integer Property Position Get getPosition As Integer Property NextField Get getNextField As Object ' METHODS for object: DataConConfigureWizard.ConfigureFields.CHKField7 Sub Click If SuppressClicks = 0 Then If Parent.wizard.Editing then Parent.wizard.FormMaker.ToggleReadOnly(Parent.ScrollBar1.Value + Position - 1) End If With Parent.wizard.FormMaker Try .OptionGroup(Position + Parent.ScrollBar1.Value - 1).CanEdit = IIf(Value = 0, False, True) Catch RangeError End Try End With End If End Sub Function getNextField As Object Dim TempStr as string TempStr = "TBMaxChar" & Position getNextField = FindEmbed(Parent, TempStr) End Function Function getPosition As Integer getPosition = Right$(Name, 1) End Function Sub HandOff(obj as object) ' Set flag to suppress handling click events. Setting the Value ' on a checkbox will trigger a Click event. We do not want ' process these events, since we're setting the Value to reflect ' the object's current state, not to change its state. SuppressClicks = 1 If obj Then Visible = True Value = IIf(obj.CanEdit, 1, 0) Else Visible = False Value = 0 End If SuppressClicks = 0 NextField.HandOff(obj) End Sub End Type Type TBMaxChar7 From TextBox Property Position Get getPosition As Integer Property NextField Get getNextField As Object ' METHODS for object: DataConConfigureWizard.ConfigureFields.TBMaxChar7 Function getNextField As Object Dim TempStr as string TempStr = "TBWidth" & Position getNextField = FindEmbed(Parent, TempStr) End Function Function getPosition As Integer getPosition = Right$(Name, 1) End Function Sub HandOff(obj as object) If obj Then Visible = True Caption = obj.MaxLength Else Visible = False Caption = "" End If NextField.HandOff(obj) End Sub Sub LostFocus With Parent.wizard.FormMaker If Parent.Editing Then .LocateObjectByField(Parent.GetField(Position)).MaxLength = Text Else .OptionGroup(Position + Parent.ScrollBar1.Value - 1).MaxLength = Text End If End With End Sub End Type Type TBWidth7 From TextBox Property Position Get getPosition As Integer ' METHODS for object: DataConConfigureWizard.ConfigureFields.TBWidth7 Function getPosition As Integer getPosition = Right$(Name, 1) End Function Sub HandOff(obj as object) If obj Then Visible = True Caption = obj.Width Else Visible = False Caption = "" End If End Sub Sub LostFocus With Parent.wizard.FormMaker If Parent.Editing Then If Text = "0" Then Dim o as Window o = .LocateObjectByField(Parent.GetField(Position)) If o.MaxLength = 0 Then o.Width = .HyperWidth - .LabelWidth - .Margin Else o.Width = (2 + MaxLength) * (IIf(TypeOf o Is DatabaseReadOnlyField, .DBROMaxCharWidth, .DBRWMaxCharWidth)) End If Else .LocateObjectByField(Parent.GetField(Position)).Width = Text End If Else .OptionGroup(Position + Parent.ScrollBar1.Value - 1).Width = Text End If End With End Sub End Type Dim TBWidth1 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar1 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField1 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel1 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName1 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim TBWidth2 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar2 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField2 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel2 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName2 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim TBWidth3 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar3 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField3 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel3 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName3 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim TBWidth4 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar4 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField4 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel4 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName4 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim TBWidth5 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar5 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField5 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel5 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName5 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim TBWidth6 As New DataConConfigureWizard.ConfigureFields.TBWidth7 Dim TBMaxChar6 As New DataConConfigureWizard.ConfigureFields.TBMaxChar7 Dim CHKField6 As New DataConConfigureWizard.ConfigureFields.CHKField7 Dim TBFieldLabel6 As New DataConConfigureWizard.ConfigureFields.TBFieldLabel7 Dim LBLFieldName6 As New DataConConfigureWizard.ConfigureFields.LBLFieldName7 Dim ScrollBar1 As New ScrollBar Dim LBLCanEditHeading As New Label Dim LBLCaptionHeading As New Label Dim LBLFieldHeading As New Label Dim LBLWidthHeading As New Label Dim LBLMaxCharHeading As New Label Dim ColumnGroup As New Group Property Editing Get getEditing As Boolean ' METHODS for object: DataConConfigureWizard.ConfigureFields Sub DisplayFields(TopRow as integer) Dim STT as New SuspendDebugExceptionTrapping Dim i as integer Dim o as Label Dim n as integer Dim g as Group g = wizard.FormMaker.OptionGroup n = g.Count - 1 i = 0 For Each o In ColumnGroup o.HandOff(IIf(i <= n, g(TopRow + i), Nothing)) i = i + 1 Next o End Sub Function getEditing As Boolean With wizard.FormMaker.DBFMRecordSet getEditing = .Controls && .Controls.Count End With End Function Function GetField(pos as integer) as string Dim o as object o = FindEmbed(Me, "LBLFieldName" & pos) GetField = o.Caption End Function Sub ScrollBar1_Change() DisplayFields(ScrollBar1.Value) End Sub End Type Type SelectFields From WizardMaster.FrmStep Dim LBFieldList As New ListBox Dim LBSelFields As New ListBox Dim BTNAddAll As New Button Dim BTNAdd As New Button Dim BTNRemove As New Button Dim BTNRemoveAll As New Button Dim LBLInclude As New Label Dim LBLAllFields As New Label ' METHODS for object: DataConConfigureWizard.SelectFields Sub BTNAddAll_Click() While LBFieldList.ListCount > 0 LBFieldList.ListIndex = 0 BTNAdd_Click Wend End Sub Sub BTNAdd_Click() If LBFieldList.ListIndex = -1 Then Throw NoFieldSelected Else Dim i as integer With LBSelFields Dim TheItem as string Dim Blank as Object TheItem = LBFieldList.Text If .ItemIndex(TheItem) = -1 Then .InsertItem(LBFieldList.Text, IIf(.ListIndex > -1, .ListIndex + 1, .ListCount)) Blank = CopyObject(DataBaseFormMaker.FieldOptions, "") Blank.FieldName = TheItem Blank.Caption = Blank.FieldName ' Smart Compute MaxWidth part here If LBSelFields.ListIndex = -1 Then DataBaseFormMaker.OptionGroup.Append(Blank) LBSelFields.ListIndex = LBSelFields.ListCount - 1 Else DataBaseFormMaker.OptionGroup.InsertAt(Blank, LBSelFields.ListIndex + 1) LBSelFields.ListIndex = LBSelFields.ListIndex + 1 End If i = LBFieldList.ListIndex End With With LBFieldList .RemoveItem(.ListIndex) .ListIndex = IIf(i < .ListCount - 1, i, .ListCount - 1) End With End If End Sub Sub BTNRemoveAll_Click() LBSelFields.Clear FillFieldList wizard.FormMaker.OptionGroup.Clear End Sub Sub BTNRemove_Click() If LBSelFields.ListIndex = -1 Then Throw NoSelField Else With LBSelFields Dim i as integer SortedInsert(.Text) wizard.FormMaker.OptionGroup.RemoveAt(.ListIndex) i = .ListIndex .RemoveItem(.ListIndex) .ListIndex = IIf(i < .ListCount - 1, i, .ListCount - 1) End With End If End Sub Sub FillFieldList With wizard.FormMaker.DBFMRecordSet Dim i as integer LBFieldList.Clear For i = 0 To .FieldCount - 1 .FieldIndex = i LBFieldList.AddItem(.FieldName) Next i End With End Sub Sub SortedInsert(item as string) With wizard.FormMaker.DBFMRecordSet Dim i as integer Dim j as integer Dim f as string j = 0 For i = 0 To .FieldCount - 1 ' Compare Database(i) with j .FieldIndex = i f = .FieldName If f = item Then LBFieldList.InsertItem(item, j) LBFieldList.ListIndex = j Exit Sub End If If LBFieldList.List(j) = f Then j = j + 1 Next i LBFieldList.AddItem(item) End With End Sub End Type Property FormMaker Get getFormMaker As Object Type SetColors From WizardMaster.FrmStep Dim FieldReadOnly As New Label Dim TBReadOnly As New TextBox Dim TBReadWrite As New TextBox Dim FieldReadWrite As New Label Dim LBLNotice As New Label Dim BTNSetROBack As New Button Dim BTNSetROFore As New Button Dim BTNSetROFont As New Button Dim BTNSetRWFont As New Button Dim BTNSetRWFore As New Button Dim BTNSetRWBack As New Button Dim BTNSetLBLFont As New Button Dim BTNSetLBLFore As New Button Dim BTNSetLBLBack As New Button Dim LBLSetRO As New Label Dim LBLSetRW As New Label Dim LBLSetLabel As New Label Dim ColorDlg As New ColorDialog ' METHODS for object: DataConConfigureWizard.SetColors Sub BTNSetLBLBack_Click() SetColor(wizard.FormMaker.LblBackColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_LABEL) End Sub Sub BTNSetLBLFont_Click() Dim FP as New FontPicker If FP.Execute = IDOK Then FieldReadOnly.Font = FP.FontRef FieldReadWrite.Font = FP.FontRef If wizard.Editing Then wizard.FormMaker.Modify(DBC_LABEL, DBC_NO_CHANGE, DBC_NO_CHANGE, FP.FontRef) Else wizard.FormMaker.DBLblFont = FP.FontRef End If LayDisplay End If End Sub Sub BTNSetLBLFore_Click() SetColor(wizard.FormMaker.LblForeColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_LABEL) End Sub Sub BTNSetROBack_Click() SetColor(wizard.FormMaker.DBROBackColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_READ_ONLY) End Sub Sub BTNSetROFont_Click() Dim FP as New FontPicker If FP.Execute = IDOK Then TBReadOnly.Font = FP.FontRef If wizard.Editing Then wizard.FormMaker.Modify(DBC_READ_ONLY, DBC_NO_CHANGE, DBC_NO_CHANGE, FP.FontRef) Else wizard.FormMaker.DBROFont = FP.FontRef End If LayDisplay End If End Sub Sub BTNSetROFore_Click() SetColor(wizard.FormMaker.DBROForeColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_READ_ONLY) End Sub Sub BTNSetRWBack_Click() SetColor(wizard.FormMaker.DBRWBackColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_READ_WRITE) End Sub Sub BTNSetRWFont_Click() Dim FP as New FontPicker If FP.Execute = IDOK Then TBReadWrite.Font = FP.FontRef If wizard.Editing Then wizard.FormMaker.Modify(DBC_READ_WRITE, DBC_NO_CHANGE, DBC_NO_CHANGE, FP.FontRef) Else wizard.FormMaker.DBRWFont = FP.FontRef End If LayDisplay End If End Sub Sub BTNSetRWFore_Click() SetColor(wizard.FormMaker.DBRWForeColor) If wizard.Editing Then wizard.FormMaker.Refresh(DBC_READ_WRITE) End Sub Sub ClearFonts() FieldReadOnly.Font = Nothing FieldReadWrite.Font = Nothing TBReadOnly.Font = Nothing TBReadWrite.Font = Nothing End Sub Sub LayDisplay() Dim SetHt as integer Dim Margin as integer Dim LblW, LblH, RWW, RWH, ROW, ROH as integer Dim CurX, CurY as integer ' Ensure that the Scale of the page is 15tpp ScaleMode = 0 ScaleWidth = 7140 ScaleHeight = 4410 Margin = 150 ' Get the dimensions DataBaseFormMaker.GetFontDims(Me, FieldReadOnly.Font, "Read Only:", LblW, LblH) DataBaseFormMaker.GetFontDims(Me, TBReadOnly.Font, "D. Gagne", ROW, ROH) DataBaseFormMaker.GetFontDims(Me, TBReadWrite.Font, "Active", RWW, RWH) ' Fudge the textboxes ROH = ROH * 1.25 RWH = RWH * 1.25 ' Figure out which is the largest variable of the three SetHt = LblH SetHt = IIf(SetHt > ROH, SetHt, ROH) SetHt = IIf(SetHt > RWH, SetHt, RWH) ' Since All TextBoxes are the same height, use the larger of ROH and RWH ROH = IIF(ROH > RWH, ROH, RWH) ' Ensure that we don't go bounding into the buttons If (2 * SetHt) + Margin > 1500 Then SetHt = (1500 - Margin) / 2 CurX = 2850 CurY = 525 FieldReadOnly.Move(CurX, ((SetHt - LblH) / 2) + CurY, LblW, LblH) CurX = CurX + LblW + Margin TBReadOnly.Move(CurX, ((SetHt - ROH) / 2) + CurY, 6825 - CurX, ROH) CurX = 2850 CurY = CurY + SetHt + Margin FieldReadWrite.Move(CurX, ((SetHt - LblH) / 2) + CurY, LblW, LblH) CurX = CurX + LblW + Margin TBReadWrite.Move(CurX, ((SetHt - ROH) / 2) + CurY, 6825 - CurX, ROH) ' Put the ScaleMode back to twips ScaleMode = 1 End Sub Sub SetColor(OldColor as long) ' OldColor is INTENTIONALLY passed ByRef ColorDlg.Color = OldColor If ColorDlg.Execute = IDOK Then OldColor = ColorDlg.Color SetColors End If End Sub Sub SetColors With wizard.FormMaker FieldReadOnly.BackColor = .LblBackColor FieldReadOnly.ForeColor = .LblForeColor FieldReadWrite.BackColor = .LblBackColor FieldReadWrite.ForeColor = .LblForeColor TBReadOnly.BackColor = .DBROBackColor TBReadOnly.ForeColor = .DBROForeColor TBReadWrite.BackColor = .DBRWBackColor TBReadWrite.ForeColor = .DBRWForeColor End With End Sub Sub SetDefaults() Dim DBRW as DatabaseReadWriteField Dim DBRO as DatabaseReadOnlyField Dim DBLbl as DatabaseLabel For Each DBRW EmbeddedIn wizard.FormMaker.DBFMForm With TBReadWrite .BackColor = DBRW.BackColor .ForeColor = DBRW.ForeColor .Font = DBRW.Font Exit For End With Next DBRW For Each DBRO EmbeddedIn wizard.FormMaker.DBFMForm With TBReadOnly .BackColor = DBRO.BackColor .ForeColor = DBRO.ForeColor .Font = DBRO.Font Exit For End With Next DBRO For Each DBLbl EmbeddedIn wizard.FormMaker.DBFMForm With FieldReadOnly .BackColor = DBLbl.BackColor .ForeColor = DBLbl.ForeColor .Font = DBLbl.Font End With With FieldReadWrite .BackColor = DBLbl.BackColor .ForeColor = DBLbl.ForeColor .Font = DBLbl.Font Exit For End With Next DBLbl End Sub End Type Property Editing Get getEditing As Boolean Type SelectSource From WizardMaster.FrmStep Dim CBSource As New ComboBox Dim BTNModify As New Button Dim BTNNew As New Button ' METHODS for object: DataConConfigureWizard.SelectSource Sub BTNModify_Click() ODBC.ManageDataSources(hWnd) ' Because ManageDataSources may add/remove Data Sources, regen the listbox contents UpdateListBoxes() End Sub Sub BTNNew_Click() dim msgStr as String dim SExTrp as New SuspendDebugExceptionTrapping Try If CBSource.Text = "" Then msgStr = "Please enter the name of the DataSource to create." InfoBox.Message("Input required", msgStr) ElseIf (Not CBSource.ItemIndex(CBSource.Text) = -1) Then msgStr = "DataSource '" & CBSource.Text & "' already exists. Please enter new DataSource name." InfoBox.Message("Name conflict", msgStr) Else Try ' Get the name of the driver to use dim drvName As String drvName = PickDatabaseDriver.Execute(ODBC) If drvName <> "" Then ODBC.CreateDataSource(hWnd, drvName, CBSource.Text) msgStr = CBSource.Text UpdateListBoxes CBSource.ListIndex = CBSource.ItemIndex(msgStr) End If Catch MessageBox.Message("Failed Create New", "Could not create new DataSource, please try again") End Try End If Catch End Try End Sub Function UpdateListBoxes() as Boolean Dim ok as Boolean ok = False If (Not TypeOf wizard.DATASET Is RecordSet) && (Not TypeOf wizard.DATASET Is Dynaset) Then UpdateListBoxes = ok Exit Function End If If (Not TypeOf wizard.DATASET.Database Is ODBC) Then wizard.DATASET.Database = Nothing ODBC.UpdateDataSources CBSource.Clear ODBC.DataSourceIndex = 0 While (ODBC.DataSourceIndex < ODBC.DataSourceCount - 1) CBSource.InsertItem(ODBC.DataSourceName, ODBC.DataSourceIndex) ODBC.DataSourceIndex = ODBC.DataSourceIndex + 1 Wend If (ODBC.DataSourceIndex = ODBC.DataSourceCount - 1) Then CBSource.InsertItem(ODBC.DataSourceName, ODBC.DataSourceIndex) ODBC.DataSourceIndex = ODBC.DataSourceIndex + 1 End If CBSource.ListIndex = CBSource.ItemIndex(wizard.DATASET.Connect) If (CBSource.ListIndex = -1) Then CBSource.ListIndex = 0 ok = True UpdateListBoxes = ok End Function End Type Type FillSource From WizardMaster.FrmStep Dim LBTable As New ListBox Dim OBTable As New OptionButton Dim OBSQL As New OptionButton Dim TBSQL As New TextBox End Type Type StartStep From WizardMaster.FrmStep Dim OBAscii As New OptionButton Dim OBODBC As New OptionButton Dim ObjRef As DataControl Dim OBJump As New OptionButton Dim BtnWhackLayout As New Button ' METHODS for object: DataConConfigureWizard.StartStep Sub BtnWhackLayout_Click() Dim YNBox As New YesNoBox If YNBox.Message("Verify Destruction", "You are sure you want to destroy the existing layout") = IDYES Then wizard.FormMaker.DestroyControls ' Enable appropriate OptButton If wizard.DATASET.DatabaseType = "ODBC" Then OBODBC.Value = True Else OBAscii.Value = True End If ' Disable OBJump and Hide BtnWhack OBJump.Enabled = False BtnWhackLayout.Visible = False End If End Sub End Type Type ConfigText From WizardMaster.FrmStep Dim CHKFirstLine As New CheckBox Dim OBDelim As New OptionButton Dim OBFixed As New OptionButton Dim TBRowDelim As New TextBox Dim TBRowDelimXpr As New TextBox Dim TBFieldDelim As New TextBox Dim TBFieldDelimXpr As New TextBox Dim TBNumFields As New TextBox Dim TBFieldWidth As New TextBox Dim LBLFieldDelimXpr As New Label Dim LBLFieldDelim As New Label Dim LBLNumFields As New Label Dim LBLFieldWidth As New Label Dim LBLRowDelim As New Label Dim LBLRowDelimXpr As New Label ' METHODS for object: DataConConfigureWizard.ConfigText Sub CHKFirstLine_Click() If CHKFirstLine.Value = 0 Then wizard.DATASET.Database.FirstLineAsFieldNames = True Else wizard.DATASET.Database.FirstLineAsFieldNames = False End If End Sub Sub OBDelim_Click() If OBDelim.Value = True Then LBLRowDelim.Visible = True LBLRowDelimXpr.Visible = True LBLFieldDelimXpr.Visible = True TBRowDelim.Visible = True TBRowDelimXpr.Visible = True TBFieldDelimXpr.Visible = True TBFieldDelim.Visible = True TBFieldWidth.Visible = False TBNumFields.Visible = False LBLFieldDelim.Visible = True LBLFieldWidth.Visible = False LBLNumFields.Visible = False wizard.DATASET.DatabaseType = "DelimitedAscii" If CHKFirstLine.Value = 1 Then wizard.DATASET.Database.FirstLineAsFieldNames = True Else wizard.DATASET.Database.FirstLineAsFieldNames = False End If End If End Sub Sub OBFixed_Click() If OBFixed.Value = True Then LBLRowDelim.Visible = False LBLRowDelimXpr.Visible = False LBLFieldDelimXpr.Visible = False TBRowDelim.Visible = False TBRowDelimXpr.Visible = False TBFieldDelimXpr.Visible = False TBFieldDelim.Visible = False TBFieldWidth.Visible = True TBNumFields.Visible = True LBLFieldDelim.Visible = False LBLFieldWidth.Visible = True LBLNumFields.Visible = True wizard.DATASET.DatabaseType = "FixedAscii" If CHKFirstLine.Value = 1 Then wizard.DATASET.Database.FirstLineAsFieldNames = True Else wizard.DATASET.Database.FirstLineAsFieldNames = False End If End If End Sub Sub TBFieldDelim_KeyUp(keyCode As Integer, ByVal shift As Integer) If TBFieldDelim.Text <> "" Then wizard.DATASET.Database.FieldDelimiter = TBFieldDelim.Text End If End Sub Sub TBFieldWidth_KeyUp(keyCode As Integer, ByVal shift As Integer) If TBFieldWidth.Text <> "" Then wizard.DATASET.Database.FieldWidthList = TBFieldWidth.Text TBNumFields.Text = wizard.DATASET.Database.FieldCount End If End Sub Sub TBNumFields_KeyUp(keyCode As Integer, ByVal shift As Integer) If TBNumFields.Text <> "" Then wizard.DATASET.Database.FieldCount = TBNumFields.Text TBFieldWidth.Text = wizard.DATASET.Database.FieldWidthList End If End Sub End Type Type SelectFile From WizardMaster.FrmStep Dim TBFileName As New TextBox Dim BTNBrowse As New Button Type TBFileView From TextBox Dim font As New Font End Type Dim BTNViewFile As New Button Dim DATABASE As Database ' METHODS for object: DataConConfigureWizard.SelectFile Sub BTNBrowse_Click() dim fileNav as new OpenDialog dim ok as integer dim OldFile as string ' Use OldFile in case the user cancels the OpenDialog OldFile = TBFileName.Text fileNav.Filter = "*.txt" fileNav.FileName = "*.txt" ok = fileNav.Execute If (ok = 1) Then TBFileName.Text = fileNav.FileName DisplayFile Else TBFileName.Text = OldFile End If End Sub Sub BTNViewFile_Click() DisplayFile End Sub Sub DisplayFile dim f as new TextFile f.FileName = TBFileName.Text If (f.Exists) Then TBFileView.Text = f.ContentsAsString Else TBFileView.Text = "" End If End Sub End Type Type ConfigCtrls From WizardMaster.FrmStep Dim LBControls As New ListBox Dim BTNClearLB As New Button Dim LBFields As New ListBox Dim BTNAdd As New Button Dim BTNRemove As New Button Dim LBLControls As New Label Dim LBLFields As New Label Dim DATABASE As Database Dim DragFeedback As New Label ' METHODS for object: DataConConfigureWizard.ConfigCtrls Sub BTNAdd_Click() dim c as Window If (LBControls.ListIndex = -1) Then InfoBox.Message("Need selection", "You must first Select a Control.") Exit Sub End If If (LBFields.ListIndex = -1) Then InfoBox.Message("Need selection", "You must first Select a Field.") Exit Sub End If c = FindObject(LBControls.Text) If (c) Then c.DataSource = wizard.DATASET c.DataField = LBFields.Text Else LBControls.RemoveItem(LBControls.ListIndex) End If End Sub Sub BTNClearLB_Click() LBControls.Clear End Sub Sub BTNRemove_Click() dim c as Window If (LBControls.ListIndex = -1) Then InfoBox.Message("Need selection", "You must first Select a Control.") Exit Sub End If c = FindObject(LBControls.Text) LBControls.RemoveItem(LBControls.ListIndex) If (c) Then c.DataSource = Nothing c.DataField = "" End If End Sub Sub LBControls_Click() dim c as Window c = FindObject(LBControls.Text) If c Then LBFields.ListIndex = LBFields.ItemIndex(c.DataField) End Sub Sub LBControls_DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect) ' We allow 'Window' type of objects, and no others. If TypeOf source.ObjectRef Is Window Then effect = 1 Else effect = 0 If state = 2 Then ' Provide feedback for any type of object DragFeedback.Text = source.ObjectRef Exit Sub ElseIf state = 3 && TypeOf source.ObjectRef Is Window Then LBControls.InsertItem(source.ObjectRef, LBControls.ListCount) LBControls.ListIndex = LBControls.ListCount - 1 End If ' Clear feedback after drop, and for state=Leave DragFeedback.Text = "" End Sub Sub PopulateLB(ByVal o as Object) Dim i as integer LBControls.Clear While Not TypeOf o Is Form o = HostObject(o) Wend If TypeOf o Is DataControl Then o = o.Parent For i = 0 To o.Controls.Count - 1 LBControls.AddItem(o.Controls(i)) Next i End Sub End Type Dim ConnectString As String ' METHODS for object: DataConConfigureWizard Function CanModify as Boolean If Not DATASET || Not TypeOf DATASET Is RecordSet || Not DATASET.Controls Then CanModify = False Else Dim o as object Dim Flag as Boolean Flag = False For Each o In DATASET.Controls If TypeOf o Is DatabaseLabel || TypeOf o Is DatabaseReadOnlyField || TypeOf o Is DatabaseReadWriteField Then Flag = True Next o CanModify = Flag End If End Function Sub ConfigCtrls_ValidateDisplay(ok As Boolean) dim I as integer ConfigCtrls.BtnFinish.Enabled = True ConfigCtrls.BtnCancel.Enabled = False If Not ConfigCtrls.initialized Then ConfigCtrls.PopulateLB(DATASET) ConfigCtrls.initialized = True End If ConfigCtrls.LBFields.Clear For I = 0 To DATASET.FieldCount - 1 DATASET.FieldIndex = I ConfigCtrls.LBFields.AddItem(DATASET.FieldName) Next I End Sub Sub ConfigureFields_ValidateDisplay(ok As Boolean) With ConfigureFields If .Editing Then FormMaker.ReconstructGroup .BtnCancel.Enabled = False SetColors.SetDefaults Else .BtnCancel.Enabled = True End If If .ScrollBar1.Value <> 0 Then .ScrollBar1.Value = 0 Else .DisplayFields(0) End If .ScrollBar1.Max = IIf(FormMaker.OptionGroup.Count > 7, FormMaker.OptionGroup.Count - 7, 0) If .ScrollBar1.Max = 0 Then .ScrollBar1.Enabled = False Else .ScrollBar1.Enabled = True End If End With End Sub Sub ConfigureFields_ValidateFinish(ok As Boolean) If Not Editing Then FormMaker.Go End Sub Function getEditing As Boolean getEditing = ConfigureFields.Editing End Function Function getFormMaker As Object ' Initially this code is hard coded for the DataBaseFormMaker ' but this method may be changed for other FormMaker paradigns If FindObject("DataBaseFormMaker") Then getFormMaker = DataBaseFormMaker Else getFormMaker = Nothing End Function Sub SelectFields_ValidateDisplay(ok As Boolean) If ConfigureFields.Editing Then Dim YN as New YesNoBox YN.title = "Editing DATASET with Controls" YN.message = "WARNING: Editing the order of the fields, or adding or deleting from the SelectedFields will destroy any previous work. Are you sure you want to edit the selected fields list?" YN.Execute If YN.result = IDYES Then DataBaseFormMaker.DestroyControls Else SelectFields.BtnNext_Click Exit Sub End If End If If Not SelectFields.initialized Then If FormMaker Then FormMaker.OptionGroup.Clear With SelectFields .FillFieldList .LBSelFields.Clear If Not Editing Then FormMaker.ResetTemplates End If End With SelectFields.initialized = True End If End If End Sub Sub SelectFields_ValidateFinish(ok As Boolean) If Not Editing Then FormMaker.Go End Sub Sub SelectFields_ValidateNext(ok As Boolean) Dim i as integer If SelectFields.LBSelFields.ListCount = 0 Then Dim MBX as New MessageBox MBX.Message("No Fields", "You must select at least one field to continue") ok = False End If If Not FormMaker Then Throw NoFormMaker End Sub Sub SetColors_ValidateDisplay(ok As Boolean) With SetColors If Not .initialized Then FormMaker.ClearColors .SetColors .ClearFonts If Editing then .SetDefaults End If .initialized = True End If If Editing then .BtnCancel.Enabled = False Else .BtnCancel.Enabled = True End If .LayDisplay End With End Sub Sub SetColors_ValidateFinish(ok As Boolean) If Not Editing Then FormMaker.Go End Sub Sub ConfigText_ValidateDisplay(ok As Boolean) ConfigText.BtnFinish.Enabled = False ConfigText.BtnCancel.Enabled = True ' If we're working with a Dynaset, we don't need to configure ' controls If TypeOf DATASET Is Dynaset Then ConfigText.NextStep = Nothing ConfigText.BtnNext.Enabled = False ConfigText.BtnFinish.Enabled = True Else ConfigText.NextStep = Branch ConfigText.BtnNext.Enabled = True ConfigText.BtnFinish.Enabled = False End If If DATASET.DatabaseType <> "None" Then If DATASET.Database.FirstLineAsFieldNames = True Then ConfigText.CHKFirstLine.Value = 1 Else ConfigText.CHKFirstLine.Value = 0 End If End If Select Case DATASET.DatabaseType Case "None" ConfigText.OBDelim.Value = True DATASET.DatabaseType = "DelimitedAscii" ConfigText.OBFixed.Value = False ConfigText.TBFieldDelim.Text = "," DATASET.Database.FieldDelimiter = "," ConfigText.TBFieldDelimXpr.Text = DATASET.Database.FieldDelimiterExpr ConfigText.TBRowDelim.Text = "^^M^^J" DATASET.Database.RowDelimiter = "^M^J" ConfigText.TBRowDelimXpr.Text = DATASET.Database.RowDelimiterExpr ConfigText.TBNumFields.Text = "4" ConfigText.TBFieldWidth.Text = "10, 10, 10, 10" Case "DelimitedAscii" ConfigText.OBFixed.Value = False ConfigText.OBDelim.Value = True ConfigText.TBNumFields.Text = "4" ConfigText.TBFieldWidth.Text = "10, 10, 10, 10" ConfigText.TBFieldDelim.Text = DATASET.Database.FieldDelimiter ConfigText.TBFieldDelimXpr.Text = DATASET.Database.FieldDelimiterExpr If DATASET.Database.RowDelimiter = "^M^J" Then ConfigText.TBRowDelim.Text = "^^M^^J" Else ConfigText.TBRowDelim.Text = DATASET.Database.RowDelimiter End If If DATASET.Database.RowDelimiterExpr = "^M^J" Then ConfigText.TBRowDelimXpr.Text = "^^M^^J" Else ConfigText.TBRowDelimXpr.Text = DATASET.Database.RowDelimiterExpr End If Case "FixedAscii" ConfigText.OBFixed.Value = True ConfigText.OBDelim.Value = False ConfigText.TBFieldDelim.Text = "," ConfigText.TBNumFields.Text = DATASET.Database.FieldCount ConfigText.TBFieldWidth.Text = DATASET.Database.FieldWidthList End Select End Sub Sub ConfigText_ValidateFinish(ok as Boolean) If TypeOf DATASET Is Dynaset Then ConfigText_ValidateNext(ok) Else MessageBox.Message("Error", "You may not finish at this point unless the RecordSet in question is a Dynaset") End If End Sub Sub ConfigText_ValidateNext(ok As Boolean) ok = False If ConfigText.OBFixed.Value = True Then If ConfigText.TBNumFields.Text = "" Then InfoBox.Message("DataControl Configuration", "A FixedTable must have a Number of Fields.") ok = False Exit Sub End If If ConfigText.TBFieldWidth.Text = "" Then InfoBox.Message("DataControl Configuration", "A FixedTable must have a Field Width.") ok = False Exit Sub End If DATASET.DatabaseType = "FixedAscii" DATASET.Database.FieldCount = ConfigText.TBNumFields.Text DATASET.Database.FieldWidthList = ConfigText.TBFieldWidth.Text DATASET.Connect = ConnectString Else If ConfigText.TBFieldDelim.Text = "" Then InfoBox.Message("DataControl Configuration", "A DelimitedAscii Table must have a Field Delimiter.") ok = False Exit Sub End If DATASET.DatabaseType = "DelimitedAscii" DATASET.Database.FieldDelimiter = ExpandCtrlCharSequences(ConfigText.TBFieldDelim.Text) DATASET.Database.FieldDelimiterExpr = ExpandCtrlCharSequences(ConfigText.TBFieldDelimXpr.Text) DATASET.Database.RowDelimiter = ExpandCtrlCharSequences(ConfigText.TBRowDelim.Text) DATASET.Database.RowDelimiterExpr = ExpandCtrlCharSequences(ConfigText.TBRowDelimXpr.Text) End If If ConfigText.CHKFirstLine.Value = 1 Then DATASET.Database.FirstLineAsFieldNames = True Else DATASET.Database.FirstLineAsFieldNames = False End If DATASET.Connect = ConnectString DATASET.Refresh ok = True End Sub Sub Edit(o as Object) If (o && (TypeOf o Is Dynaset || TypeOf o Is RecordSet)) Then DATASET = o Show ElseIf (o && TypeOf o Is DataControl) Then DATASET = o.RecordSet Show Else Error End If End Sub Sub FillSource_ValidateDisplay(ok As Boolean) dim d as Database dim i as Integer FillSource.BtnFinish.Enabled = False FillSource.BtnCancel.Enabled = True d = DATASET.Database ' If we're working with a Dynaset, we don't need to configure ' controls If TypeOf DATASET Is Dynaset Then FillSource.NextStep = Nothing FillSource.BtnNext.Enabled = False FillSource.BtnFinish.Enabled = True Else FillSource.NextStep = Branch FillSource.BtnNext.Enabled = True FillSource.BtnFinish.Enabled = False End If FillSource.LBTable.Clear For i = 0 To d.TableCount - 1 d.TableIndex = i FillSource.LBTable.InsertItem(d.TableName, d.TableIndex) Next i FillSource.LBTable.ListIndex = FillSource.LBTable.ItemIndex(DATASET.RecordSource) If (FillSource.LBTable.ListIndex <> -1 Or DATASET.RecordSource = "") Then If (FillSource.LBTable.ListIndex = -1) Then FillSource.LBTable.ListIndex = 0 FillSource.OBTable.Value = True FillSource.OBSQL.Value = False Else FillSource.OBTable.Value = False FillSource.OBSQL.Value = True End If End Sub Sub FillSource_ValidateFinish(ok as Boolean) If TypeOf DATASET Is Dynaset Then FillSource_ValidateNext(ok) Else MessageBox.Message("Error", "You may not finish at this point unless the RecordSet in question is a Dynaset") End If End Sub Sub FillSource_ValidateNext(ok As Boolean) Try If (FillSource.OBTable.Value = True) Then If (FillSource.LBTable.ListIndex <> -1) Then DATASET.RecordSource = FillSource.LBTable.Text DATASET.Refresh ok = True Else InfoBox.Message("Need selection", "You must first select a Table before continuing.") ok = False End If Else DATASET.RecordSource = FillSource.TBSQL.Text DATASET.Refresh ok = True End If Catch End Try End Sub Function ExpandCtrlCharSequences(oldstr as string) as string Dim newstr, tempchar as string Dim I as integer ' The purpose of this function is to take a string with encoded control sequences ' and turn them into real control characters. An encoded control character sequence ' is something like "^M", this is turned into Chr(13) in the return string. newstr = "" For I = 1 To Len(oldstr) If Mid$(oldstr, I, 1) = "^^" Then tempchar = UCase(Mid$(oldstr, I + 1, 1)) If tempchar >= "A" && tempchar <= "Z" Then newstr = newstr & Chr(Asc(tempchar) - Asc("A") + 1) ' Advance the string past the next char, we used it. I = I + 1 ElseIf tempchar = "^^" Then ' Skip the first character of a "^^" sequence End If Else newstr = newstr & Mid$(oldstr, I, 1) End If Next I ExpandCtrlCharSequences = newstr End Function Sub SelectFile_ValidateBack(ok As Boolean) ConnectString = SelectFile.TBFileName.Text End Sub Sub SelectFile_ValidateDisplay(ok As Boolean) SelectFile.BtnFinish.Enabled = False SelectFile.BtnCancel.Enabled = True If Not SelectFile.initialized Then SelectFile.TBFileName.Clear SelectFile.initialized = True End If SelectFile.TBFileName.Text = ConnectString SelectFile.TBFileView.Clear End Sub Sub SelectFile_ValidateNext(ok As Boolean) ok = False If SelectFile.TBFileName.Text = "" Then InfoBox.Message("Select File", "You must select a file name first") Exit Sub End If ConnectString = SelectFile.TBFileName.Text ok = True End Sub Sub SelectSource_ValidateDisplay(ok As Boolean) SelectSource.BtnFinish.Enabled = False SelectSource.BtnCancel.Enabled = True ok = SelectSource.UpdateListBoxes End Sub Sub SelectSource_ValidateNext(ok As Boolean) Dim SExTrp as New SuspendDebugExceptionTrapping If SelectSource.CBSource.Text <> "" Then If Not StrComp(DATASET.Connect, SelectSource.CBSource.Text, 1) = 0 Then Try DATASET.Connect = SelectSource.CBSource.Text ok = True Catch MessageBox.Message("Failed to Connect", "Could not connect to DataSource, please verify Connect string and try again") ok = False End Try End If Else InfoBox.Message("Need selection", "Please select Data Source before continuing.") ok = False End If End Sub Sub StartStep_ValidateDisplay(ok As Boolean) With StartStep .BtnFinish.Enabled = False .BtnCancel.Enabled = True .OBJump.Enabled = CanModify .BtnWhackLayout.Visible = .OBJump.Enabled If Not .initialized Then ConnectString = "" .OBJump.Value = False .initialized = True End If Select Case DATASET.DatabaseType Case "ODBC", "None" .OBODBC.Value = True Case "DelimitedAscii", "FixedAscii" If Len(DATASET.Connect) > 0 Then ConnectString = DATASET.Connect End If .OBAscii.Value = True End Select ' If we can jump, set it as the default .OBJump.Value = .OBJump.Enabled ' If we can jump, set the appropriate references If .OBJump.Enabled Then FormMaker.SetReferences(DATASET) End With End Sub Sub StartStep_ValidateNext(ok As Boolean) With StartStep If .OBAscii.Value Then ' Place info for Ascii NextStep .NextStep = SelectFile End If If .OBODBC.Value Then ' Place info for ODBC NextStep .NextStep = SelectSource End If If (.OBODBC.Value || .OBAscii.Value) && .OBJump.Enabled then ' We're Editing, but the user DOESN'T want to modify existing layout Dim YNBX as New YesNoBox If YNBX.Message("Destroy old layout", "Envelop has already laid out a form based on this Recordset, the layout should be destroyed before altering the Recordset. Do you want to destroy the layout associated with the Recordset?") = IDYES then FormMaker.DestroyControls else ok = False End If End If If .OBJump.Value Then .NextStep = ConfigureFields End If End With ' Change database type if necessary With DATASET If StartStep.OBAscii.Value And (.DatabaseType = "ODBC" Or .DatabaseType = "None") Then ' If changing to Ascii, presume delimited DATASET.DatabaseType = "DelimitedAscii" ElseIf StartStep.OBODBC.Value And .DatabaseType <> "ODBC" Then DATASET.DatabaseType = "ODBC" End If End With End Sub Function TextUnload(ByVal indent As String, cmds As String) As Integer ' Write our parent's properties, but none of ours. TextUnload = False End Function End Type Begin Code ' Reconstruction commands for object: DatabaseConstants ' With DatabaseConstants .DBC_READ_ONLY := 1 .DBC_READ_WRITE := 2 .DBC_LABEL := 3 .DBC_NO_CHANGE := -2 .DBC_ALL := 4 End With 'DatabaseConstants ' Reconstruction commands for object: DataBaseFormMaker ' With DataBaseFormMaker .CurrentY := 2175 .Margin := 150 .DBLblFont := Nothing .DBRWFont := Nothing .DBROFont := Nothing .LblBackColor := -1 .LblForeColor := -1 .DBROForeColor := -1 .DBROBackColor := RGB(255, 255, 255) .DBRWBackColor := -1 .DBRWForeColor := -1 .LabelWidth := 1350 .LabelHeight := 285 .DBROMaxCharWidth := 195 .DBRWMaxCharWidth := 195 .HyperWidth := 8850 With .FieldOptions .CanEdit := True .FieldName := "" .MaxLength := 0 .Width := 0 .Caption := "" End With 'DataBaseFormMaker.FieldOptions With .OptionGroup End With 'DataBaseFormMaker.OptionGroup With .DefaultFont .FaceName := "MS Sans Serif" .Size := 8.000000 .Bold := False .Italic := False .Strikethru := False End With 'DataBaseFormMaker.DefaultFont End With 'DataBaseFormMaker ' Reconstruction commands for object: QBEDataSourceName ' With QBEDataSourceName .Move(3720, 1815, 9075, 4305) .QueryObject := ODBC .Processing := 0 .Canceled := 0 With .DataSourceList .ZOrder := 1 .Move(135, 585, 3480, 1950) End With 'QBEDataSourceName.DataSourceList With .CancelBttn .Caption := "Cancel" .ZOrder := 2 .Move(6900, 1935, 1830, 600) End With 'QBEDataSourceName.CancelBttn With .ConnectButton .Caption := "Connect" .ZOrder := 3 .Move(6900, 600, 1830, 600) End With 'QBEDataSourceName.ConnectButton With .TablesButton .Caption := "Browse Tables" .ZOrder := 4 .Move(6900, 1260, 1830, 600) End With 'QBEDataSourceName.TablesButton With .TableList .ZOrder := 5 .Move(3735, 585, 3150, 1950) End With 'QBEDataSourceName.TableList With .ConnectTextBox .ZOrder := 6 .Move(2085, 3015, 5415, 420) End With 'QBEDataSourceName.ConnectTextBox With .ConnectLabel .Caption := "Connection String:" .ZOrder := 7 .Move(105, 3075, 1830, 315) End With 'QBEDataSourceName.ConnectLabel With .DataSourceLabel .Caption := "Data Sources" .ZOrder := 8 .Move(150, 150, 1500, 270) End With 'QBEDataSourceName.DataSourceLabel With .TableListLabel .Caption := "Available Tables" .ZOrder := 9 .Move(3750, 150, 3000, 270) End With 'QBEDataSourceName.TableListLabel End With 'QBEDataSourceName ' Reconstruction commands for object: QBETableData ' With QBETableData .Move(4095, 2535, 2040, 1755) .DB := Nothing With .FieldsList .Caption := "FieldsList" .BackColor := 12632256 .ForeColor := 255 .ZOrder := 2 .Move(0, 360, 1920, 990) End With 'QBETableData.FieldsList With .TablesList .BackColor := 12632256 .ForeColor := 16711808 .ZOrder := 1 .Move(0, 0, 1920, 360) End With 'QBETableData.TablesList End With 'QBETableData ' Reconstruction commands for object: PickDatabaseDriver ' With PickDatabaseDriver .Caption := "Add Data Source" .Font := PickDatabaseDriver.EnvelopFont .Move(4305, 3780, 6030, 3300) .DefaultButton := PickDatabaseDriver.btnOK .CancelButton := PickDatabaseDriver.btnCancel With .btnOK .Caption := "OK" .ZOrder := 5 .Move(4515, 150, 1275, 375) End With 'PickDatabaseDriver.btnOK With .btnCancel .Caption := "Cancel" .ZOrder := 4 .Move(4515, 600, 1275, 375) End With 'PickDatabaseDriver.btnCancel With .lbDrivers .Caption := "lbDrivers" .ZOrder := 3 .Move(225, 975, 4170, 1785) End With 'PickDatabaseDriver.lbDrivers With .Label1 .Caption := "Select which ODBC driver you want to use from the list, then choose OK." .ZOrder := 2 .Move(225, 75, 3525, 450) End With 'PickDatabaseDriver.Label1 With .Label2 .Caption := "Installed ODBC &Drivers:" .ZOrder := 1 .Move(225, 675, 2400, 225) End With 'PickDatabaseDriver.Label2 With .EnvelopFont .FaceName := "MS Sans Serif" .Size := 8.000000 .Bold := True .Italic := False .Strikethru := False End With 'PickDatabaseDriver.EnvelopFont End With 'PickDatabaseDriver ' Reconstruction commands for object: QBEFieldData ' With QBEFieldData .Move(6810, 3510, 2055, 2265) With .Table .BackColor := 12632256 .ForeColor := 255 .ZOrder := 5 .Move(0, 0, 1935, 375) .BorderStyle := "Fixed Single" .Alignment := "Center" End With 'QBEFieldData.Table With .Field .BackColor := 12632256 .ForeColor := 16711808 .ZOrder := 4 .Move(0, 375, 1935, 330) .BorderStyle := "Fixed Single" .Alignment := "Center" End With 'QBEFieldData.Field With .SortOrder .BackColor := 12632256 .ZOrder := 3 .Move(0, 705, 1935, 360) End With 'QBEFieldData.SortOrder With .CriteriaAnd .BackColor := 12632256 .ZOrder := 2 .Move(0, 1065, 1935, 390) .Alignment := "Center" End With 'QBEFieldData.CriteriaAnd With .CriteriaOr .BackColor := 12632256 .ZOrder := 1 .Move(0, 1455, 1935, 390) .Alignment := "Center" End With 'QBEFieldData.CriteriaOr End With 'QBEFieldData ' Reconstruction commands for object: QBE ' With QBE .Move(2805, 4125, 11505, 6150) .Spacing := 100 .DataConnection := Nothing .FieldsCount := 0 .TablesCount := 0 With .Execute .Caption := "Done" .ZOrder := 5 .Move(10050, 5025, 1125, 345) End With 'QBE.Execute With .SQLText .ZOrder := 6 .Move(735, 4530, 10440, 390) .WordWrap := True .MultiLine := True .ScrollBars := "Vertical" End With 'QBE.SQLText With .Dismiss .Caption := "Cancel" .ZOrder := 7 .Move(135, 5010, 1110, 345) End With 'QBE.Dismiss With .LabelTable .Caption := "Table :" .ZOrder := 8 .Move(60, 2265, 630, 210) .Alignment := "Right" End With 'QBE.LabelTable With .LabelField .Caption := "Field :" .ZOrder := 9 .Move(60, 2580, 630, 285) .Alignment := "Right" End With 'QBE.LabelField With .LabelSort .Caption := "Sort :" .ZOrder := 10 .Move(60, 2955, 630, 255) .Alignment := "Right" End With 'QBE.LabelSort With .LabelAnd .Caption := "And :" .ZOrder := 11 .Move(60, 3330, 630, 270) .Alignment := "Right" End With 'QBE.LabelAnd With .LabelOr .Caption := "Or :" .ZOrder := 12 .Move(60, 3735, 630, 285) .Alignment := "Right" End With 'QBE.LabelOr With .BuildSql .Caption := "SQL" .ZOrder := 13 .Move(120, 4530, 615, 390) End With 'QBE.BuildSql With .DeleteTable .Caption := "Delete" .ZOrder := 14 .Move(10335, 525, 855, 855) .BevelOuter := "Raised" .Picture := QBE.DeleteTable.pict With .pict .LoadType := "MemoryBased" .FileName := "dbtools.ero" .ResId := 0 End With 'QBE.DeleteTable.pict End With 'QBE.DeleteTable With .TablesScroll .Caption := "TablesScroll" .ZOrder := 4 .Move(75, 1740, 10230, 285) .Orientation := "Horizontal" .Move(75, 1740, 10230, 285) .OldValue := 0 End With 'QBE.TablesScroll With .NewTable .Caption := "New" .ZOrder := 3 .Move(10335, 105, 855, 345) End With 'QBE.NewTable With .TablesContainer .Caption := "TablesContainer" .ZOrder := 2 .Move(60, 30, 9825, 1635) .BorderStyle := "None" .MaxButton := False .ControlBox := False .Parent := QBE .Visible := True End With 'QBE.TablesContainer With .FieldsContainer .Caption := "FieldsContainer" .ZOrder := 1 .Move(855, 2160, 10215, 1920) .BorderStyle := "None" .MaxButton := False .ControlBox := False .Parent := QBE .Visible := True End With 'QBE.FieldsContainer With .FieldsScroll .Caption := "FieldsScroll" .ZOrder := 15 .Move(735, 4140, 10440, 285) .Move(735, 4140, 10440, 285) End With 'QBE.FieldsScroll End With 'QBE ' Reconstruction commands for object: DataConConfigureWizard ' With DataConConfigureWizard .GraphicFileName := "dbtools.ero" .FirstStep := DataConConfigureWizard.StartStep .LastStep := DataConConfigureWizard.ConfigCtrls With .Branch .Move(4290, 3300, 7155, 4815) .DefaultButton := DataConConfigureWizard.Branch.BtnNext .CancelButton := DataConConfigureWizard.Branch.BtnCancel .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.ConfigCtrls .BackStep := DataConConfigureWizard.ConfigText .initialized := -1 With .OBAuto .Caption := "Let Envelop do the layout" .ZOrder := 2 .Move(2850, 1800, 3135, 300) End With 'DataConConfigureWizard.Branch.OBAuto With .OBManual .Caption := "Use existing controls" .ZOrder := 1 .Move(2850, 1425, 3135, 300) .TabStop := True .Value := True End With 'DataConConfigureWizard.Branch.OBManual With .BtnFinish .ZOrder := 3 .Enabled := False .Move(6165, 3990, 825, 300) End With 'DataConConfigureWizard.Branch.BtnFinish With .BtnNext .ZOrder := 4 .Move(5265, 3990, 825, 300) End With 'DataConConfigureWizard.Branch.BtnNext With .BtnBack .ZOrder := 5 .Move(4440, 3990, 825, 300) End With 'DataConConfigureWizard.Branch.BtnBack With .BtnCancel .ZOrder := 6 .Enabled := False .Move(3540, 3990, 825, 300) End With 'DataConConfigureWizard.Branch.BtnCancel With .ImgGraphic .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.Branch.ImgGraphic With .LblInstruction .Caption := "Would you like to attach existing controls to the dataset, or let Envelop attempt to layout and configure controls. There will be a shortcut to this step from the first page of this wizard in the future." .ZOrder := 8 .Move(2850, 225, 4065, 1050) End With 'DataConConfigureWizard.Branch.LblInstruction With .Frame1 .ZOrder := 9 .Move(75, 3765, 6915, 75) End With 'DataConConfigureWizard.Branch.Frame1 End With 'DataConConfigureWizard.Branch With .ConfigureFields .Caption := "Configure Database for layout" .Move(3690, 4230, 7155, 4815) .DefaultButton := DataConConfigureWizard.ConfigureFields.BtnNext .CancelButton := DataConConfigureWizard.ConfigureFields.BtnCancel .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.SetColors .BackStep := DataConConfigureWizard.SelectFields With .LBLFieldName7 .ZOrder := 41 .Move(3150, 3300, 1170, 300) .Visible := False End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName7 With .TBFieldLabel7 .ZOrder := 25 .Move(4320, 3300, 975, 300) .Visible := False End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel7 With .CHKField7 .ZOrder := 26 .Move(5400, 3300, 225, 300) .Visible := False .SuppressClicks = 0 End With 'DataConConfigureWizard.ConfigureFields.CHKField7 With .TBMaxChar7 .ZOrder := 27 .Move(5625, 3300, 630, 300) .Visible := False End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar7 With .TBWidth7 .ZOrder := 28 .Move(6255, 3300, 630, 300) .Visible := False End With 'DataConConfigureWizard.ConfigureFields.TBWidth7 With .TBWidth1 .Caption := "0" .ZOrder := 4 .Move(6255, 1050, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth1 With .TBMaxChar1 .Caption := "0" .ZOrder := 3 .Move(5625, 1050, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar1 With .CHKField1 .ZOrder := 2 .Move(5400, 1050, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField1 With .TBFieldLabel1 .Caption := "First Name" .ZOrder := 1 .Move(4320, 1050, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel1 With .LBLFieldName1 .Caption := "First Name" .ZOrder := 40 .Move(3150, 1050, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName1 With .TBWidth2 .Caption := "0" .ZOrder := 8 .Move(6255, 1425, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth2 With .TBMaxChar2 .Caption := "0" .ZOrder := 7 .Move(5625, 1425, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar2 With .CHKField2 .ZOrder := 6 .Move(5400, 1425, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField2 With .TBFieldLabel2 .Caption := "Last Name" .ZOrder := 5 .Move(4320, 1425, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel2 With .LBLFieldName2 .Caption := "Last Name" .ZOrder := 39 .Move(3150, 1425, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName2 With .TBWidth3 .Caption := "0" .ZOrder := 12 .Move(6255, 1800, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth3 With .TBMaxChar3 .Caption := "0" .ZOrder := 11 .Move(5625, 1800, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar3 With .CHKField3 .ZOrder := 10 .Move(5400, 1800, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField3 With .TBFieldLabel3 .Caption := "Style" .ZOrder := 9 .Move(4320, 1800, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel3 With .LBLFieldName3 .Caption := "Style" .ZOrder := 38 .Move(3150, 1800, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName3 With .TBWidth4 .Caption := "0" .ZOrder := 16 .Move(6255, 2175, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth4 With .TBMaxChar4 .Caption := "0" .ZOrder := 15 .Move(5625, 2175, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar4 With .CHKField4 .ZOrder := 14 .Move(5400, 2175, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField4 With .TBFieldLabel4 .Caption := "Age" .ZOrder := 13 .Move(4320, 2175, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel4 With .LBLFieldName4 .Caption := "Age" .ZOrder := 37 .Move(3150, 2175, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName4 With .TBWidth5 .Caption := "0" .ZOrder := 20 .Move(6255, 2550, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth5 With .TBMaxChar5 .Caption := "0" .ZOrder := 19 .Move(5625, 2550, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar5 With .CHKField5 .ZOrder := 18 .Move(5400, 2550, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField5 With .TBFieldLabel5 .Caption := "Sex" .ZOrder := 17 .Move(4320, 2550, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel5 With .LBLFieldName5 .Caption := "Sex" .ZOrder := 36 .Move(3150, 2550, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName5 With .TBWidth6 .Caption := "0" .ZOrder := 24 .Move(6255, 2925, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBWidth6 With .TBMaxChar6 .Caption := "0" .ZOrder := 23 .Move(5625, 2925, 630, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBMaxChar6 With .CHKField6 .ZOrder := 22 .Move(5400, 2925, 225, 300) .Visible := True .Value := "Checked" End With 'DataConConfigureWizard.ConfigureFields.CHKField6 With .TBFieldLabel6 .Caption := "Status" .ZOrder := 21 .Move(4320, 2925, 975, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.TBFieldLabel6 With .LBLFieldName6 .Caption := "Status" .ZOrder := 35 .Move(3150, 2925, 1170, 300) .Visible := True End With 'DataConConfigureWizard.ConfigureFields.LBLFieldName6 With .ScrollBar1 .Caption := "ScrollBar1" .ZOrder := 34 .Move(2850, 990, 225, 2670) .SmallChange := 1 .LargeChange := 6 .Max := 0 End With 'DataConConfigureWizard.ConfigureFields.ScrollBar1 With .LBLCanEditHeading .Caption := "Can Edit" .ZOrder := 33 .Move(5250, 525, 375, 450) End With 'DataConConfigureWizard.ConfigureFields.LBLCanEditHeading With .LBLCaptionHeading .Caption := "Caption" .ZOrder := 32 .Move(4350, 750, 900, 225) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigureFields.LBLCaptionHeading With .LBLFieldHeading .Caption := "Field" .ZOrder := 31 .Move(3150, 750, 1200, 225) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigureFields.LBLFieldHeading With .LBLWidthHeading .Caption := "Width" .ZOrder := 30 .Move(6225, 750, 675, 225) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigureFields.LBLWidthHeading With .LBLMaxCharHeading .Caption := "Max Char" .ZOrder := 29 .Move(5625, 525, 600, 450) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigureFields.LBLMaxCharHeading With .ColumnGroup .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName1) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName2) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName3) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName4) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName5) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName6) .Append(DataConConfigureWizard.ConfigureFields.LBLFieldName7) End With 'DataConConfigureWizard.ConfigureFields.ColumnGroup With .Frame2 .ZOrder := 49 .Move(3075, 900, 3885, 2775) End With 'DataConConfigureWizard.ConfigureFields.Frame2 With .BtnFinish .ZOrder := 42 .Move(6165, 3990, 825, 300) End With 'DataConConfigureWizard.ConfigureFields.BtnFinish With .BtnNext .ZOrder := 43 .Move(5265, 3990, 825, 300) End With 'DataConConfigureWizard.ConfigureFields.BtnNext With .BtnBack .ZOrder := 44 .Move(4440, 3990, 825, 300) End With 'DataConConfigureWizard.ConfigureFields.BtnBack With .BtnCancel .ZOrder := 45 .Move(3540, 3990, 825, 300) End With 'DataConConfigureWizard.ConfigureFields.BtnCancel With .ImgGraphic .ZOrder := 46 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.ConfigureFields.ImgGraphic With .LblInstruction .Caption := "Configure the selected fields here." .ZOrder := 47 .Move(2850, 225, 4065, 225) End With 'DataConConfigureWizard.ConfigureFields.LblInstruction With .Frame1 .ZOrder := 48 .Move(75, 3765, 6915, 75) End With 'DataConConfigureWizard.ConfigureFields.Frame1 End With 'DataConConfigureWizard.ConfigureFields With .SelectFields .Caption := "Configure Database for layout" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.SelectFields.BtnNext .CancelButton := DataConConfigureWizard.SelectFields.BtnCancel .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.ConfigureFields .BackStep := DataConConfigureWizard.Branch With .LBFieldList .Caption := "LBFieldList" .ZOrder := 8 .Move(2850, 1200, 1350, 2370) .Sorted := False .IntegralHeight := False End With 'DataConConfigureWizard.SelectFields.LBFieldList With .LBSelFields .Caption := "LBSelFields" .ZOrder := 7 .Move(5550, 1200, 1350, 2370) .Sorted := False .IntegralHeight := False End With 'DataConConfigureWizard.SelectFields.LBSelFields With .BTNAddAll .Caption := "Add All ->" .ZOrder := 6 .Move(4350, 1275, 1050, 450) End With 'DataConConfigureWizard.SelectFields.BTNAddAll With .BTNAdd .Caption := "Add ->" .ZOrder := 5 .Move(4350, 1875, 1050, 450) End With 'DataConConfigureWizard.SelectFields.BTNAdd With .BTNRemove .Caption := "<- Remove" .ZOrder := 4 .Move(4350, 2475, 1050, 450) End With 'DataConConfigureWizard.SelectFields.BTNRemove With .BTNRemoveAll .Caption := "<- Clear All" .ZOrder := 3 .Move(4350, 3075, 1050, 450) End With 'DataConConfigureWizard.SelectFields.BTNRemoveAll With .LBLInclude .Caption := "Selected Fields" .ZOrder := 2 .Move(5550, 900, 1350, 225) .Alignment := "Center" End With 'DataConConfigureWizard.SelectFields.LBLInclude With .LBLAllFields .Caption := "Field List" .ZOrder := 1 .Move(2850, 900, 1350, 225) .Alignment := "Center" End With 'DataConConfigureWizard.SelectFields.LBLAllFields With .BtnFinish .ZOrder := 9 .Move(6165, 3990, 825, 300) End With 'DataConConfigureWizard.SelectFields.BtnFinish With .BtnNext .ZOrder := 10 .Move(5265, 3990, 825, 300) End With 'DataConConfigureWizard.SelectFields.BtnNext With .BtnBack .Enabled := False .ZOrder := 11 .Move(4440, 3990, 825, 300) End With 'DataConConfigureWizard.SelectFields.BtnBack With .BtnCancel .ZOrder := 12 .Move(3540, 3990, 825, 300) End With 'DataConConfigureWizard.SelectFields.BtnCancel With .ImgGraphic .ZOrder := 13 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.SelectFields.ImgGraphic With .LblInstruction .Caption := "Select the fields to include in the layout. The order of the fields in the selected list box will be the order in which the fields will be laid out." .ZOrder := 14 .Move(2850, 225, 4065, 600) End With 'DataConConfigureWizard.SelectFields.LblInstruction With .Frame1 .ZOrder := 15 .Move(75, 3765, 6915, 75) End With 'DataConConfigureWizard.SelectFields.Frame1 End With 'DataConConfigureWizard.SelectFields With .SetColors .Caption := "Configure Database for layout" .Move(3690, 4230, 7155, 4815) .DefaultButton := DataConConfigureWizard.SetColors.BtnFinish .CancelButton := DataConConfigureWizard.SetColors.BtnCancel .wizard := DataConConfigureWizard .BackStep := DataConConfigureWizard.ConfigureFields .initialized := -1 With .FieldReadOnly .Caption := "Read Only:" .ForeColor := 16711680 .ZOrder := 18 .Move(2850, 975, 1200, 300) .Alignment := "Right" End With 'DataConConfigureWizard.SetColors.FieldReadOnly With .TBReadOnly .Caption := "D. Gagne" .BackColor := 12632256 .ZOrder := 17 .Move(4125, 975, 2700, 300) End With 'DataConConfigureWizard.SetColors.TBReadOnly With .TBReadWrite .Caption := "Active" .BackColor := 12615808 .ZOrder := 14 .Move(4125, 1725, 2700, 300) End With 'DataConConfigureWizard.SetColors.TBReadWrite With .FieldReadWrite .Caption := "Editable:" .ForeColor := 16711680 .ZOrder := 15 .Move(2850, 1725, 1200, 300) .Alignment := "Right" End With 'DataConConfigureWizard.SetColors.FieldReadWrite With .LBLNotice .Caption := "All controls will be sized to fit requested font" .ZOrder := 13 .Move(2775, 2100, 4050, 225) End With 'DataConConfigureWizard.SetColors.LBLNotice With .BTNSetROBack .Caption := "BackColor" .ZOrder := 12 .Move(3750, 2475, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetROBack With .BTNSetROFore .Caption := "ForeColor" .ZOrder := 11 .Move(4770, 2475, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetROFore With .BTNSetROFont .Caption := "Font" .ZOrder := 10 .Move(5790, 2475, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetROFont With .BTNSetRWFont .Caption := "Font" .ZOrder := 7 .Move(5790, 2850, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetRWFont With .BTNSetRWFore .Caption := "ForeColor" .ZOrder := 8 .Move(4770, 2850, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetRWFore With .BTNSetRWBack .Caption := "BackColor" .ZOrder := 9 .Move(3750, 2850, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetRWBack With .BTNSetLBLFont .Caption := "Font" .ZOrder := 4 .Move(5790, 3225, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetLBLFont With .BTNSetLBLFore .Caption := "ForeColor" .ZOrder := 5 .Move(4770, 3225, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetLBLFore With .BTNSetLBLBack .Caption := "BackColor" .ZOrder := 6 .Move(3750, 3225, 1020, 300) End With 'DataConConfigureWizard.SetColors.BTNSetLBLBack With .LBLSetRO .Caption := "Read Only" .ZOrder := 3 .Move(2775, 2475, 975, 300) End With 'DataConConfigureWizard.SetColors.LBLSetRO With .LBLSetRW .Caption := "Editable" .ZOrder := 2 .Move(2775, 2850, 975, 300) End With 'DataConConfigureWizard.SetColors.LBLSetRW With .LBLSetLabel .Caption := "Labels" .ZOrder := 1 .Move(2775, 3225, 975, 300) End With 'DataConConfigureWizard.SetColors.LBLSetLabel With .ColorDlg .Color := 12615808 End With 'DataConConfigureWizard.SetColors.ColorDlg With .BtnFinish .ZOrder := 20 .Move(6165, 3990, 825, 300) End With 'DataConConfigureWizard.SetColors.BtnFinish With .BtnNext .Enabled := False .ZOrder := 21 .Move(5265, 3990, 825, 300) End With 'DataConConfigureWizard.SetColors.BtnNext With .BtnBack .ZOrder := 22 .Move(4440, 3990, 825, 300) End With 'DataConConfigureWizard.SetColors.BtnBack With .BtnCancel .ZOrder := 23 .Move(3540, 3990, 825, 300) End With 'DataConConfigureWizard.SetColors.BtnCancel With .ImgGraphic .ZOrder := 24 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.SetColors.ImgGraphic With .LblInstruction .Caption := "Choose the colors and fonts for the layout." .ZOrder := 25 .Move(2850, 225, 4065, 225) End With 'DataConConfigureWizard.SetColors.LblInstruction With .Frame1 .ZOrder := 26 .Move(75, 3765, 6915, 75) End With 'DataConConfigureWizard.SetColors.Frame1 End With 'DataConConfigureWizard.SetColors With .SelectSource .Caption := "Configure DataControl" .Move(4080, 2280, 7230, 4785) .DefaultButton := DataConConfigureWizard.SelectSource.BtnNext .CancelButton := DataConConfigureWizard.SelectSource.BtnCancel .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.FillSource .BackStep := DataConConfigureWizard.StartStep With .CBSource .ZOrder := 1 .Move(2850, 1200, 4050, 300) End With 'DataConConfigureWizard.SelectSource.CBSource With .BTNModify .Caption := "Modify..." .ZOrder := 2 .Move(5550, 1650, 1350, 300) End With 'DataConConfigureWizard.SelectSource.BTNModify With .BTNNew .Caption := "New..." .ZOrder := 3 .Move(2850, 1650, 1350, 300) End With 'DataConConfigureWizard.SelectSource.BTNNew With .BtnFinish .Enabled := False .ZOrder := 9 .Move(6300, 4020, 825, 300) End With 'DataConConfigureWizard.SelectSource.BtnFinish With .BtnNext .ZOrder := 4 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.SelectSource.BtnNext With .BtnBack .ZOrder := 5 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.SelectSource.BtnBack With .BtnCancel .ZOrder := 6 .Move(3675, 4020, 825, 300) End With 'DataConConfigureWizard.SelectSource.BtnCancel With .ImgGraphic .ZOrder := 10 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.SelectSource.ImgGraphic With .LblInstruction .Caption := "Which Data Source would you like to use? Include any special parameters or Connect string arguments." .ZOrder := 7 .Move(2850, 300, 4200, 750) End With 'DataConConfigureWizard.SelectSource.LblInstruction With .Frame1 .ZOrder := 8 .Move(75, 3795, 7050, 75) End With 'DataConConfigureWizard.SelectSource.Frame1 End With 'DataConConfigureWizard.SelectSource With .FillSource .Caption := "Configure DataControl" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.FillSource.BtnNext .CancelButton := Nothing .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.Branch .BackStep := DataConConfigureWizard.SelectSource With .LBTable .Caption := "LBTable" .ZOrder := 4 .Move(2850, 1050, 4050, 1005) End With 'DataConConfigureWizard.FillSource.LBTable With .OBTable .Caption := "Use Table" .ZOrder := 3 .Move(2850, 750, 2145, 225) .TabStop := True End With 'DataConConfigureWizard.FillSource.OBTable With .OBSQL .Caption := "Use SQL" .ZOrder := 2 .Move(2850, 2250, 2145, 225) End With 'DataConConfigureWizard.FillSource.OBSQL With .TBSQL .ZOrder := 1 .Move(2850, 2550, 4050, 1050) .WordWrap := True .MultiLine := True .ScrollBars := "Vertical" End With 'DataConConfigureWizard.FillSource.TBSQL With .BtnFinish .Enabled := False .ZOrder := 5 .Move(6300, 4020, 825, 300) End With 'DataConConfigureWizard.FillSource.BtnFinish With .BtnNext .ZOrder := 6 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.FillSource.BtnNext With .BtnBack .ZOrder := 7 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.FillSource.BtnBack With .BtnCancel .ZOrder := 8 .Move(3675, 4020, 825, 300) End With 'DataConConfigureWizard.FillSource.BtnCancel With .ImgGraphic .ZOrder := 9 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.FillSource.ImgGraphic With .LblInstruction .Caption := "How would you like to fill in the Source?" .ZOrder := 10 .Move(2850, 300, 4200, 300) End With 'DataConConfigureWizard.FillSource.LblInstruction With .Frame1 .ZOrder := 11 .Move(75, 3795, 7050, 75) End With 'DataConConfigureWizard.FillSource.Frame1 End With 'DataConConfigureWizard.FillSource With .StartStep .Caption := "Configure DataControl" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.StartStep.BtnNext .CancelButton := Nothing .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.SelectSource .initialized := -1 .ObjRef := Nothing With .OBAscii .Caption := "Ascii text file" .ZOrder := 4 .Move(3240, 1725, 3525, 630) End With 'DataConConfigureWizard.StartStep.OBAscii With .OBODBC .Caption := "ODBC database" .ZOrder := 3 .Move(3240, 1020, 3525, 630) .TabStop := True .Value := True End With 'DataConConfigureWizard.StartStep.OBODBC With .OBJump .Caption := "Modify existing layout properties" .ZOrder := 2 .Move(3225, 2505, 3525, 630) .TabStop := True .Value := True End With 'DataConConfigureWizard.StartStep.OBJump With .BtnWhackLayout .Caption := "Destroy Existing Layout" .ZOrder := 1 .Move(3525, 3000, 2700, 300) End With With .BtnFinish .Enabled := False .ZOrder := 5 .Move(6300, 4020, 825, 300) End With 'DataConConfigureWizard.StartStep.BtnFinish With .BtnNext .ZOrder := 6 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.StartStep.BtnNext With .BtnBack .Enabled := False .ZOrder := 7 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.StartStep.BtnBack With .BtnCancel .ZOrder := 8 .Move(3675, 4020, 825, 300) End With 'DataConConfigureWizard.StartStep.BtnCancel With .ImgGraphic .ZOrder := 9 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.StartStep.ImgGraphic With .LblInstruction .Caption := "Select which type of data to use." .ZOrder := 10 .Move(2805, 225, 4245, 300) End With 'DataConConfigureWizard.StartStep.LblInstruction With .Frame1 .ZOrder := 11 .Move(75, 3795, 7050, 75) End With 'DataConConfigureWizard.StartStep.Frame1 End With 'DataConConfigureWizard.StartStep With .ConfigText .Caption := "Configure DataControl" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.ConfigText.BtnNext .CancelButton := Nothing .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.Branch .BackStep := DataConConfigureWizard.SelectFile With .CHKFirstLine .Caption := "First line as Field names" .Move(2925, 900, 3165, 300) .TabStop := False End With 'DataConConfigureWizard.ConfigText.CHKFirstLine With .OBDelim .Caption := "DelimitedAscii File" .Move(2925, 1500, 1905, 300) End With 'DataConConfigureWizard.ConfigText.OBDelim With .OBFixed .Caption := "FixedAscii File" .Move(2925, 1800, 3450, 300) .TabStop := True End With 'DataConConfigureWizard.ConfigText.OBFixed With .TBRowDelim .Caption := "RowDelimiter" .Move(5175, 2175, 1725, 300) .Visible := False End With 'DataConConfigureWizard.ConfigText.TBRowDelim With .TBRowDelimXpr .Caption := "RowDelimiter Expression" .Move(5175, 2550, 1725, 300) .Visible := False End With 'DataConConfigureWizard.ConfigText.TBRowDelimXpr With .TBFieldDelim .Caption := "Field Delimiter" .Move(5175, 2925, 1725, 300) .Visible := False End With 'DataConConfigureWizard.ConfigText.TBFieldDelim With .TBFieldDelimXpr .Caption := "FieldDelimiter Expression" .Move(5175, 3300, 1725, 300) .Visible := False End With 'DataConConfigureWizard.ConfigText.TBFieldDelimXpr With .TBNumFields .Caption := "Number Of Fields" .Move(4575, 2175, 2325, 375) End With 'DataConConfigureWizard.ConfigText.TBNumFields With .TBFieldWidth .Caption := "FieldWidth" .Move(4575, 2775, 2325, 450) End With 'DataConConfigureWizard.ConfigText.TBFieldWidth With .LBLRowDelim .Caption := "Row Delimiter" .Move(2775, 2175, 2235, 225) .Visible := False .WordWrap := False .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLRowDelim With .LBLFieldWidth .Caption := "Field widths" .Move(2775, 2775, 1635, 165) .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLFieldWidth With .LBLNumFields .Caption := "Number of fields" .Move(2775, 2250, 1635, 165) .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLNumFields With .LBLFieldDelim .Caption := "Field Delimiter" .Move(2775, 2925, 2235, 225) .Visible := False .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLFieldDelim With .LBLRowDelimXpr .Caption := "Row Delimiter Expression" .Move(2775, 2550, 2235, 225) .Visible := False .WordWrap := False .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLRowDelimXpr With .LBLFieldDelimXpr .Caption := "Field Delimiter Expression" .Move(2775, 3300, 2235, 225) .Visible := False .WordWrap := False .TabStop := False End With 'DataConConfigureWizard.ConfigText.LBLFieldDelimXpr With .BtnFinish .Enabled := False .Move(6300, 4020, 825, 300) .TabStop := False End With 'DataConConfigureWizard.ConfigText.BtnFinish With .BtnNext .ZOrder := 17 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigText.BtnNext With .BtnBack .ZOrder := 18 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigText.BtnBack With .BtnCancel .ZOrder := 19 .Move(3675, 4020, 825, 300) .TabStop := False End With 'DataConConfigureWizard.ConfigText.BtnCancel With .ImgGraphic .ZOrder := 20 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap .TabStop := False End With 'DataConConfigureWizard.ConfigText.ImgGraphic With .LblInstruction .Caption := "Select text file type and configuration options." .ZOrder := 21 .Move(2925, 300, 4125, 450) .TabStop := False End With 'DataConConfigureWizard.ConfigText.LblInstruction With .Frame1 .ZOrder := 22 .Move(75, 3795, 7050, 75) .TabStop := False End With 'DataConConfigureWizard.ConfigText.Frame1 End With 'DataConConfigureWizard.ConfigText With .SelectFile .Caption := "Configure DataControl" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.SelectFile.BtnNext .CancelButton := Nothing .wizard := DataConConfigureWizard .NextStep := DataConConfigureWizard.ConfigText .BackStep := DataConConfigureWizard.StartStep .DATABASE := Nothing With .TBFileName .Caption := "TBFileName" .ZOrder := 4 .Move(2850, 750, 4050, 450) End With 'DataConConfigureWizard.SelectFile.TBFileName With .BTNBrowse .Caption := "Browse..." .ZOrder := 3 .Move(5700, 1275, 1200, 300) End With 'DataConConfigureWizard.SelectFile.BTNBrowse With .TBFileView .Caption := "TBFileView" .ForeColor := 0 .Font := DataConConfigureWizard.SelectFile.TBFileView.font .ZOrder := 2 .Move(2850, 1950, 4050, 1650) .WordWrap := True .MultiLine := True .ScrollBars := "Both" With .font .FaceName := "Lucida Console" .Size := 8.000000 .Bold := True .Italic := False .Strikethru := False End With 'DataConConfigureWizard.SelectFile.TBFileView.font End With 'DataConConfigureWizard.SelectFile.TBFileView With .BTNViewFile .Caption := "View File" .ZOrder := 1 .Move(2850, 1575, 1500, 300) End With 'DataConConfigureWizard.SelectFile.BTNViewFile With .BtnFinish .Enabled := False .ZOrder := 5 .Move(6300, 4020, 825, 300) End With 'DataConConfigureWizard.SelectFile.BtnFinish With .BtnNext .ZOrder := 6 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.SelectFile.BtnNext With .BtnBack .ZOrder := 7 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.SelectFile.BtnBack With .BtnCancel .ZOrder := 8 .Move(3675, 4020, 825, 300) End With 'DataConConfigureWizard.SelectFile.BtnCancel With .ImgGraphic .ZOrder := 9 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.SelectFile.ImgGraphic With .LblInstruction .Caption := "Type the filename of the file to use or press Browse." .ZOrder := 10 .Move(2850, 150, 4200, 450) End With 'DataConConfigureWizard.SelectFile.LblInstruction With .Frame1 .ZOrder := 11 .Move(75, 3795, 7050, 75) End With 'DataConConfigureWizard.SelectFile.Frame1 End With 'DataConConfigureWizard.SelectFile With .ConfigCtrls .Caption := "Configure DataControl" .Move(5610, 2115, 7230, 4785) .DefaultButton := DataConConfigureWizard.ConfigCtrls.BtnFinish .CancelButton := Nothing .wizard := DataConConfigureWizard .BackStep := DataConConfigureWizard.Branch .DATABASE := Nothing With .LBControls .Caption := "LBControls" .ZOrder := 6 .Move(2700, 825, 4350, 810) .IntegralHeight := False End With 'DataConConfigureWizard.ConfigCtrls.LBControls With .BTNClearLB .Caption := "Clear List" .Move(5550, 1650, 1500, 225) End With 'DataConConfigureWizard.ConfigCtrls.BTNClearLB With .LBFields .Caption := "LBFields" .ZOrder := 5 .Move(3450, 2475, 3600, 1200) .Sorted := False .IntegralHeight := False End With 'DataConConfigureWizard.ConfigCtrls.LBFields With .BTNAdd .Caption := "Add" .ZOrder := 4 .Move(3975, 2100, 900, 300) End With 'DataConConfigureWizard.ConfigCtrls.BTNAdd With .BTNRemove .Caption := "Remove" .ZOrder := 3 .Move(4950, 2100, 900, 300) End With 'DataConConfigureWizard.ConfigCtrls.BTNRemove With .LBLControls .Caption := "Controls" .ZOrder := 14 .Move(2775, 900, 900, 210) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigCtrls.LBLControls With .LBLFields .Caption := "Fields" .ZOrder := 2 .Move(2775, 2475, 600, 210) .Alignment := "Center" End With 'DataConConfigureWizard.ConfigCtrls.LBLFields With .DragFeedback .ZOrder := 1 .Move(2700, 1875, 4350, 225) End With 'DataConConfigureWizard.ConfigCtrls.DragFeedback With .BtnFinish .ZOrder := 7 .Move(6300, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigCtrls.BtnFinish With .BtnNext .Enabled := False .ZOrder := 8 .Move(5400, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigCtrls.BtnNext With .BtnBack .ZOrder := 9 .Move(4575, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigCtrls.BtnBack With .BtnCancel .Enabled := False .ZOrder := 10 .Move(3675, 4020, 825, 300) End With 'DataConConfigureWizard.ConfigCtrls.BtnCancel With .ImgGraphic .ZOrder := 11 .Move(225, 225, 2475, 3150) .Picture := DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard.ConfigCtrls.ImgGraphic With .LblInstruction .Caption := "Select controls and assign fields to them. ^M^J(Add Controls by dragging them with right mouse button onto box below.Be sure form edit is off.)" .ZOrder := 12 .Move(2850, 150, 4200, 600) End With 'DataConConfigureWizard.ConfigCtrls.LblInstruction With .Frame1 .ZOrder := 13 .Move(75, 3795, 7050, 75) End With 'DataConConfigureWizard.ConfigCtrls.Frame1 End With 'DataConConfigureWizard.ConfigCtrls With .Bitmap .LoadType := "MemoryBased" .FileName := "dbtools.ero" .ResId := 3884 End With 'DataConConfigureWizard.Bitmap End With 'DataConConfigureWizard End Code