frmpsoderinfo.frm

金算盘软件代码

   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "日期"
      Height          =   165
      Index           =   3
      Left            =   2715
      TabIndex        =   5
      Top             =   795
      Width           =   450
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   240
      Index           =   6
      Left            =   5415
      TabIndex        =   4
      Top             =   795
      Width           =   1815
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   240
      Index           =   3
      Left            =   3210
      TabIndex        =   3
      Top             =   795
      Width           =   1380
   End
   Begin VB.Label lblField 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   240
      Index           =   1
      Left            =   1020
      TabIndex        =   2
      Top             =   795
      Width           =   1635
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "付款信息"
      Height          =   270
      Left            =   120
      TabIndex        =   1
      Top             =   1860
      Width           =   1035
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "应付单信息"
      Height          =   240
      Left            =   180
      TabIndex        =   0
      Top             =   60
      Width           =   1155
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H8000000E&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H80000010&
      Height          =   1425
      Index           =   1
      Left            =   150
      Top             =   270
      Width           =   7260
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H80000010&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H80000010&
      Height          =   1485
      Index           =   0
      Left            =   135
      Top             =   270
      Width           =   7260
   End
End
Attribute VB_Name = "frmPSOderInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'采购定单,销售定单执行情况
'作者:诸涛
Private WithEvents mclsGrid As NewGrid    '声明类模块
Attribute mclsGrid.VB_VarHelpID = -1
Private blnBz As Boolean
Private blnRelat As Boolean
Private mlhls As rdoResultset     '声明数据表类型
Private ActiviTypeID1  As Long
Private ActivityID1  As Long

'lngActivityID1:采购，销售定单号 ,strAmount1 金额,Bz 为 True ,采购定单，Bz 为 Fale,销售定单
Public Sub PSOrder(lngActivityID1 As Long, strAmount1 As String, bz As Boolean)
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim i As Long
    Dim frm As Form
    
    blnBz = bz
    If blnBz Then
        Set frm = FrmPurchaseOrder
    Else
        Set frm = FrmSaleOrder
    End If
'    Set mclsGrid = New NewGrid
'    Set mclsGrid.Grid = grdList
'    Set mclsGrid.Form = Me
    
'On Error GoTo Err
    frm.MousePointer = vbHourglass
    
    If blnBz Then   'and ItemActivity.lngActivityTypeID>=1 and  ItemActivity.lngActivityTypeID<=10
'           strSql = "SELECT ItemActivity.lngActivityID as ID1,ItemActivity.strDate as 日期, " _
'                    & "ReceiptType.strReceiptTypeName as 单据类型, ItemActivity.strReceiptNO & Format(ItemActivity.lngReceiptNO,'00##') as 单据号, " _
'                    & "Item.strItemCode + ' ' +Item.strItemName + ' ' + Item.strItemStyle  as 商品编码名称及规格, ItemActivityDetail.dblQuantity  as 数量, " _
'                    & "[ItemActivityDetail].[dblCurrPrice]*[ItemUnit].[dblFactor] as 不含税单价, IIF(ItemActivityDetail.dblDiscountRate=0,'',ItemActivityDetail.dblDiscountRate) as [扣率%]," _
'                    & "ItemActivityDetail.dblCurrAmount as 不含税金额,IIF(Tax.dblPurchaseTaxRate=0,'',Tax.dblPurchaseTaxRate) as [税率%],ItemActivityDetail.dblCurrTaxAmount as 税额," _
'                    & "ItemUnit.dblFactor,ItemActivity.lngActivityTypeID as ID2,CurrencyS.bytCurrencyDec,ItemUnit.strUnitName " & _
'                "FROM ((((((PurchaseOrderDetail INNER JOIN PurchaseOrder ON PurchaseOrderDetail.lngPurchaseOrderID = PurchaseOrder.lngPurchaseOrderID) " _
'                   & "INNER JOIN (ItemActivity INNER JOIN ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) ON " _
'                   & " PurchaseOrderDetail.lngPurchaseOrderDetailID = ItemActivityDetail.lngOrderDetailID) LEFT JOIN Item ON ItemActivityDetail.lngItemID " _
'                   & "= Item.lngItemID) LEFT JOIN Tax ON ItemActivityDetail.lngTaxID = Tax.lngTaxID) LEFT JOIN ReceiptType " _
'                   & "ON ItemActivity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID) LEFT JOIN ItemUnit ON ItemActivityDetail.lngUnitID = " _
'                   & "ItemUnit.lngUnitID ) LEFT JOIN CurrencyS ON ItemActivity.lngCurrencyID = CurrencyS.lngCurrencyID " & _
'                "WHERE PurchaseOrderDetail.lngPurchaseOrderID=" & lngActivityID1 & " and " _
'                   & "ItemActivity.lngReceiptTypeID IN (2,3,4) " & " AND PurchaseOrder.blnIsVoid=FALSE AND ItemActivity.blnIsVoid=FALSE "
           strSql = "SELECT ItemActivity.lngActivityID as ID1,ItemActivity.strDate as 日期, " _
                    & "ReceiptType.strReceiptTypeName as 单据类型, Ltrim(ItemActivity.strReceiptNO || LPAD(ItemActivity.lngReceiptNO,4,'0')) as 单据号, " _
                    & "Item.strItemCode || ' ' ||Item.strItemName || ' '|| Item.strItemStyle  as 商品编码名称及规格, ItemActivityDetail.dblQuantity  as 数量, " _
                    & "ItemActivityDetail.dblCurrPrice*ItemUnit.dblFactor as 不含税单价, to_char(ItemActivityDetail.dblDiscountRate,'999.00') as " & """扣率％""" & "," _
                    & "ItemActivityDetail.dblCurrAmount as 不含税金额,Decode(Tax.dblPurchaseTaxRate,0,' ',Tax.dblPurchaseTaxRate) as " & """税率％""" & ",ItemActivityDetail.dblCurrTaxAmount as 税额," _
                    & "ItemUnit.dblFactor,ItemActivity.lngActivityTypeID as ID2,CurrencyS.bytCurrencyDec,ItemUnit.strUnitName " & _
                " FROM PurchaseOrderDetail,PurchaseOrder,ItemActivity,ItemActivityDetail,Item,Tax,ReceiptType,ItemUnit,CurrencyS " & _
                " WHERE PurchaseOrderDetail.lngPurchaseOrderID = PurchaseOrder.lngPurchaseOrderID " _
                   & " AND ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                   & " AND PurchaseOrderDetail.lngPurchaseOrderDetailID = ItemActivityDetail.lngOrderDetailID " _
                   & " AND ItemActivityDetail.lngItemID = Item.lngItemID(+) " _
                   & " AND ItemActivityDetail.lngTaxID = Tax.lngTaxID(+) " _
                   & " AND ItemActivity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID(+) " _
                   & " AND ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID(+) " _
                   & " AND ItemActivity.lngCurrencyID = CurrencyS.lngCurrencyID(+) " & _
                "AND PurchaseOrderDetail.lngPurchaseOrderID=" & lngActivityID1 & " and " _
                   & "ItemActivity.lngReceiptTypeID IN (2,3,4) " & " AND PurchaseOrder.blnIsVoid=0 AND ItemActivity.blnIsVoid=0 "
    Else        'and ItemActivity.lngActivityTypeID>=11 and  ItemActivity.lngActivityTypeID<=22
'           strSql = "SELECT ItemActivity.lngActivityID as ID1,ItemActivity.strDate as 日期, " _
'                    & "ReceiptType.strReceiptTypeName as 单据类型, ItemActivity.strReceiptNO & Format(ItemActivity.lngReceiptNO,'00##') as 单据号," _
'                    & "Item.strItemCode + ' ' +Item.strItemName + ' ' + Item.strItemStyle  as 商品编码名称及规格, " _
'                    & "ItemActivityDetail.dblQuantity as 数量, [ItemActivityDetail].[dblCurrPrice]*[ItemUnit].[dblFactor] as 不含税单价, " _
'                    & "ItemActivityDetail.dblDiscountRate as [扣率%], ItemActivityDetail.dblCurrAmount as 不含税金额," _
'                    & "IIF(Tax.dblSaleTaxRate=0,'',Tax.dblSaleTaxRate) as [税率%],IIF(ItemActivityDetail.dblCurrTaxAmount=0,'',ItemActivityDetail.dblCurrTaxAmount) as 税额," _
'                    & "ItemUnit.dblFactor,ItemActivity.lngActivityTypeID as ID2,CurrencyS.bytCurrencyDec,ItemUnit.strUnitName " & _
'               "FROM ((((((SaleOrderDetail INNER JOIN SaleOrder ON SaleOrderDetail.lngSaleOrderID = SaleOrder.lngSaleOrderID) " _
'                    & "INNER JOIN (ItemActivity INNER JOIN ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) ON " _
'                    & "SaleOrderDetail.lngSaleOrderDetailID = ItemActivityDetail.lngOrderDetailID) LEFT JOIN Item ON ItemActivityDetail.lngItemID = " _
'                    & "Item.lngItemID) LEFT JOIN Tax ON ItemActivityDetail.lngTaxID = Tax.lngTaxID) LEFT JOIN ReceiptType ON ItemActivity.lngReceiptTypeID = " _
'                    & "ReceiptType.lngReceiptTypeID) LEFT JOIN ItemUnit ON ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID ) LEFT JOIN CurrencyS ON " _
'                    & "ItemActivity.lngCurrencyID = CurrencyS.lngCurrencyID  " & _
'               "WHERE SaleOrderDetail.lngSaleOrderID=" & lngActivityID1 & " and " _
'                    & " ItemActivity.lngReceiptTypeID IN (13,15,18) " & " AND SaleOrder.blnIsVoid=FALSE AND ItemActivity.blnIsVoid=FALSE"
           strSql = "SELECT ItemActivity.lngActivityID as ID1,ItemActivity.strDate as 日期, " _
                    & "ReceiptType.strReceiptTypeName as 单据类型, Ltrim(ItemActivity.strReceiptNO || LPAD(ItemActivity.lngReceiptNO,4,'0')) as 单据号," _
                    & "Item.strItemCode || ' ' ||Item.strItemName || ' ' || Item.strItemStyle  as 商品编码名称及规格, " _
                    & "ItemActivityDetail.dblQuantity as 数量, ItemActivityDetail.dblCurrPrice*ItemUnit.dblFactor as 不含税单价, " _
                    & "to_char(ItemActivityDetail.dblDiscountRate,'999.00') as " & """扣率％""" & ", ItemActivityDetail.dblCurrAmount as 不含税金额," _
                    & "decode(Tax.dblSaleTaxRate,0,' ',Tax.dblSaleTaxRate) as " & """税率％""" & ",decode(ItemActivityDetail.dblCurrTaxAmount,0,' ',ItemActivityDetail.dblCurrTaxAmount) as 税额," _
                    & "ItemUnit.dblFactor,ItemActivity.lngActivityTypeID as ID2,CurrencyS.bytCurrencyDec,ItemUnit.strUnitName " & _
               " FROM SaleOrderDetail,SaleOrder,ItemActivity,ItemActivityDetail,Item,Tax,ReceiptType,ItemUnit,CurrencyS " & _
               " WHERE SaleOrderDetail.lngSaleOrderID = SaleOrder.lngSaleOrderID " _
                    & " AND ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                    & " AND SaleOrderDetail.lngSaleOrderDetailID = ItemActivityDetail.lngOrderDetailID " _
                    & " AND ItemActivityDetail.lngItemID = Item.lngItemID(+) " _
                    & " AND ItemActivityDetail.lngTaxID = Tax.lngTaxID(+) " _
                    & " AND ItemActivity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID(+) " _
                    & " AND ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID(+) " _
                    & " AND ItemActivity.lngCurrencyID = CurrencyS.lngCurrencyID(+) " & _
               " AND SaleOrderDetail.lngSaleOrderID=" & lngActivityID1 & " and " _
                    & " ItemActivity.lngReceiptTypeID IN (13,15,18) " & " AND SaleOrder.blnIsVoid=0 AND ItemActivity.blnIsVoid=0"
    End If
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Dim lngHwnd As Long
    Dim blnShowMsg As Boolean
    
    blnShowMsg = True
    If Me.Visible Then
        If Not frmMain.ActiveForm Is Nothing Then
            lngHwnd = frmMain.ActiveForm.hwnd
        Else
            blnShowMsg = False
        End If
    Else
        lngHwnd = Me.hwnd
    End If
    
    If recTemp Is Nothing Then
        If blnBz Then
            If blnShowMsg Then ShowMsg lngHwnd, "该张采购订单还没有执行，不能查看其采购资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
        Else
            If blnShowMsg Then ShowMsg lngHwnd, "该张销售订单还没有执行，不能查看其销售资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
        End If
        frm.MousePointer = vbDefault
        Unload Me
        Exit Sub
    End If
    If recTemp.EOF() And recTemp.BOF() Then
        If blnBz Then
            If blnShowMsg Then ShowMsg lngHwnd, "该张采购订单还没有执行，不能查看其采购资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
        Else
            If blnShowMsg Then ShowMsg lngHwnd, "该张销售订单还没有执行，不能查看其销售资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
        End If
        frm.MousePointer = vbDefault
        recTemp.Close
        Set recTemp = Nothing
        Unload Me
        Exit Sub
    End If
   '===================有记录====================
    '显示"付款信息":将生成结果绑定到MSFlexGrid控件中:
    Set datGrid.Resultset = recTemp
    
    '显示表头信息"
    
      With frm
        lblField(0).Caption = .lblHead(1).Caption  '单位
        lblField(1).Caption = .lblField(2).Caption   '单据号
        lblField(2).Caption = cutString(.lblField(12).Caption) '付款条件
        lblField(3).Caption = .lblField(3).Caption  '日期
        lblField(4).Caption = cutString(.lblField(9).Caption)  '币种
        lblField(5).Caption = cutString(.lblField(5).Caption) '部门
        lblField(6).Caption = cutString(.lblField(4).Caption)  '业务员
        lblField(7).Caption = strAmount1  '金额
      End With
    For i = 1 To grdList.Rows - 1
        SUM1 = grdList.TextMatrix(i, 5) '数量
        sum2 = IIf(Len(grdList.TextMatrix(i, 11)) = 0, 1, grdList.TextMatrix(i, 11))    '折算因子
        grdList.TextMatrix(i, 5) = BillPublic.DisplayData(Me.hwnd, NumberConvert(SUM1, C2Dbl(sum2), False), C2Dbl(sum2)) & Trim(grdList.TextMatrix(i, 14))
        grdList.TextMatrix(i, 6) = Format(IIf(C2Dbl(grdList.TextMatrix(i, 6)) = 0, "", C2Dbl(grdList.TextMatrix(i, 6))), FormatString(gclsBase.PriceDec))