+

VB开发的ERP系统

'*******************************************************
'*    模 块 名 称 :人事项目排列
'*    功 能 描 述 :设定录入时个项目的位置
'*    程序员姓名  :刘刚
'*    最后修改人  :刘刚
'*    最后修改时间:2002/01/29
'*    备        注:经过自己测试
'*******************************************************

Option Explicit
Dim tf As Boolean
Dim Move_Y As Integer
Dim Move_X As Integer
Dim VS_int As Integer
Dim Rows_int As Integer
Dim Ssql_str As String
Dim add_item As New ADODB.Recordset
Dim VsE_TF As Boolean
Dim frmOwner As Integer                         '用来区分是人事系统在调用还是工资在调用

Private Sub Form_Load()
    frmOwner = Xtcdcs
    Xtcdcs = ""

    Me.Caption = "人事项目排列"
    List
End Sub

Public Sub List() '向界面加载项目信息
    On Error Resume Next
    
    Dim b As Integer
    Dim tmpTab As Integer
    Dim tmpLeft As Integer
    Dim tmpTop As Integer
    
    VsE_TF = False
    Pict.Top = 0: Pict.Left = 0: VS_E.Value = 0
    VsE_TF = True
    
    For b = 1 To Text_T.Count - 1
        Unload Text_T(b)
        Unload T_Label(b)
    Next b
    '-------------
    Dim i As Integer
    i = 1
    VS_E.Max = 500: VS_int = 0
    If frmOwner = 1 Then
        Set add_item = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items  where (SID='1' OR Rs='1') and (FieldName='pic' or YNShow='1') order by tab")
    Else
        Set add_item = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items  where (SID='2' OR Pm='1' or FieldName='pic') and sYNShow='1' order by stab")
    End If
    Rows_int = add_item.RecordCount
    Do While Not add_item.EOF
        If frmOwner = 1 Then
            tmpTab = Val("" & add_item!Tab)
            tmpLeft = Val("" & add_item!pLeft)
            tmpTop = Val("" & add_item!pTop)
        Else
            tmpTab = Val("" & add_item!sTab)
            tmpLeft = Val("" & add_item!sLeft)
            tmpTop = Val("" & add_item!Stop)
        End If
        
        
        If UCase(Trim(add_item.Fields("FieldName"))) = "PIC" Then
            If tmpTop < 100 Then tmpTop = 100
            If tmpLeft < 200 Then tmpLeft = 200
            Lbl_P.Top = tmpTop
            Lbl_P.Left = tmpLeft - 200
            Pic_Emp.Top = tmpTop
            Pic_Emp.Left = tmpLeft
        Else
            Load T_Label(i)
            Load Text_T(i)
            T_Label(i).Left = tmpLeft
            T_Label(i).Top = tmpTop
            T_Label(i).Tag = add_item!ItemId
            T_Label(i).Caption = add_item!ChName
            Text_T(i).Left = T_Label(i).Left + T_Label(i).Width + 100
            Text_T(i).Top = T_Label(i).Top - 50
            Text_T(i).TabIndex = tmpTab - 1
            Text_T(i).Width = add_item!FieldLength * 105
            Text_T(i).Visible = True
            Text_T(i).Text = tmpTab
            T_Label(i).Visible = True
            i = i + 1
        End If
        
        
       
    add_item.MoveNext
    Loop
    add_item.Close
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
           Case "Save"
                YesNo_str = MsgBox("您是否保存当前格式？", vbYesNo + 32, "百利/ERP5.0-人事管理")
                If YesNo_str = vbNo Then Exit Sub
                Save
           Case "SD"
                SD_Text
           Case "HD"
                HD_Text
           Case "sx"
                List
           Case "Item"
                 Xtcdcs = frmOwner
                 Set_ItemVisibleFrm.Show 1
                List
           Case "bz"
                Call F1bz
           Case "Exit"
                Unload Me
    End Select
End Sub

Private Sub Lbl_P_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    tf = True
    Move_Y = y
    Move_X = x
    Label1.Top = Lbl_P.Top + 930
    Label1.Left = Lbl_P.Left + 1000
    Label2.Caption = "X=" & Int(Pic_Emp.Left) & ",Y=" & Int(Pic_Emp.Top)
    Label1.Visible = True
End Sub

Private Sub Lbl_P_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If tf = True Then
        If Lbl_P.Top - (Move_Y - y) >= 0 Then
            If Lbl_P.Top - (Move_Y - y) <= 5000 + VS_E.Value * 8 - 200 Then
                Lbl_P.Top = Lbl_P.Top - (Move_Y - y)
                Label1.Top = Label1.Top - (Move_Y - y)
                Pic_Emp.Top = Lbl_P.Top - 50
            End If
        End If
        '-------------------
        If Lbl_P.Left - (Move_X - x) >= 0 Then
            Lbl_P.Left = Lbl_P.Left - (Move_X - x)
            Label1.Left = Label1.Left - (Move_X - x)
            Pic_Emp.Left = Lbl_P.Left + Lbl_P.Width + 100
        End If
        Label2.Caption = "X=" & Pic_Emp.Left & ",Y=" & Pic_Emp.Top
    End If
End Sub

Private Sub Lbl_P_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    tf = False
    Label1.Visible = False
End Sub

Private Sub T_Label_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    tf = True
    Move_Y = y
    Move_X = x
    Label1.Top = T_Label(Index).Top + 200
    Label1.Left = T_Label(Index).Left + 200
    Label2.Caption = "X=" & Text_T(Index).Left & ",Y=" & Text_T(Index).Top
    Label1.Visible = True
End Sub

Private Sub T_Label_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If tf = True Then
    
        If T_Label(Index).Top - (Move_Y - y) >= 0 Then
            If T_Label(Index).Top - (Move_Y - y) <= 5000 + VS_E.Value * 8 - 200 Then
                T_Label(Index).Top = T_Label(Index).Top - (Move_Y - y)
                Label1.Top = Label1.Top - (Move_Y - y)
                Text_T(Index).Top = T_Label(Index).Top - 50
            End If
        End If
        '-------------------
        If T_Label(Index).Left - (Move_X - x) >= 0 Then
            T_Label(Index).Left = T_Label(Index).Left - (Move_X - x)
            Label1.Left = Label1.Left - (Move_X - x)
            Text_T(Index).Left = T_Label(Index).Left + T_Label(Index).Width + 100
        End If
        Label2.Caption = "X=" & Text_T(Index).Left & ",Y=" & Text_T(Index).Top
    End If
End Sub

Private Sub T_Label_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    tf = False
    Label1.Visible = False
End Sub

Private Sub Text_T_Change(Index As Integer)
    If Text_T(Index).Text <> "" Then
        Text_T(Index).Text = Int(Val(Text_T(Index).Text))
    End If
End Sub

Private Sub Text_T_DblClick(Index As Integer)
    If Text_T(Index).BackColor = &HFFFFFF Then
       Text_T(Index).BackColor = &HF2FAEB
       Else
       Text_T(Index).BackColor = &HFFFFFF
    End If
End Sub

Private Sub Text_T_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then
    Else
        KeyAscii = 0
    End If
End Sub



Private Sub VS_E_Change()     '滚动条
    If VsE_TF = True Then
        If VS_int < VS_E.Value Then
            Pict.Top = Pict.Top - (VS_E.Value * 8 - VS_int)
        Else
            If VS_int <> VS_E.Value Then
                Pict.Top = Pict.Top + (VS_int - VS_E.Value * 8)
            End If
        End If
        VS_int = VS_E.Value * 8
    End If
End Sub

Private Sub Save() '保存格式
    On Error Resume Next
    Dim i As Integer
    Dim h As Integer
    Dim sSql As String
    
    For i = 1 To Rows_int - 1
    
        If Trim(T_Label(i).Caption) = "职工号" And Val(Text_T(i).Text) <> 1 Then
            Call Xtxxts("职工号的Tab值必须为1!", 0, 3)
            Exit Sub
        End If
        If Trim(T_Label(i).Caption) = "姓名" And Val(Text_T(i).Text) <> 2 Then
            Call Xtxxts("姓名的Tab值必须为2!", 0, 3)
            Exit Sub
        End If
        
        If Val(Text_T(i).Text) > Rows_int Or Val(Text_T(i).Text) <= 0 Then
            MsgBox "Tab数必须是1至" & Rows_int & "之间的连续数值!", 48, "百利/ERP5.0-人事管理"
            Text_T(i).SetFocus
            Exit Sub
        End If
        '--------------------
        For h = i + 1 To Rows_int - 1
            If Text_T(i).Text = Text_T(h).Text Then
                MsgBox "Tab数值不能重复!", 48, "百利/ERP5.0-人事管理"
                Text_T(h).SetFocus
                Exit Sub
            End If
        Next
    Next
    
    sSql = ""
    For i = 1 To Rows_int
        If frmOwner = 1 Then
            sSql = sSql & " UPDATE Rs_Items SET pLeft=" & T_Label(i).Left & ",pTop=" & T_Label(i).Top _
                               & ",Tab=" & Trim(Text_T(i).Text) & " where ItemId='" & T_Label(i).Tag & "'"
        Else
            sSql = sSql & " UPDATE Rs_Items SET sLeft=" & T_Label(i).Left & ",sTop=" & T_Label(i).Top _
                               & ",sTab=" & Trim(Text_T(i).Text) & " where ItemId='" & T_Label(i).Tag & "'"
        End If
        
    Next i
        If frmOwner = 1 Then
            sSql = sSql & " UPDATE Rs_Items SET pLeft=" & Lbl_P.Left & ",pTop=" & Lbl_P.Top & " WHERE FieldName ='pic'"
        Else
            sSql = sSql & " UPDATE Rs_Items SET sLeft=" & Lbl_P.Left & ",sTop=" & Lbl_P.Top & " WHERE FieldName ='pic'"
        End If
    Cw_DataEnvi.DataConnect.Execute sSql
    
    Call Xtxxts("保存成功!", 0, 4)
End Sub

Private Sub SD_Text() '竖对
    Dim i As Integer: Dim y As Integer
    y = 1
    For y = 1 To Text_T.Count - 1
        If Text_T(y).BackColor = &HF2FAEB Then
            For i = 1 To Text_T.Count - 1
                If Text_T(i).BackColor = &HF2FAEB Then
                    If Text_T(y).Top > Text_T(i).Top Then
                        y = i
                    End If
                End If
            Next i
            Exit For
        End If
    Next y
    
    For i = 1 To Text_T.Count - 1
        If Text_T(i).BackColor = &HF2FAEB Then
            Text_T(i).Left = Text_T(y).Left
            T_Label(i).Left = Text_T(i).Left - T_Label(i).Width - 100
            Text_T(i).BackColor = &HFFFFFF
        End If
    Next i
End Sub

Private Sub HD_Text() '横对
    Dim i As Integer: Dim y As Integer
    y = 1
    For y = 1 To Text_T.Count - 1
        If Text_T(y).BackColor = &HF2FAEB Then
            For i = 1 To Text_T.Count - 1
                If Text_T(i).BackColor = &HF2FAEB Then
                    If Text_T(y).Top > Text_T(i).Top Then
                        y = i
                    End If
                End If
            Next i
            Exit For
        End If
    Next y
    
    For i = 1 To Text_T.Count - 1
        If Text_T(i).BackColor = &HF2FAEB Then
            Text_T(i).Top = Text_T(y).Top
            T_Label(i).Top = Text_T(i).Top + 50
            Text_T(i).BackColor = &HFFFFFF
        End If
    Next i
End Sub