frmcommlist.frm

来自「金算盘软件代码」· FRM 代码 · 共 1,519 行 · 第 1/4 页

    gclsSys.CurrFormName = Me.hwnd
    Select Case mintListType
        Case 1
            vntCompareMessage = Message.msgcurrency
        Case 2
            vntCompareMessage = Message.msgVoucherType
        Case 3
            vntCompareMessage = Message.msgPaymentMethod
        Case 4
            vntCompareMessage = Message.msgTerm
    End Select
    For Each vntMessage In mclsMainControl.Messages
                If vntMessage = vntCompareMessage Then '接收到付款条件改变消息
                    mclsMainControl_ToolRefresh
                    mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
                End If
            Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    If mclsList.ListSet.ShowListSet(intViewID) Then
        mclsList.ShowAll = chkShowAll.Value
        msgCurrencys.Cols = 0
        GetList
'        Set datCurrencys.Recordset = GetList()
'        If datCurrencys.Recordset.RecordCount > 0 Then
'           datCurrencys.Recordset.MoveLast
'        End If
'        datCurrencys.Recordset.Close
'        Set datCurrencys.Recordset = Nothing
        mclsList.SetFlexGrid
        UpdateMenuStatus
        '初始化查找复合列表框
        mclsList.InitcboFindKind
    End If
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
End Sub

Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
'    If Not mblnIsSaveListset Then
'        If Not FindlngViewID(intViewID) Then mclsList.ListSet.SaveList
'        mblnIsSaveListset = True
'    End If
    If mclsList.ListSet.ListID < 1 Then mclsList.ListSet.SaveList
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgCurrencys.Cols = 0
    GetList
'    Set datCurrencys.Recordset = GetList()
'    If datCurrencys.Recordset.RecordCount > 0 Then
'       datCurrencys.Recordset.MoveLast
'    End If
'    datCurrencys.Recordset.Close
'    Set datCurrencys.Recordset = Nothing
    mclsList.SetFlexGrid
    UpdateMenuStatus
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    
    '初始化查找复合列表框
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Dim intListPrintID As Integer
    
    Set MyPrintSet = New PrintClass
    Select Case mintListType
        Case 1
            intListPrintID = 29
        Case 2
            intListPrintID = 30
        Case 3
            intListPrintID = 31
        Case 4
            intListPrintID = 32
    End Select
    MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , intListPrintID, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set MyPrintSet = Nothing
End Sub



Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
    'mclsSubClass.CallWndProc Msg, wParam, lParam
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

'
' FLEXGRID控件
'

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

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgCurrencys_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 msgCurrencys_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
      With msgCurrencys
      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 mclsMainControl_EditEdit()
    Dim lngID As Long
    Dim bCancel As Boolean
    
    lngID = ListID
    bCancel = False
    Me.Enabled = False
    If lngID > 0 Then
        Select Case mintListType
            Case 1
                If CheckIDUsed("Currencys", "lngCurrencyID", lngID) Then
'                    frmCurrencyListCard.EditCard lngID
                    frmCurrencyCard.EditCard lngID, vbModal
                    Set frmCurrencyCard = Nothing
                    bCancel = False
                Else
                    bCancel = True
                End If
            Case 2
                If CheckIDUsed("VoucherType", "lngVoucherTypeID", lngID) Then
'                    frmVoucherTypeListCard.EditCard lngID
                    frmEntryTypeCard.EditCard lngID, vbModal
                    Set frmEntryTypeCard = Nothing
                    bCancel = False
                Else
                    bCancel = True
                End If
            Case 3
                If CheckIDUsed("paymentMethod", "lngpaymentMethodID", lngID) Then
'                    frmPaymentMethodListCard.EditCard lngID
                    frmPaymentMethodCard.EditCard lngID, vbModal
                    Set frmPaymentMethodCard = Nothing
                    bCancel = False
                Else
                    bCancel = True
                End If
            Case 4
                If CheckIDUsed("Term", "lngTermID", lngID) Then
'                    frmtermlistcard.EditCard lngID
                    frmTermCard.EditCard lngID, vbModal
                    Set frmTermCard = Nothing
                    bCancel = False
                Else
                    bCancel = True
                End If
        End Select
        If bCancel Then
             bCancel = False
            ShowMsg 0, "该" & mstrListName & "不存在，不能进行修改！", vbExclamation + MB_TASKMODAL, "mStrListName" & "列表"
            mclsMainControl_ToolRefresh
        End If
    End If
    
   Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Select Case mintListType
        Case 1
'            frmCurrencyListCard.AddCard
            frmCurrencyCard.AddCard , vbModal
            Set frmCurrencyCard = Nothing
        Case 2
'            frmVoucherTypeListCard.AddCard
            frmEntryTypeCard.AddCard , vbModal
            Set frmEntryTypeCard = Nothing
        Case 3
'            frmPaymentMethodListCard.AddCard
            frmPaymentMethodCard.AddCard , vbModal
            Set frmPaymentMethodCard = Nothing
        Case 4
'            frmtermlistcard.AddCard
            frmTermCard.AddCard , vbModal
            Set frmTermCard = Nothing
    End Select
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    Dim blnDeleteSucess As Boolean
    
    lngID = ListID
    blnDeleteSucess = False
    Select Case mintListType
        Case 1
            If UserRight.GetIsShowcard(1) Then
'                If lngID = frmCurrencyListCard.GetCurID And lngID > 0 Then
                If lngID = frmCurrencyCard.GetCurID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的币种！", vbExclamation
'                    frmCurrencyListCard.Show
'                    frmCurrencyListCard.ZOrder 0
                    frmCurrencyCard.EditCard lngID, vbModal
                    'Unload frmCurrencyCard
                    Set frmCurrencyCard = Nothing
                    Exit Sub
                End If
            End If
            If lngID = 1 Then
                MsgBox "不能删除本位币", vbExclamation
            Else
'                blnDeleteSucess = frmCurrencyListCard.DelCard(lngID)
                blnDeleteSucess = frmCurrencyCard.DelCard(lngID, Me.hwnd, True)
                Unload frmCurrencyCard
                Set frmCurrencyCard = Nothing
            End If
        Case 2
            If UserRight.GetIsShowcard(2) Then
'                If lngID = frmVoucherTypeListCard.VoucherTypeID And lngID > 0 Then
                If lngID = frmEntryTypeCard.VoucherTypeID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的凭证类型！", vbExclamation
'                    frmVoucherTypeListCard.Show
'                    frmVoucherTypeListCard.ZOrder 0
                    frmEntryTypeCard.EditCard lngID, vbModal
                    Set frmEntryTypeCard = Nothing
                    Exit Sub
                End If
            End If
'            blnDeleteSucess = frmVoucherTypeListCard.DelCard(lngID)
            blnDeleteSucess = frmEntryTypeCard.DelCard(lngID, Me.hwnd, True)
            Unload frmEntryTypeCard
            Set frmEntryTypeCard = Nothing
        Case 3
            If UserRight.GetIsShowcard(3) 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
                    Set frmPaymentMethodCard = Nothing
                    Exit Sub
                End If
            End If
'            blnDeleteSucess = frmPaymentMethodListCard.DelCard(lngID)
            blnDeleteSucess = frmPaymentMethodCard.DelCard(lngID, Me.hwnd, True)
            Unload frmPaymentMethodCard
            Set frmPaymentMethodCard = Nothing
        Case 4
            If UserRight.GetIsShowcard(4) Then
'                If lngID = frmtermlistcard.TermID And lngID > 0 Then
                If lngID = frmTermCard.TermID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的付款条件！", vbExclamation
'                    frmtermlistcard.Show
'                    frmtermlistcard.ZOrder 0
                    frmTermCard.EditCard lngID, vbModal
                    Set frmTermCard = Nothing
                    Exit Sub
                End If
            End If
'            blnDeleteSucess = frmtermlistcard.DelCard(lngID)
            blnDeleteSucess = frmTermCard.DelCard(lngID, Me.hwnd, True)
            Unload frmTermCard
            Set frmTermCard = Nothing
        End Select
        If blnDeleteSucess Then
            With msgCurrencys
                .RowHeight(.Row) = 0
                .RowData(.Row) = 1
                mclsList.SetFlexRow
            End With
            Select Case mintListType
                Case 1
                    gclsSys.SendMessage Me.hwnd, Message.msgcurrency
                Case 2
                    gclsSys.SendMessage CStr(Me.hwnd), Message.msgVoucherType
                Case 3
                    gclsSys.SendMessage CStr(0), Message.msgPaymentMethod
                Case 4
                    gclsSys.SendMessage CStr(Me.hwnd), Message.msgTerm
            End Select
        End If
    UpdateMenuStatus
'    Select Case mintListType
'        Case 1
'            Unload frmCurrencyListCard
'        Case 2
'            Unload frmVoucherTypeListCard
'        Case 3
'            Unload frmPaymentMethodListCard
'        Case 4
'            Unload frmtermlistcard
'    End Select
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = ListID
    
    blnSucess = False
    If mintListType = 1 Then
        If ListID = 1 Then
            MsgBox "本位币不能停用", vbExclamation, Me.Caption
            Exit Sub
        End If
    End If
    If UpdateListInActive(ListID, Not ListRecIsInActive) Then
        With msgCurrencys
             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
             blnSucess = True
             '发出付款方式消息
             'gclsSys.SendMessage CStr(Me.hwnd), Message.msgcurrency
        End With
    End If
    If blnSucess Then
        Select Case mintListType
            Case 1
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgcurrency
            Case 2
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgVoucherType
            Case 3
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgPaymentMethod
            Case 4
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgTerm
        End Select
    End If
   UpdateMenuStatus
End Sub