frmlistlendadjustprice.frm

金算盘软件代码

'/////////////////////////////////////////////////////////////////////////////////
'////////
'////////
'////////                            按纽菜单
'////////
'////////
'/////////////////////////////////////////////////////////////////////////////////

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    Dim i As Integer
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        For i = 1 To 12
            Load .mnuListEditMenu(i)
        Next i
    End With
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_EditFilter
    Case 8: '栏目设置
        mclsMainControl_EditColumn
    Case 10: '刷新
        mclsMainControl_ToolRefresh
    Case 11: '打印
        mclsMainControl_FilePrintReceipt
    Case 12
        mclsMainControl_FilePrint
    End Select
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑
Private Sub mclsMainControl_EditEdit()
    Dim lngActivityID As Long
    'Dim frmEdit As FrmAdjustCost2
    Me.Enabled = False
    mblnFinish = True
    lngActivityID = GetlngActivityID()
    
    If mIsShowEdit Then
        theEditForm.ShowAOldBill (lngActivityID) '调用接口
    Else
        'Set frmEdit = New FrmAdjustCost2
        theEditForm.ShowAOldBill (lngActivityID) '调用接口
        mIsShowEdit = True
        'Set frmEdit = Nothing
    End If
    mblnFinish = False
    Me.Enabled = True
End Sub

'新增
Private Sub mclsMainControl_EditNew()
    'Dim frmEdit As FrmAdjustCost2
    mblnFinish = True
    If mIsShowEdit Then
        theEditForm.ShowANewBill
    Else
        'Set frmEdit = New FrmAdjustCost2
        theEditForm.ShowANewBill
        mIsShowEdit = True
        'Set frmEdit = Nothing
    End If
    mblnFinish = False
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngActivityID As Long
    
    lngActivityID = GetlngActivityID()
      
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    
    If mIsShowEdit Then
        If lngActivityID = theEditForm.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    
    If Not mclsAdjust.DeleteLendAdjustPrice(lngActivityID) Then Exit Sub
    
    '从Grid中删除本行
    With grdList
        If .Rows = 2 Then '要删除的行是GRID 的最后一行
            mclsMainControl_ToolRefresh
        Else
            .RemoveItem (.Row)
        End If
    End With
    
End Sub

'作废
Private Sub mclsMainControl_EditInActive()
    Dim lngActivityID As Long
    Dim theRow As Long
 On Error GoTo TheErr
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    lngActivityID = GetlngActivityID()
    If lngActivityID = 0 Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    
    If ShowMsg(Me.hwnd, "本张委托代销调价单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Sub
    
    If Not blnIsVoid Then
        If blnIsVouchered Then
            cMsgBox "本张委托代销调价单已生成记帐凭证，不能作废！"
            Exit Sub
        End If
    End If
         
    If Not mclsAdjust.DeleteLendAdjustPrice(lngActivityID, True) Then Exit Sub
        
    With grdList
        If chkShowAll.Value = 1 Then
            If .TextMatrix(.Row, 1) = "" Then
                .TextMatrix(.Row, 1) = "√"
            Else
                .TextMatrix(.Row, 1) = ""
            End If
        Else
            .TextMatrix(.Row, 1) = "√"
            .RowHeight(.Row) = 0
            mclsList.SetFlexRow
            chkShowAll.Enabled = True
            frmMain.mnuEditShowAll.Enabled = True
        End If
    End With
    
    'UpdateMenuStatus
    Exit Sub
TheErr:
    cMsgBox "操作失败！"
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    
    If frmMain.mnuEditShowAll.Checked Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub
'栏目设置
Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With grdList
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            grdList.Cols = 0
            Set datGrid.Resultset = GetList()
            If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
            datGrid.Resultset.Close
            mclsList.SetFlexGrid
'            HideColOfMe Me
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtFind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub
'筛选
Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
   '执行过滤
    If mclsList.ListSet.ListID < 1 Then
        mclsList.ListSet.SaveList
        DefaultWhere intViewID, mclsList.ListSet.ListID
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    grdList.Redraw = False
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    grdList.Cols = 0
    Set datGrid.Resultset = GetList()
    If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
    datGrid.Resultset.Close
    mclsList.SetFlexGrid
'    HideColOfMe Me
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    grdList.Redraw = True
End Sub
'搜索
Private Sub mclsMainControl_EditSearch()
On Error GoTo TheErr
    frmTreeFind.ShowFind
TheErr:
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    
'    HaveAnyVoid
    
    With grdList
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        .Redraw = False
        '刷新列表记录
        .Cols = 0
        Set datGrid.Resultset = GetList()
        If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
        datGrid.Resultset.Close
        mclsList.SetFlexGrid
'        HideColOfMe Me
        '恢复以前排序列
        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, 41, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName '代销调价               41
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
End Sub
'
' 报表菜单
'
Private Sub MakeListReportMenu()
'cmdReport
    Dim intCnt As Integer
  
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        
        .mnuListReportMenu(0).Caption = "代销调价汇总表"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        .mnuListReportMenu(0).Checked = False
        
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "代销调价明细表"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = True
        .mnuListReportMenu(1).Checked = False
        
    End With
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0: '代销调价汇总表
'        mclsMainControl_Report 0
'        Report.ShowStandardReport 241, 199
    Case 1: '代销调价明细表
'        mclsMainControl_Report 1
'        Report.ShowStandardReport 242, 200
    End Select

End Sub

Private Sub mclsMainControl_Report(intReportType As Integer)
'    Dim mclsPrintclass As PrintClass
'    Set mclsPrintclass = New PrintClass
'    Select Case intReportType
'    Case 0:  '代销调价汇总表
'
'    Case 1:  '代销调价明细表
'
'    End Select
End Sub


Public Sub RefreshList(theCurrentID As Long)
    Dim i As Long
    mclsMainControl_ToolRefresh
    
   '将当前行设置到刷新后的ID=theCurrentID的行
    With grdList
        For i = 1 To .Rows - 1
            If CLng(.TextMatrix(i, 0)) = theCurrentID Then
                theEditRow = i
                GotoRow (i)
                Exit For
            End If
        Next i
    End With
 '   Me.ZOrder 1
 '   FrmPayable.SetFocus
End Sub

'告诉列表：编辑窗口已关闭
Public Sub IAmCLosed()
    mIsShowEdit = False
End Sub
 
Public Function BindingResult()
    Me.Hide
      '得到付款条件列表记录集
    Set datGrid.Resultset = GetList()
    If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
    datGrid.Resultset.Close
    
    mclsList.SetFlexGrid
'    HideColOfMe Me
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    '设置第一行为选定行
    With grdList
        If .Rows > 1 Then grdList.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
  
    Me.Show
    Me.ZOrder 0
End Function