accountlist.frm

金算盘软件代码

'重画窗体
Private Sub Form_Resize()
'    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
'    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
'      Me.Left = 300
'    End If
   ' Me.WindowState = intWinFormState
    RedrawForm
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    SetHelpID Me.HelpContextID
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
'    If mclsList(sstCustom.Tab).FlexGrid.Enabled Then mclsList(sstCustom.Tab).FlexGrid.SetFocus
    mclsList(sstCustom.Tab).FlexGrid.Redraw = True
    UpdateMenuStatus
    'If (Me.Left + Me.Width) < 0 Or Me.Left > Screen.Width Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
    'Me.WindowState = intWinFormState
End Sub
'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
    With sstCustom
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).DoShowAll chkShowall.Value
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
    'cboFindKind_Click
     UpdateMenuStatus
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    
    If mblnComboxNoClick Then Exit Sub
    mclsList(sstCustom.Tab).ReGetColCaption
    With mclsList(sstCustom.Tab).FlexGrid
        .Redraw = False
        
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                If .RowHeight(.Row) > 0 Then strFind = .TextMatrix(.Row, i)
                mclsList(sstCustom.Tab).FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    If mclsList(sstCustom.Tab).FlexGrid.Rows > 1 Then
       If txtFind.Text = strFind Then
          txtFind_Change
       Else
          txtFind.Text = strFind
       End If
    End If
    mclsList(sstCustom.Tab).FlexGrid.Redraw = True
  '  mclsList(sstTypAct.Tab).FlexGrid.SetFocus
End Sub

'响应消息
Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
     SetHelpID Me.HelpContextID
     gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        ToolRefresh sstCustom.Tab
        mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

'栏目设置
Private Sub mclsMainControl_EditColumn()
    With sstCustom
        If mclsList(.Tab).ListSet.ShowListSet(intViewID(.Tab)) Then
            blnIsLoad(.Tab) = False
            sstCustom_Click .Tab
        End If
    End With
End Sub

'筛选
Private Sub mclsMainControl_EditFilter()
        '筛选
    Dim blnFlage(5) As Boolean
    With sstCustom
        If mclsList(.Tab).ListSet.ListID < 1 Then mclsList(.Tab).ListSet.SaveList
        Filter.ShowFilter mclsList(.Tab).ListSet.ListID, 1, , , , , blnFlage(.Tab)
        If Not blnFlage(.Tab) Then Exit Sub
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).SaveListSet
        mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
        mclsList(.Tab).FlexGrid.Cols = 0
        Set datCustom(.Tab).Resultset = GetList(.Tab)
        If Not datCustom(.Tab).Resultset.EOF Then datCustom(.Tab).Resultset.MoveLast
        datCustom(.Tab).Resultset.Close
        'Set datCustom(.Tab).Recordset = Nothing
        mclsList(.Tab).SetFlexGrid
        UpdateMenuStatus
        '初始化查找复合列表框
        mclsList(.Tab).InitcboFindKind
        If chkShowall.Value = 0 Then mclsList(.Tab).DoShowAll False
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
End Sub

'打印设置
Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    With sstCustom
        Select Case .Tab
            Case 0
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 23, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 1
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 55, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 2
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 56, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 3
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 57, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 4
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 58, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 5
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 59, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        End Select
    End With
    Set MyPrintSet = Nothing
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Dim i As Integer
    i = AccountNature(ListID(sstCustom.Tab))
    Select Case intIndex
        Case 0
            With frmMain
                If Len(Trim(Mid(.mnuListReportMenu(0).Caption, 5))) > 4 Then
                    If Left(.mnuListReportMenu(0).Caption, 3) = "明细帐" Then
                       'If Not ListIsInActive(sstCustom.Tab) Then ShowQuickBook msgDetail, ListID(sstCustom.Tab)
                        If gclsBase.ControlAccount Then
                            Select Case i
                                Case 3
                                    ShowReceiveBook msgDetail, ListID(sstCustom.Tab)
                                Case 4
                                    ShowPayBook msgDetail, ListID(sstCustom.Tab)
                                Case Else
                                    If Not ListIsInActive(sstCustom.Tab) Then ShowQuickBook msgDetail, ListID(sstCustom.Tab)
                            End Select
'                           If Not ListIsInActive(sstCustom.Tab) Then ShowQuickBook msgDetail, ListID(sstCustom.Tab)
                        Else
                            Select Case i
                                Case 3
                                    If Not ListIsInActive(sstCustom.Tab) Then Report.ShowAcntBook 1738, 1107, , , msgDetail, ListID(sstCustom.Tab)
                                Case 4
                                    If Not ListIsInActive(sstCustom.Tab) Then Report.ShowAcntBook 1739, 1108, , , msgDetail, ListID(sstCustom.Tab)
                                Case Else
                                    If Not ListIsInActive(sstCustom.Tab) Then ShowQuickBook msgDetail, ListID(sstCustom.Tab)
                            End Select
                        End If
                    ElseIf Left(.mnuListReportMenu(0).Caption, 3) = "日记帐" Then
                        'ShowQuickBook msgDay, ListID(sstCustom.Tab)
                        'Report.ShowAcntBook 0, 1, , , msgDay, ListID(sstCustom.Tab)
                        If gclsBase.ControlAccount Then
                            Select Case i
                                Case 1
                                    ShowCashDaily msgDay, ListID(sstCustom.Tab)
                                Case 2
                                    ShowBankDaily msgDay, ListID(sstCustom.Tab)
                            End Select
                        Else
                            Select Case i
                                Case 1
                                    If Not ListIsInActive(sstCustom.Tab) Then Report.ShowAcntBook 1741, 1109, , , msgDay, ListID(sstCustom.Tab)
                                Case 2
                                    If Not ListIsInActive(sstCustom.Tab) Then Report.ShowAcntBook 1743, 1109, , , msgDay, ListID(sstCustom.Tab)
                                Case Else
                                    ShowQuickBook msgDay, ListID(sstCustom.Tab)
                            End Select
                        End If
                    End If
                Else
                    ShowMsg Me.hwnd, "当前科目不存在,请刷新再做", vbOKCancel, "会计科目列表"
                End If
            End With
'        Case 2
'            Report.ShowListReport 93, 143
'        Case 3
'           'ShowQuickBook msgTotal, ListID(sstCustom.Tab)
'           'Report.ShowListReport 265, 223
'           Report.ShowBalance 1414, 632
'        Case 4
'            Report.ShowBalance 1437, 662
            'Report.ShowListReport 267, 225
        Case 2
            Report.ShowBalance 1414, 632
        Case 3
            Report.ShowBalance 1437, 662
    End Select
End Sub

'钩子处理
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList(sstCustom.Tab).HookProc Msg, wParam, lParam, mclsSubClass
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)

        MinMax.ptMinTrackSize.x = 430
        MinMax.ptMinTrackSize.y = 250

        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
'    ElseIf Msg = WM_PAINT Then
'         DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.Width - 2 * (ListFormLeft + ListFormRight), 500

    End If
End Sub

Private Sub msgCustom5_DblClick()
    With msgCustom5
         If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
            mclsMainControl_EditEdit
         End If
    End With
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgCustom5_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustom5
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom4_DblClick()
   With msgCustom4
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
           mclsMainControl_EditEdit
        End If
   End With
End Sub

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

Private Sub msgCustom4_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom4
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

Private Sub msgCustom0_DblClick()
    With msgCustom0
         If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
            mclsMainControl_EditEdit
         End If
    End With
End Sub

Private Sub msgCustom0_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustom0
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom0_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom0
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

Private Sub msgCustom1_DblClick()
    With msgCustom1
         If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
            mclsMainControl_EditEdit
         End If
    End With
End Sub

Private Sub msgCustom1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    With msgCustom1
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom1
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

Private Sub msgCustom2_DblClick()
    With msgCustom2
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
               mclsMainControl_EditEdit
            End If
    End With
End Sub

Private Sub msgCustom2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    With msgCustom2
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom2
        If Button = vbLeftButton Then