frmcustomer.frm

金算盘软件代码

End Sub

'筛选
Private Sub mclsMainControl_EditFilter()
    Dim blnFlage(2) As Boolean
    With sstCustomer
    '    If Not mblnIsSaveListset(.Tab) Then
    '        If Not FindlngViewID(intViewID(.Tab)) Then mclsList(.Tab).ListSet.SaveList
    '        mblnIsSaveListset(.Tab) = True
    '    End If
        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).SaveListSet
        mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
        mclsList(.Tab).FlexGrid.Cols = 0
        Set datCustomer(.Tab).Resultset = GetList(.Tab)
        If Not datCustomer(.Tab).Resultset.EOF Then datCustomer(.Tab).Resultset.MoveLast
        datCustomer(.Tab).Resultset.Close
        'Set datItem(.Tab).Recordset = Nothing
        mclsList(.Tab).SetFlexGrid
        UpdateMenuStatus
        '初始化查找复合列表框
        mclsList(.Tab).InitcboFindKind
        If chkShowAll.Value = 0 Then mclsList(.Tab).DoShowAll False
        
    End With
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    With sstCustomer
        Select Case .Tab
            Case 0
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 54, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 1
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 16, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            Case 2
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 64, " " & 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)
   If gclsBase.ControlAccount Then
       Select Case intIndex
              'Case 0
                   'AccountAR_Detail '应收明细
                  ' Report.ShowStandardReport 254, 212
              'Case 1
                   'AccountAP_Detail '往来单位类型一览表
    '               Report.ShowListReport 303, 322
    '          Case 1
    '               Report.ShowListReport 78, 132
                   'Customer_Detail '往来单位一览表
              Case 0
                  ' AccountAR_Total '应收余额总帐
                   Report.ShowBalance 1420, 638, , , ListID(sstCustomer.Tab)
              Case 1
                   'AccountAP_Total '应付余额总帐
                   Report.ShowBalance 1421, 639, , , ListID(sstCustomer.Tab)
              Case 2
                    Report.ShowAgeReport 120, 610
                  ' AccountAP_Analyse '应付帐龄分析表
              Case 3
                    Report.ShowAgeReport 121, 126 'AccountAR_Analyse '应收帐龄分析表
    '        #If conVersionType <> 16 Then
    '          Case 6
    '                Report.ShowListReport 79, 133
    '        #End If
      End Select
    Else
        Select Case intIndex
            Case 0
                Report.ShowBalance 1420, 638, , , ListID(sstCustomer.Tab)
            Case 1
                Report.ShowBalance 1421, 639, , , ListID(sstCustomer.Tab)
            Case 2
                Report.ShowAgeReport 1691, 1005
            Case 3
                Report.ShowAgeReport 1693, 1007
        End Select
    End If
  
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Debug.Print "hook2 Grid Start"
    mclsList(sstCustomer.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 = 450
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub
'
' FLEXGRID控件
'
'双击FLEXGRID调用卡片
Private Sub msgCustomer_DblClick()
    With msgCustomer
        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 msgCustomer_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 msgCustomer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustomer
        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

'双击FLEXGRID调用卡片
Private Sub msgCustomerType_DblClick()
    With msgCustomerType
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
           mclsMainControl_EditEdit
        End If
    End With
End Sub

Private Sub msgCustomerType_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 msgCustomerType_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustomerType
        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 msgJob_DblClick()
    With msgJob
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
           mclsMainControl_EditEdit
        End If
    End With
End Sub

Private Sub msgJob_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 msgJob_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgJob
        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 sstCustomer_Click(PreviousTab As Integer)
    Dim blnOldShowAll As Boolean
    With sstCustomer
        Set mclsList(0).Again = Nothing
        Set mclsList(1).Again = Nothing
        Set mclsList(2).Again = Nothing
        mclsList(0).FlexGrid.TabStop = False
        mclsList(1).FlexGrid.TabStop = False
        mclsList(2).FlexGrid.TabStop = False
        mclsList(.Tab).FlexGrid.TabStop = True
        Set mclsList(.Tab).Again = cmdAgain
        mclsList(.Tab).FlexNoChange = True
        mclsList(.Tab).FindNoChange = True
        
        '改变钩子对象的作用窗体
        blnOldShowAll = mclsList(.Tab).ShowAll
        
        mclsSubClass.hwnd = mclsList(.Tab).FlexGrid.hwnd
        If Not blnIsLoad(.Tab) Then
            mclsList(.Tab).FlexGrid.Redraw = False
            '得到列表记录集
            mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
            mclsList(.Tab).InitFlexGrid
'              mclsList(.Tab).FlexGrid.Redraw = False
            Set datCustomer(.Tab).Resultset = GetList(.Tab)
            If datCustomer(.Tab).Resultset.RowCount > 0 Then
               datCustomer(.Tab).Resultset.MoveLast
            End If
            datCustomer(.Tab).Resultset.Close
'            Set datCustomer(.Tab).Recordset = Nothing
            mclsList(.Tab).SetFlexGrid
            
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
            mclsList(.Tab).FlexGrid.Redraw = False
            'RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstCustomer.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstCustomer.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            End With
            'chkShowAll.Value = 0
            mclsList(.Tab).DoShowAll blnOldShowAll
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
            mclsList(.Tab).FlexGrid.Redraw = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtfind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtfind.Text = ""
            End If
            mblnCheckNoChange = True
            chkShowAll.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
            UpdateMenuStatus
            mblnCheckNoChange = False
        End If
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
        If mclsList(.Tab).FlexGrid.Row = 0 Then mclsList(.Tab).FlexGrid.col = 0
       #If conVersionType <> 16 Then
        If .Tab = 1 Then
            cmdPopupMenu(3).Enabled = True
        Else
            cmdPopupMenu(3).Enabled = False
        End If
       #End If
    End With
    Debug.Print "Hook1:" & mclsList(sstCustomer.Tab).FlexGrid.hwnd
End Sub
'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstCustomer.Tab).TextFind txtfind.Text
End Sub

'应主控对象事件
'
'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = ListID(sstCustomer.Tab)
    Me.Enabled = False
    Select Case sstCustomer.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("CustomerType", "lngCustomerTypeID", lngID) Then
'                    frmCustomerTypeListCard.EditCard lngID
                    frmCustomerTypeCard.EditCard lngID, vbModal
                    Set frmCustomerTypeCard = Nothing
                Else
                    ShowMsg 0, "该单位类型不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改单位类型"
                    ToolRefresh sstCustomer.Tab
                End If
            End If
         Case 1
            If lngID > 0 Then
                If CheckIDUsed("Customer", "lngCustomerID", lngID) Then
'                    frmCustomerListCard.EditCard lngID
                    frmCustomerCard.EditCard lngID, vbModal
                    Set frmCustomerCard = Nothing
                Else
                    ShowMsg 0, "该往来单位不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改往来单位"
                    ToolRefresh sstCustomer.Tab
                End If
            End If
        Case 2
            If lngID > 0 Then
                If CheckIDUsed("Job", "lngJobID", lngID) Then
'                    frmJobListCard.EditCard lngID
                    frmJobCard.EditCard lngID, vbModal
                    Set frmJobCard = Nothing
                Else
                    ShowMsg 0, "该工程不存在,不能进行修改！", _
                           vbExclamation + MB_TASKMODAL, "修改工程"
                    ToolRefresh sstCustomer.Tab
                End If
            End If
    End Select
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Select Case sstCustomer.Tab
        Case 0
'           frmCustomerTypeListCard.AddCard
            frmCustomerTypeCard.AddCard , vbModal
            Set frmCustomerTypeCard = Nothing
        Case 1
'           frmCustomerListCard.AddCard
            frmCustomerCard.AddCard , vbModal
            Set frmCustomerCard = Nothing
        Case 2
'            frmJobListCard.AddCard
            frmJobCard.AddCard , vbModal
            Set frmJobCard = Nothing
    End Select
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
'    Dim recRecordset As Recordset
'    If mIsShowCard Then
'        If lngID = frmCustomerCard.CustomerID Then
'            MsgBox "不能删除当前编辑的付款方式！", vbExclamation
'            frmCustomerCard.SetFocus