⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmlistsales.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
    If gclsBase.OperatorID = recTemp(1) Then
        blnChange = True
    Else
        blnChange = False
    End If
    '3
    blnIsInvoice = recTemp(2)
    Set recTemp = Nothing
    GetItemStatus = True
End Function

'获得记录集
 Public Function GetList() As rdoResultset
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strSelect As String
    Dim strFrom   As String
    Dim strWhere  As String
    Dim strGroup As String
    Dim strHaving As String
'    Dim arrHaving(6) As String
On Error Resume Next
'    arrHaving(0) = "Sum(ItemActivityDetail.dblAmount)" '本币金额
'    arrHaving(1) = "Sum(ItemActivityDetail.dblCurrAmount)" '原币金额
    
'    arrHaving(0) = "Sum(ItemActivityDetail.dblAmount)" '本币金额
'    arrHaving(1) = "Sum(ItemActivityDetail.dblTaxAmount)" '本币税额
'    arrHaving(2) = "Sum(ItemActivityDetail.dblAmount+ItemActivityDetail.dblTaxAmount)" '本币价税合计
'    arrHaving(3) = "Sum(ItemActivityDetail.dblCurrAmount)" '原币金额
'    arrHaving(4) = "Sum(ItemActivityDetail.dblCurrTaxAmount)" '原币税额
'    arrHaving(5) = "Sum(ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount)" '原币价税合计
    
    strSelect = mclsList.ListSet.GetSelect
'    strSelect = strSelect & ",First(Currencys.bytCurrencyDec) AS CurDec,First(Currencys.bytRateDec) AS RateDec,First(" & gclsBase.NaturalCurDec & ") As NaturalCurDec "
    strFrom = mclsList.ListSet.FromOfSql
    strWhere = mclsList.ListSet.WhereOfSql
    strHaving = mclsList.ListSet.HavingOfSql
    If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
        Set GetList = Nothing
        Exit Function
    End If
    
'    strWhere = Filter.ModifyCond(strWhere, arrHaving(), strHaving)
    If Trim(strHaving) <> "" Then
        strHaving = " AND " & strHaving
    End If
    If Trim(strWhere) <> "" Then
        strWhere = " WHERE " & strWhere & " AND "
    Else
        strWhere = " WHERE "
    End If
    strSelect = "SELECT ItemActivity.lngActivityID, min(decode(ItemActivity.blnIsVoid,1,'√','')) AS ""作废""," & strSelect
    'strWhere = strWhere & " ItemActivity.lngActivityTypeID = " & intformtype & " AND CDate([ItemActivity]![strDate])>=#" & BeginDate & "# And CDate([ItemActivity]![strDate])<=#" & EndDate & "#"
    If intFormType = 18 Then
        strWhere = strWhere & " ((ItemActivity.lngReceiptTypeID>11 and ItemActivity.blnIsInvoice=1) OR ItemActivity.lngActivityTypeID = " & intFormType & ")"
    Else
        strWhere = strWhere & " ItemActivity.lngActivityTypeID = " & intFormType
    End If
    If mclsList.ListSet.ListID < 1 Then
        strWhere = strWhere & "AND  To_Date(ItemActivity.strDate,'rrrr-mm-dd')>=To_date('" & Format(gclsBase.PeriodBegin, "yyyy-mm-dd") & "','rrrr-mm-dd') " & _
                            " AND  To_Date(ItemActivity.strDate,'rrrr-mm-dd')<=To_date('" & Format(gclsBase.PeriodEnd, "yyyy-mm-dd") & "','rrrr-mm-dd') "
    End If
    strGroup = " GROUP BY ItemActivity.lngActivityID"
    strHaving = " HAVING min(ItemActivity.lngActivityTypeID)>10 And min(ItemActivity.lngActivityTypeID)<23" & strHaving
          
    strSql = strSelect & strFrom & strWhere & strGroup & strHaving
    Debug.Print "Sale GetList Excut Start:" & time
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Debug.Print "Sale GetList Excut End:" & time
    '列表是否为空
    If recTemp.RowCount = 0 Then
        grdList.HighLight = flexHighlightNever      '光标亮条消失
        cmdAgain.Enabled = False
    Else
        grdList.HighLight = flexHighlightAlways     '光标亮条显示
        cmdAgain.Enabled = True
    End If
   
   '成本调整不能作废
'    If intFormType = 20 Then
'        frmMain.mnuEditInActive.Enabled = False
'        frmMain.mnuEditShowAll.Enabled = False
'    Else
'        recTemp.FindFirst "作废 = '√'"
'        If recTemp.NoMatch Then
'            chkShowAll.Enabled = False '《全部显示》置灰
'            frmMain.mnuEditShowAll.Enabled = False
'        Else
'            chkShowAll.Enabled = True
'            frmMain.mnuEditShowAll.Enabled = True
'        End If
    'End If
    mclsList.ShowAll = True
    Set GetList = recTemp
End Function

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    
    If grdList.Rows > 1 And grdList.ColSel <> 0 And grdList.RowHeight(grdList.Row) > 0 Then
        blnIsnotEmpty = True
    Else
        blnIsnotEmpty = False
    End If
    If Not blnMenuBuilded Then
        MakeListEditMenu
    End If
    
    With frmMain
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty And blnEdit
        .mnuEditNew.Enabled = blnEdit
        .mnuEditDel.Enabled = blnIsnotEmpty And blnEdit
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        .mnuEditInActive.Enabled = blnIsnotEmpty And blnEdit
        If chkShowAll.Value = 1 Then
            .mnuEditShowAll.Checked = True
        Else
            .mnuEditShowAll.Checked = False
        End If
        If chkShowAll.Enabled = True Then
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditShowAll.Enabled = False
        End If
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuFilePrintReceipt.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)       '修改
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)        '新增
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)        '删除
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)       '----
        .mnuListEditMenu(4).Caption = "冲销(&S)"
        .mnuListEditMenu(4).Enabled = blnEdit
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        If intFormType = 21 Then
            .mnuListEditMenu(4).Visible = False
            .mnuListEditMenu(5).Visible = False
        Else
            .mnuListEditMenu(4).Visible = True
            .mnuListEditMenu(5).Visible = True
        End If
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(6)   '作废
        .mnuListEditMenu(6).Visible = True
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(7)    '显示所有/显示非作废
        .mnuListEditMenu(7).Visible = True
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)       '----
        .mnuListEditMenu(8).Visible = True
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(9)     '筛选
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(10)     '栏目设置
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)       '----
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(12)   '刷新
        Utility.CloneMenu .mnuFilePrintReceipt, .mnuListEditMenu(13)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)     '打印
        
        '成本调整不能作废 & 不能作废
'        If intFormType = 20 Then
'            .mnuEditInActive.Enabled = False      '作废
'            .mnuEditShowAll.Enabled = False       '显示所有/显示非作废
'            .mnuListEditMenu(4).Enabled = False
'            .mnuListEditMenu(5).Enabled = False
'            .mnuListEditMenu(3).Visible = False
'            .mnuListEditMenu(4).Visible = False
'            .mnuListEditMenu(5).Visible = False
'        End If
    End With
    
    If grdList.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList.FindNoChange
        mclsList.FindNoChange = True
        txtFind.Text = ""
        mclsList.FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtFind.Left + txtFind.width
    cmdEdit.top = Me.ScaleHeight - cmdEdit.Height - ListFormBottom
    cmdReport.top = cmdEdit.top
    chkShowAll.top = cmdEdit.top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
    With grdList
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
End Sub



'打印设置
Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 39, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName '商品出货               39
    Set MyPrintSet = Nothing
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt intFormType
End Sub
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
'//////////////////////////////////////////////////////////////
'///////        窗体 Form 控件
'//////////////////////////////////////////////////////////////

Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    On Error GoTo ErrHandle
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    '热键帮助(F1)
    
    Me.Caption = strTypeName & "列表"
    If intFormType = 20 Or intFormType = 21 Or intFormType = 22 Then
        cmdReport.Visible = False
    Else
        #If conVersionType = 16 Then
            If gclsBase.ControlAccount And intFormType = 18 Then
                cmdReport.Visible = False
            Else
                cmdReport.Visible = True
            End If
        #End If
    End If
    
    Select Case intFormType
    Case 11 '商品销售
        #If conVersionType = 16 Then
            Me.HelpContextID = 40029
        #Else
            Me.HelpContextID = 40007
        #End If
        frmMain.mnuTaskSale.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_11) '判断有无编辑权限
    Case 12 '直运销售
        Me.HelpContextID = 40011
        frmMain.mnuTaskDirectSale.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_12)
    Case 13 '代销出库
        Me.HelpContextID = 40021
        frmMain.mnuTaskLendOut.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_13)
    Case 14 '代销结算
        Me.HelpContextID = 40023
        frmMain.mnuTaskLendSale.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_14)
    Case 15 '加工出库
        Me.HelpContextID = 10245
        frmMain.mnuInventoryEntrustOut.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_15)
    Case 16 '分期出库
        Me.HelpContextID = 40017
        frmMain.mnuTaskStageOut.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_16)
    Case 17 '分期结算
        Me.HelpContextID = 40019
        frmMain.mnuTaskStageSale.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_17)
    Case 18 '销售发票
        Me.HelpContextID = 40029
        frmMain.mnuTaskSaleInvoice.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_18)
    Case 19 '领用出库
        Me.HelpContextID = 50003
        frmMain.mnuInventoryOut.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_19)
    Case 20 '成本调整
        Me.HelpContextID = 50019
        frmMain.mnuInventoryCostAdjust.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_20)
    Case 21 '盘亏出库
        Me.HelpContextID = 50013
        frmMain.mnuInventoryCheckDown.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_21)
    Case 22 '其它出库
        Me.HelpContextID = 50007
        frmMain.mnuInventoryOtherOut.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListSalesID_22)
    End Select
    
    Set mclsSales = New clsSales
    mclsSales.SethWnd Me.hwnd
   ' Set frmEdit = New FrmSalesBill
    If frmStockSales(intFormType + 2) Is Nothing Then
        Set frmEdit = New FrmSalesBill
    Else
        Set frmEdit = frmStockSales(intFormType + 2)
    End If
    
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = grdList
    Set mclsList.FindKind = cboFindKind
    Set mclsList.Find = txtFind
    Set mclsList.Again = cmdAgain

    mclsList.ListSet.ViewId = intViewID
    mclsList.InitFlexGrid
'    If mclsList.ListSet.ListID < 1 Then
'        gclsBase.DateOfPeriod gclsBase.AccountYear, gclsBase.Period, BeginDate, EndDate '当前时间对应的会计期间
'    End If
    '得到付款条件列表记录集
    Debug.Print "Sale Form_load Start:" & time
'    Set datGrid.Resultset = GetList()
'    If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -