📄 frmrefamily.frm

📁 由visual basic编写的完整的基于企业管理的
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
End Sub

Private Sub cboZhiW_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cmdAddnew_Click()
If bEdit Then
    rec.AddNew
    bEdit = False
    InitItem
End If
StaBarStatus
End Sub

Private Sub cmdDelete_Click()
If bEdit Then
    If MsgBox("您确信删除此数据吗？", vbQuestion + vbOKCancel, "询问") = vbOK Then
        rec.Delete
        If rec.RecordCount <> 0 Then
            rec.MoveLast
            ShowRecord
        Else
            InitItem
        End If
    End If
End If
End Sub

Private Sub cmdExit_Click()
If bEdit Then
    If bChanged Then
        EditRecord
    End If
Else
    If SaveRecord Then
        rec.Update
    End If
End If
Unload Me
End Sub

Private Sub cmdFirst_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = 0 Then
        MsgBox "信息提示！这是第一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveFirst
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveFirst
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveFirst
        ShowRecord
    End If
End If
End Sub

Private Sub cmdLast_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = rec.RecordCount - 1 Then
        MsgBox "信息提示！这是最后一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveLast
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdNext_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = rec.RecordCount - 1 Then
        MsgBox "信息提示！这是最后一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveNext
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdPrevious_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = 0 Then
        MsgBox "信息提示！这是第一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MovePrevious
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdSave_Click()
If Not bEdit Then
    If SaveRecord Then
        rec.Update
        If MsgBox("您是否添加下一条数据？", vbQuestion + vbOKCancel, "信息") = vbOK Then
            InitItem
            Ctl(0).SetFocus
            rec.AddNew
        Else
            rec.MoveLast
            bEdit = True
            ShowRecord
        End If
    End If
End If
End Sub


Private Sub Form_Load()
'to do
  Set rec = dbEstate.OpenRecordset("select * from jiatqk", dbOpenDynaset)
'end do
'建立控件绑定
ControlToField
'初始化Combo框
ComboInit
If rec.AbsolutePosition = -1 Then
    Exit Sub
Else
    rec.MoveLast
    rec.MoveFirst
    rec.FindFirst "工号='" + Trim(GongH) + "'"
    bEdit = True
    bChanged = False
    If rec.NoMatch Then
        Call cmdAddnew_Click
        Dim recMain As Recordset
        Set recMain = dbEstate.OpenRecordset("select gongh,xinm from jiaozgzfxx where gongh='" + Trim(GongH) + "'", dbOpenSnapshot)
        recMain.FindFirst "gongh='" + Trim(GongH) + "'"
        txtGongH = GongH
        If Not IsNull(recMain!xinm) Then txtHuZM = recMain!xinm
    Else
        ShowRecord
        StaBarStatus
    End If
End If
End Sub

'to do
'检查当前字段所属的控件单元是否合法
Private Function CheckedItem(Index As Integer) As Boolean
bNumberNull = False
bDateNull = False
CheckedItem = True
Select Case Index
Case 0:
  If Len(Ctl(Index)) = 0 Then
      MsgBox "信息提示！工号不能为空。", vbExclamation + vbOKOnly, "信息"
      Ctl(Index).SetFocus
      CheckedItem = False
  End If
Case 5, 6, 7, 12:
  If Len(Ctl(Index)) <> 0 Then
      If Not IsDate(Ctl(Index)) Then
          MsgBox "信息提示！时间输入有误。", vbExclamation + vbOKOnly, "信息"
          CheckedItem = False
          Ctl(Index) = ""
          Ctl(Index).SetFocus
      End If
  Else
      bDateNull = True
  End If
End Select
End Function
'end do

'显示当前记录
Private Sub ShowRecord()
Dim I As Integer
For I = 0 To CtlCount
  If Not IsNull(rec.Fields(I).Value) Then
      Ctl(I) = rec.Fields(I).Value
  Else
      Ctl(I) = ""
  End If
Next I
bChanged = False
bEdit = True
StaBarStatus
End Sub

'保存当前记录修改
Private Sub EditRecord()
Dim I As Integer
For I = 0 To CtlCount
  If CheckedItem(I) Then
      If Not bDateNull And Not bNumberNull Then
        rec.Edit
        rec.Fields(I) = Ctl(I).Text
        rec.Update
      End If
  End If
Next I
End Sub

'信息初始化
Private Sub InitItem()
Dim I As Integer
For I = 0 To CtlCount
  Ctl(I) = ""
Next I
End Sub

'状态显示
Private Sub StaBarStatus()
StaBar.Panels(2) = "共" & CStr(rec.RecordCount) & "条记录"
StaBar.Panels(3) = "第" & CStr(rec.AbsolutePosition + 1) & "条记录"
End Sub

'to do控件绑定
Private Sub ControlToField()
Set Ctl(0) = txtGongH
Set Ctl(1) = txtHuZM
Set Ctl(2) = cboChenW
Set Ctl(3) = txtChuSNY
Set Ctl(4) = cboXinB
Set Ctl(5) = txtXinM
Set Ctl(6) = txtCanJGMGZ
Set Ctl(7) = txtLaiXGZ
Set Ctl(8) = txtDanW
Set Ctl(9) = cboZhiW
Set Ctl(10) = cboZhiC
Set Ctl(11) = cboHunY
Set Ctl(12) = txtPeiFRQ
CtlCount = 12
End Sub
'end do 控件绑定

Private Sub txtCanJGMGZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtChuSNY_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtDanW_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtGongH_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtHuZM_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtLaiXGZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtPeiFRQ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtXinM_Change()
If bEdit Then bChanged = True
End Sub

Private Function SaveRecord() As Boolean
Dim I As Integer
SaveRecord = True
For I = 0 To CtlCount
  If CheckedItem(I) Then
      If Not bDateNull And Not bNumberNull Then rec.Fields(I) = Ctl(I).Text
  Else
      SaveRecord = False
      Exit Function
  End If
Next I
End Function

'初始化Combo框
Private Sub ComboInit()
Dim recCombo As Recordset
Set recCombo = dbEstate.OpenRecordset("select distinct 职务 from jiatqk", dbOpenSnapshot)
If recCombo.RecordCount > 0 Then
    recCombo.MoveLast
    recCombo.MoveFirst
    While Not recCombo.EOF
      If Not IsNull(recCombo!职务) Then cboZhiW.AddItem CStr(recCombo!职务)
      recCombo.MoveNext
    Wend
End If
Set recCombo = dbEstate.OpenRecordset("select distinct 职称 from jiatqk", dbOpenSnapshot)
If recCombo.RecordCount > 0 Then
    recCombo.MoveLast
    recCombo.MoveFirst
    While Not recCombo.EOF
      If Not IsNull(recCombo!职称) Then cboZhiC.AddItem CStr(recCombo!职称)
      recCombo.MoveNext
    Wend
End If
Set recCombo = dbEstate.OpenRecordset("select distinct 称谓 from jiatqk", dbOpenSnapshot)
If recCombo.RecordCount > 0 Then
    recCombo.MoveLast
    recCombo.MoveFirst
    While Not recCombo.EOF
      If Not IsNull(recCombo!称谓) Then cboChenW.AddItem CStr(recCombo!称谓)
      recCombo.MoveNext
    Wend
End If
End Sub
上一页 1 23
⌨️ 快捷键说明

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