frmwlcx.frm

物流管理系统实例程序

            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   6
         BeginProperty Column00 
            DataField       =   "物流类型"
            Caption         =   "物流类型"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   "数量"
            Caption         =   "数量"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column02 
            DataField       =   "价值"
            Caption         =   "价值"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   1
               Format          =   """￥""#,##0.00"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column03 
            DataField       =   "经手人"
            Caption         =   "经手人"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column04 
            DataField       =   "日期"
            Caption         =   "日期"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   1
               Format          =   "yyyy-MM-dd"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column05 
            DataField       =   "说明"
            Caption         =   "说明"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
            BeginProperty Column02 
            EndProperty
            BeginProperty Column03 
            EndProperty
            BeginProperty Column04 
            EndProperty
            BeginProperty Column05 
               ColumnWidth     =   4004.788
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmWlcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rsWl As ADODB.Recordset
Attribute rsWl.VB_VarHelpID = -1
Dim rsWp As ADODB.Recordset
Attribute rsWp.VB_VarHelpID = -1

Private Sub Form_Activate()
    fMain.RsPC Tag '显示窗口信息
End Sub

Private Sub Form_Load()
    On Error Resume Next
    StateForm
    Set rsWl = New ADODB.Recordset
    Set rsWp = New ADODB.Recordset
End Sub

Private Sub Form_Resize()
    ReFrom
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If rsWl.State = 1 Then rsWl.Close
    If rsWp.State = 1 Then rsWp.Close
    Set rsWl = Nothing
    Set rsWp = Nothing
    Set frmWlcx = Nothing
End Sub

Private Sub imgZp_Click()
    Dim frmNewWin As New frmZp
    frmNewWin.Image1.Picture = imgZp.Picture
    frmNewWin.Show vbModal
    Set frmNewWin = Nothing
End Sub

Private Sub rsWl_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    On Error Resume Next
    Dim intRsPos As Integer, intRsCount As Integer
    intRsPos = rsWl.AbsolutePosition
    intRsCount = rsWl.RecordCount
    
    Tag = Caption & Space(3) & "当前位置:" & _
    intRsPos & Space(3) & "记录总数:" & intRsCount
    fMain.RsPC Tag  '显示窗口信息
End Sub

Private Sub OpenRs(ByVal lngWpID As Long, ByVal strLx As String, _
 ByVal strZyID As String, ByVal dtRq1 As Date, ByVal dtRq2 As Date)
    On Error Resume Next
    '从数据源取得记录集
    If rsWl.State = 1 Then rsWl.Close
    If rsWp.State = 1 Then rsWp.Close
    
    Set rsWp = mCdt.rsWPQKCX(lngWpID)
    Set lblLb.DataSource = rsWp
    lblLb.DataField = "类别ID"
    Set lblWpID.DataSource = rsWp
    lblWpID.DataField = "物品ID"
    Set lblMc.DataSource = rsWp
    lblMc.DataField = "名称"
    Set lblDj.DataSource = rsWp
    lblDj.DataField = "单价"
    Set lblKcl.DataSource = rsWp
    lblKcl.DataField = "库存量"
    Set lblKcjz.DataSource = rsWp
    lblKcjz.DataField = "库存价值"
    Set txtSm.DataSource = rsWp
    txtSm.DataField = "说明"
    Set imgZp.DataSource = rsWp
    imgZp.DataField = "照片"
    
    Set rsWl = mCdt.rsWLCX(lngWpID, strLx, strZyID, dtRq1, dtRq2)
    Set DataGrid1.DataSource = rsWl
End Sub

Public Sub ReFrom()
    On Error Resume Next
    '调整控件位置、大小
    If Width < 5680 Then Width = 5680
    If Height < 7600 Then Height = 7600
    Frame1.Height = Height - 5000
    TreeView1.Height = Frame1.Height - 1300
    Picture1(1).Move 5565, 0, Width - 5680, Height - 400
    DataGrid1.Move 0, 0, Picture1(1).Width - 60, Picture1(1).Height - 60
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    '以搜索树节点值为条件进行查询
    Dim lngWpID As Long, strLx As String, strZyID As String
    Dim dtRq1 As Date, dtRq2 As Date
    strLx = "%"
    strZyID = "%"
    dtRq1 = dtpCxRq(0).Value
    dtRq2 = dtpCxRq(1).Value
    
    If Left(Node.Key, 3) = "WPA" Then
        lngWpID = Node.Tag
    ElseIf Left(Node.Key, 3) = "WPB" Then
        strZyID = Node.Parent.Tag
        lngWpID = Node.Tag
    ElseIf Left(Node.Key, 3) = "LXA" Then
        lngWpID = Node.Parent.Tag
        strLx = Node.Tag
    ElseIf Left(Node.Key, 3) = "LXB" Then
        strZyID = Node.Parent.Parent.Tag
        lngWpID = Node.Parent.Tag
        strLx = Node.Tag
    Else
        Exit Sub
    End If
    
    OpenRs lngWpID, strLx, strZyID, dtRq1, dtRq2
End Sub

Private Sub StateForm()
    On Error Resume Next
    '设置树形查询搜索框的节点
    Dim mNode As Node
    Dim strNodeKey(1 To 3) As String
    Dim rsNodes(1 To 3) As ADODB.Recordset
    Dim lngXh(1 To 3) As Long
    
    Set mNode = TreeView1.Nodes.Add(, tvwFirst, "1NODE")
    mNode.Text = "按物品类别搜索"
    
    Set mNode = TreeView1.Nodes.Add("1NODE", tvwNext, "2NODE")
    mNode.Text = "按物流经手人搜索"
    '取得物品类别节点
    Set rsNodes(1) = mCdt.rsWLCX_WPLBQD
    lngXh(1) = 1
    Do Until rsNodes(1).EOF
        strNodeKey(1) = "WLB" & rsNodes(1)(0) & lngXh(1)
        Set mNode = TreeView1.Nodes.Add("1NODE", tvwChild, strNodeKey(1))
        mNode.Text = rsNodes(1)(0)
        '取得物品节点
        lngXh(2) = lngXh(1) * 1000 + 1
        Set rsNodes(2) = mCdt.rsWLCX_WPQD(rsNodes(1)(0), "%")
        Do Until rsNodes(2).EOF
            strNodeKey(2) = "WPA" & rsNodes(2)(0) & lngXh(2)
            Set mNode = TreeView1.Nodes.Add(strNodeKey(1), tvwChild, strNodeKey(2))
            mNode.Tag = rsNodes(2)(0)
            mNode.Text = rsNodes(2)(1) & "(" & rsNodes(2)(0) & ")"
            '取得物流类型节点
            lngXh(3) = lngXh(2) * 10 + 1
            Set rsNodes(3) = mCdt.rsWLCX_WLLXQD(rsNodes(2)(0), "%")
            Do Until rsNodes(3).EOF
                strNodeKey(3) = "LXA" & rsNodes(3)(0) & lngXh(3)
                Set mNode = TreeView1.Nodes.Add(strNodeKey(2), tvwChild, strNodeKey(3))
                mNode.Tag = rsNodes(3)(0)
                mNode.Text = rsNodes(3)(0)
                rsNodes(3).MoveNext
                lngXh(3) = lngXh(3) + 1
            Loop
            rsNodes(3).Close
            rsNodes(2).MoveNext
            lngXh(2) = lngXh(2) + 1
        Loop
        rsNodes(2).Close
        rsNodes(1).MoveNext
        lngXh(1) = lngXh(1) + 1
    Loop
    rsNodes(1).Close
    
    '取得经手人节点
    Set rsNodes(1) = mCdt.rsWLCX_JSRQD
    lngXh(1) = 1
    Do Until rsNodes(1).EOF
        strNodeKey(1) = "JSR" & rsNodes(1)(0)
        Set mNode = TreeView1.Nodes.Add("2NODE", tvwChild, strNodeKey(1))
        mNode.Tag = rsNodes(1)(0)
        mNode.Text = rsNodes(1)(0)
        '取得物品节点
        lngXh(2) = lngXh(1) * 1000 + 1
        Set rsNodes(2) = mCdt.rsWLCX_WPQD("%", rsNodes(1)(0))
        Do Until rsNodes(2).EOF
            strNodeKey(2) = "WPB" & rsNodes(2)(0) & lngXh(2)
            Set mNode = TreeView1.Nodes.Add(strNodeKey(1), tvwChild, strNodeKey(2))
            mNode.Tag = rsNodes(2)(0)
            mNode.Text = rsNodes(2)(1) & "(" & rsNodes(2)(0) & ")"
            '取得物流类型节点
            lngXh(3) = lngXh(2) * 10 + 1
            Set rsNodes(3) = mCdt.rsWLCX_WLLXQD(rsNodes(2)(0), rsNodes(1)(0))
            Do Until rsNodes(3).EOF
                strNodeKey(3) = "LXB" & rsNodes(3)(0) & lngXh(3)
                Set mNode = TreeView1.Nodes.Add(strNodeKey(2), tvwChild, strNodeKey(3))
                mNode.Tag = rsNodes(3)(0)
                mNode.Text = rsNodes(3)(0)
                rsNodes(3).MoveNext
                lngXh(3) = lngXh(3) + 1
            Loop
            rsNodes(3).Close
            rsNodes(2).MoveNext
            lngXh(2) = lngXh(2) + 1
        Loop
        rsNodes(2).Close
        rsNodes(1).MoveNext
        lngXh(1) = lngXh(1) + 1
    Loop
    rsNodes(1).Close
    
    Set rsNodes(1) = Nothing
    Set rsNodes(2) = Nothing
    Set rsNodes(3) = Nothing
    dtpCxRq(0) = DateAdd("M", -1, Date)
    dtpCxRq(1) = Date
End Sub