frmlisttrans.frm

金算盘软件代码

    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) And Me.WindowState <> 2 Then
        Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
    mclsMainControl_ChildActive
   
    grdList.Redraw = True
    
    'frmMain.mnuEditShowAll.Enabled = False
    'frmMain.mnuEditInActive.Enabled = False
    MakeListEditMenu
    MakeListReportMenu
    UpdateMenuStatus
    blnMenuBuilded = True
    'frmMain.mnuEditInActive.Enabled = False '作废
    frmMain.mnuEditSearch.Enabled = False   '收索
    frmMain.mnuEditUse.Enabled = False      '引用
    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
    GetRateDirect
    If grdList.Rows > 1 And grdList.ColSel > 0 And grdList.Row > 0 Then
       cmdAgain.Enabled = True
    Else
       cmdAgain.Enabled = False
    End If
End Sub

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    If gclsBase.OperatorID <> lngOldOperatorID Then '系统重新登录（更换了操作员）
        lngOldOperatorID = gclsBase.OperatorID
        blnEdit = IsCanDo(frmRightsID.frmListTransID) '判断有无编辑权限
    End If
    
    '响应消息: msgTrans = 101                               '通用转帐消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgTrans Then
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
        End If
    Next
    mclsMainControl.Messages.Clear
End Sub

Private Sub Form_Deactivate()
    blnMenuBuilded = False
    frmMain.mnuEditSearch.Enabled = False
End Sub

'查找条件类型 ComboBox 控件
Private Sub cboFindKind_Click()
Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    
    With grdList
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                '保存新排序列内容
                strFind = .TextMatrix(.Row, i)
                '重新排序
                'mclsList.FixrowSortBold i
                Exit For
            End If
       Next
    End With
    '设置新的“查找内容”控件
    
    '恢复以前选定行
    If txtFind.Text = strFind Then
        txtFind_Change
    Else
        If grdList.Rows > 1 Then
           txtFind.Text = strFind
        End If
    End If
    
    With grdList
        For i = 1 To .Cols - 1
            If Trim(cboFindKind.list(cboFindKind.ListIndex)) = Trim(.TextArray(i)) Then
                intFindCol = i
                Exit For
            End If
        Next i
    End With
        
    grdList.Redraw = True
End Sub

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 txtFind.Text = "" Then Exit Sub
    If KeyCode = 8 Then
        intSelLen = txtFind.SelLength
        If txtFind.SelStart > 0 Then If txtFind.SelStart > 0 Then txtFind.SelStart = txtFind.SelStart - 1
        txtFind.SelLength = intSelLen + 1
    End If
End Sub

'弹出右键菜单
Private Sub grdlist_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With grdList
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

'鼠标左键弹起时(执行-->取消执行)
Private Sub grdList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     With grdList
        If .Row = 0 Then Exit Sub
        If .MouseRow <> .Row Then Exit Sub
        If Button = vbLeftButton Then
            If .ColSel > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    If .TextMatrix(.Row, 1) = "√" Then
                        .TextMatrix(.Row, 1) = ""
                    Else
                        .TextMatrix(.Row, 1) = "√"
                    End If
                End If
            End If
        End If
    End With
    '鼠标左键弹起时，更新菜单
    If Button = vbLeftButton Then
        UpdateMenuStatus
    End If
End Sub

Private Sub grdList_DblClick()
    If grdList.Row = 0 Then Exit Sub
    
    With grdList
        If .Row >= 1 And .ColSel <> 0 Then
            txtFind.Text = .TextMatrix(.Row, intFindCol)
        Else
            txtFind.Text = ""
        End If
    End With
       
    If grdList.MouseRow > 0 And grdList.ColSel > 0 And grdList.MouseCol > 1 Then
        bDblClick = True
        'If frmMain.mnuEditEdit.Enabled = False Then Exit Sub
        mclsMainControl_EditEdit
    End If
End Sub

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

Private Sub cmdReport_Click()
    MakeListReportMenu
    RefreshMenu
    PopupMenu frmMain.mnuListReport, , cmdReport.Left, cmdReport.top + cmdReport.Height
End Sub

Private Sub RefreshMenu(Optional RefreshMenu As Boolean = True, Optional blnDo As Boolean, Optional blnUndo As Boolean)
  Dim intRow As Integer
  Dim blnAllChoose As Boolean
  Dim blnAllCancel As Boolean
  Dim blnRun As Boolean
  Dim blnUnRun As Boolean
  Dim intCol As Integer, intCount As Integer
   
   
    On Error Resume Next
    For intCount = 1 To mclsList.ListSet.Columns
      If mclsList.ListSet.ColumnFieldID(intCount) = 10573 Then
         intCol = intCount
         Exit For
      End If
    Next intCount
    With grdList
      For intRow = 1 To .Rows - 1
        If Trim(.TextMatrix(intRow, 1)) <> "" And Trim(.TextMatrix(intRow, intCol + 1)) <> "" Then
            blnUnRun = True
        End If
        If Trim(.TextMatrix(intRow, 1)) <> "" Then
            blnAllCancel = True
            blnRun = True
        End If
        If Trim(.TextMatrix(intRow, 1)) = "" Then
            blnAllChoose = True
        End If
      Next intRow
    End With
    If RefreshMenu Then
        frmMain.mnuListReportMenu(0).Enabled = blnAllChoose
        frmMain.mnuListReportMenu(1).Enabled = blnAllCancel
        frmMain.mnuListReportMenu(3).Enabled = blnRun
        frmMain.mnuListReportMenu(4).Enabled = blnUnRun
    Else
        blnDo = blnRun
        blnUndo = blnUnRun
    End If
End Sub

'/////////////////////////////////////////////////////////////////////////////////
'////////
'////////
'////////                            按纽菜单
'////////
'////////
'/////////////////////////////////////////////////////////////////////////////////

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        Load .mnuListEditMenu(1)
        Load .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        Load .mnuListEditMenu(5)
        Load .mnuListEditMenu(6)
        Load .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
    End With
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_EditFilter
    Case 5: '栏目设置
        mclsMainControl_EditColumn
    Case 7: '刷新
        mclsMainControl_ToolRefresh
    Case 8: '打印
        mclsMainControl_FilePrint
    End Select
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑
Private Sub mclsMainControl_EditEdit()
    Dim lngTransVoucherID As Long
    'Dim frmEdit As frmTransVoucher
    Me.Enabled = False
    lngTransVoucherID = GetTransID()
   
    If mIsShowEdit Then
        theEditForm.ShowAOldBill (lngTransVoucherID) '调用接口
    Else
        'Set frmEdit = New frmTransVoucher
        theEditForm.ShowAOldBill (lngTransVoucherID) '调用接口
        mIsShowEdit = True
        'Set frmEdit = Nothing
    End If
    Me.Enabled = True
End Sub

'新增
Private Sub mclsMainControl_EditNew()
    'Dim frmEdit As frmTransVoucher
    
    If mIsShowEdit Then
        frmTransVoucher.ShowANewBill
    Else
        'Set frmEdit = New frmTransVoucher
        theEditForm.ShowANewBill
        mIsShowEdit = True
        'Set frmEdit = Nothing
    End If
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngTransVoucherID As Long
    
    lngTransVoucherID = GetTransID()
      
    If Not GetItemStatus(lngTransVoucherID) Then Exit Sub
    
    If mIsShowEdit Then
        If lngTransVoucherID = theEditForm.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    
    If Not DeleteTrans(lngTransVoucherID) Then Exit Sub
    
    '从Grid中删除本行
    With grdList
        If .Rows = 2 Then '要删除的行是GRID 的最后一行
            mclsMainControl_ToolRefresh
        Else
            .RemoveItem (.Row)
        End If
    End With
    
End Sub

Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With grdList
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            grdList.Cols = 0
            Set datGrid.Resultset = GetList()
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    If grdList.Rows > 1 Then
                        txtFind.Text = strFind
                    Else
                        txtFind.Text = ""
                    End If
                    Exit For
                End If
            Next intCount
            mclsList.DoShowAll True
            .Redraw = True
        End If
    
    If .Rows > 1 Then
        .Row = 1
        .col = 1
        .ColSel = .Cols - 1
    End If
       
    End With
End Sub

Private Sub mclsMainControl_EditFilter()