frmnotelist.frm

金算盘软件代码

                Unload frmNoteListCard
                UpdateMenuStatus
'            Else
'                ShowMsg "不是末级编码，不能删除！", vbCritical, Me.Caption
'            End If
       ' End If
    'End If
   ' recRecordset.Close
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
     If UpdateDoneFlage(TermID, Not TermIsDone) Then
        With msgTerm
            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
        End With
         gclsSys.SendMessage CStr(Me.hwnd), Message.msgnote
    End If
    Unload frmNoteListCard
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_EditFilter()
    Dim blnFlage As Boolean
    
    If Not mblnIsSaveListset Then
        If Not FindlngViewID(intViewID) Then mclsList.ListSet.SaveList
        mblnIsSaveListset = True
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgTerm.Cols = 0
    Set datTerm.Resultset = GetList()
    datTerm.Resultset.Close
    mclsList.SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
   ' mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
     If mclsList.FlexGrid.Row = 0 Then
         'mclsList.FlexGrid.Row = 1 '
         mclsList.FlexGrid.col = 0 'mclsList.FlexGrid.Cols - 1
    End If
End Sub

'栏目设置
Private Sub mclsMainControl_EditColumn()

    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer

    With msgTerm
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        'strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            msgTerm.Cols = 0
            Set datTerm.Resultset = GetList()
            If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
            datTerm.Resultset.Close
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtFind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldSort As String
    Dim strOldText As String
    Me.MousePointer = vbHourglass
    With msgTerm
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        mclsList.SaveListColWidth
        .Redraw = False
        '刷新列表记录
        .Cols = 0
        Set datTerm.Resultset = GetList() ' GetList()
        If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
        datTerm.Resultset.Close
        'Set datTerm.Recordset = Nothing
        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
        '发出付款条件消息
    End With
    Me.MousePointer = vbDefault
End Sub

'打印
Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 63, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.AddReGetColCaption
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_EditFilter
        Case 8
            mclsMainControl_EditColumn
        Case 10:
            mclsMainControl_ToolRefresh
        Case 11:
            mclsMainControl_FilePrint
    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)
'        .mnuListEditMenu(4).Caption = "完成"
'
'        .mnuListEditMenu(4).Enabled = True
'
'        Load .mnuListEditMenu(5)
'        .mnuListEditMenu(5).Caption = "未完成"
'        If mclsList.FlexGrid.Row > 0 Then
'            .mnuListEditMenu(5).Enabled = True
'        Else
'            .mnuListEditMenu(5).Enabled = False
'        End If
'
'        If DoneFlage Then
'            .mnuListEditMenu(4).Visible = False
'            .mnuListEditMenu(5).Visible = True
'        Else
'            .mnuListEditMenu(4).Visible = True
'            .mnuListEditMenu(5).Visible = False
'        End If
'        Dim blnIsnotEmpty As Boolean
'        If mclsList.FlexGrid.Rows > 1 And mclsList.FlexGrid.ColSel <> 0 And mclsList.FlexGrid.RowHeight(mclsList.FlexGrid.Row) > 0 Then
'            blnIsnotEmpty = True
'        Else
'            blnIsnotEmpty = False
'        End If
'        .mnuListEditMenu(4).Enabled = blnIsnotEmpty
'        .mnuListEditMenu(5).Enabled = blnIsnotEmpty
         Load .mnuListEditMenu(4)
         Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "完成"
        .mnuListEditMenu(4).Visible = True
        '.mnuListEditMenu(4).Enabled = True

        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        '.mnuListEditMenu(5).Caption = "未完成"
        .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 .mnuEditFilter, .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(8)

        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)

        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(11)
    End With
End Sub

'
' 报表菜单
'
'Private Sub MakeListReportMenu()
'    Dim intCnt As Integer
'
'    With frmMain
'        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
'            Unload .mnuListReportMenu(intCnt)
'        Next
'       ' Load .mnuListEditMenu(19)
'        Utility.CloneMenu .mnuFilePrint, .mnuListReportMenu(0)
'        'Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'
'      '  Load .mnuListReportMenu(1)
'      '  Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
'       ' Load .mnuListReportMenu(2)
''        .mnuListReportMenu(0).Caption = "商品货位一览表(&T)"
''        .mnuListReportMenu(0).Enabled = True
''        .mnuListReportMenu(0).Visible = True
'    End With
'End Sub

'“钩子”事件
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    '“钩子”事件处理
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
End Sub
'完成
Private Sub Finished()
    With msgTerm
    'If gclsBase.OperatorName = .TextMatrix(.Row, GetCol("提醒对象")) Or .TextMatrix(.Row, GetCol("提醒对象")) = "" Then
        If UpdateDoneFlage(TermID, Not DoneFlage) Then
            If .TextMatrix(.Row, 1) = "" Then
              .TextMatrix(.Row, 1) = "√"
            Else
              .TextMatrix(.Row, 1) = ""
            End If
         'mblnisFinished = True
        End If
    'End If
    End With
End Sub
 '未完成
Private Sub unFinished()
    With msgTerm
    'If gclsBase.OperatorName = .TextMatrix(.Row, GetCol("提醒对象")) Or .TextMatrix(.Row, GetCol("提醒对象")) = "" Then
        If UpdateDoneFlage(TermID, Not DoneFlage) Then
            If .TextMatrix(.Row, 1) = "" Then
                   .TextMatrix(.Row, 1) = "√"
            Else
               .TextMatrix(.Row, 1) = ""
            End If
           'mblnisFinished = False
        End If
    'End If
    End With
End Sub

Private Function UpdateDoneFlage(lngID As Long, blnIsDone As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE Note SET blnIsDoned = " & IIf(blnIsDone, 1, 0) & " WHERE lngNoteID = " & lngID
    UpdateDoneFlage = gclsBase.ExecSQL(strSql)
End Function

Public Property Get DoneFlage() As Variant
    With msgTerm
        If .Row > 0 Then DoneFlage = Not (.TextArray((.Row * .Cols + 1)) = "")
    End With
End Property

Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    
    With mclsList.FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Or .TextMatrix(0, i) = strColName & "↑" Or .TextMatrix(0, i) = strColName & "↓" Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function
Public Function BindingResultSet()
    Me.Hide
    Set datTerm.Resultset = GetList() 'GetList()
    If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
    
    datTerm.Resultset.Close
    'Set datTerm.Recordset = Nothing
    mclsList.SetFlexGrid
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    With msgTerm
        If .Rows > 1 Then msgTerm.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    Debug.Print "Load End: ", Timer
    mclsList.DoShowAll False
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function