frmcustomer.frm

金算盘软件代码

    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    On Error Resume Next
    With sstCustomer
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画MS FlexGrid 控件
    Dim intTab As Integer
    With mclsList(sstCustomer.Tab).FlexGrid
        .Left = ListGridLeft
        .width = sstCustomer.width - ListGridLeft - ListGridRight
        .Height = sstCustomer.Height - sstCustomer.TabHeight - ListGridTop - ListGridBottom
    End With

    '重画其余控件
    txtfind.width = Me.ScaleWidth - txtfind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtfind.Left + txtfind.width
    cmdPopupMenu(0).top = Me.ScaleHeight - cmdPopupMenu(0).Height - ListFormBottom
    cmdPopupMenu(1).top = cmdPopupMenu(0).top
    cmdPopupMenu(2).top = cmdPopupMenu(0).top
    cmdPopupMenu(3).top = cmdPopupMenu(0).top
    chkShowAll.top = cmdPopupMenu(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
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
                
                MakeListReportMenu (strFieldName)
                If sstCustomer.Tab = 0 Or sstCustomer.Tab = 2 Or (strFieldName = "") Then
       
                    With frmMain
'                         .mnuListReportMenu(0).Enabled = False
'                         .mnuListReportMenu(1).Enabled = False
'                         If sstCustomer.Tab = 0 Then
'                            .mnuListReportMenu(0).Enabled = True
'                            .mnuListReportMenu(1).Enabled = False
'                        #If conVersionType <> 16 Then
'                            .mnuListReportMenu(6).Enabled = False
'                        #End If
'                        ElseIf sstCustomer.Tab = 1 Then
'                            .mnuListReportMenu(0).Enabled = False
'                            .mnuListReportMenu(1).Enabled = True
'                        #If conVersionType <> 16 Then
'                            .mnuListReportMenu(6).Enabled = False
'                        #End If
'                        ElseIf sstCustomer.Tab = 2 Then
'                            .mnuListReportMenu(0).Enabled = False
'                            .mnuListReportMenu(1).Enabled = False
'                        #If conVersionType <> 16 Then
'                            .mnuListReportMenu(6).Enabled = True
'                        #End If
'                        End If
                        
                         .mnuListReportMenu(0).Enabled = False
                         .mnuListReportMenu(1).Enabled = False
                         .mnuListReportMenu(2).Enabled = False
                         .mnuListReportMenu(3).Enabled = False
                    End With
                Else
                   
                   With frmMain
'                        #If conVersionType <> 16 Then
'                            .mnuListReportMenu(6).Enabled = False
'                        #End If
                   Select Case strFieldType
                          Case "客户"
'                             .mnuListReportMenu(0).Enabled = False
'                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(0).Enabled = True
                             .mnuListReportMenu(1).Enabled = False
                             .mnuListReportMenu(2).Enabled = True
                             .mnuListReportMenu(3).Enabled = False
                             '.mnuListReportMenu(7).Enabled = False
                          Case "供应商"
'                             .mnuListReportMenu(0).Enabled = False '                             .mnuListReportMenu(1).Enabled = True
'                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(0).Enabled = False
                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(2).Enabled = False
                             .mnuListReportMenu(3).Enabled = True
                          Case "供销"
'                             .mnuListReportMenu(0).Enabled = False
'                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(0).Enabled = True
                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(2).Enabled = True
                             .mnuListReportMenu(3).Enabled = True
                            ' .mnuListReportMenu(7).Enabled = True
                        Case "其它"
'                             .mnuListReportMenu(0).Enabled = False
'                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(0).Enabled = True
                             .mnuListReportMenu(1).Enabled = True
                             .mnuListReportMenu(2).Enabled = True
                             .mnuListReportMenu(3).Enabled = True
                   End Select
                   End With
                End If
                PopupMenu frmMain.mnuListReport, , PosX, PosY
            Case 2
                mnuComStart '往来期初
            Case 3
            '调整折扣率
            #If conVersionType <> 16 Then
                mnuUpdate
            #End If
    End Select
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    
    On Error GoTo ErrHandle
    Me.HelpContextID = 30005
    '付款方式列表窗体初始化
    Debug.Print "Load Start: ", Timer
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    intViewID(0) = 8
    intViewID(1) = 7
    intViewID(2) = 12
    For i = 0 To 2
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        'Set mclsList(i).Again = cmdAgain
        Set mclsList(i).Find = txtfind
    Next
    Set mclsList(0).FlexGrid = msgCustomerType
    Set mclsList(1).FlexGrid = msgCustomer
    Set mclsList(2).FlexGrid = msgJob
    
    '设置钩子对象
    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
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    
'    If sstCustomer.Tab = 0 Then
'        sstCustomer_Click 0
'    Else
'        sstCustomer.Tab = 0
'    End If
    Debug.Print "Load End: ", Timer
    Unload MsgForm
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
'    #If conVersionType = 16 Then
'        sstCustomer.TabVisible(2) = False
''        cmdPopupMenu(3).Visible = False
'    #Else
'        sstCustomer.TabVisible(2) = True
''        cmdPopupMenu(3).Visible = True
'    #End If
     Exit Sub
     
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me 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_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Select Case True
            Case mIsShowCard(0)
                ShowMsg hwnd, "请先关闭往来单位卡片！", vbExclamation, Me.Caption
                Cancel = True
'                frmCustomerListCard.Show
'                frmCustomerListCard.ZOrder 0
            Case mIsShowCard(1)
                 ShowMsg hwnd, "请先关闭往来单位类型卡片！", vbExclamation, Me.Caption
                 Cancel = True
'                 frmCustomerTypeListCard.Show
'                 frmCustomerTypeListCard.ZOrder 0
            Case mIsShowCard(2)
                 ShowMsg hwnd, "请先关闭调整拆扣率卡片！", vbExclamation, Me.Caption
                 Cancel = True
                 frmCustomerDiscountCard.Show
                 frmCustomerDiscountCard.ZOrder 0
'            Case mIsShowCard(3)
'                 ShowMsg hwnd, "请先关闭往来期初卡片！", vbExclamation, Me.Caption
'                 Cancel = True
'                 frmCustomerInit.Show
'                 frmCustomerInit.ZOrder 0
            Case mIsShowCard(4)
                ShowMsg Me.hwnd, "请先关闭工程卡片！", vbExclamation, "工程卡片"
                Cancel = True
'                frmJobListCard.Show
'                frmJobListCard.ZOrder 0
        End Select
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    On Error Resume Next
'    If mIsShowCard(0) Then Unload frmCustomerListCard
'    If mIsShowCard(1) Then Unload frmCustomerTypeListCard
    If mIsShowCard(2) Then Unload frmCustomerDiscountCard
    If mIsShowCard(3) Then Unload frmCustomerInit
'    If mIsShowCard(4) Then Unload frmJobListCard
    For intCount = 0 To sstCustomer.Tabs - 1
        If blnIsLoad(intCount) Then
            mclsList(intCount).SaveListSet
        End If
        blnIsLoad(intCount) = False
        Set mclsList(intCount) = Nothing
    Next
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

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
    RedrawForm
End Sub

Private Sub Form_Activate()
    SetHelpID 30005
    If Me.WindowState = 1 Then Me.WindowState = 0
    mclsMainControl_ChildActive '响应消息
    gclsSys.CurrFormName = Me.hwnd
'    If mclsList(sstCustomer.Tab).FlexGrid.Enabled Then mclsList(sstCustomer.Tab).FlexGrid.SetFocus
    mclsList(sstCustomer.Tab).FlexGrid.Redraw = True
    UpdateMenuStatus
    'If (Me.Left + Me.Width < 0 Or Me.Left > Screen.Width) Then Me.Left = 300
End Sub
'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
   If mblnCheckNoChange Then Exit Sub
    With sstCustomer
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).DoShowAll chkShowAll.Value
        'cboFindKind_Click
        UpdateMenuStatus
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
End Sub
'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim strFind As String
    
    If mblnComboxNoClick Then Exit Sub
    mclsList(sstCustomer.Tab).ReGetColCaption
    With mclsList(sstCustomer.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(sstCustomer.Tab).FixrowSortBold i '加粗排序列
                Exit For
            End If
       Next
    End With
    If mclsList(sstCustomer.Tab).FlexGrid.Rows > 1 Then
       If txtfind.Text = strFind Then
          txtFind_Change
       Else
          txtfind.Text = strFind
       End If
    End If
    mclsList(sstCustomer.Tab).FlexGrid.Redraw = True
End Sub

'响应消息
Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    For Each vntMessage In mclsMainControl.Messages
        Select Case vntMessage
               Case Message.msgCustomerType '接收到往来单位改变消息
                    ToolRefresh 0
                    mclsMainControl.Messages.Remove CStr(vntMessage) '清除往来单位改变消息
               Case Message.msgCustomer '接收到往来单位改变消息
                    ToolRefresh 1
                    mclsMainControl.Messages.Remove CStr(vntMessage) '清除往来单位改变消息
                Case Message.msgJob
                    ToolRefresh 2
                    mclsMainControl.Messages.Remove CStr(vntMessage)
        End Select
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
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