📄 frmrecord.frm

📁 该软件非常适合学校小型数据管理
💻 FRM
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34

If RStTxtCode.State = adstateclsed Then
RStTxtCode.Open "会员档案", DBCON, adOpenKeyset, adLockPessimistic, adCmdTable
End If
Set TxtCode.RowSource = RStTxtCode
TxtCode.BoundColumn = "会员编号"
TxtCode.ListField = "会员编号"
RStTxtCode.Close

If RSTxtName.State = adstateclsed Then
RSTxtName.Open "会员档案", DBCON, adOpenKeyset, adLockPessimistic, adCmdTable
End If
Set TxtName.RowSource = RSTxtName
TxtName.BoundColumn = "会员姓名"
TxtName.ListField = "会员姓名"
RSTxtName.Close


If RSCombo1.State = adstateclsed Then
RSCombo1.Open "会员档案", DBCON, adOpenKeyset, adLockPessimistic, adCmdTable
End If
Set Combo1.RowSource = RSCombo1
Combo1.BoundColumn = "获奖情况"
Combo1.ListField = "获奖情况"
On Error Resume Next

Call TxtState       '//调用启用文本框的Enabled属性过程
Call CmdState1      '//调用命令按钮Visible属性为隐藏的过程
End Sub

Private Sub CmdDel_Click()
If MsgBox("确定要删除吗？", vbInformation + vbYesNo, "删除信息") = vbYes Then
    If RsRecord.RecordCount <> 0 Then
        RsRecord.Delete         '//删除记录
        Call CmdMove_Click
    Else
        MsgBox "当前没有任何记录", , "删除记录"
        Call FormTxtValue2      '//调用给文本框赋空值的过程
    End If
End If
End Sub

Private Sub CmdEdit_Click()
'Call CmdState1                  '//调用命令按钮Visible属性为隐藏的过程
'Call TxtState                   '//调用启用文本框的Enabled属性过程
loadfile
CmdEdit.Tag = "1"
End Sub

Private Sub CmdMove_Click()
If RsRecord.RecordCount <> 0 Then
    RsRecord.MoveNext           '//记录向下移一条
    If RsRecord.EOF Then
    MsgBox "已经到达资料库底部!将回到第一行资料"
        RsRecord.MoveFirst      '//将记录移到第一行
    End If
    Call FormTxtValue1          '//调用将记录数据赋给文本框的过程
Else
MsgBox "当前没有任何记录", , "移动记录"
End If
'可以把多余的照片删除掉,利用编号一一核对的办法,如果该照片不等于数据库里的照片代码时就会被删除.
End Sub

Private Sub CmdPrint_Click()
DataRepRecord.Show
End Sub

Private Sub CmdRefresh_Click()
Set VSDateRecord.DataSource = RsRecord.DataSource
End Sub

Private Sub CmdRetrun_Click()
Unload Me
End Sub

Private Sub CmdSave_Click()
Dim StrSQL As String
StrSQL = "select 会员编号 from 会员档案 where 会员编号='" & Trim(TxtCode.Text) & "'"
If Trim(TxtForID.Text) <> Empty Then
    Call UpRsValue          '//调用更新记录集的过程
On Error GoTo ErrSave
        RsRecord.Update         '//更新记录
        Call CmdMove_Click
        MsgBox "数据已保存", , "保存成功"
        SSTRecord.Tab = 0
        Call CmdState2
        Call TxtState1
Else
MsgBox "原身份不能为空", , "验证失败"
SSTRecord.Tab = 1
End If
Exit Sub
ErrSave:
    Select Case Err.Number
        Case -2147217887
            MsgBox "会员编号已存在," & vbCrLf & "或性别、相关信息、部门、身份有空选项！", vbInformation + vbOKOnly, "输入错误"
            RsRecord.CancelUpdate
        Case Else
        MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "非法操作"
        Unload Me
    End Select
End Sub
Private Sub FormTxtValue1()
On Error Resume Next

TxtCode.Text = RsRecord.Fields(0).Value
TxtName.Text = RsRecord.Fields(1).Value
CmbSex.Text = RsRecord.Fields(2).Value
TxtPlace.Text = RsRecord.Fields(3).Value
DTPBrithday.Value = RsRecord.Fields(4).Value
TxtEdu.Text = RsRecord.Fields(5).Value
TxtSubject.Text = RsRecord.Fields(6).Value
TxtIDCard.Text = RsRecord.Fields(7).Value
Label1.Caption = RsRecord.Fields(8).Value
TxtPolity.Text = RsRecord.Fields(9).Value
TxtTel.Text = RsRecord.Fields(10).Value
TxtPostCode.Text = RsRecord.Fields(11).Value
TxtEmail.Text = RsRecord.Fields(12).Value
TxtAddress.Text = RsRecord.Fields(13).Value
DTPInCompanyDate.Value = RsRecord.Fields(14).Value
DTPRiceDate.Value = RsRecord.Fields(15).Value
TxtBranch.Text = RsRecord.Fields(16).Value
DTPInBranchDate.Value = RsRecord.Fields(17).Value
TxtTiltle.Text = RsRecord.Fields(18).Value
DTPTitleDate.Value = RsRecord.Fields(19).Value
TxtForID.Text = RsRecord.Fields(20).Value
TxtForTitle.Text = RsRecord.Fields(21).Value
TxtForUnit.Text = RsRecord.Fields(22).Value
DTPForInToWork.Value = RsRecord.Fields(23).Value
TxtWork.Text = RsRecord.Fields(24).Value
DataCombo1.Text = RsRecord.Fields(25).Value
Text4.Text = RsRecord.Fields(26).Value
TxtBeiZhu.Text = RsRecord.Fields(27).Value
LblCount.Caption = RsRecord.RecordCount
Image1.Picture = LoadPicture(App.Path & "\DateBase\photos\" & Label1.Caption)
Call flash_Click
End Sub
Private Sub FormTxtValue2()
Image1.Picture = LoadPicture(App.Path & "\DateBase\photos\请添加照片.jpg")
TxtCode.Text = "ACM0"
TxtName.Text = Empty
CmbSex.Text = Empty
TxtPlace.Text = Empty
DTPBrithday.Value = Date
TxtEdu.Text = "0"
TxtSubject.Text = Empty
TxtIDCard.Text = Empty
Label1.Caption = "请添加照片"
TxtPolity.Text = "100"
TxtTel.Text = Empty
TxtPostCode.Text = Empty
TxtEmail.Text = Empty
TxtAddress.Text = Empty
DTPInCompanyDate.Value = Date
DTPRiceDate.Value = Date
TxtBranch.Text = "暂无"
DTPInBranchDate.Value = Date
TxtTiltle.Text = "暂无"
DTPTitleDate.Value = Date
TxtForID.Text = "无"
TxtForTitle.Text = "无"
TxtForUnit.Text = "无"
DTPForInToWork.Value = Date
TxtWork.Text = "无"
TxtBeiZhu.Text = "无"
LblCount.Caption = RsRecord.RecordCount
End Sub
Private Sub TxtState()
Combo1.Enabled = True
Command1.Enabled = True
TxtCode.Enabled = True
TxtName.Enabled = True
CmbSex.Enabled = True
TxtPlace.Enabled = True
DTPBrithday.Enabled = True
'TxtEdu.Enabled = True
TxtSubject.Enabled = True
TxtIDCard.Enabled = True
CmbMarrageState.Enabled = True
'TxtPolity.Enabled = True
TxtTel.Enabled = True
TxtPostCode.Enabled = True
TxtEmail.Enabled = True
TxtAddress.Enabled = True
DTPInCompanyDate.Enabled = True
DTPRiceDate.Enabled = True
TxtBranch.Enabled = True
DTPInBranchDate.Enabled = True
TxtTiltle.Enabled = True
DTPTitleDate.Enabled = True
TxtForID.Enabled = True
TxtForTitle.Enabled = True
TxtForUnit.Enabled = True
DTPForInToWork.Enabled = True
TxtWork.Enabled = True
TxtBeiZhu.Enabled = True
End Sub
Private Sub TxtState1()
Combo1.Enabled = False
Command1.Enabled = False
TxtCode.Enabled = False
TxtName.Enabled = False
CmbSex.Enabled = False
TxtPlace.Enabled = False
DTPBrithday.Enabled = False
TxtEdu.Enabled = False
TxtSubject.Enabled = False
TxtIDCard.Enabled = False
CmbMarrageState.Enabled = False
TxtPolity.Enabled = False
TxtTel.Enabled = False
TxtPostCode.Enabled = False
TxtEmail.Enabled = False
TxtAddress.Enabled = False
DTPInCompanyDate.Enabled = False
DTPRiceDate.Enabled = False
TxtBranch.Enabled = False
DTPInBranchDate.Enabled = False
TxtTiltle.Enabled = False
DTPTitleDate.Enabled = False
TxtForID.Enabled = False
TxtForTitle.Enabled = False
TxtForUnit.Enabled = False
DTPForInToWork.Enabled = False
TxtWork.Enabled = False
TxtBeiZhu.Enabled = False
End Sub
Private Sub CmdState1()
CmdAdd.Visible = False
CmdEdit.Visible = False
CmdDel.Visible = False
CmdMove.Visible = False
CmdSave.Visible = True
CmdRetrun.Enabled = False
End Sub
Private Sub CmdState2()
CmdAdd.Visible = True
CmdEdit.Visible = True
CmdDel.Visible = True
CmdMove.Visible = True
CmdSave.Visible = False
CmdRetrun.Enabled = True
End Sub
Private Sub UpRsValue()
On Error Resume Next
RsRecord.Fields(0).Value = TxtCode.Text
RsRecord.Fields(1).Value = TxtName.Text
RsRecord.Fields(2).Value = CmbSex.Text
RsRecord.Fields(3).Value = TxtPlace.Text
RsRecord.Fields(4).Value = DTPBrithday.Value
RsRecord.Fields(5).Value = TxtEdu.Text
RsRecord.Fields(6).Value = TxtSubject.Text
RsRecord.Fields(7).Value = TxtIDCard.Text
RsRecord.Fields(8).Value = Label1.Caption
RsRecord.Fields(9).Value = TxtPolity.Text
RsRecord.Fields(10).Value = TxtTel.Text
RsRecord.Fields(11).Value = TxtPostCode.Text
RsRecord.Fields(12).Value = TxtEmail.Text
RsRecord.Fields(13).Value = TxtAddress.Text
RsRecord.Fields(14).Value = DTPInCompanyDate.Value
RsRecord.Fields(15).Value = DTPRiceDate.Value
RsRecord.Fields(16).Value = TxtBranch.Text
RsRecord.Fields(17).Value = DTPInBranchDate.Value
RsRecord.Fields(18).Value = TxtTiltle.Text
RsRecord.Fields(19).Value = DTPTitleDate.Value
RsRecord.Fields(20).Value = TxtForID.Text
RsRecord.Fields(21).Value = TxtForTitle.Text
RsRecord.Fields(22).Value = TxtForUnit.Text
RsRecord.Fields(23).Value = DTPForInToWork.Value
RsRecord.Fields(24).Value = TxtWork.Text
RsRecord.Fields(25).Value = TxtBeiZhu.Text
End Sub

Private Sub flashs()
'Set VSFlexGrid1.DataSource = RsRecord.DataSource
'VSDateRecord.Refresh
End Sub
Function loadname() As String
 Dim i As Integer

    Dim Y As Integer
    Dim Z As Integer
    Dim FileNames$()
    Dim ggg, jj
    Const OFN_ALLOWMULTISELECT = &H200&
    
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "图片文件|*.bmp;*.wmf;*.ico;*.gif;*.jpg"
    CommonDialog1.Flags = OFN_ALLOWMULTISELECT
    CommonDialog1.Action = 1
    
    CommonDialog1.FileName = CommonDialog1.FileName & Chr(32)   'Chr(32)为空格
    Z = 1
    For i = 1 To Len(CommonDialog1.FileName)
        i = InStr(Z, CommonDialog1.FileName, Chr(32))
        If i = 0 Then Exit For

        ReDim Preserve FileNames(Y)
        FileNames(Y) = Mid(CommonDialog1.FileName, Z, i - Z)
        Z = i + 1
        Y = Y + 1
    Next
    
   If Y = 1 Then
         loadname = FileNames(0)
  ' Else
     '   Text2.Text = ""
    '    For i = 0 To Y - 1
       '     If i = 0 Then
     '          ggg = FileNames(i)
      '      Else
        '        Text2.Text = Text2.Text & UCase(FileNames(i)) & Chr$(13) & Chr$(10)
      '      End If

       ' Next
End If
        On Error Resume Next
 'loadname = ggg
End Function

Private Sub Nochane()

On Error Resume Next
CmbSex.Text = RsRecord1.Fields(2).Value
TxtPlace.Text = RsRecord1.Fields(3).Value
DTPBrithday.Value = RsRecord1.Fields(4).Value
TxtEdu.Text = RsRecord1.Fields(5).Value
TxtSubject.Text = RsRecord1.Fields(6).Value
TxtIDCard.Text = RsRecord1.Fields(7).Value
Label1.Caption = RsRecord1.Fields(8).Value
TxtPolity.Text = RsRecord1.Fields(9).Value
TxtTel.Text = RsRecord1.Fields(10).Value
TxtPostCode.Text = RsRecord1.Fields(11).Value
TxtEmail.Text = RsRecord1.Fields(12).Value
TxtAddress.Text = RsRecord1.Fields(13).Value
DTPInCompanyDate.Value = RsRecord1.Fields(14).Value
DTPRiceDate.Value = RsRecord1.Fields(15).Value
TxtBranch.Text = RsRecord1.Fields(16).Value
DTPInBranchDate.Value = RsRecord1.Fields(17).Value
TxtTiltle.Text = RsRecord1.Fields(18).Value
DTPTitleDate.Value = RsRecord1.Fields(19).Value
TxtForID.Text = RsRecord1.Fields(20).Value
TxtForTitle.Text = RsRecord1.Fields(21).Value
TxtForUnit.Text = RsRecord1.Fields(22).Value
DTPForInToWork.Value = RsRecord1.Fields(23).Value
TxtWork.Text = RsRecord1.Fields(24).Value
Combo1.Text = RsRecord1.Fields(25).Value
Text4.Text = RsRecord1.Fields(26).Value
TxtBeiZhu.Text = RsRecord1.Fields(27).Value

If Label1.Caption = "请添加照片" Or Label1.Caption = "" Then
Image1.Picture = LoadPicture(App.Path & "\DateBase\photos\请添加照片.jpg")
Else
Image1.Picture = LoadPicture(App.Path & "\DateBase\photos\" & Label1.Caption)
End If
On Error Resume Next

'End If
End Sub

Private Sub Tmr_Timer()
Call CmdRefresh_Click   '//定时刷新
VSDateRecord.Refresh
End Sub

Private Sub TxtCode_Change()
If RsRecord1.State = adStateOpen Then
RsRecord1.Close              '//关闭记录集
End If
On Error Resume Next
RsRecord1.Open "select *from 会员档案 where 会员编号='" & TxtCode.Text & "' ", DBCON, adOpenKeyset, adLockOptimistic, adCmdText

TxtName.Text = RsRecord1.Fields(1).Value
Call Nochane
End Sub

Private Sub TxtName_Change()
If RsRecord1.State = adStateOpen Then
RsRecord1.Close              '//关闭记录集
End If
RsRecord1.Open "select *from 会员档案 where 会员姓名='" & TxtName.Text & "' ", DBCON, adOpenKeyset, adLockOptimistic, adCmdText

TxtCode.Text = RsRecord1.Fields(0).Value
Call Nochane
End Sub
上一页 1 2 34
⌨️ 快捷键说明

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