frmselectwares.frm

针对农资系统的商品进销存管理系统软件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSelectWares 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择商品"
   ClientHeight    =   5130
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5190
   ControlBox      =   0   'False
   ForeColor       =   &H00000000&
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5130
   ScaleWidth      =   5190
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   120
      Top             =   4560
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSelectWares.frx":0000
            Key             =   "ROOT"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSelectWares.frx":0452
            Key             =   "TYPE"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSelectWares.frx":08A4
            Key             =   "WARES"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSelectWares.frx":0FF6
            Key             =   "TYPEOPEN"
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "放弃(&C)"
      Height          =   315
      Left            =   4080
      TabIndex        =   2
      Top             =   4720
      Width           =   975
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Height          =   315
      Left            =   2880
      TabIndex        =   1
      Top             =   4720
      Width           =   975
   End
   Begin MSComctlLib.TreeView trvList 
      Height          =   4455
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4935
      _ExtentX        =   8705
      _ExtentY        =   7858
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   529
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      HotTracking     =   -1  'True
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin VB.Label lblPrompt 
      AutoSize        =   -1  'True
      Caption         =   "提示：必须选择商品明细信息！"
      ForeColor       =   &H000000FF&
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   4800
      Width           =   2520
   End
End
Attribute VB_Name = "frmSelectWares"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_DatRs As ADODB.Recordset
Dim m_sWaresCode As String
Dim m_sFilter As String
Dim m_nType As Integer  '=0, 选择商品明细; =1, 选择商品类别; =2, 选择类别或明细
Private Const ROOT_KEY As String = "Root"
Private Const ROOT_TEXT As String = "商品类别"

Public Property Get SelectWaresCode()
    SelectWaresCode = m_sWaresCode
End Property

Property Let SqlFilter(sFilter As String, nType As Integer)
    m_sFilter = sFilter
    m_nType = nType
End Property

Private Function GetCode(sNodeKey As String) As String
    Dim sCode As String
    
    If sNodeKey = ROOT_KEY Then
        sCode = ""
    Else
        sCode = Mid(sNodeKey, 2)
    End If
    
    GetCode = sCode
End Function

Private Function GetParentKey(sCode As String) As String
    Dim sKey As String
    
    sKey = GetParentCode(sCode)
    If sKey = "" Then
        sKey = ROOT_KEY
    Else
        sKey = "K" & sKey
    End If
    
    GetParentKey = sKey
End Function

Private Sub BuildTree(ByRef myTree As TreeView, rs As Recordset)
    Dim nodX As Node, sKey As String, sText As String, sImage As String
    
    myTree.Nodes.Clear
    Set nodX = myTree.Nodes.Add(, , ROOT_KEY, ROOT_TEXT, "ROOT", "ROOT")
'    nodX.EnsureVisible
    
    With rs
        Do While Not .EOF
            sKey = GetParentKey(![FWaresCode])
                If ![FMaster] Then  '商品分类信息
                    sText = ![FWaresCode] & Space(2) & ![FName]
                    sImage = "TYPE"
                Else                '明细商品信息
                    sText = ![FWaresCode] & Space(2) & ![FName] & Space(2) & IIf(IsNull(![FSpecName]), "", ![FSpecName])
                    sImage = "WARES"
                End If
                
                Set nodX = myTree.Nodes.Add(sKey, tvwChild, "K" & ![FWaresCode], sText, sImage, sImage)
                nodX.ExpandedImage = "TYPEOPEN"
    '            If ![FMaster] Then nodX.EnsureVisible
            .MoveNext
        Loop
    End With
    myTree.Nodes(ROOT_KEY).Selected = True
End Sub

Private Sub Form_Activate()
    Dim i As Integer
    For i = 1 To trvList.Nodes.Count
        If trvList.Nodes.Item(i).Image = "TYPE" Then
            trvList.Nodes.Item(i).EnsureVisible
        End If
    Next
End Sub

Private Sub Form_Load()
    SetForm Me, 9
    
    Select Case m_nType
    Case 0
        Me.Caption = "选择商品明细"
        lblPrompt.Visible = True
    Case 1
        Me.Caption = "选择商品类别"
        lblPrompt.Visible = False
    Case 2
        Me.Caption = "选择商品明细或类别"
        lblPrompt.Visible = False
    End Select
    
    Dim sSqlStr As String
    sSqlStr = "SELECT FWaresCode, FName, FSpecName, FMeasurement, FMaster FROM WaresList "
    If m_sFilter <> "" Then
        sSqlStr = sSqlStr & " Where " & m_sFilter
    End If
    sSqlStr = sSqlStr & " Order by FWaresCode"
    Set m_DatRs = New ADODB.Recordset
    m_DatRs.Open sSqlStr, m_gDBCnn, adOpenDynamic, adLockOptimistic, adCmdUnknown

    BuildTree trvList, m_DatRs
End Sub

Private Sub cmdCancel_Click()
    m_sWaresCode = ""
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Dim sCode As String
    
    If trvList.SelectedItem Is Nothing Then Exit Sub
    sCode = GetCode(trvList.SelectedItem.Key)
    
    With m_DatRs
        If .RecordCount > 0 Then .MoveFirst
        .Find "FWaresCode = '" & sCode & "'"
        If Not .EOF Then
            Select Case m_nType
            Case 0  '明细
                If Not ![FMaster] Then
                    m_sWaresCode = sCode
                    Me.Hide
                End If
            Case 1  '类别
                If ![FMaster] Then
                    m_sWaresCode = sCode
                    Me.Hide
                End If
            Case 2  '明细或类别
                m_sWaresCode = sCode
                Me.Hide
            End Select
        End If
    End With
End Sub

Private Sub trvList_DblClick()
    cmdOK_Click
End Sub

Private Sub trvList_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdOK_Click
    End If
End Sub