frmlistpurchase.frm

金算盘软件代码

    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.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 as ID, max(decode(ItemActivity.blnIsVoid,1,'√','')) AS ""作废""," & strSelect
    'strWhere = strWhere & " ItemActivity.lngActivityTypeID = " & intformtype & " AND  CDate([ItemActivity]![strDate])>=#" & BeginDate & "# And CDate([ItemActivity]![strDate])<=#" & EndDate & "#"
    If intFormType = 7 Then
        strWhere = strWhere & " ((ItemActivity.lngReceiptTypeID<12 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 Max(ItemActivity.lngActivityTypeID)<11" & strHaving
          
    strSql = strSelect & strFrom & strWhere & strGroup & strHaving
'    #If conVersionType = 4 Then
'        Strsql = strReplace(Strsql, "原币", "")
'    #End If
    Debug.Print "Purchase GetListExcut Start:" & time
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Debug.Print "Purchase GetListExcut end:" & time
    '列表是否为空
    
    If recTemp.RowCount = 0 Then
        grdList.HighLight = flexHighlightNever      '光标亮条消失
        cmdAgain.Enabled = False
    Else
        grdList.HighLight = flexHighlightAlways     '光标亮条显示
        cmdAgain.Enabled = True
    End If
      
'    recTemp.FindFirst "作废 = '√'"
'    If recTemp.NoMatch Then
'        chkShowAll.Enabled = False '《全部显示》置灰
'        frmMain.mnuEditShowAll.Enabled = False
'    Else
'        chkShowAll.Enabled = True
'        frmMain.mnuEditShowAll.Enabled = True
'    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.Enabled = blnEdit And blnIsnotEmpty
        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) '新增
        .mnuListEditMenu(1).Caption = "新增(&N)"
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2) '删除
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)       '----
        .mnuListEditMenu(4).Caption = "冲销(&S)"
        .mnuListEditMenu(4).Enabled = blnEdit
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        If intFormType = 9 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)     '打印
    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 cboFindKind_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub cmdAgain_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub cmdEdit_KeyUp(KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub cmdReport_KeyUp(KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub





Private Sub grdList_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 36, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName '商品进货               36
    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 = 9 Or intFormType = 10 Then
        cmdReport.Visible = False
    Else
        #If conVersionType = 16 Then
            If gclsBase.ControlAccount And intFormType = 7 Then
                cmdReport.Visible = False
            Else
                cmdReport.Visible = True
            End If
        #End If
    End If
    Select Case intFormType
    Case 1 '"商品采购单"
        #If conVersionType = 16 Then
            Me.HelpContextID = 40027
        #Else
            Me.HelpContextID = 40005
        #End If
        frmMain.mnuTaskPurchase.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_1) '判断有无编辑权限
    Case 2 '"直运采购单"
        Me.HelpContextID = 40009
        frmMain.mnuTaskDirectPurchase.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_2)
    Case 3 '"受托入库单"
        Me.HelpContextID = 40013
        frmMain.mnuTaskBorrowIn.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_3)
    Case 4 '"受托结算单"
        Me.HelpContextID = 40015
        frmMain.mnuTaskBorrowPurchase.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_4)
    Case 5 '"加工入库单"
        Me.HelpContextID = 10246
        frmMain.mnuInventoryEntrustIn.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_5)
    Case 6 '"加工费用单"
        Me.HelpContextID = 10528
        frmMain.mnuInventoryEntrustExpense.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_6)
    Case 7 '"采购发票"
        Me.HelpContextID = 40027
        frmMain.mnuTaskPurchaseInvoice.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_7)
    Case 8 '"自制入库单"
        Me.HelpContextID = 50001
        frmMain.mnuInventoryIn.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_8)
    Case 9 '"盘盈入库单"
        Me.HelpContextID = 50011
        frmMain.mnuInventoryCheckUp.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_9)
    Case 10 '"其他入库单"
        Me.HelpContextID = 50005
        frmMain.mnuInventoryOtherIn.Tag = Me.hwnd
        blnEdit = IsCanDo(frmRightsID.frmListPurchaseID_10)
    End Select
               
    
    Set mclsPurchase = New clsPurchase
    mclsPurchase.SethWnd Me.hwnd
    If frmStockSales(intFormType + 1) Is Nothing Then
        Set frmEdit = New FrmStockBill
    Else
        Set frmEdit = frmStockSales(intFormType + 1)
    End If
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = grdList
    Set mclsList.FindKind = cboFindKind
    Set mclsList.Find = txtFind