currencyslist.frm

金算盘软件代码

               mclsMainControl_EditInActive
               .MousePointer = flexDefault
            End If
         End If
         UpdateMenuStatus
      End If
      End With
End Sub

'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = CurrencysID
    Me.Enabled = False
   If lngID > 0 Then
        If CheckIDUsed("Currencys", "lngCurrencyID", lngID) Then
'            frmCurrencyListCard.EditCard lngID
            frmCurrencyCard.EditCard lngID, vbModal
        Else
            ShowMsg 0, "币种汇率已不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改币种汇率"
            mclsMainControl_ToolRefresh
        End If
    End If
   Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
'    frmCurrencyListCard.AddCard
    frmCurrencyCard.AddCard , vbModal
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = CurrencysID
    If mIsShowCard(0) Then
'        If lngID = frmCurrencyListCard.GetCurID And lngID > 0 Then
        If lngID = frmCurrencyCard.GetCurID And lngID > 0 Then
            MsgBox "不能删除当前编辑的币种！", vbExclamation
'            frmCurrencyListCard.Show
'            frmCurrencyListCard.ZOrder 0
            frmCurrencyCard.EditCard lngID, vbModal
            Exit Sub
        End If
    End If
    If lngID = 1 Then
        MsgBox "不能删除本位币", vbExclamation
    Else
'        If frmCurrencyListCard.DelCard(lngID) Then
        If frmCurrencyCard.DelCard(lngID) Then
            With msgCurrencys
                .RowHeight(.Row) = 0
                .RowData(.Row) = 1
                mclsList.SetFlexRow
            End With
            gclsSys.SendMessage Me.hwnd, Message.msgcurrency
        End If
    End If
    UpdateMenuStatus
    'If Not frmCurrencyCard.Visible Then
'    Unload frmCurrencyListCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    If CurrencysID = 1 Then
        MsgBox "本位币不能停用", vbExclamation, Me.Caption
        Exit Sub
    End If
    If UpdateCurrencysInActive(CurrencysID, Not CurrencysIsInActive) Then
       With msgCurrencys
            If chkShowAll.Value Then
               If .TextMatrix(.Row, 1) = "" Then
                  .TextMatrix(.Row, 1) = "√"
               Else
                  .TextMatrix(.Row, 1) = ""
               End If
            Else
               .TextMatrix(.Row, 1) = "√"
               .RowHeight(.Row) = 0
               mclsList.SetFlexRow
            End If
            '发出付款方式消息
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgcurrency
       End With
   End If
   UpdateMenuStatus
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()
    UseCode Message.msgcurrency, CurrencysID
    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
        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
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 29, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.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_EditUse
        Case 8:
            mclsMainControl_EditSearch
        Case 10:
            frmClearRate.ClearRate (CurrencysID)   '清除过时汇率
        Case 12:
            mclsMainControl_EditColumn
        Case 13:
            mclsMainControl_EditFilter
        Case 15:
            mclsMainControl_ToolRefresh
        Case 16
            mclsMainControl_FilePrint
    End Select
End Sub

'清除过时汇率
Private Sub ClearlasteRate()
    frmClearRate.ClearRate (CurrencysID)
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)"
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        
        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)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        .mnuListEditMenu(10).Caption = "清除过时汇率(&Z)"
        .mnuListEditMenu(10).Enabled = True
        .mnuListEditMenu(10).Visible = True
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(12)
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(14)
        
        Load .mnuListEditMenu(15)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(15)
        Load .mnuListEditMenu(16)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(16)
    End With
    Dim blnIsnotEmpty As Boolean
    With mclsList.FlexGrid
        If .Rows > 1 Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    frmMain.mnuListEditMenu(10).Enabled = blnIsnotEmpty
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