MODIFIED SOURCE CODE FOR DFD.FRM

Made on Tuesday, Apr 8, 2003 at 9:43 AM

DFD.FRM contained 44 resource strings and 66 non-user interface strings.

Option Explicit '>>>>>>>>>>>>>>>>>>>>>>>> 'ResMe Converted To A Property: Const FORMCAPTION = "Data Form Designer" 'ResMe Converted To A Property: Const BUTTON1 = "&Build the Form" 'ResMe Converted To A Property: Const BUTTON2 = "&Close" 'ResMe Converted To A Property: Const Label1 = "Form Name (w/o Extension):" 'ResMe Converted To A Property: Const Label2 = "RecordSource:" 'ResMe Converted To A Property: Const LABEL3 = "Select a Table/QueryDef from the list or enter a SQL statement." 'ResMe Converted To A Property: Const LABEL4 = "Available Fields:" 'ResMe Converted To A Property: Const LABEL5 = "Included Fields:" 'ResMe Converted To A Property: Const MSG1 = "Form Name cannot be blank!" 'ResMe Converted To A Property: Const MSG2 = "You must enter a RecordSource!" 'ResMe Converted To A Property: Const MSG3 = "You must include some Columns!" 'ResMe Converted To A Property: Const CTLNAME1 = "&Add" 'ResMe Converted To A Property: Const CTLNAME2 = "&Delete" 'ResMe Converted To A Property: Const CTLNAME3 = "&Refresh" 'ResMe Converted To A Property: Const CTLNAME4 = "&Update" 'ResMe Converted To A Property: Const CTLNAME5 = "&Close" '>>>>>>>>>>>>>>>>>>>>>>>> Dim mrecRS As Recordset Private Sub cboRecordSource_Change() Set mrecRS = Nothing lstAll.Clear lstSelected.Clear End Sub Private Sub cboRecordSource_Click() Call cboRecordSource_LostFocus End Sub Private Sub cboRecordSource_LostFocus() On Error GoTo RSErr Dim i As Integer Dim fld As Field If Len(cboRecordSource.Text) = 0 Then Exit Sub Screen.MousePointer = 11 If mrecRS Is Nothing Then Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text) For Each fld In mrecRS.Fields lstAll.AddItem fld.Name Next ElseIf mrecRS.Name <> cboRecordSource.Text Then lstAll.Clear lstSelected.Clear Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text) For Each fld In mrecRS.Fields lstAll.AddItem fld.Name Next End If If lstAll.ListCount > 0 Then lstAll.ListIndex = 0 Screen.MousePointer = 0 Exit Sub RSErr: Screen.MousePointer = 0 MsgBox Error$ End Sub Sub cmdBuildForm_Click() If Len(txtFormName.Text) = 0 Then MsgBox MSG1, 16 txtFormName.SetFocus Exit Sub End If If Len(cboRecordSource.Text) = 0 Then MsgBox MSG2, 16 Exit Sub End If If lstSelected.ListCount = 0 Then MsgBox MSG3, 16 Exit Sub End If BuildForm End Sub Sub cmdClose_Click() Unload Me End Sub Private Sub cmdDown_Click() On Error Resume Next Dim nItem As Integer With lstSelected If .ListIndex < 0 Then Exit Sub nItem = .ListIndex If nItem = .ListCount - 1 Then Exit Sub 'can't move last item down 'move item down .AddItem .Text, nItem + 2 'remove old item .RemoveItem nItem 'select the item that was just moved .Selected(nItem + 1) = True End With End Sub Private Sub cmdMoveFields_Click(Index As Integer) Dim i As Integer Select Case Index Case 0 If lstAll.ListIndex < 0 Then Exit Sub lstSelected.AddItem lstAll.Text i = lstAll.ListIndex lstAll.RemoveItem i If lstAll.ListCount > 0 Then If i > lstAll.ListCount - 1 Then lstAll.ListIndex = i - 1 Else lstAll.ListIndex = i End If End If lstSelected.ListIndex = lstSelected.NewIndex Case 1 If lstAll.ListCount = 0 Then Exit Sub For i = 0 To lstAll.ListCount - 1 lstSelected.AddItem lstAll.List(i) Next lstAll.Clear lstSelected.ListIndex = 0 Case 2 If lstSelected.ListCount = 0 Then Exit Sub For i = 0 To lstSelected.ListCount - 1 lstAll.AddItem lstSelected.List(i) Next lstSelected.Clear lstAll.ListIndex = lstAll.NewIndex Case 3 If lstSelected.ListIndex < 0 Then Exit Sub lstAll.AddItem lstSelected.Text i = lstSelected.ListIndex lstSelected.RemoveItem i lstAll.ListIndex = lstAll.NewIndex If lstSelected.ListCount > 0 Then If i > lstSelected.ListCount - 1 Then lstSelected.ListIndex = i - 1 Else lstSelected.ListIndex = i End If End If End Select End Sub Private Sub cmdUp_Click() On Error Resume Next Dim nItem As Integer With lstSelected If .ListIndex < 0 Then Exit Sub nItem = .ListIndex If nItem = 0 Then Exit Sub 'can't move 1st item up 'move item up .AddItem .Text, nItem - 1 'remove old item .RemoveItem nItem + 1 'select the item that was just moved .Selected(nItem - 1) = True End With End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 And Shift = 0 Then DisplayTopic 2018517 End If End Sub Sub Form_Load() 'ResMe autogenerated line of code to call the initialization routine that was automatically generated. Call frmDFD_Auto_Init Me.Caption = FORMCAPTION cmdBuildForm.Caption = BUTTON1 cmdClose.Caption = BUTTON2 lblLabels(0).Caption = Label1 lblLabels(1).Caption = Label2 lblLabels(2).Caption = LABEL3 lblLabels(3).Caption = LABEL4 lblLabels(4).Caption = LABEL5 GetTableList cboRecordSource, True, False, True End Sub Private Sub lstAll_DblClick() cmdMoveFields_Click 0 End Sub Private Sub lstSelected_DblClick() cmdMoveFields_Click 3 End Sub Sub BuildForm() On Error GoTo BuildErr Dim i As Integer Dim sTmp As String Dim nNumFlds As Integer Dim frmNewForm As VBComponent Dim ctlNewControl As VBControl Dim nButtonTop As Integer Dim bOLEFields As Boolean nNumFlds = lstSelected.ListCount 'create the new form Set frmNewForm = gVDClass.VBInstance.ActiveVBProject.VBComponents.Add(vbext_ct_VBForm) 'form height = 320 * numflds + 1260 for buttons and data control 'form width = 5640 With frmNewForm .Properties!Appearance = 1 .Properties!Caption = Left(mrecRS.Name, 32) .Properties!Height = 1115 + (nNumFlds * 320) .Properties!Left = 1050 .Properties!Name = "frm" & txtFormName.Text .Properties!Width = 5640 End With 'labels.left = 120, .width = 1815, .height = 255 'fields.left = 2040, .width = 3375, .height = 285 For i = 0 To nNumFlds - 1 sTmp = lstSelected.List(i) Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("Label", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = sTmp & ":" .Properties!Height = 255 .Properties!Index = i .Properties!Left = 120 .Properties!Name = "lblLabels" .Properties!Top = (i * 320) + 60 .Properties!Width = 1815 End With If mrecRS.Fields(sTmp).Type = 1 Then 'true/false field Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CheckBox", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = "" .Properties!Height = 285 .Properties!Left = 2040 .Properties!Name = "chkFields" .Properties!Top = (i * 320) + 40 .Properties!Width = 3375 'WAS: .Properties!DataSource = "Data1" .Properties!DataSource = LoadResString(S137_Data1) .Properties!DataField = sTmp End With ElseIf mrecRS.Fields(sTmp).Type = 11 Then 'picture field bOLEFields = True Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("OLE", Nothing) With ctlNewControl .Properties!Height = 285 .Properties!Left = 2040 .Properties!Name = "oleFields" .Properties!OLETypeAllowed = 1 .Properties!Top = (i * 320) + 40 .Properties!Width = 3375 'WAS: .Properties!DataSource = "Data1" .Properties!DataSource = LoadResString(S137_Data1) .Properties!DataField = sTmp If .Properties("Index") = -1 Then .Properties("Index") = 0 End If End With SendKeys "{Esc}" Else Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("TextBox", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Left = 2040 .Properties!Name = "txtFields" .Properties!Text = "" If mrecRS.Fields(sTmp).Type < 10 Then 'numeric or date .Properties!Width = 1935 Else 'string or memo .Properties!Width = 3375 End If 'WAS: .Properties!DataSource = "Data1" .Properties!DataSource = LoadResString(S137_Data1) .Properties!DataField = sTmp If mrecRS.Fields(sTmp).Type = 10 Then .Properties!Height = 285 .Properties!Top = (i * 320) + 40 .Properties!MaxLength = mrecRS.Fields(sTmp).Size ElseIf mrecRS.Fields(sTmp).Type = 12 Then .Properties!Height = 310 .Properties!Top = (i * 320) + 30 .Properties!MultiLine = True .Properties!ScrollBars = 2 Else .Properties!Height = 285 .Properties!Top = (i * 320) + 40 End If End With End If Next nButtonTop = ctlNewControl.Properties!Top + 340 'add the data control and buttons Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("Data", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Align = 2 .Properties!Caption = "" If gsDataType <> gsSQLDB Then 'only set for local dbs .Properties!DatabaseName = gdbCurrentDB.Name End If .Properties!Connect = gdbCurrentDB.Connect .Properties!RecordSource = cboRecordSource.Text End With Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = CTLNAME1 .Properties!Height = 300 .Properties!Left = 120 .Properties!Name = "cmdAdd" .Properties!Top = nButtonTop .Properties!Width = 975 End With Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = CTLNAME2 .Properties!Height = 300 .Properties!Left = 1200 .Properties!Name = "cmdDelete" .Properties!Top = nButtonTop .Properties!Width = 975 End With Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = CTLNAME3 .Properties!Height = 300 .Properties!Left = 2280 .Properties!Name = "cmdRefresh" .Properties!Top = nButtonTop .Properties!Width = 975 End With Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = CTLNAME4 .Properties!Height = 300 .Properties!Left = 3360 .Properties!Name = "cmdUpdate" .Properties!Top = nButtonTop .Properties!Width = 975 End With Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing) With ctlNewControl .Properties!Appearance = 1 .Properties!Caption = CTLNAME5 .Properties!Height = 300 .Properties!Left = 4440 .Properties!Name = "cmdClose" .Properties!Top = nButtonTop .Properties!Width = 975 End With 'add the code to the form frmNewForm.CodeModule.AddFromString BuildFrmCode(bOLEFields) 'set the form back to defaults txtFormName.Text = "" cboRecordSource.Text = "" 'try to set focus back to the form Me.SetFocus txtFormName.SetFocus Exit Sub BuildErr: MsgBox Err.Description End Sub Function BuildFrmCode(bOLEFields As Boolean) As String Dim sCode As String Dim i As Integer .Properties!DataSource = LoadResString(S137_Data1) sCode = sCode & vbCrLf & " Data1.Recordset.AddNew" 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & " Data1.Recordset.Delete" sCode = sCode & vbCrLf & " Data1.Recordset.MoveNext" 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & " Data1.Refresh" 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & " Data1.UpdateRecord" 'WAS: sCode = sCode & vbCrLf & " Data1.Recordset.Bookmark = Data1.Recordset.LastModified" sCode = sCode & vbCrLf & LoadResString(S139_Data1_Recordset_Boo) 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) 'WAS: sCode = sCode & vbCrLf & " Unload Me" sCode = sCode & vbCrLf & LoadResString(S557_Unload_Me) 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) 'WAS: sCode = sCode & vbCrLf & " MsgBox ""Data error event hit err:"" & Error$(DataErr)" sCode = sCode & vbCrLf & LoadResString(S327_MsgBox_Data_error_e) 'WAS: sCode = sCode & vbCrLf & " Response = 0 'throw away the error" sCode = sCode & vbCrLf & LoadResString(S460_Response_0_throw_aw) 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) 'WAS: sCode = sCode & vbCrLf & " Screen.MousePointer = vbDefault" sCode = sCode & vbCrLf & LoadResString(S473_Screen_MousePointer) 'WAS: sCode = sCode & vbCrLf & " On Error Resume Next" sCode = sCode & vbCrLf & LoadResString(S359_On_Error_Resume_Nex) sCode = sCode & vbCrLf & LoadResString(S359_On_Error_Resume_Nex) sCode = sCode & vbCrLf & LoadResString(S359_On_Error_Resume_Nex) 'WAS: sCode = sCode & vbCrLf & " Data1.Caption = ""Record: "" & (Data1.Recordset.AbsolutePosition + 1)" sCode = sCode & vbCrLf & LoadResString(S138_Data1_Caption_Recor) sCode = sCode & vbCrLf & LoadResString(S138_Data1_Caption_Recor) sCode = sCode & vbCrLf & LoadResString(S138_Data1_Caption_Recor) sCode = sCode & vbCrLf & LoadResString(S138_Data1_Caption_Recor) 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) 'WAS: sCode = sCode & vbCrLf & " Select Case Action" sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) sCode = sCode & vbCrLf & LoadResString(S481_Select_Case_Action) 'WAS: sCode = sCode & vbCrLf & " End Select" sCode = sCode & vbCrLf & LoadResString(S186_End_Select) 'WAS: sCode = sCode & vbCrLf & " Screen.MousePointer = vbHourglass" sCode = sCode & vbCrLf & LoadResString(S474_Screen_MousePointer) 'WAS: sCode = sCode & vbCrLf & "End Sub" sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf 'write the code for the bound OLE client control(s) If bOLEFields Then sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) sCode = sCode & vbCrLf & " oleFields(Index).InsertObjDlg" 'WAS: sCode = sCode & vbCrLf & "End Sub" & vbCrLf sCode = sCode & vbCrLf & LoadResString(S187_End_Sub) & vbCrLf End If BuildFrmCode = sCode End Function '********************************************************************************* '** This Section Of Code Was Automatically Generated By ResMe ** '** ** '** String assignments to Constants have been converted to read-only properties ** '********************************************************************************* 'This was: Const FORMCAPTION = "Data Form Designer" Property Get FORMCAPTION As String 'WAS: FORMCAPTION = "Data Form Designer" FORMCAPTION = LoadResString(S130_Data_Form_Designer) End Property 'This was: Const BUTTON1 = "&Build the Form" Property Get BUTTON1 As String 'WAS: BUTTON1 = "&Build the Form" BUTTON1 = LoadResString(S77_Build_the_Form) End Property 'This was: Const BUTTON2 = "&Close" Property Get BUTTON2 As String 'WAS: BUTTON2 = "&Close" BUTTON2 = LoadResString(S94_Close) End Property 'This was: Const Label1 = "Form Name (w/o Extension):" Property Get Label1 As String 'WAS: Label1 = "Form Name (w/o Extension):" Label1 = LoadResString(S257_Form_Name_w_o_Exten) End Property 'This was: Const Label2 = "RecordSource:" Property Get Label2 As String Label2 = "RecordSource:" End Property 'This was: Const LABEL3 = "Select a Table/QueryDef from the list or enter a SQL statement." Property Get LABEL3 As String LABEL3 = "Select a Table/QueryDef from the list or enter a SQL statement." End Property 'This was: Const LABEL4 = "Available Fields:" Property Get LABEL4 As String 'WAS: LABEL4 = "Available Fields:" LABEL4 = LoadResString(S66_Available_Fields) End Property 'This was: Const LABEL5 = "Included Fields:" Property Get LABEL5 As String 'WAS: LABEL5 = "Included Fields:" LABEL5 = LoadResString(S293_Included_Fields) End Property 'This was: Const MSG1 = "Form Name cannot be blank!" Property Get MSG1 As String 'WAS: MSG1 = "Form Name cannot be blank!" MSG1 = LoadResString(S259_Form_Name_cannot_be) End Property 'This was: Const MSG2 = "You must enter a RecordSource!" Property Get MSG2 As String 'WAS: MSG2 = "You must enter a RecordSource!" MSG2 = LoadResString(S594_You_must_enter_a_Re) End Property 'This was: Const MSG3 = "You must include some Columns!" Property Get MSG3 As String 'WAS: MSG3 = "You must include some Columns!" MSG3 = LoadResString(S596_You_must_include_so) End Property 'This was: Const CTLNAME1 = "&Add" Property Get CTLNAME1 As String 'WAS: CTLNAME1 = "&Add" CTLNAME1 = LoadResString(S33_Add) End Property 'This was: Const CTLNAME2 = "&Delete" Property Get CTLNAME2 As String 'WAS: CTLNAME2 = "&Delete" CTLNAME2 = LoadResString(S156_Delete) End Property 'This was: Const CTLNAME3 = "&Refresh" Property Get CTLNAME3 As String 'WAS: CTLNAME3 = "&Refresh" CTLNAME3 = LoadResString(S441_Refresh) End Property 'This was: Const CTLNAME4 = "&Update" Property Get CTLNAME4 As String 'WAS: CTLNAME4 = "&Update" CTLNAME4 = LoadResString(S558_Update) End Property 'This was: Const CTLNAME5 = "&Close" Property Get CTLNAME5 As String 'WAS: CTLNAME5 = "&Close" CTLNAME5 = LoadResString(S94_Close) End Property Private Sub frmDFD_Auto_Init() 'This routine initializes all User Interface control properties on frmDFD. 'This section of code was automatically generated by the ResMe String Extraction Utility. 'WAS: Me.Caption = "Data Form Designer" Me.Caption = LoadResString(S130_Data_Form_Designer) 'WAS: cmdBuildForm.Caption = "&Build the Form" cmdBuildForm.Caption = LoadResString(S77_Build_the_Form) 'WAS: cmdClose.Caption = "&Close" cmdClose.Caption = LoadResString(S94_Close) 'WAS: lblLabels(2).Caption = "Select a Table/QueryDef from the list or enter a SQL statement." lblLabels(2).Caption = LoadResString(S480_Select_a_Table_Quer) 'WAS: lblLabels(4).Caption = "Included Fields: " lblLabels(4).Caption = LoadResString(S294_Included_Fields) 'WAS: lblLabels(1).Caption = "RecordSource: " lblLabels(1).Caption = LoadResString(S440_RecordSource) 'WAS: lblLabels(3).Caption = "Available Fields: " lblLabels(3).Caption = LoadResString(S67_Available_Fields) 'WAS: lblLabels(0).Caption = "Form Name (w/o Extension): " lblLabels(0).Caption = LoadResString(S258_Form_Name_w_o_Exten) End Sub