paymentmethodlist.frm

金算盘软件代码

'钩子处理
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 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
    End If
End Sub

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList.TextFind txtfind.Text
End Sub

'
' FLEXGRID控件
'

'双击FLEXGRID调用卡片
Private Sub msgPaymentMethod_DblClick()
    With msgPaymentMethod
        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 msgPaymentMethod_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 msgPaymentMethod_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    With msgPaymentMethod
        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
                   mclsMainControl_EditInActive
               End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = PaymentMethodID
    Me.Enabled = False
   If lngID > 0 Then
        If CheckIDUsed("paymentMethod", "lngpaymentMethodID", lngID) Then
'            frmPaymentMethodListCard.EditCard lngID
            frmPaymentMethodCard.EditCard lngID, vbModal
        Else
            ShowMsg 0, "该付款方式不存在，不能进行修改！", vbExclamation + MB_TASKMODAL, "修改付款方式"
            mclsMainControl_ToolRefresh
        End If
    End If
   Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
'   frmPaymentMethodListCard.AddCard
    frmPaymentMethodCard.AddCard , vbModal
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = PaymentMethodID
    If mIsShowCard Then
'        If lngID = frmPaymentMethodListCard.PaymentMethodID And lngID > 0 Then
        If lngID = frmPaymentMethodCard.PaymentMethodID And lngID > 0 Then
            MessageBox Me.hwnd, "不能删除当前编辑的付款方式！", "付款方式删除提示", &H40&
'            frmPaymentMethodListCard.Show
'            frmPaymentMethodListCard.ZOrder 0
            frmPaymentMethodCard.EditCard lngID, vbModal
            Exit Sub
        End If
    End If
'    If frmPaymentMethodListCard.DelCard(PaymentMethodID) Then
    If frmPaymentMethodCard.DelCard(PaymentMethodID) Then
        With msgPaymentMethod
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            mclsList.SetFlexRow
        End With
        gclsSys.SendMessage CStr(0), Message.msgPaymentMethod
    End If
    UpdateMenuStatus
    'If Not frmPaymentMethodListCard.Visible Then
'    Unload frmPaymentMethodListCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    If UpdatePaymentMethodInActive(PaymentMethodID, Not PaymentMethodIsInActive) Then
       With msgPaymentMethod
            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
            '发出付款方式消息
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgPaymentMethod
      End With
    End If
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_EditUse()
     UseCode Message.msgPaymentMethod, PaymentMethodID
      Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
     Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    With msgPaymentMethod
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        mclsList.SaveListColWidth
        .Redraw = False
        '刷新列表记录
        mclsList.SaveListColWidth '保存列宽
        .Cols = 0
        Set datPaymentMethod.Recordset = GetList()
        If Not datPaymentMethod.Recordset.EOF Then
           datPaymentMethod.Recordset.MoveLast
        End If
        datPaymentMethod.Recordset.Close
        'Set datPaymentMethod.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, 31, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
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_EditUse
    Case 8:
        mclsMainControl_EditSearch
    Case 10:
        mclsMainControl_EditFilter
    Case 11:
        mclsMainControl_EditColumn
    Case 13:
        mclsMainControl_ToolRefresh
    Case 14:
        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)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = False
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    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
        
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'
'        Load .mnuListReportMenu(1)
'        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
'        Load .mnuListReportMenu(2)
        .mnuListReportMenu(0).Caption = "付款方式一览表(&P)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
    End With
End Sub

'快捷报表
Private Sub mclsMainControl_ReportQuick()

End Sub

'付款方式一览表
Private Sub mclsMainControl_ListPaymentMethod()
    Me.MousePointer = vbHourglass
    With frmPaymentmethodList
         .Show
         .ZOrder 0
    End With
    Me.MousePointer = vbDefault
End Sub

Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "付款方式编码" Or .TextMatrix(0, 2 + i) = "付款方式编码↑" Or .TextMatrix(0, 2 + i) = "付款方式编码↓" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "付款方式名称" Or .TextMatrix(0, i + 2) = "付款方式名称↑" Or .TextMatrix(0, i + 2) = "付款方式名称↓" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function