frmqchd.frm

适合于中小型企业管理

            Key             =   "define"
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":4834
            Key             =   "exec"
         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":4BCE
            Key             =   "xz"
         EndProperty
         BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":4F68
            Key             =   "sc"
         EndProperty
         BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":5302
            Key             =   "sx"
         EndProperty
         BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":569C
            Key             =   "cx"
         EndProperty
         BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":5A36
            Key             =   "zd"
         EndProperty
         BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":5DD0
            Key             =   "dz"
         EndProperty
         BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":616A
            Key             =   "ph"
         EndProperty
         BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":6504
            Key             =   "fz"
         EndProperty
         BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":689E
            Key             =   "dw"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList1 
      Index           =   1
      Left            =   720
      Top             =   3840
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":6C38
            Key             =   "Root"
            Object.Tag             =   "Root"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmQchd.frx":7A8C
            Key             =   "Child"
            Object.Tag             =   "Child"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView tv 
      Height          =   6375
      Left            =   120
      TabIndex        =   16
      Top             =   720
      Width           =   2640
      _ExtentX        =   4657
      _ExtentY        =   11245
      _Version        =   393217
      LineStyle       =   1
      Style           =   7
      ImageList       =   "ImageList1(1)"
      Appearance      =   1
   End
   Begin vsElasticLightLibCtl.vsElasticLight vsElasticLight1 
      Left            =   2520
      OleObjectBlob   =   "FrmQchd.frx":7DA8
      Top             =   6000
   End
   Begin VB.Image imgSplitter 
      Height          =   6315
      Left            =   2820
      MousePointer    =   9  'Size W E
      Top             =   750
      Width           =   90
   End
End
Attribute VB_Name = "FrmQchd"
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 Rstmp As ADODB.Recordset
Dim CBJ As String
Dim CJMC As String
Dim YGXM As String

Private Sub BcCommand_Click()
On Error GoTo Err
     If Trim(LrText(0).Text) = "" Or Trim(LrText(1).Text) = "" Or Trim(LrText(2).Text) = "" Or Trim(LrText(3).Text) = "" Or Trim(Combo1.Text) = "" Then
       MsgBox "记录输入不完整！"
       Exit Sub
     End If
     If Trim(LrText(1).Text) <> "一级品" And Trim(LrText(1).Text) <> "二级品" Then
        MsgBox "产品级别错误！"
        LrText(1).SetFocus
        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!仓库名称 = Combo1.Text
    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
   ' loaddata
    Call Cxnrtcwg(Combo1.Text)
    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", 600
    lstContracts.ColumnHeaders.Add , , "    图  号   ", 1600
    lstContracts.ColumnHeaders.Add , , " 级别", 900
    lstContracts.ColumnHeaders.Add , , " 仓库名称", 1200
    lstContracts.ColumnHeaders.Add , , "仓库结存", 1000
    lstContracts.ColumnHeaders.Add , , "  结转日期", 1480
    
    Dim topNode As Node
    Dim Rsbj As ADODB.Recordset
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "select 仓库名称 from Bs_仓库列表 order by 仓库名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    tv.Nodes.Clear
    Combo1.Clear
    Do While Not Rsbj.EOF
        Set topNode = tv.Nodes.Add(, , "A" & CStr(Rsbj!仓库名称), Rsbj!仓库名称, "Root")
        topNode.Tag = Rsbj!仓库名称
        
            '填 充 网 格
        LoadChild (Rsbj!仓库名称)
        Combo1.AddItem Rsbj!仓库名称
        Rsbj.MoveNext
    Loop
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
     
    '设置为非录入状态
    Lrzt = 0
   
End Sub

Private Sub loaddata()
    Dim topNode As Node
    Dim Rsbj As ADODB.Recordset
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "select 仓库名称 from Bs_仓库列表 order by 仓库名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    tv.Nodes.Clear
    Combo1.Clear
    Do While Not Rsbj.EOF
        Set topNode = tv.Nodes.Add(, , "A" & CStr(Rsbj!仓库名称), Rsbj!仓库名称, "Root")
        topNode.Tag = Rsbj!仓库名称
        
            '填 充 网 格
        'Call Cxnrtcwg(Rsbj!仓库名称)
        LoadChild (Rsbj!仓库名称)
        Combo1.AddItem Rsbj!仓库名称
        Rsbj.MoveNext
    Loop
End Sub

Private Sub LoadChild(Lbj As String)
        Dim child As Node
        
        Set Rsyg = New ADODB.Recordset
    
        Rsyg.Open "select * from Bs_期初数据 where 仓库名称 = '" & Lbj & "' order by 图号", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Do While Not Rsyg.EOF
            Set child = tv.Nodes.Add("A" & Lbj, tvwChild, "B" & CStr(Rsyg!Id), Rsyg!图号, "Child")
                child.Tag = Rsyg!图号
                
            Rsyg.MoveNext
        Loop
    Set Cxnrrec = New ADODB.Recordset
    Cxnrrec.Open "select * from Bs_期初数据 where 仓库名称 = '" & Combo1.Text & "' order by 图号", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic, adCmdText
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 = "2008-04-20"
            Cxnrrec.AddNew
        Case "xg"                                            '修 改
            AddFlg = False
            Call Xgdqjl
        Case "sc"                                            '删 除
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call loaddata
            lstContracts.ListItems.Clear
        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 = ""
    LrText(3).Text = ""
    
End Function

Private Sub Scdqjl()                                     '删 除 当 前 记 录
    Toolfbjzt
     If Not lstContracts.ListItems.Count < 1 Then
        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 loaddata
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!结转日期
             Combo1.Text = Cxnrrec!仓库名称
    End If
End Sub

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


    '[>>查询连接串
    Sqlstr = "SELECT * FROM Bs_期初数据 where 仓库名称='" & StrBM & "' order by 图号,仓库名称,级别"
    '<<]
    Set Jlbrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    

    '[>>以下为自定义部分
    Dim ItmX As ListItem

    lstContracts.ListItems.Clear
    Do While Not Jlbrec.EOF
        Set ItmX = lstContracts.ListItems.Add(, , Jlbrec!Id)
         ItmX.SubItems(1) = Jlbrec!图号
         ItmX.SubItems(3) = Jlbrec!仓库名称
         ItmX.SubItems(2) = Jlbrec!级别
         ItmX.SubItems(4) = Jlbrec!仓库结存
         ItmX.SubItems(5) = Jlbrec!结转日期
        
        Jlbrec.MoveNext
    Loop

    '以上为自定义部分<<]
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub

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

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    tv.Enabled = False
    StTab.TabEnabled(0) = False
    LrText(0).Enabled = True
    LrText(2).Enabled = True
    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
    tv.Enabled = True
    StTab.TabEnabled(1) = False
    Lrzt = 0
    LrText(0).Enabled = False
    LrText(2).Enabled = False
    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

Private Sub tv_NodeClick(ByVal Node As MSComctlLib.Node)
   On Error Resume Next
   Dim txtSQLBJ As String
    If Left(Node.Key, 1) = "B" Then
        CBJ = Right(Node.Parent.Key, Len(Node.Parent.Key) - 1)
        Combo1.Text = Node.Parent.Tag
        CJMC = Node.Parent.Tag
        YGXM = Node.Tag
        
    ElseIf Left(Node.Key, 1) = "A" Then
        CBJ = Right(Node.Key, Len(Node.Key) - 1)
        Combo1.Text = Node.Tag
        CJMC = Node.Tag
         
         Call Cxnrtcwg(CJMC)
    End If

End Sub