frmcustomcodelist.frm

金算盘软件代码

        strfieldName = ""
        
    End If
End Sub

'重画Form
Private Sub RedrawForm()
    
    With sstCustomer
        .Left = ListFormLeft
        .Width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画MS FlexGrid 控件
    With mclsList(sstCustomer.Tab).FlexGrid
        .Left = ListGridLeft
        .Width = sstCustomer.Width - ListGridLeft - ListGridRight
        .Height = sstCustomer.Height - sstCustomer.TabHeight - ListGridTop - ListGridBottom
    End With
    
    '重画其余控件
    mclsList(sstCustomer.Tab).Find.Width = Me.ScaleWidth - mclsList(sstCustomer.Tab).Find.Left - ListFormBottom - cmdAgain.Width - 15
    cmdAgain.Left = mclsList(sstCustomer.Tab).Find.Left + mclsList(sstCustomer.Tab).Find.Width
    cmdPopupMenu(0).Top = Me.ScaleHeight - cmdPopupMenu(0).Height - ListFormBottom
    cmdPopupMenu(1).Top = cmdPopupMenu(0).Top
    cmdPopupMenu(2).Top = cmdPopupMenu(0).Top
    chkShowAll.Top = cmdPopupMenu(0).Top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
End Sub

Private Sub cleFind_Change()
    mclsList(sstCustomer.Tab).cleFindChange
End Sub

Private Sub cldFind_Change()
    mclsList(sstCustomer.Tab).dteFindChange
End Sub

'弹出菜单
Private Sub cmdPopupMenu_Click(Index As Integer)
    Dim PosX, PosY As Integer
    
    PosX = cmdPopupMenu(Index).Left
    PosY = cmdPopupMenu(Index).Top + cmdPopupMenu(Index).Height
    Select Case Index
           Case 0
                MakeListEditMenu
                PopupMenu frmMain.mnuListEdit, , PosX, PosY
           Case 1
                MakeListActivityMenu
                PopupMenu frmMain.mnuListActivity, , PosX, PosY
           Case 2
                MakeListReportMenu (strfieldName)
                If sstCustomer.Tab = 0 Or (strfieldName = "") Then
       
                    With frmMain
                         .mnuListReportMenu(0).Enabled = False
                         .mnuListReportMenu(1).Enabled = False
                         .mnuListReportMenu(3).Enabled = True
                         .mnuListReportMenu(4).Enabled = False
                         .mnuListReportMenu(5).Enabled = False
                         .mnuListReportMenu(6).Enabled = False
                         .mnuListReportMenu(7).Enabled = False
                    End With
                Else
                  
                   With frmMain
                   Select Case strfieldType
                          Case "供货"
                             .mnuListReportMenu(0).Enabled = False
                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(3).Enabled = True
                             .mnuListReportMenu(4).Enabled = False
                             .mnuListReportMenu(5).Enabled = True
                             .mnuListReportMenu(6).Enabled = True
                             .mnuListReportMenu(7).Enabled = False
                          Case "购货"
                             .mnuListReportMenu(0).Enabled = True
                             .mnuListReportMenu(1).Enabled = False
                             .mnuListReportMenu(3).Enabled = True
                             .mnuListReportMenu(4).Enabled = True
                             .mnuListReportMenu(5).Enabled = False
                             .mnuListReportMenu(6).Enabled = False
                             .mnuListReportMenu(7).Enabled = True
                          Case "供销"
                             .mnuListReportMenu(0).Enabled = True
                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(3).Enabled = True
                             .mnuListReportMenu(4).Enabled = True
                             .mnuListReportMenu(5).Enabled = True
                             .mnuListReportMenu(6).Enabled = True
                             .mnuListReportMenu(7).Enabled = True
                   End Select
                   End With
                End If
                PopupMenu frmMain.mnuListReport, , PosX, PosY
                
    End Select
  
End Sub


'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    
    '付款方式列表窗体初始化
    Debug.Print "Load Start: ", Timer
    
    intViewID(0) = 8
    intViewID(1) = 7
    
    mblnFormNoRezise = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    mblnFormNoRezise = False
    
    For i = 0 To 1
        Set mclsList(i) = New List
        Set mclsList(i).FindKind = cboFindKind
        Set mclsList(i).Again = cmdAgain
    Next
    Set mclsList(0).FlexGrid = msgCustomerType
    Set mclsList(1).FlexGrid = msgCustomer
    
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass

    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    If sstCustomer.Tab = 0 Then
        sstCustomer_Click 0
    Else
        sstCustomer.Tab = 0
    End If
    Debug.Print "Load End: ", Timer
    
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hWnd, ListFormLeft, 500, Me.Width - 2 * (ListFormLeft + ListFormRight), 500
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu And mIsShowCard Then
        ShowMsg hWnd, "请先关闭往来单位卡片！", vbExclamation
        Cancel = True
'        frmTermEdit.SetFocus
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    
    For intCount = 0 To sstCustomer.Tabs - 1
        If blnIsLoad(intCount) Then
            mclsList(intCount).SaveListSet
        End If
        blnIsLoad(intCount) = False
    Next
 
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub Form_Resize()
    If mblnFormNoRezise Then Exit Sub
    On Error Resume Next
    If Me.Height < intFormHeight Then Me.Height = intFormHeight
    If Me.Width < intFormWidth Then Me.Width = intFormWidth
    Debug.Print "dujian"
    'mclslist.gridLineRefresh
    RedrawForm
End Sub

Private Sub Form_Activate()
    Dim vntMessage As Variant
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgCustomer Then '接收到往来单位改变消息
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除往来单位改变消息
        End If
    Next
    mclsMainControl.Messages.Clear
    
    mclsList(sstCustomer.Tab).FlexGrid.SetFocus
    mclsList(sstCustomer.Tab).FlexGrid.Redraw = True
End Sub

'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
    Dim strOldText As String
    Dim strOldSort As String
    Dim i As Integer
    
    If mblnCheckNoChange Then Exit Sub
    Me.MousePointer = vbHourglass
    With sstCustomer
        mclsList(.Tab).FlexGrid.Redraw = False
        
        '保存当前排序列
        mclsList(.Tab).GetOldSort strOldSort, strOldText
        mclsList(.Tab).SaveListSet
        mclsList(.Tab).ShowAll = chkShowAll.Value
        If chkShowAll.Value Then
            mclsList(.Tab).SortCol = mclsList(.Tab).SortCol + 1
        Else
            mclsList(.Tab).SortCol = mclsList(.Tab).SortCol - 1
        End If
        
        '得到新的列表
        mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
        If Not datCustomer(.Tab).Recordset Is Nothing Then
            datCustomer(.Tab).Recordset.Close
            Set datCustomer(.Tab).Recordset = Nothing
        End If
        mclsList(.Tab).FlexGrid.FixedCols = 0
        Set datCustomer(.Tab).Recordset = GetList(.Tab)
        
        mclsList(.Tab).SetFlexGrid
        
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        If mclsList(.Tab).FlexGrid.rows > 1 Then
            mclsList(.Tab).Find.Text = strOldText
        End If
            
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
    Me.MousePointer = vbDefault
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
    
    With mclsList(sstCustomer.Tab).FlexGrid
        .Redraw = False
        For i = 1 To .cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                strFind = .TextMatrix(.Row, i)
                mclsList(sstCustomer.Tab).FixrowSortBold i '加粗排序列
                Exit For
            End If
       Next
    End With
    If Not mclsList(sstCustomer.Tab).Find Is Nothing Then
        mclsList(sstCustomer.Tab).Find.Visible = False
        intWidth = mclsList(sstCustomer.Tab).Find.Width
    End If
    With cboFindKind
        Select Case .ItemData(.ListIndex)
            Case 1
                Set mclsList(sstCustomer.Tab).Find = cleFind
            Case 2
                Set mclsList(sstCustomer.Tab).Find = cldFind
            Case Else
                Set mclsList(sstCustomer.Tab).Find = txtFind
        End Select
    End With
    mclsList(sstCustomer.Tab).Find.Width = intWidth
    mclsList(sstCustomer.Tab).Find.Visible = True
    If mclsList(sstCustomer.Tab).Find.Text = strFind Then
        With cboFindKind
            Select Case .ItemData(.ListIndex)
                Case 1
                    cleFind_Change
                Case 2
                    cldFind_Change
                Case Else
                    txtFind_Change
            End Select
        End With
    Else
        If mclsList(sstCustomer.Tab).FlexGrid.rows > 1 Then
            mclsList(sstCustomer.Tab).Find.Text = strFind
        End If
    End If
    mclsList(sstCustomer.Tab).FlexGrid.Redraw = True
    mclsList(sstCustomer.Tab).FlexGrid.SetFocus
End Sub


Private Sub mclsMainControl_EditColumn()
    With sstCustomer
        If mclsList(.Tab).ListSet.ShowListSet(intViewID(.Tab)) Then
            blnIsLoad(.Tab) = False
            sstCustomer_Click .Tab
        End If
    End With
End Sub

'筛选
Private Sub mclsMainControl_EditFilter()

End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Select Case intIndex
           Case 0
                AccountReceive '收款单
           Case 1
                Accountpayment '付款单
           Case 2
                AccountAR '应收单
           Case 3
                AccountAP  '应付单
    End Select
    
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
   Select Case intIndex
          Case 0
               AccountAR_Detail '应收明细
          Case 1
               AccountAP_Detail '应付明细
          Case 3
               Customer_Detail '往来单位一览表
          Case 4
               AccountAR_Total '应收总帐
          Case 5
               AccountAP_Total '应付总帐
          Case 6
               AccountAP_Analyse '应付帐龄分析表
          Case 7
               AccountAR_Analyse '应收帐龄分析表
  End Select
  
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList(sstCustomer.Tab).HookProc Msg, wParam, lParam, mclsSubClass
End Sub

'
' FLEXGRID控件
'

'双击FLEXGRID调用卡片
Private Sub msgCustomer_DblClick()
    If mclsList(sstCustomer.Tab).FlexGrid.Row > 0 And mclsList(sstDepEmp.Tab).FlexGrid.ColSel > 0 Then
        mclsMainControl_EditEdit
    End If
End Sub



'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgCustomer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustomer
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
        Else
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustomer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = vbLeftButton Then
        UpdateMenuStatus
     End If
End Sub

'双击FLEXGRID调用卡片
Private Sub msgCustomerType_DblClick()
    If mclsList(sstCustomer.Tab).FlexGrid.Row > 0 And mclsList(sstCustomer.Tab).FlexGrid.ColSel > 0 Then
        mclsMainControl_EditEdit
    End If
End Sub

Private Sub msgCustomerType_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustomerType
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
        Else
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustomerType_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
       UpdateMenuStatus
    End If
End Sub

Private Sub sstCustomer_Click(PreviousTab As Integer)
    With sstCustomer
        mclsList(.Tab).FlexNoChange = True
        mclsList(.Tab).FindNoChange = True
        If Not blnIsLoad(.Tab) Then
            '得到列表记录集
            mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
            mclsList(.Tab).InitFlexgrid
            Set datCustomer(.Tab).Recordset = GetList(.Tab)
            mclsList(.Tab).SetFlexGrid
            
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
            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
            '重画列表线
            mclsList(.Tab).gridLineRefresh
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                mclsList(.Tab).Find.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                mclsList(.Tab).Find.Text = ""
            End If