frmalisttemplate.frm

金算盘软件代码

        End If
            If Not .Resultset(.intTab).EOF And Not .Resultset(.intTab).BOF Then
                mblnIsFindTextChange = False
                txtFind.Text = IIf(IsNull(.Resultset(.intTab).rdoColumns(.SortCol + 1).Value), _
                                "", .Resultset(.intTab).rdoColumns(.SortCol + 1).Value)
                mblnIsFindTextChange = True
            End If
        End With
    End If
    Exit Sub
End Sub

Private Sub pctDataGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
    End If
End Sub

Private Sub pctDataGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lngX As Long
    Dim lngY As Integer
    
    With mclsList.DbTabCtrl
        .MouseCell lngX, lngY
    If lngY = 1 Then
           pctDataGrid.MousePointer = vbCustom
    Else
         pctDataGrid.MousePointer = vbDefault
    End If
    End With
End Sub

Private Sub pctDataGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lngX As Long
    Dim lngY As Integer
    With mclsList.DbTabCtrl
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .Row < .Rows And .Row > 0 Then
                .MouseCell lngX, lngY
                If lngX <> 0 And lngY = 1 Then
                    pctDataGrid.MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    pctDataGrid.MousePointer = flexDefault
                End If
            End If
            UpdateEditMenuStatus
        ElseIf Button = vbRightButton Then
             Form_MouseDown Button, Shift, x, y
        End If
  End With
End Sub

Private Sub sstPages_Click(PreviousTab As Integer)
    With sstPages
        If blnIsEmployee And .Tab = 1 Then
            cmdEAR(3).Enabled = True
        Else
            cmdEAR(3).Enabled = False
        End If
        
        Debug.Print "T1: " & Timer
        If ComPleteLoad > 0 Then
            mclsList.SaveListSet
            mclsList.ListSet.ViewId = mintViewId(.Tab)
        End If
        IsFind = False
        intcboFindKind
        IsFind = True
        Debug.Print "T2: " & Timer
        mclsList.DbTabCtrl.Clear
        If Not mblnIsload(.Tab) Then
            If blnReceptionList And mclsList.ListSet.ListID < 1 Then
                Select Case mintViewId(.Tab)
                    Case 529, 530, 531, 532, 533, 534, 535
                    Case Else
                        mclsList.ListSet.SaveList
                        If Not blnunDefaultWhere Then SetDefaultWhere mintViewId(.Tab), mclsList.ListSet.ListID
                        mclsList.ListSet.RefreshWhere
                End Select
            End If
            Debug.Print "T3: " & Timer
            MakeListSql .Tab
            mblnIsload(.Tab) = True
            Debug.Print "T4: " & Timer
        Else
           ' mclsList.RefreshCurrTab .Tab
            RefreshListCurrTab .Tab
            mclsMainControl_ChildActive
        End If
        mclsList.ShowAll = IIf(mintcEnableOnPageNo(0) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False) And IIf(chkShowall.Value = 1, True, False)
        mclsList.SetGridFormate
        Debug.Print "T5: " & Timer
        mclsList.DbTabCtrl.Refresh
        mclsList.frmDoShowAll
    End With
    UpdateEditMenuStatus
    Debug.Print "T6: " & Timer
End Sub

'根新编辑菜单
Private Sub UpdateEditMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    
    With mclsList.DbTabCtrl
        If .Row > mclsList.TotalRow(mclsList.intTab) Then
            .Row = .Rows - 1
        End If
        If .Row > 0 And .Row <= mclsList.TotalRow(mclsList.intTab) Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditEdit.Enabled = blnIsnotEmpty And mblnEditbyRight(mclsList.intTab)
        .mnuEditNew.Enabled = True And mblnEditbyRight(mclsList.intTab)
        .mnuEditDel.Enabled = blnIsnotEmpty And mblnEditbyRight(mclsList.intTab)
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Enabled = blnIsnotEmpty And mblnEditbyRight(mclsList.intTab) And IIf(mintcEnableOnPageNo(0) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        chkShowall.Enabled = IIf(mintcEnableOnPageNo(0) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuEditShowAll.Checked = chkShowall.Value
        .mnuEditShowAll.Enabled = True And IIf(mintcEnableOnPageNo(1) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        If Not blnReceptionList Then
            .mnuEditUse.Enabled = blnIsnotEmpty And IIf(mintcEnableOnPageNo(2) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        Else
            If Not blnunDefaultWhere Then .mnuFilePrintReceipt = True
        End If
        '.mnuEditSearch.Enabled = True And IIf(mintcEnableOnPageNo(0) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuEditColumn.Enabled = True And IIf(mintcEnableOnPageNo(3) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuEditFilter.Enabled = True And IIf(mintcEnableOnPageNo(4) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuFilePrint.Enabled = True And IIf(mintcEnableOnPageNo(5) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuToolRefresh.Enabled = True And IIf(mintcEnableOnPageNo(6) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
        .mnuFilePrintSetup.Enabled = True And IIf(mintcEnableOnPageNo(7) Mod 2 ^ (mclsList.intTab + 1) >= 2 ^ mclsList.intTab, True, False)
    End With
    mblnIsFindTextChange = False
    With mclsList
    If .TotalRow(.intTab) = 0 Then  '无当前选定行
        txtFind.Text = ""
        cmdAgain.Enabled = False
    Else
        If .DbTabCtrl.Row < .TotalRow(.intTab) + 1 Then
            '.Resultset(.intTab).Move .DbTabCtrl.Row - 1, 1
            On Error Resume Next
            .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row '- 1
            txtFind.Text = IIf(IsNull(.Resultset(.intTab).rdoColumns(.SortCol + 1)), "", .Resultset(.intTab).rdoColumns(.SortCol + 1))
        End If
    End If
    mblnIsFindTextChange = True
    End With
    frmMain.SetToolBar
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0:
            If blnIsDealMenu Then
                mblnEdit = True
            Else
                mclsMainControl_EditEdit
            End If
        Case 1:
            If blnIsDealMenu Then
                mblnNew = True
            Else
                mclsMainControl_EditNew
            End If
        Case 2:
            mclsMainControl_EditDel
    End Select
    If mCallMenuPostion(0) <> 0 And intIndex = mCallMenuPostion(0) Then
        mclsMainControl_EditInActive
    ElseIf mCallMenuPostion(1) <> 0 And intIndex = mCallMenuPostion(1) Then
        mclsMainControl_EditShowAll
    ElseIf mCallMenuPostion(2) <> 0 And intIndex = mCallMenuPostion(2) Then
         mclsMainControl_EditUse
    ElseIf mCallMenuPostion(3) <> 0 And intIndex = mCallMenuPostion(3) Then
        mclsMainControl_EditFilter
    ElseIf mCallMenuPostion(4) <> 0 And intIndex = mCallMenuPostion(4) Then
        mclsMainControl_EditColumn
    ElseIf mCallMenuPostion(5) <> 0 And intIndex = mCallMenuPostion(5) Then
        mclsMainControl_ToolRefresh
    ElseIf mCallMenuPostion(6) <> 0 And intIndex = mCallMenuPostion(6) Then
        mclsMainControl_FilePrintReceipt
    ElseIf mCallMenuPostion(7) <> 0 And intIndex = mCallMenuPostion(7) Then
        mclsMainControl_FilePrint
    Else
        RaiseEvent ListUserMenu(intIndex)
'        Me.Refresh
    End If
    mclsList.Resultset(mclsList.intTab).Requery
    mclsList.DbTabCtrl.Refresh
End Sub
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    Dim blnIsSelect As Boolean
    Dim k As Integer
    With mclsList.DbTabCtrl
        If .Row > 0 And .Row <= .Rows - 1 Then
            blnIsSelect = True
        Else
            blnIsSelect = False
        End If
    End With
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        .mnuListEditMenu(0).Caption = "修改(&E)"
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "新增(&N)"
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        If blnReceptionList And blnIsReceptionWriteoff Then
            Load .mnuListEditMenu(.mnuListEditMenu.Count)
             .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "冲销(&S)"
            .mnuListEditMenu(.mnuListEditMenu.Count - 1).Enabled = blnIsSelect
            Load .mnuListEditMenu(.mnuListEditMenu.Count)
            Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        End If
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        .mnuEditInActive.Checked = False
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        If Not blnReceptionList Then
            .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "停用(&H)"
        Else
           .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "作废(&H)"
        End If
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Visible = True
        mCallMenuPostion(0) = .mnuListEditMenu.Count - 1
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "全部显示(&W)"
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Visible = True
        mCallMenuPostion(1) = .mnuListEditMenu.Count - 1
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        
        If mintSpMenu > 0 And mintSpPosition = .mnuListEditMenu.Count Then
            For k = 0 To mintSpMenu - 1
                Load .mnuListEditMenu(.mnuListEditMenu.Count)
                .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = mstrSpMenuName(k)
                If mintEnableOnPageNo(k) Mod (2 ^ (mclsList.intTab + 1)) >= 2 ^ (mclsList.intTab) Then
                    If mblnConstant(k) Then
                        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Enabled = True
                    Else
                        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Enabled = blnIsSelect
                    End If
                Else
                    .mnuListEditMenu(.mnuListEditMenu.Count - 1).Enabled = False
                End If
            Next
            Load .mnuListEditMenu(.mnuListEditMenu.Count)
            Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        End If
        
        If Not blnReceptionList Then
            Load .mnuListEditMenu(.mnuListEditMenu.Count)
            Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
            mCallMenuPostion(2) = .mnuListEditMenu.Count - 1
        End If
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "筛选(&F)"
        mCallMenuPostion(3) = .mnuListEditMenu.Count - 1
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Caption = "栏目设置(&M)"
        mCallMenuPostion(4) = .mnuListEditMenu.Count - 1
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        .mnuListEditMenu(.mnuListEditMenu.Count - 1).Visible = True
        
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        mCallMenuPostion(5) = .mnuListEditMenu.Count - 1
        If blnReceptionList And Not blnunDefaultWhere Then
            Load .mnuListEditMenu(.mnuListEditMenu.Count)
            Utility.CloneMenu .mnuFilePrintReceipt, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
            mCallMenuPostion(6) = .mnuListEditMenu.Count - 1
        End If
        Load .mnuListEditMenu(.mnuListEditMenu.Count)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(.mnuListEditMenu.Count - 1)
        mCallMenuPostion(7) = .mnuListEditMenu.Count - 1
End With
End Sub
'制作报表
Private Sub MakeListReportMenu(Optional ByVal strAccount As String = "")
    Dim intCnt As Integer
    Dim blnIsnotEmpty As Boolean
    If blnReceptionList And blnIsHavingReport Then
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        For intCnt = 1 To mintReportNo - 1
            Load .mnuListReportMenu(intCnt)
        Next
        For intCnt = 0 To mintReportNo - 1
            .mnuListReportMenu(intCnt).Caption = mstrReportName(intCnt)
            .mnuListReportMenu(intCnt).Enabled = True
        Next
    End With
    End If

End Sub
Private Sub txtFind_Change()
    cmdAgain.Enabled = True
    If mblnIsFindTextChange Then mclsList.FindText 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

Public Sub ListRefresh()
    mclsList.Resultset(mclsList.intTab).Requery
End Sub

Private Sub RefreshListCurrTab(ByVal intTab As Integer)
    Dim strSql As String
    Debug.Print "Re1: "; Timer
'    If mclsList.Resultset(intTab).State = 0 Then
'        strSql = mclsList.Resultset(intTab).Source
'        mclsList.Resultset(intTab).Open strSql, m_Connect, adOpenStatic
'    End If
    mclsList.Resultset(intTab).Requery
    mclsList.RefreshCurrTab intTab
   ' mclsList.frmDoShowAll
    Debug.Print "Re2: "; Timer
End Sub
'显示列表
Public Function Showlist(ByVal lngID As Long, ByVal intTab As Integer, ByVal strWhere As String) As Boolean
    Dim strForm As String
    Dim strSql As String
    Dim strSelect As String
    Dim recTmp As rdoResultset
    If mclsList.intTabs > 1 Then sstPages.Tab = intTab
    With mclsList
    strSelect = " Select " & .ListSet.ColumnFieldName(.SortCol) & " as SortCol "
    strForm = .ListSet.FromOfSql
    strSql = strSelect & strForm & " Where " & strWhere
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If Not recTmp.EOF Then
        txtFind.Text = recTmp!SortCol
        If ListID = lngID Then
            Showlist = True
        Else
            Showlist = False
        End If
    Else
        Showlist = False
    End If
    recTmp.Close
    Set recTmp = Nothing
    End With
End Function

Public Function strInID() As String
    Dim i As Long
    Dim strIn As String
    
    strInID = ""
    If mclsList.TotalRow(mclsList.intTab) < 1 Then
        Exit Function
    End If
    With mclsList.DbTabCtrl
    For i = 1 To .Rows - 1
        strIn = strIn & "," & .CellValue(i, 0)
    Next
    strIn = "(" & Mid(strIn, 2) & ")"
    End With
    strInID = strIn
End Function