frmselectwares.frm

来自「针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程」· FRM 代码 · 共 224 行

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 Label1 
      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
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)
    m_sFilter = sFilter
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) 'Left(sCode, Len(sCode) - SERIES_LEN)
    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
    
    Dim sSqlStr As String
    sSqlStr = "SELECT FWaresCode, FName, FSpecName, FPackageUnit, FMeasurement, FConversion, WaresList.FPriceMode, PriceMode.FPriceName, FProducingArea, FMaster FROM WaresList Inner join PriceMode On WaresList.FPriceMode = PriceMode.FPriceMode "
    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
    
    With trvList
        If .SelectedItem Is Nothing Then Exit Sub
        sCode = GetCode(.SelectedItem.Key)
        
        With m_DatRs
            If .RecordCount > 0 Then .MoveFirst
            .Find "FWaresCode = '" & sCode & "'"
            If Not .EOF Then
                If Not ![FMaster] Then
                    m_sWaresCode = sCode
                    Me.Hide
                End If
            End If
        End With
    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