VB开发的ERP系统

                            Ssql3 = Ssql3 & tFieldName(i) & "=" & Trim(Txt_RsItm(i).Text) & ","
                        End If
                    Case Else
                        If UCase(tFieldName(i)) = "YNSTOP" Then
                            Ssql3 = Ssql3 & tFieldName(i) & "='" & Chk_YNStop.Value & "',"
                        Else
                            Ssql3 = Ssql3 & tFieldName(i) & "='" & Trim(Txt_RsItm(i).Text) & "',"
                        End If
                End Select
                
            End If
        End If
    Else
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'然后整理非固定字段 Rs_ExtendInfo,将字段名和值的sql语句拼好
        If Lrzt = 1 Then                                                               '新增状态的sql
            Ssql1 = Ssql1 & tFieldName(i) & ","
            If tIsCode(1, i) = 1 Then                                                  '编码
                Ssql2 = Ssql2 & "'" & tIsCode(2, i) & "',"
            Else                                                                       '非编码
                Select Case tDataType(i)
                    Case 7
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的日期型字段存NULL
                            Ssql2 = Ssql2 & " null,"
                        Else
                            Ssql2 = Ssql2 & "'" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
                        End If
                    Case 5
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的数字型字段存0
                            Ssql2 = Ssql2 & " 0,"
                        Else
                            Ssql2 = Ssql2 & Trim(Txt_RsItm(i).Text) & ","
                        End If
                    Case Else
                        Ssql2 = Ssql2 & "'" & Trim(Txt_RsItm(i).Text) & "',"
                End Select
                    
            End If
        Else                                                                           '修改状态的sql
            If tIsCode(1, i) = 1 Then                                                  '编码
                Ssql1 = Ssql1 & tFieldName(i) & "='" & tIsCode(2, i) & "',"
            Else                                                                       '非编码
                Select Case tDataType(i)
                    Case 7
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的日期型字段存NULL
                            Ssql1 = Ssql1 & tFieldName(i) & "= null, "
                        Else
                            Ssql1 = Ssql1 & tFieldName(i) & "='" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
                        End If
                    Case 5
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的数字型字段存0
                            Ssql1 = Ssql1 & tFieldName(i) & "= 0, "
                        Else
                            Ssql1 = Ssql1 & tFieldName(i) & "=" & Trim(Txt_RsItm(i).Text) & ","
                        End If
                    Case Else
                        Ssql1 = Ssql1 & tFieldName(i) & "='" & Trim(Txt_RsItm(i).Text) & "',"
                End Select
            End If
        End If
    End If
Next i
    

On Error GoTo Quit_Err

    '去掉最后的逗号
    If Trim(Ssql1) <> "" Then Ssql1 = Mid(Trim(Ssql1), 1, Len(Trim(Ssql1)) - 1)
    If Trim(Ssql3) <> "" Then Ssql3 = Mid(Trim(Ssql3), 1, Len(Trim(Ssql3)) - 1)
    
    Cw_DataEnvi.DataConnect.BeginTrans

    If Lrzt = 1 Then
        '新增记录
        Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT MAXID=MAX(EmpID) from Rs_BasicInfo")
        MAXID_Z = Val("" & tmpRs!maxid) + 1
        EmpID = MAXID_Z
        If Trim(Ssql1) <> "" Then
            Ssql1 = "INSERT INTO  Rs_ExtendInfo( EmpID," & Ssql1 & ") VALUES ( " & MAXID_Z & "," & Mid(Ssql2, 1, Len(Ssql2) - 1) & ")"
        Else
            Ssql1 = "INSERT INTO Rs_ExtendInfo( EmpID) VALUES ( " & MAXID_Z & ")"
        End If
        
        Ssql3 = "INSERT INTO Rs_BasicInfo( EmpID," & Ssql3 & ") VALUES( " & MAXID_Z & "," & Mid(Ssql4, 1, Len(Ssql4) - 1) & ") "
        tmpRs.Close
    Else
        '修改记录
        Ssql3 = "UPDATE Rs_BasicInfo SET " & Ssql3 & " WHERE EmpID=" & EmpID
        
        If Trim(Ssql1) <> "" Then
            Ssql1 = "UPDATE Rs_ExtendInfo SET " & Ssql1 & " WHERE EmpID=" & EmpID
            
        End If
    End If

    Cw_DataEnvi.DataConnect.Execute Ssql3
    
    If Trim(Ssql1) <> "" Then Cw_DataEnvi.DataConnect.Execute Ssql1
    
'   设置辅助保留项目
    SsqlR = "UPDATE Rs_OtherSet SET ItemParameter = '" & EmpID & "' WHERE ItemName= 'ReserveID'"
    Cw_DataEnvi.DataConnect.Execute SsqlR
    
'存储图片

    If Trim(Pic_Emp.Tag) <> "" Then
            Cw_DataEnvi.DataConnect.Execute ("UPDATE Rs_BasicInfo SET pic = Null WHERE EmpId = '" & EmpID & "'")
            Dim map As New ADODB.Recordset
            map.Open "SELECT * FROM Rs_BasicInfo WHERE EmpId='" & EmpID & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
            SavePic2DB map, EmpID
            map.Close
    End If
      
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Saved = True
Exit Sub

Quit_Err:
    Saved = False
End Sub



Private Function GetIdByNo(emp_No As String) As Integer
'根据职工号获取id的函数,未停用的
Dim tmpDataRs As New ADODB.Recordset
Dim tmpStr As String

GetIdByNo = 0
tmpStr = "SELECT EmpId FROM Rs_BasicInfo WHERE empNo = '" & Trim(emp_No) & "' AND YNStop = 0"
Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute(tmpStr)
If Not tmpDataRs.EOF Then
    GetIdByNo = tmpDataRs.Fields("EmpId")
End If
Set tmpDataRs = Nothing
End Function

Private Function LoadData(emp_id As Integer) As Boolean
'取出数据填充文本框
Dim tmpDataRs As New ADODB.Recordset
Dim tmpStr As String
Dim i As Integer

LoadData = True
On Error GoTo ErrDeal
'打开记录集，获得数据
tmpStr = Item_Info(SysOwner) & " where b.EmpId=" & emp_id & " and b.EmpId=e.EmpId"
Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute(tmpStr)

If tmpDataRs.EOF Then LoadData = False: Exit Function

'--清空文本框和图片栏
    For i = 1 To Lbl_ItmName.UBound
        Txt_RsItm(i).Text = ""
    Next i
    Chk_YNStop.Value = 0

    Pic_Emp.Picture = LoadPicture("")
    Pic_Emp.Tag = ""

'--填充文本框
For i = 1 To Lbl_ItmName.Count - 1
    
    If tIsCode(1, i) = 1 Then                                                                       '编码型的显示编码对应的值
        Txt_RsItm(i).Text = Trim("" & tmpDataRs.Fields("N_" + tFieldName(i)))
        tIsCode(2, i) = "" & tmpDataRs.Fields(tFieldName(i))
    Else                                                                                            '非编码的直接显示
        Txt_RsItm(i).Text = Trim("" & tmpDataRs.Fields(tFieldName(i)))
        If tDataType(i) = 7 And Not IsNull(tmpDataRs.Fields(tFieldName(i))) Then Txt_RsItm(i).Text = Format(tmpDataRs.Fields(tFieldName(i)), "yyyy-mm-dd")
        If UCase(tFieldName(i)) = "YNSTOP" Then                                                     '对停用复选框单独处理
            If tmpDataRs.Fields(tFieldName(i)) Then
                Chk_YNStop.Value = 1
            Else
                Chk_YNStop.Value = 0
            End If
        End If
    End If
Next

'--填充图片内容
Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute("SELECT Pic FROM Rs_BasicInfo WHERE EmpId = '" & EmpID & "'")
If Not tmpDataRs.EOF Then
    If tmpDataRs.Fields("Pic").ActualSize = 0 Then Exit Function
    Call getPicture("Pic", tmpDataRs)
    Pic_Emp.Picture = LoadPicture(App.Path & "\temp.bmp")
End If
Set tmpDataRs = Nothing

Exit Function
ErrDeal:
LoadData = False

End Function


Private Function SetTxtStatus(aClear As Boolean, aLock As Boolean, modi As Boolean, aLrzt As Integer) As Boolean
'根据需要设置文本框的状态，aClear 清空文本框，aLock 锁定文本框, modi 针对修改时工号帮助的锁定
Dim i As Integer

SetTxtStatus = True
On Error GoTo ErrDeal
If aClear Then                                                      '对文本框清空的处理
    For i = 1 To Lbl_ItmName.UBound
        Txt_RsItm(i).Text = ""
        tIsCode(2, i) = ""                                          '对应的编码也清掉
    Next i
    Chk_YNStop.Value = 0
    Pic_Emp.Picture = LoadPicture("")
    Pic_Emp.Tag = ""
End If

If aLock Then                                                       '对文本框锁定的处理
    For i = 1 To Lbl_ItmName.UBound
        Txt_RsItm(i).Enabled = False
        Cmd_CommHlp(i).Visible = False
    Next i
    Chk_YNStop.Enabled = False
    Pic_Emp.Enabled = False
Else                                                                '解锁
    For i = 1 To Lbl_ItmName.UBound
        Txt_RsItm(i).Enabled = True
    Next i
    Chk_YNStop.Enabled = True
    Pic_Emp.Enabled = True
End If

If aLrzt = 1 Then Exit Function                                     '对新增状态不需要对工号文本框单独关照

If modi Then
    For i = 1 To Lbl_ItmName.UBound
        Txt_RsItm(i).Enabled = False
        If UCase(tFieldName(i)) = "EMPNO" Then
            Txt_RsItm(i).Enabled = True
            Cmd_CommHlp(i).Visible = True
            Cmd_CommHlp(i).Enabled = True
            Exit For
        End If
    Next i
Else
    For i = 1 To Lbl_ItmName.UBound
        If UCase(tFieldName(i)) = "EMPNO" Then
            Txt_RsItm(i).Enabled = False
            Cmd_CommHlp(i).Visible = False
            Cmd_CommHlp(i).Enabled = False
            
            Exit For
        End If
    Next i
End If
'如果是工资系统，则有部分文本框被锁定

For i = 1 To Lbl_ItmName.UBound
    If SysOwner = 1 And tSysROnly(i) = True And UCase(tFieldName(i)) <> "EMPNO" Then
        Txt_RsItm(i).Enabled = False
    End If
Next i

If SysOwner = 1 Then Pic_Emp.Enabled = False

Exit Function


ErrDeal:
SetTxtStatus = False
End Function


Private Sub Move_Cursor(Direct As String)
'参数：设置游标的移动方向，用4个单词来识别
Dim i As Integer
    
    With QuerySet
    If .RecordCount = 0 Then Exit Sub
    Select Case UCase(Trim(Direct))
        Case "FIRST"
            .MoveFirst
        Case "PREVIOUS"
            .MovePrevious
            If .BOF Then
                .MoveFirst
                Exit Sub
            End If

        Case "NEXT"
            .MoveNext
            If .EOF Then
                .MoveLast
                Exit Sub
            End If
        Case "LAST"
            .MoveLast
    End Select
    EmpID = .Fields("Rs_BasicInfo#EmpID")
    lpId.Caption = lID.Caption
    lID.Caption = EmpID
    Call LoadData(EmpID)
    Call SetTxtStatus(False, True, False, Lrzt)
    
End With
End Sub


Private Sub SwitchToolBar(Status As Integer)
'设置工具栏状态  0.非编辑状态  1.编辑状态(新增) 2.编辑状态(修改)
With SzToolbar
Select Case Status
    Case 0:             '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
        '工具条
        Me.Caption = "人事信息维护"
        .Buttons("PrinterSet").Enabled = True          '打印设置
        .Buttons("Printer").Enabled = True             '打印
        .Buttons("Preview").Enabled = True             '预览
        .Buttons("New").Enabled = True                 '新增
        .Buttons("Modi").Enabled = True                '修改
        .Buttons("Del").Enabled = True                 '删除