frmcommlist.frm

来自「金算盘软件代码」· FRM 代码 · 共 1,519 行 · 第 1/4 页

'全部显示/显示未停用记录
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 mintListType
        Case 1
            UseCode Message.msgcurrency, ListID
        Case 2
            UseCode Message.msgVoucherType, ListID
        Case 3
            UseCode Message.msgPaymentMethod, ListID
        Case 4
            UseCode Message.msgTerm, ListID
    End Select
    Me.ZOrder 1
End Sub

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

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    With msgCurrencys
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        .Redraw = False
        
        '刷新列表记录
        mclsList.SaveListColWidth
        .Cols = 0
        GetList
'        Set datCurrencys.Recordset = GetList()
'        Set datCurrencys.Recordset = GetList()
'        If datCurrencys.Recordset.RecordCount > 0 Then
''           'datCurrencys.Recordset.MoveFirst
'           datCurrencys.Recordset.MoveLast
'        End If
'        'datCurrencys.Refresh
'        '.Refresh
'        datCurrencys.Recordset.Close
        '.Redraw = False
        mclsList.SetFlexGrid
        
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        cboFindKind.Text = strOldSort
        .Redraw = False
        If .Rows > 1 Then
            txtfind.Text = strOldText
        End If
        If chkShowAll.Value = 0 Then mclsList.DoShowAll False
        
        '更新菜单状态
        UpdateMenuStatus
        .Redraw = True
    Me.MousePointer = vbDefault
End With
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Dim intPrintID As Integer
    
    Set myPrintclass = New PrintClass
    
    Select Case mintListType
        Case 1
            intPrintID = 29
        Case 2
            intPrintID = 30
        Case 3
            intPrintID = 31
        Case 4
            intPrintID = 32
    End Select
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, intPrintID, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    If mintListType = 1 Then
        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_EditUse
'            Case 8:
'                mclsMainControl_EditSearch
            Case 7:
                frmClearRate.ClearRate (ListID)   '清除过时汇率
            Case 9
                mclsMainControl_EditUse
            Case 10:
                mclsMainControl_EditFilter
            Case 11:
                mclsMainControl_EditColumn
            Case 13:
                mclsMainControl_ToolRefresh
            Case 14
                mclsMainControl_FilePrint
        End Select
    Else
        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_EditUse
'            Case 8:
'                mclsMainControl_EditSearch
            Case 8:
                mclsMainControl_EditFilter
            Case 9:
                mclsMainControl_EditColumn
            Case 11:
                mclsMainControl_ToolRefresh
            Case 12:
                mclsMainControl_FilePrint
        End Select
    End If
End Sub

'清除过时汇率
Private Sub ClearlasteRate()
    frmClearRate.ClearRate (ListID)
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 = False
        
'        Load .mnuListEditMenu(7)
'        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
'
'        Load .mnuListEditMenu(8)
'        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
'        .mnuListEditMenu(8).Visible = False
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = True
        
        Select Case mintListType
            Case 1
                Load .mnuListEditMenu(7)
                .mnuListEditMenu(7).Caption = "清除过时汇率(&Z)"
                .mnuListEditMenu(7).Enabled = True
                .mnuListEditMenu(7).Visible = True
                
                Load .mnuListEditMenu(8)
                Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
                
                Load .mnuListEditMenu(9)
                Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(9)
                
                
                Load .mnuListEditMenu(10)
                Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
                Load .mnuListEditMenu(11)
                Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
                
                Load .mnuListEditMenu(12)
                Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
                
                Load .mnuListEditMenu(13)
                Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
                Load .mnuListEditMenu(14)
                Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
            
                Dim blnIsnotEmpty As Boolean
                If mclsList.FlexGrid.Rows > 1 Then
                    blnIsnotEmpty = True
                Else
                    blnIsnotEmpty = False
                End If
            .mnuListEditMenu(7).Enabled = blnIsnotEmpty
        Case 2, 3, 4
        
            Load .mnuListEditMenu(7)
            Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
            
            Load .mnuListEditMenu(8)
            Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(8)
            Load .mnuListEditMenu(9)
            Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(9)
            
            Load .mnuListEditMenu(10)
            Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(10)
            
            Load .mnuListEditMenu(11)
            Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(11)
            Load .mnuListEditMenu(12)
            Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(12)
    End Select
End With
End Sub

Private Sub cmdEdit_Click()
    MakeListEditMenu
    PopupMenu frmMain.mnuListEdit, , cmdEdit.Left, cmdEdit.top + cmdEdit.Height
End Sub

'
' 报表菜单
'
Private Sub MakeListReportMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        
       ' Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'        .mnuListReportMenu(0).Caption = "外币明细表(&F)"
'        .mnuListReportMenu(0).Enabled = False
'        .mnuListReportMenu(0).Visible = True
     '   Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
        
'        Load .mnuListReportMenu(1)
'        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
        
       ' Load .mnuListReportMenu(2)
       '删除
'        .mnuListReportMenu(0).Caption = "币种一览表(&C)"
'        .mnuListReportMenu(0).Enabled = True
'        .mnuListReportMenu(0).Visible = True
'
    End With
End Sub

Private Sub cmdReport_Click()
    MakeListReportMenu
    PopupMenu frmMain.mnuListReport, , cmdReport.Left, cmdReport.top + cmdReport.Height
End Sub
'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList.TextFind txtfind.Text
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    If KeyCode = 8 Then
        intSelLen = txtfind.SelLength
        If txtfind.SelStart > 0 Then txtfind.SelStart = txtfind.SelStart - 1
        txtfind.SelLength = intSelLen + 1
    End If
End Sub

Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "币种编码" Or .TextMatrix(0, 2 + i) = "币种编码↑" Or .TextMatrix(0, 2 + i) = "币种编码↓" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "币种名称" Or .TextMatrix(0, i + 2) = "币种名称↑" Or .TextMatrix(0, i + 2) = "币种名称↓" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function
Public Function SetListType(ByVal intListType As Integer)
    
    Select Case intListType
        Case 1
            mstrListName = "币种汇率"
            intViewID = 15
        Case 2
            mstrListName = "凭证类型"
            intViewID = 14
        Case 3
            mstrListName = "付款方式"
            intViewID = 17
        Case 4
            mstrListName = "付款条件"
            intViewID = 18
    End Select
    mintListType = intListType
End Function
Public Function BindingResultSet()
    Me.Hide
        GetList
'    Set datCurrencys.Recordset = GetList()
'    If datCurrencys.Recordset.RecordCount > 0 Then
'       datCurrencys.Recordset.MoveLast
'    End If
'    datCurrencys.Recordset.Close
    
'    Set datCurrencys.Recordset = Nothing
    mclsList.SetFlexGrid
    
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    
    '设置第一行为选定行
    With msgCurrencys
        If .Rows > 1 Then .Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    mclsList.DoShowAll False
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function