frmbmwh.frm

适合于中小型企业管理

         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":3938
            Key             =   "prev"
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":3CD2
            Key             =   "next"
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":406C
            Key             =   "last"
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":4406
            Key             =   "xx"
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":47A0
            Key             =   "define"
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":4B3A
            Key             =   "exec"
         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":4ED4
            Key             =   "xz"
         EndProperty
         BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":526E
            Key             =   "sc"
         EndProperty
         BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":5608
            Key             =   "sx"
         EndProperty
         BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":59A2
            Key             =   "cx"
         EndProperty
         BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":5D3C
            Key             =   "zd"
         EndProperty
         BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":60D6
            Key             =   "dz"
         EndProperty
         BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":6470
            Key             =   "ph"
         EndProperty
         BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":680A
            Key             =   "fz"
         EndProperty
         BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmBmwh.frx":6BA4
            Key             =   "dw"
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox vsElasticLight1 
      Height          =   480
      Left            =   6660
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   15
      Top             =   1230
      Width           =   1200
   End
End
Attribute VB_Name = "FrmBmwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim AddFlg As Boolean
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Bln_Cancel As Boolean                '取消按钮信息传递
Dim RsCsDel As ADODB.Recordset
Dim DelFlg As Boolean

Private Sub BcCommand_Click()
On Error GoTo Err
     If Trim(LrText(0).Text) = "" Or Trim(LrText(1).Text) = "" Or Trim(LrText(2).Text) = "" Then
       MsgBox "记录输入不完整！"
       Exit Sub
     End If
      Cxnrrec!部门名称 = Trim(LrText(0).Text)
      Cxnrrec!负责人 = Trim(LrText(1).Text)
      Cxnrrec!联系电话 = Trim(LrText(2).Text)
      Cxnrrec!创建日期 = Trim(LrText(3).Text)
      Cxnrrec!生产部门 = Check1.Value
      If AddFlg = True Then
        Cxnrrec.Update
        MsgBox "记录添加成功！", vbInformation
        Cxnrrec.MoveNext
        If Cxnrrec.EOF Then Cxnrrec.MoveLast
    Else
        Cxnrrec.UpdateBatch adAffectAllChapters
        MsgBox "记录修改成功！", vbInformation
        Cxnrrec.MoveNext
        If Cxnrrec.EOF Then Cxnrrec.MoveLast
    End If
    
    Call Toolfbjzt
    Call Cxnrtcwg
    Exit Sub
Err:
        If AddFlg = True Then
            Cxnrrec.CancelUpdate
        Else
            Cxnrrec.CancelBatch adAffectAllChapters
        End If
End Sub

Private Sub Form_Load()
    '调入网格设置信息
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , "  ID", 900
    lstContracts.ColumnHeaders.Add , , "  部门名称", 1680
    lstContracts.ColumnHeaders.Add , , "  负责人", 1480
    lstContracts.ColumnHeaders.Add , , "  联系电话", 1880
    lstContracts.ColumnHeaders.Add , , "  创建日期", 1680
    lstContracts.ColumnHeaders.Add , , "生产部门", 1100


    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
     
    '设置为非录入状态
    Lrzt = 0
    DelFlg = False
End Sub

Private Sub lstContracts_DblClick()
    Call Xgdqjl
End Sub

Private Sub QxCommand_Click()                                           '取消
    If AddFlg = True Then
      Cxnrrec.CancelUpdate
    Else
      Cxnrrec.CancelBatch adAffectAllChapters
    End If
    
    If Bln_Cancel Then
        Bln_Cancel = False
        Exit Sub
    End If
    
    Call Toolfbjzt
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
      
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            DY_Dyymsz.Show 1
        Case "yl"                                            '预 览
                
        Case "dy"                                            '打 印
            
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            Call Cshlrxx(Lrzt)
            AddFlg = True
            LrText(3).Text = Gsdate()
            Cxnrrec.AddNew
        Case "xg"                                            '修 改
            Call Xgdqjl
            LrText(3).Text = Gsdate()
            AddFlg = False
        Case "sc"                                            '删 除
            DelFlg = False
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
    Toolbjzt
    LrText(0).Text = ""
    LrText(1).Text = ""
    LrText(2).Text = ""
End Function

Private Sub Scdqjl()                                     '删 除 当 前 记 录
    Toolfbjzt
     If Not lstContracts.ListItems.Count < 1 Then
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Sc_领料表 where 部门名称='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在领料表（普通车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Sc_检验表 where 部门名称='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在检验表（普通车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Dm_领料表 where 部门名称='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在领料表（镀膜车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Dm_检验表 where 部门名称='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在检验表（镀膜车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        RsCsDel.Close
        Set RsCsDel = Nothing
        If DelFlg = True Then Exit Sub
        If vbYes = MsgBox("确认是要删除此记录么？" & "(" & lstContracts.SelectedItem.Text & ")", vbYesNo, "删除对话框") Then
            Sqlstr = "delete FROM Bs_部门分类 where id='" & Trim(lstContracts.SelectedItem.Text) & "'"
            Set RsView = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        End If
    Else
        MsgBox "请选择要删除的记录行！", vbCritical, "错误："
    End If
    
    Call Cxnrtcwg
End Sub

Private Sub Xgdqjl()                                     '修改当前编码记录
    
    If Not lstContracts.ListItems.Count < 1 Then
        Toolbjzt
        Set Cxnrrec = New ADODB.Recordset
        Cxnrrec.Open "SELECT *  FROM Bs_部门分类 where id='" & Trim(lstContracts.SelectedItem.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
             LrText(0).Text = Cxnrrec!部门名称
             LrText(1).Text = Cxnrrec!负责人
             LrText(2).Text = Cxnrrec!联系电话
             LrText(3).Text = Cxnrrec!创建日期
             If Cxnrrec!生产部门 = True Then
                Check1.Value = 1
             Else
                 Check1.Value = 0
             End If
              
    End If
    
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

     
End Function

 
Private Sub Cxnrtcwg()                               '查询内容填充网格(刷新)
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结


    '[>>查询连接串
    Set Cxnrrec = New ADODB.Recordset
    Cxnrrec.Open "SELECT * FROM Bs_部门分类 order by ID", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
       
    With Cxnrrec

        If .EOF And .BOF Then

            Exit Sub
        End If

        
        '[>>以下为自定义部分
        Dim ItmX As ListItem
    
        lstContracts.ListItems.Clear
        Do While Not .EOF
            Set ItmX = lstContracts.ListItems.Add(, , Cxnrrec!Id)
             ItmX.SubItems(1) = Cxnrrec!部门名称
             ItmX.SubItems(2) = Cxnrrec!负责人
             ItmX.SubItems(3) = Cxnrrec!联系电话
             ItmX.SubItems(4) = Cxnrrec!创建日期
             ItmX.SubItems(5) = Cxnrrec!生产部门
            Cxnrrec.MoveNext
        Loop
    End With
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub

Private Sub Toolbjzt()                                   'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
  
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
    End With
  
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With
  
End Sub