frmcustomer.frm

金算盘软件代码

'            Exit Sub
'        End If
'    End If
    Dim lngID As Long
    lngID = ListID(sstCustomer.Tab)
    Dim blnSucess As Boolean
    blnSucess = False
    Select Case sstCustomer.Tab
        Case 0
            If mIsShowCard(1) Then
'                If lngID = frmCustomerTypeListCard.getID And lngID > 0 Then
                If lngID = frmCustomerTypeCard.getID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的单位类别！", vbExclamation
'                    frmCustomerTypeListCard.Show
'                    frmCustomerTypeListCard.ZOrder 0
                    frmCustomerTypeCard.EditCard lngID, vbModal
                    Set frmCustomerTypeCard = Nothing
                    Exit Sub
                End If
            End If
'            If frmCustomerTypeListCard.DelCard(ListID(sstCustomer.Tab)) Then
            If frmCustomerTypeCard.DelCard(ListID(sstCustomer.Tab)) Then
                UpDatePreFlage
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomerType
            End If
            Unload frmCustomerTypeCard
            Set frmCustomerTypeCard = Nothing
            
            'If Not frmCustomerTypeCard.Visible Then
'            Unload frmCustomerTypeListCard
        Case 1
            If mIsShowCard(0) Then
'                If lngID = frmCustomerListCard.getID And lngID > 0 Then
                If lngID = frmCustomerCard.getID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的单位！", vbExclamation
'                    frmCustomerListCard.Show
'                    frmCustomerListCard.ZOrder 0
                    frmCustomerCard.EditCard lngID, vbModal
                    Set frmCustomerCard = Nothing
                    Exit Sub
                End If
            End If
'            If frmCustomerListCard.DelCard(ListID(sstCustomer.Tab)) Then
            If frmCustomerCard.DelCard(ListID(sstCustomer.Tab)) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomer
            End If
            Unload frmCustomerCard
            Set frmCustomerCard = Nothing
            'If Not frmCustomerListCard.Visible Then
'            Unload frmCustomerListCard
        Case 2
            If mIsShowCard(4) Then
'                If lngID = frmJobListCard.getID And lngID > 0 Then
'                    MsgBox "不能删除当前编辑的单位！", vbExclamation
'                    frmJobListCard.Show
'                    frmJobListCard.ZOrder 0
'                    Exit Sub
'                End If
            End If
'            If frmJobListCard.DelCard(ListID(sstCustomer.Tab)) Then
            If frmJobCard.DelCard(ListID(sstCustomer.Tab)) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgJob
            End If
            Unload frmJobCard
            Set frmJobCard = Nothing
            'If Not frmCustomerListCard.Visible Then
'            Unload frmJobListCard
    End Select
    If blnSucess Then
        With mclsList(sstCustomer.Tab).FlexGrid
                     .RowHeight(.Row) = 0
                     .RowData(.Row) = 1
                     mclsList(sstCustomer.Tab).SetFlexRow
        End With
    End If
    UpdateMenuStatus
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    With sstCustomer
    Select Case .Tab
        Case 0
            CeaseLower
        Case 1, 2
        If UpdateListInActive(.Tab, ListID(.Tab), Not ListIsInActive(.Tab)) Then
            If chkShowAll.Value Then
                With mclsList(.Tab).FlexGrid
                    If .TextMatrix(.Row, 1) = "" Then
                        .TextMatrix(.Row, 1) = "√"
                    Else
                        .TextMatrix(.Row, 1) = ""
                    End If
                End With
           Else
                With mclsList(.Tab).FlexGrid
                    .TextMatrix(.Row, 1) = "√"
                    .RowHeight(.Row) = 0
                End With
                mclsList(.Tab).SetFlexRow
            End If
            '发出单位消息
            If .Tab = 1 Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomer
            If .Tab = 2 Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgJob
         End If
    End Select
      UpdateMenuStatus
    End With
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
    Select Case sstCustomer.Tab
        Case 0
            UseCode Message.msgCustomerType, ListID(0)
        Case 1
            UseCode Message.msgCustomer, ListID(1)
        Case 2
            UseCode Message.msgJob, ListID(2)
    End Select
    Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

Private Sub ToolRefresh(ByVal intTab As Integer)
    Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    
    '保存当前排序列
    strOldSort = cboFindKind.Text
    With mclsList(intTab).FlexGrid
         strOldText = .TextMatrix(.Row, mclsList(intTab).SortCol)
    End With
    mclsList(intTab).FlexGrid.Redraw = False
    
    '刷新列表记录
    mclsList(intTab).SaveListColWidth
    mclsList(intTab).FlexGrid.Cols = 0
    mclsList(intTab).ListSet.ViewId = intViewID(intTab)
    Set datCustomer(intTab).Resultset = GetList(intTab)
    If datCustomer(intTab).Resultset.RowCount > 0 Then
       datCustomer(intTab).Resultset.MoveLast
    End If
    datCustomer(intTab).Resultset.Close
'        Set datCustomer(intTab).Recordset = Nothing
    '设置FlexGrid列表
    mclsList(intTab).SetFlexGrid
    
    '恢复以前排序列
    cboFindKind.Text = strOldSort
    cboFindKind.Text = strOldSort
    mclsList(intTab).FlexGrid.Redraw = False
    If mclsList(intTab).FlexGrid.Rows > 1 Then
        txtfind.Text = strOldText
    End If
    If chkShowAll.Value = 0 Then mclsList(intTab).DoShowAll False
    
    '更新菜单状态
    UpdateMenuStatus
    mclsList(intTab).FlexGrid.Redraw = True
    
    Me.MousePointer = vbDefault
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    ToolRefresh sstCustomer.Tab
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    mclsList(sstCustomer.Tab).ReGetColCaption
    Select Case sstCustomer.Tab
        Case 0
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustomer.Tab).FlexGrid, 54, "单位类型列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustomer.Tab).FlexGrid, 16, "往来单位列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 2
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustomer.Tab).FlexGrid, 64, "工程列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End Select
    mclsList(sstCustomer.Tab).AddReGetColCaption
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0:
            mclsMainControl_EditEdit
        Case 1:
            mclsMainControl_EditNew
        Case 2:
            mclsMainControl_EditDel
        Case 4:
            mclsMainControl_EditInActive
        Case 5:
            mclsMainControl_EditShowAll
        
        Case 7:
            mclsMainControl_EditSearch
        Case 8:
            mclsMainControl_EditNotepad
        #If conVersionType <> 16 Then
            Case 10:
                mnuUpdate '调整折扣率
            'Case 12
                'mnuComStart '往来期初
            Case 12:
                mclsMainControl_EditUse
            Case 13
                mclsMainControl_EditFilter
            Case 14
                mclsMainControl_EditColumn
            Case 16:
                 mclsMainControl_ToolRefresh
            Case 17:
                mclsMainControl_FilePrint
        #Else
            Case 10:
                mclsMainControl_EditUse
            Case 11
                mclsMainControl_EditFilter
            Case 12
                mclsMainControl_EditColumn
            Case 14:
                 mclsMainControl_ToolRefresh
            Case 15:
                mclsMainControl_FilePrint
        #End If
    End Select
End Sub

'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        .mnuListEditMenu(4).Visible = True
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        .mnuListEditMenu(5).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = True
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(7)
        .mnuListEditMenu(7).Visible = False
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditNotepad, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        .mnuListEditMenu(9).Visible = False
        #If conVersionType <> 16 Then
            Load .mnuListEditMenu(10)
            .mnuListEditMenu(10).Caption = "调整折扣率(&Z)"
            .mnuListEditMenu(10).Enabled = False
            .mnuListEditMenu(10).Visible = True
            
    '        Load .mnuListEditMenu(12)
    '        .mnuListEditMenu(12).Caption = "往来期初(&G)"
    '        .mnuListEditMenu(12).Enabled = False
    '        .mnuListEditMenu(12).Visible = True
                       
            Load .mnuListEditMenu(11)
            Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)
            
            Load .mnuListEditMenu(12)
            Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(12)
        
            Load .mnuListEditMenu(13)
            Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(13)
            Load .mnuListEditMenu(14)
            Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(14)
                        
            Load .mnuListEditMenu(15)
            Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(15)
            
            Load .mnuListEditMenu(16)
            Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(16)
            
            Load .mnuListEditMenu(17)
            Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(17)
        End With
        
        Dim blnIsnotEmpty As Boolean
        If sstCustomer.Tab = 1 Then
            With mclsList(sstCustomer.Tab).FlexGrid
                If .Rows > 1 And .Row <> 0 And .RowHeight(.Row) > 0 Then
                    blnIsnotEmpty = True
                Else
                    blnIsnotEmpty = False
                End If
            End With
            With frmMain
                .mnuListEditMenu(10).Enabled = blnIsnotEmpty
'                .mnuListEditMenu(12).Enabled = blnIsnotEmpty
            End With
        End If
    #Else
                    
            Load .mnuListEditMenu(10)
            Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(10)
        
            Load .mnuListEditMenu(11)
            Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(11)
            Load .mnuListEditMenu(12)
            Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(12)
            
                        
            Lo