frmtakestockwizard.frm

金算盘软件代码

        ListText(0).Comparts = 3
        ListText(0).AddRefer "所有货位", , 1
        ListText(0).AddRefer "选择货位", , 1
        ListText(0).AddRefer "自定义", , 1

        strSql = "SELECT lngPositionID,strPositionCode,strPositionName FROM Position WHERE " _
            & "(intLevel=1 OR blnIsDetail=0) AND blnIsInActive=0 ORDER BY strPositionCode"

        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        i = 4
        Do While Not recTemp.EOF
            i = i + 1
            ListText(0).AddRefer recTemp!strPositionCode & vbTab & recTemp!strPositionName, , 2
'            ListText(0).TextMatrix(CInt(i), 1) = recTemp!lngPositionID
            recTemp.MoveNext
        Loop
        recTemp.Close
        Set recTemp = Nothing
        ListText(0).ColWidth(1) = 0
    Case 1
        ListText(1).ClearRefer
        ListText(1).Comparts = 3
        
        strSql = "SELECT Item.lngItemID AS lngItemID,Item.strItemCode AS strItemCode,Item.strItemName AS " _
            & "strItemName FROM Item,ItemNature WHERE Item.lngItemNatureID=ItemNature.lngItemNatureID " _
            & " AND Item.blnIsInActive=0 AND ItemNature.strItemCategory='1' ORDER BY Item.strItemCode"
        ListText(1).SeekCol = "1,2,3"
        Set ListText(1).Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        
        ListText(1).Comparts = 3
        ListText(1).AddRefer "所有商品", , 1
        ListText(1).AddRefer "选择商品", , 1
        ListText(1).AddRefer "自定义", , 1

        strSql = "SELECT lngItemTypeID,strItemTypeCode,strItemTypeName FROM ItemType WHERE " _
            & " blnIsInActive=0 ORDER BY strItemTypeCode"

        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        i = 4
        Do While Not recTemp.EOF
            i = i + 1
            ListText(1).AddRefer recTemp!strItemTypeCode & vbTab & recTemp!strItemTypeName, , 2
            ListText(1).TextMatrix(CInt(i), 1) = recTemp!lngItemTypeID
            recTemp.MoveNext
        Loop
        recTemp.Close
        Set recTemp = Nothing
        ListText(1).ColWidth(1) = 0
    Case 2
        ListSelect(1).AddItem "货位"
        ListSelect(1).AddItem "商品编码名称及规格"
        ListSelect(1).AddItem "计量单位"
        ListSelect(1).AddItem "帐存数量"
        ListSelect(1).AddItem "盘点数量"
        ListSelect(1).AddItem "盈亏数量"
        ListSelect(0).AddItem "单价"
        ListSelect(0).AddItem "供应商"
        '版本控制
        #If conVersionType = 4 Then         '实达版
        #ElseIf conVersionType = 16 Then '财务版
        #Else
            ListSelect(0).AddItem "生产批号"
            ListSelect(0).AddItem "生产日期"
            ListSelect(0).AddItem "到期日期"
            ListSelect(0).AddItem "保质期"
'            ListSelect(0).AddItem UserDefine(0)
'            ListSelect(0).AddItem UserDefine(1)
'            ListSelect(0).AddItem UserDefine(2)
'            ListSelect(0).AddItem UserDefine(3)
'            ListSelect(0).AddItem UserDefine(4)
'            ListSelect(0).AddItem UserDefine(5)
            If UserDefineIsUsed(0) Then ListSelect(0).AddItem UserDefine(0)
            If UserDefineIsUsed(1) Then ListSelect(0).AddItem UserDefine(1)
            If UserDefineIsUsed(2) Then ListSelect(0).AddItem UserDefine(2)
            If UserDefineIsUsed(3) Then ListSelect(0).AddItem UserDefine(3)
            If UserDefineIsUsed(4) Then ListSelect(0).AddItem UserDefine(4)
            If UserDefineIsUsed(5) Then ListSelect(0).AddItem UserDefine(5)
        #End If
        cmdButton1(4).Enabled = False
        cmdButton1(5).Enabled = False
        cmdButton1(1).Enabled = True
        cmdButton1(3).Enabled = True
    Case 3
        ListSelect(3).AddItem "货位编码"
        ListSelect(3).AddItem "商品编码"
        ListSelect(2).AddItem "商品名称"
        ListSelect(2).AddItem "规格型号"
'        ListSelect(2).AddItem "帐存数量"
        ListSelect(2).AddItem "计量单位"
        ListSelect(2).AddItem "单价"
        ListSelect(2).AddItem "厂商编码"
        '版本控制
        #If conVersionType = 4 Then         '实达版
        #ElseIf conVersionType = 16 Then '财务版
        #Else
            ListSelect(2).AddItem "生产批号"
            ListSelect(2).AddItem "生产日期"
            ListSelect(2).AddItem "到期日期"
            ListSelect(2).AddItem "保质期"
        #End If
        Combo1.AddItem "升序"
        Combo1.AddItem "降序"
        Combo1.AddItem "不排序"
        Combo1.ListIndex = 0
        cmdButton2(4).Enabled = False
        cmdButton2(5).Enabled = False
        cmdButton2(1).Enabled = True
        cmdButton2(3).Enabled = True
    Case 4
        GACalendar1.Text = Format(gclsBase.BaseDate, "yyyy-mm-dd")
    End Select
End Sub


Private Sub GACalendar1_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
'    If KeyCode = 13 Then
'        cmdPNFC_Click 2
'    ElseIf KeyCode = 9 Then
'        If Shift And vbShiftMask = 0 Then
'            DoEvents
'            cmdPNFC(3).SetFocus
'        Else
'            DoEvents
'            stbBuildNewAcnt.SetFocus
'        End If
'    End If

End Sub

Private Sub GACalendar1_KeyPress(KeyAscii As Integer, bCancel As Long)
    If KeyAscii = 13 Then
        cmdPNFC_Click 2
    ElseIf KeyAscii = 9 Then
'        If Shift And vbShiftMask = 0 Then
'            DoEvents
'            cmdPNFC(3).SetFocus
'        Else
'            DoEvents
'            stbBuildNewAcnt.SetFocus
'        End If
    End If

End Sub

Private Sub GACalendar1_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
'    If KeyCode = 13 Then
'        cmdPNFC_Click 2
'    ElseIf KeyCode = 9 Then
'        If Shift And vbShiftMask = 0 Then
'            cmdPNFC(3).SetFocus
'        Else
'            stbBuildNewAcnt.SetFocus
'        End If
'    End If
End Sub

Private Sub GACalendar1_lostFocus()
'    If gclsBase.PeriodClosed(GACalendar1.Text) Then
'        GACalendar1.Text = Format(Date, "yyyy-mm-dd")
'        ShowMsg Me.hwnd, "制单日不能在已结帐期间内！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "输入错误"
'    End If
End Sub

Private Sub ListSelect_Click(Index As Integer)
    setcmdButton
End Sub

Private Sub ListSelect_DblClick(Index As Integer)
    Select Case Index
    Case 0
        If ListSelect(0).ListIndex >= 0 Then
            ListSelect(1).AddItem ListSelect(0).list(ListSelect(0).ListIndex)
            ListSelect(0).RemoveItem ListSelect(0).ListIndex
        End If
        blnMakeTempLate = True
    Case 1
        If ListSelect(1).ListIndex >= 2 Then
            ListSelect(0).AddItem ListSelect(1).list(ListSelect(1).ListIndex)
            ListSelect(1).RemoveItem ListSelect(1).ListIndex
        End If
        blnMakeTempLate = True
    Case 2
        If ListSelect(2).ListIndex >= 0 Then
            ListSelect(3).AddItem ListSelect(2).list(ListSelect(2).ListIndex)
            ListSelect(2).RemoveItem ListSelect(2).ListIndex
        End If
    Case 3
        If ListSelect(3).ListIndex >= 0 Then
            ListSelect(2).AddItem ListSelect(3).list(ListSelect(3).ListIndex)
            ListSelect(3).RemoveItem ListSelect(3).ListIndex
        End If
    End Select
    setcmdButton
End Sub



Private Sub ListText_Choose(Index As Integer)
    Dim recTemp As rdoResultset
    Dim i As Long
    Dim strINIDs As String
    
    strINIDs = "0"
    
    Select Case Index
    Case 0
        If ListText(0).ReferRow = 0 Then
            strSqlP = ""
            Exit sub
        End If
        If ListText(0).ReferRow = 1 Then            '选择货位
            If strSqlP <> "" Then
                
                strSql = "SELECT STPosition.lngPositionID AS lngPositionID,STPosition.strPositionCode AS strPositionCode,STPosition.strPositionName AS strPositionName FROM " & strSqlFromP & strSqlJoinP & " AND STPosition.blnIsInActive=0 AND STPosition.blnIsDetail <>0 AND (" & strSqlP & ")"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(1).AddItem recTemp!strPositionCode + " " + recTemp!strPositionName
                        .ListSelect(1).ItemData(.ListSelect(1).NewIndex) = recTemp!lngPositionID
                        strINIDs = strINIDs & "," & recTemp!lngPositionID
                    End With
                    recTemp.MoveNext
                Wend
                recTemp.Close
                Set recTemp = Nothing
                
                strSql = "SELECT STPosition.lngPositionID AS lngPositionID ,STPosition.strPositionCode AS strPositionCode,STPosition.strPositionName AS strPositionName FROM " & strSqlFromP & strSqlJoinP & " AND STPosition.blnIsInActive=0 AND STPosition.blnIsDetail <>0 AND STPosition.lngPositionID NOT IN (" & strINIDs & ") ORDER BY STPosition.strPositionCode"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(0).AddItem recTemp!strPositionCode + " " + recTemp!strPositionName
                        .ListSelect(0).ItemData(.ListSelect(0).NewIndex) = recTemp!lngPositionID
                    End With
                    recTemp.MoveNext
                Wend
                If (recTemp.BOF And recTemp.EOF) Then
                    frmTakeStockWizardSelect.cmdButton1(1).Enabled = False
                End If
                recTemp.Close
                Set recTemp = Nothing
                
                frmTakeStockWizardSelect.Caption = "货位选择"
                frmTakeStockWizardSelect.Frame1.Caption = "选择货位"
                frmTakeStockWizardSelect.cmdButton1(3).Enabled = True
                frmTakeStockWizardSelect.Show vbModal
            Else
                strSql = "SELECT lngPositionID,strPositionCode,strPositionName FROM Position WHERE blnIsInActive=0 ORDER BY strPositionCode"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(0).AddItem recTemp!strPositionCode + " " + recTemp!strPositionName
                        .ListSelect(0).ItemData(.ListSelect(0).NewIndex) = recTemp!lngPositionID
                    End With
                    recTemp.MoveNext
                Wend
                recTemp.Close
                Set recTemp = Nothing
                frmTakeStockWizardSelect.Caption = "货位选择"
                frmTakeStockWizardSelect.Frame1.Caption = "选择货位"
                frmTakeStockWizardSelect.Show vbModal
            End If
            Exit sub
        End If
        If ListText(0).ReferRow = 2 Then        '自定义货位
            strSqlP = Select_Some(lngViewIDP)
            Exit sub
        End If
        
        If ListText(0).id=0 Then
            
            strSqlP = " (STPosition.strPositionCode='" & ListText(0).TextMatrix(ListText(0).ReferRow, 3) & _
                "' OR STPosition.strPositionCode like '" & ListText(0).TextMatrix(ListText(0).ReferRow, 3) & "-%') AND STPosition.blnIsDetail<>0 "
	Else
            strSqlP = "STPosition.lngPositionID=" & ListText(0).ID            
        End If
    Case 1
        If ListText(1).ReferRow = 0 Then
            strSqlI = ""
            Exit sub
        End If
        If ListText(1).ReferRow = 1 Then            '选择商品
            If Trim(strSqlI) <> "" Then
                strSql = "SELECT Item.lngItemID AS lngItemID,Item.strItemCode AS strItemCode,Item.strItemName AS strItemName FROM " & strSqlFromI & strSqlJoinI & " AND Item.blnIsInActive=0 AND (" & strSqlI & ") AND (ItemNature.strItemCategory='1') ORDER BY Item.strItemCode"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(1).AddItem recTemp!strItemCode + " " + recTemp!strItemName
                        .ListSelect(1).ItemData(.ListSelect(1).NewIndex) = recTemp!lngItemID
                        strINIDs = strINIDs & "," & recTemp!lngItemID
                    End With
                    recTemp.MoveNext
                Wend
                recTemp.Close
                Set recTemp = Nothing
                
                strSql = "SELECT Item.lngItemID AS lngItemID,Item.strItemCode AS strItemCode,Item.strItemName AS strItemName FROM " & strSqlFromI & strSqlJoinI & " AND Item.blnIsInActive=0 AND Item.lngItemID NOT IN (" & strINIDs & ") AND ItemNature.strItemCategory='1' ORDER BY Item.strItemCode"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(0).AddItem recTemp!strItemCode + " " + recTemp!strItemName
                        .ListSelect(0).ItemData(.ListSelect(0).NewIndex) = recTemp!lngItemID
                    End With
                    recTemp.MoveNext
                Wend
                If (recTemp.BOF And recTemp.EOF) Then
                    frmTakeStockWizardSelect.cmdButton1(1).Enabled = False
                End If
                recTemp.Close
                Set recTemp = Nothing
                
                frmTakeStockWizardSelect.Caption = "商品选择"
                frmTakeStockWizardSelect.Frame1.Caption = "选择商品"
                frmTakeStockWizardSelect.cmdButton1(3).Enabled = True
                frmTakeStockWizardSelect.Show vbModal
            Else
                strSql = "SELECT Item.lngItemID AS lngItemID ,Item.strItemCode AS strItemCode,Item.strItemName AS strItemName FROM " & strSqlFromI & strSqlJoinI & " AND Item.blnIsInActive=0 AND (ItemNature.strItemCategory='1') ORDER BY Item.strItemCode"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                While Not recTemp.EOF
                    With frmTakeStockWizardSelect
                        .ListSelect(0).AddItem recTemp!strItemCode + " " + recTemp!strItemName
                        .ListSelect(0).ItemData(.ListSelect(0).NewIndex) = recTemp!lngItemID
                    End With
                    recTemp.MoveNext
                Wend
                recTemp.Close
                Set recTemp = Nothing
                frmTakeStockWizardSelect.Caption = "商品选择"
                frmTakeStockWizardSelect.Frame1.Caption = "选择商品"
                frmTakeStockWizardSelect.Show vbModal
            End If
            Exit sub
        End If
        If ListText(1).ReferRow = 2 Then        '自定义商品
            strSqlI = Select_Some(lngViewIDI)
            Exit sub
        End If