recordclass.cls

金算盘软件代码

                            & "ItemNature.strItemCategory IN ('1','2') AND blnIsInActive=0 AND " _
                            & "Item.strItemCode<>' '  ORDER BY Item.strItemCode ASC"
            Else            '列出所有的没有封存商品（和xItem=8一样）
                strSQL = ""
            End If
    Case 37     '付款方（邮电）
        strSQL = "SELECT lngPayCustomerID,strPayCustomerName FROM PayCustomer ORDER BY lngPayCustomerID"
    Case 38     '工程合同（邮电）
        If lngItemID > 0 Then
            strSQL = "SELECT lngOrderID,strOrderCode,strOrderName,strCustomerName FROM ProjectOrder,Customer WHERE ProjectOrder.lngCustomerID = Customer.lngCustomerID AND lngProjectID = " & lngItemID
        Else
            strSQL = "SELECT lngOrderID,strOrderCode,strOrderName,strCustomerName FROM ProjectOrder,Customer WHERE ProjectOrder.lngCustomerID = Customer.lngCustomerID"
        End If
        strSQL = strSQL & " ORDER BY strOrderCode"
    Case 39     '工程项目
        strSQL = "SELECT lngProjectID,strProjectCode,strProjectName FROM Project WHERE blnIsInActive = 0 ORDER BY strProjectCode"
    End Select
WndProc:
'====================  Get the SQL   =================
    GetSQL = strSQL
End Function

Private Sub Class_Initialize()
    InitTabName
    InitReceiptArray
    ReDim intItem(0)
    strEmployeeCondition = ""
End Sub

Private Sub Class_Terminate()
    Dim i As Integer
    On Error Resume Next
    For i = 0 To UBound(intItem)
        Select Case intItem(i)
            Case 1, 2, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 26, 27
                Utility.RemoveListRecordSet intItem(i)
            Case Else
                If Not RecordCon(intItem(i)) Is Nothing Then
                    RecordCon(intItem(i)).Close
                End If
        End Select
    Next i
    If Not FrmNewTemplate Is Nothing Then
        Unload FrmNewTemplate
    End If
End Sub

'新增参照内容，成功时返回为TRUE，ELSE 返回FALSE
Public Function NewRefer(ByVal CtrlName As ListText, Optional ByVal strNewName As String = "", Optional ByVal lngCustomerID As Long = 0, Optional ByVal lngReceiptTypeID As Long = 1, _
                        Optional ByVal intIndex As Integer = 0, Optional ByVal lngProjID As Long, Optional ByVal strProjName As String) As Boolean
                        
    Dim lngNowID As Long
    Dim lngOldID As Long
    Dim strCode As String
    Dim strName As String
    
    If UCase(TypeName(CtrlName)) <> "LISTTEXT" Then
        NewRefer = False
        Exit Function
    End If
    lngOldID = CtrlName.ID
    If intIndex <> 0 Then
        intTabItem = intIndex   'Index 为控件参照的记录集。如科目、单位、币种等
    Else
        intTabItem = MsgNo2TabItem(CInt(CtrlName.Tag))
    End If
    Select Case intTabItem
        Case 1  '单位
            lngNowID = AddCard(msgCustomer, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustomer, lngID)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 2  '部门
            lngNowID = AddCard(msgDepartment, strNewName)
            Set CtrlName.Recordset = RecordCon(xDepartment)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 3  '职员
            lngNowID = AddCard(msgEmployee, strNewName)
            Set CtrlName.Recordset = RecordCon(xEmployee, lngID, , , , lngEmployeeCondition)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 4  '统计
            lngNowID = AddCard(msgClass, strNewName)
            Set CtrlName.Recordset = RecordCon(xCLASS1)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 5  '全币种
            If lngID > 0 Then
                lngNowID = AddCard(msgcurrency, strNewName, , , lngID, blnIsMutiCurrencys)
            Else
                lngNowID = AddCard(msgcurrency, strNewName)
            End If
            Set CtrlName.Recordset = RecordCon(xCurrencys, lngID)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
            If Trim(CtrlName.Text) = "" Then
                CtrlName.SeekId FirstId(xCurrencys, lngID)
            End If
        Case 6  '付款条件
            lngNowID = AddCard(msgTerm, strNewName)
            Set CtrlName.Recordset = RecordCon(xTerm)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 7  '科目
            lngNowID = AddCard(msgAccount, strNewName)
            Set CtrlName.Recordset = RecordCon(xAccount, lngID)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 8  '商品
            lngNowID = AddCard(msgItem, strNewName)
            Set CtrlName.Recordset = RecordCon(xItem)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 9  '工程表
            lngNowID = AddCard(msgJob, strNewName)
            Set CtrlName.Recordset = RecordCon(xJob)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 10 '货位
            lngNowID = AddCard(msgPosition, strNewName)
            Set CtrlName.Recordset = RecordCon(xPosition, lngID, 商品ID, 商品明细ID, lngItUnitID)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                If lngID = -100 Then
                    Call BillPublic.IdToCodeAndName(xPosition, lngNowID, strCode, strName)
                    CtrlName.Text = strCode & " " & strName
                Else
                    CtrlName.SeekId lngNowID
                End If
              End If
        Case 11 '摘要
            lngNowID = AddCard(msgRemark, strNewName)
            Set CtrlName.Recordset = RecordCon(xRemark)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 12 '自定义项目1
            lngNowID = AddCard(msgCustom2, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustom1)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 13 '自定义项目2
            lngNowID = AddCard(msgCustom3, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustom2)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 14 '自定义项目3
            lngNowID = AddCard(msgCustom4, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustom3)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 15 '自定义项目4
            lngNowID = AddCard(msgCustom5, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustom4)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else
                CtrlName.SeekId lngNowID
              End If
        Case 16 '自定义项目5
            lngNowID = AddCard(msgCustom6, strNewName)
            Set CtrlName.Recordset = RecordCon(xCustom5)
            CtrlName.AddRefer "<新增>"
            CtrlName.AddRefer "<修改>"
            CtrlName.AddRefer "<删除>"
              If lngNowID < 1 Then
                CtrlName.SeekId lngOldID
              Else