⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frminput.frm

📁 婚姻介绍所管理信息系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSComCtl2.DTPicker DTPickerIn 
      DataField       =   "入会时间"
      DataSource      =   "AdoInput"
      Height          =   375
      Left            =   8325
      TabIndex        =   44
      Top             =   495
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   661
      _Version        =   393216
      Format          =   58720257
      CurrentDate     =   38578
   End
   Begin VB.Label Label19 
      Caption         =   "入会时间"
      Height          =   195
      Left            =   7425
      TabIndex        =   45
      Top             =   585
      Width           =   780
   End
   Begin VB.Label Label20 
      Alignment       =   2  'Center
      Caption         =   "信息登记"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   510
      Left            =   3923
      TabIndex        =   43
      Top             =   90
      Width           =   2355
   End
End
Attribute VB_Name = "FrmInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tmpStr As String
Dim tmpImageFile As String '保存待保存进数据库的相片文件名
Private Sub Command1_Click()
'    sqlStr = "insert into mgydb (编号,性别,年龄,属相,出生日期,身高,体重,学历,户口,婚姻,职业,收入,住房,车,孩子,其他,要求) values ('" & Text1.Text & "','" & Combo3.Text & "'," & Text2.Text & ",'" & Combo1.Text & "','" & DTPicker1.Value & "'," & Text3.Text & ",'" & Combo2.Text & "','" & Text5.Text & "','" & Text6.Text & "','" & Text7.Text & "'," & Text8.Text & ",'" & Text9.Text & "','" & Text10.Text & "','" & Text11.Text & "','" & Text12.Text & "','" & Text13.Text & "')"
'    'MsgBox sqlStr
'    AdoInput.RecordSource = sqlStr
'    AdoInput.Refresh
    EnableCtrl True
    AdoInput.Recordset.AddNew
    Image1.Picture = LoadPicture("")
End Sub

Private Sub Command2_Click()
    EnableCtrl True
End Sub

Private Sub Command3_Click()
    If Text1.Text <> "" Then
        AdoInput.Recordset.Fields.Item(4).Value = DTPickerBirth.Value
        AdoInput.Recordset.Fields.Item(22).Value = DTPickerIn.Value
        AdoInput.Recordset.Fields.Item(29).Value = ""
        If Text12.Text <> "" Then
            tmpStr = Text12.Text
        End If
        If Text14.Text <> "" Then
            tmpStr = tmpStr & "，" & Text14.Text
        End If
        If Text15.Text <> "" Then
            tmpStr = tmpStr & "，" & Text15.Text
        End If
        If Text16.Text <> "" Then
            tmpStr = tmpStr & "，" & Text16.Text
        End If
        If Text17.Text <> "" Then
            tmpStr = tmpStr & "，" & Text17.Text
        End If
        If Text18.Text <> "" Then
            tmpStr = tmpStr & "，" & Text18.Text
        End If
        If Text19.Text <> "" Then
            tmpStr = tmpStr & "，" & Text19.Text
        End If
        If Text20.Text <> "" Then
            tmpStr = tmpStr & "，" & Text20.Text
        End If
        If Text21.Text <> "" Then
            tmpStr = tmpStr & "，" & Text21.Text
        End If
        tmpStr = tmpStr & "。"
        AdoInput.Recordset.Fields.Item(29).Value = tmpStr
        Me.MousePointer = 11
        '保存相片
        SaveImage tmpImageFile, AdoInput
        AdoInput.Recordset.Update
        EnableCtrl False
        Me.MousePointer = 0
    Else
        MsgBox "请先正确输入编号！", vbExclamation, "警告"
    End If
    FrmMain.AdoMain.RecordSource = "select 编号,年龄,属相,身高,体重,学历,职业,收入,住房,婚姻,孩子,户口,姓名, 要求对方,交往情况 from mgydb order by 编号"
    FrmMain.AdoMain.Refresh
    FrmMain.DataGrid1.Columns.Item(0).Width = 550
    FrmMain.DataGrid1.Columns.Item(1).Width = 400
    FrmMain.DataGrid1.Columns.Item(2).Width = 400
    FrmMain.DataGrid1.Columns.Item(3).Width = 500
    FrmMain.DataGrid1.Columns.Item(4).Width = 500
    FrmMain.DataGrid1.Columns.Item(5).Width = 500
    FrmMain.DataGrid1.Columns.Item(6).Width = 1000
    FrmMain.DataGrid1.Columns.Item(7).Width = 600
    FrmMain.DataGrid1.Columns.Item(8).Width = 500
    FrmMain.DataGrid1.Columns.Item(9).Width = 600
    FrmMain.DataGrid1.Columns.Item(10).Width = 1700
    FrmMain.DataGrid1.Columns.Item(11).Width = 700
    FrmMain.DataGrid1.Columns.Item(12).Width = 600
    FrmMain.DataGrid1.Columns.Item(13).Width = 4900
    FrmMain.DataGrid1.Columns.Item(14).Width = 1000
    If HasQuery = True Then
        FrmMain.DataGrid2.Columns.Item(0).Width = 550
        FrmMain.DataGrid2.Columns.Item(1).Width = 400
        FrmMain.DataGrid2.Columns.Item(2).Width = 400
        FrmMain.DataGrid2.Columns.Item(3).Width = 500
        FrmMain.DataGrid2.Columns.Item(4).Width = 500
        FrmMain.DataGrid2.Columns.Item(5).Width = 500
        FrmMain.DataGrid2.Columns.Item(6).Width = 1000
        FrmMain.DataGrid2.Columns.Item(7).Width = 600
        FrmMain.DataGrid2.Columns.Item(8).Width = 500
        FrmMain.DataGrid2.Columns.Item(9).Width = 600
        FrmMain.DataGrid2.Columns.Item(10).Width = 1700
        FrmMain.DataGrid2.Columns.Item(11).Width = 700
        FrmMain.DataGrid2.Columns.Item(12).Width = 600
        FrmMain.DataGrid2.Columns.Item(13).Width = 4900
        FrmMain.DataGrid2.Columns.Item(14).Width = 1000
    End If
End Sub

Private Sub Command4_Click()
    On Error Resume Next
    If AdoInput.Recordset.RecordCount > 0 Then
        If MsgBox("确定要删除当前记录吗? ", vbExclamation + vbYesNo, "警告") = vbYes Then
            AdoInput.Recordset.Delete 1
            AdoInput.Recordset.MoveNext
            If AdoInput.Recordset.EOF = True Then
                AdoInput.Recordset.MoveLast
            End If
        End If
        ShowImage Image1, AdoInput
    Else
        MsgBox "已无记录！", vbInformation + vbOKOnly, "提示"
    End If

    FrmInput.Refresh
    FrmMain.AdoMain.Refresh
    FrmMain.DataGrid1.Columns.Item(0).Width = 550
    FrmMain.DataGrid1.Columns.Item(1).Width = 400
    FrmMain.DataGrid1.Columns.Item(2).Width = 400
    FrmMain.DataGrid1.Columns.Item(3).Width = 500
    FrmMain.DataGrid1.Columns.Item(4).Width = 500
    FrmMain.DataGrid1.Columns.Item(5).Width = 500
    FrmMain.DataGrid1.Columns.Item(6).Width = 1000
    FrmMain.DataGrid1.Columns.Item(7).Width = 600
    FrmMain.DataGrid1.Columns.Item(8).Width = 500
    FrmMain.DataGrid1.Columns.Item(9).Width = 600
    FrmMain.DataGrid1.Columns.Item(10).Width = 1700
    FrmMain.DataGrid1.Columns.Item(11).Width = 700
    FrmMain.DataGrid1.Columns.Item(12).Width = 600
    FrmMain.DataGrid1.Columns.Item(13).Width = 4900
    FrmMain.DataGrid1.Columns.Item(14).Width = 1000
    If HasQuery = True Then
        FrmMain.DataGrid2.Columns.Item(0).Width = 550
        FrmMain.DataGrid2.Columns.Item(1).Width = 400
        FrmMain.DataGrid2.Columns.Item(2).Width = 400
        FrmMain.DataGrid2.Columns.Item(3).Width = 500
        FrmMain.DataGrid2.Columns.Item(4).Width = 500
        FrmMain.DataGrid2.Columns.Item(5).Width = 500
        FrmMain.DataGrid2.Columns.Item(6).Width = 1000
        FrmMain.DataGrid2.Columns.Item(7).Width = 600
        FrmMain.DataGrid2.Columns.Item(8).Width = 500
        FrmMain.DataGrid2.Columns.Item(9).Width = 600
        FrmMain.DataGrid2.Columns.Item(10).Width = 1700
        FrmMain.DataGrid2.Columns.Item(11).Width = 700
        FrmMain.DataGrid2.Columns.Item(12).Width = 600
        FrmMain.DataGrid2.Columns.Item(13).Width = 4900
        FrmMain.DataGrid2.Columns.Item(14).Width = 1000
    End If
    CountAll = AdoMain.Recordset.RecordCount
    FrmMain.StatusBar1.Panels.Item(2).Text = "共有" & CountAll & "条记录"
    End Sub

Private Sub Command5_Click()
    AdoInput.Recordset.MoveFirst
    ShowImage Image1, AdoInput
End Sub

Private Sub Command6_Click()
    If AdoInput.Recordset.BOF = True Then
        MsgBox "已是第一条记录！"
        AdoInput.Recordset.MoveFirst
        ShowImage Image1, AdoInput
    Else
        AdoInput.Recordset.MovePrevious
        If AdoInput.Recordset.BOF = True Then
            MsgBox "已是第一条记录！"
            AdoInput.Recordset.MoveFirst
        End If
        ShowImage Image1, AdoInput
    End If
End Sub

Private Sub Command7_Click()
    If AdoInput.Recordset.EOF = True Then
        MsgBox "已是最后一条记录！"
        AdoInput.Recordset.MoveLast
        ShowImage Image1, AdoInput
    Else
        AdoInput.Recordset.MoveNext
        If AdoInput.Recordset.EOF = True Then
            MsgBox "已是最后一条记录！"
            AdoInput.Recordset.MoveLast
        End If
        ShowImage Image1, AdoInput
    End If
End Sub

Private Sub Command8_Click()
    AdoInput.Recordset.MoveLast
    ShowImage Image1, AdoInput
End Sub

Private Sub Command9_Click()

    CmDlg.Filter = "位图文件(*.bmp)|*.bmp|所有文件(*.*)|*.*"
    CmDlg.ShowOpen
    If CmDlg.FileName <> "" Then
        tmpImageFile = CmDlg.FileName
        Image1.Picture = LoadPicture(tmpImageFile)
    Else
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    AdoInput.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mgydb.mdb;Persist Security Info=False"
    AdoInput.CommandType = adCmdText
    AdoInput.RecordSource = "select * from mgydb order by 编号"
    AdoInput.Refresh
    
    EnableCtrl False
    tmpStr = ""
    If AdoInput.Recordset.RecordCount <> 0 Then
         ShowImage Image1, AdoInput
    End If
End Sub
Sub EnableCtrl(Flag As Boolean)
    Text1.Enabled = Flag
    Text2.Enabled = Flag
    Text3.Enabled = Flag
    Text4.Enabled = Flag
    Text5.Enabled = Flag
    Text6.Enabled = Flag
    Text7.Enabled = Flag
    Text8.Enabled = Flag
    Text9.Enabled = Flag
    Text10.Enabled = Flag
    Text11.Enabled = Flag
    Text12.Enabled = Flag
    Text13.Enabled = Flag
    Text20.Enabled = Flag
    Text14.Enabled = Flag
    
    Text15.Enabled = Flag
    Text16.Enabled = Flag
    Text17.Enabled = Flag
    Text18.Enabled = Flag
    Text19.Enabled = Flag
    Text21.Enabled = Flag
    Text22.Enabled = Flag
    DTPickerBirth.Enabled = Flag
    DTPickerIn.Enabled = Flag
    Combo1.Enabled = Flag
    Combo2.Enabled = Flag
    Combo3.Enabled = Flag
    Command3.Enabled = Flag
    Command9.Enabled = Flag
End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -