📄 frmcalcsinglechoice.frm
字号:
VERSION 5.00
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GACEDIT.DLL"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmCalcSingleChoice
BorderStyle = 3 'Fixed Dialog
Caption = "选择入库商品批次"
ClientHeight = 4320
ClientLeft = 45
ClientTop = 330
ClientWidth = 7575
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4320
ScaleWidth = 7575
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSRDC.MSRDC datItem
Height = 330
Left = 630
Top = 2940
Visible = 0 'False
Width = 1575
_ExtentX = 2778
_ExtentY = 582
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 1
LockType = 3
QueryType = 0
Prompt = 3
Appearance = 1
QueryTimeout = 30
RowsetSize = 100
LoginTimeout = 15
KeysetSize = 0
MaxRows = 0
ErrorThreshold = -1
BatchSize = 15
BackColor = -2147483643
ForeColor = -2147483640
Enabled = -1 'True
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox txtQuantity
BackColor = &H80000004&
Height = 285
Left = 3630
Locked = -1 'True
TabIndex = 8
Text = "出库数量：1"
Top = 90
Width = 1455
End
Begin VB.PictureBox picGrid
Height = 975
Left = 90
ScaleHeight = 915
ScaleWidth = 1785
TabIndex = 4
Top = 420
Width = 1845
Begin GATLCTRLLibCtl.CalEdit txtEdit
Height = 225
Left = 0
OleObjectBlob = "frmCalcSingleChoice.frx":0000
TabIndex = 7
Top = 0
Visible = 0 'False
Width = 855
End
Begin MSFlexGridLib.MSFlexGrid msgBody
Bindings = "frmCalcSingleChoice.frx":0081
Height = 465
Left = 0
TabIndex = 5
Top = 465
Width = 1815
_ExtentX = 3201
_ExtentY = 820
_Version = 393216
FixedCols = 0
RowHeightMin = 250
BackColor = 16777215
BackColorBkg = 12632256
BorderStyle = 0
Appearance = 0
End
Begin MSFlexGridLib.MSFlexGrid msgHead
Height = 450
Left = 0
TabIndex = 6
Top = 0
Width = 1800
_ExtentX = 3175
_ExtentY = 794
_Version = 393216
Rows = 3
FixedRows = 2
FixedCols = 0
BackColorBkg = 12632256
ScrollBars = 0
AllowUserResizing= 1
BorderStyle = 0
Appearance = 0
End
End
Begin VB.CommandButton cmdList
Height = 350
Index = 0
Left = 2205
Style = 1 'Graphical
TabIndex = 2
Tag = "1001"
Top = 405
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdList
Height = 350
Index = 1
Left = 2205
Style = 1 'Graphical
TabIndex = 1
Tag = "1002"
Top = 750
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdList
Caption = "刷新(&R)"
Height = 350
Index = 2
Left = 2205
TabIndex = 0
Tag = "1010"
Top = 1200
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.Label lblItem
AutoSize = -1 'True
Caption = "出库商品："
Height = 180
Left = 180
TabIndex = 3
Top = 120
Width = 900
End
End
Attribute VB_Name = "frmCalcSingleChoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Private WithEvents mclsMainControl As MainControl '主控对象
Private WithEvents mclsGrid As MutiGrid 'Grid对象
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass '钩子对象
Attribute mclsSubClassform.VB_VarHelpID = -1
Private Const HelpID = 13007
Private Const mViewID = 91 '批次视图号
Private Const mlngFormMinWidth = 450 '窗体最小尺寸
Private Const mlngFormMinHeight = 200
Private Const mintLeft = 50 '窗体位置尺寸
Private Const mintTop = 420
Private Const mintBottomHeight = 75
Private Const mintColInID = 0 '入库ID列号
Private Const mintColOutID = 1 '出库ID列号
Private Const mintColBakOutQty = 2 '出库数量列号
Private Const mintColBakOutAmt = 3 '出库金额列号
Private Const mintColState = 4 '选取列号
Private Const mintColInQuantity = 8 '入库数量列号
Private Const mintColInPrice = 9 '入库金额列号
Private Const mintColInAmount = 10 '入库金额列号
Private Const mintColOutQuantity = 11 '出库数量列号
Private Const mintColOutAmount = 12 '出库金额列号
Private mlngOutID As Long '出库批次
Private mlngItemID As Long
Private mdblInQuantity As Double '出入数量
Private mdblOutQuantity As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 外部方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'初始参数
Public Sub SetParameters(ByVal OutID As Long, ByVal ItemID As Long, _
ByVal ItemName As String, dblQuantity As Double)
Hide
mlngOutID = OutID
mlngItemID = ItemID
lblItem.Caption = ItemName
txtQuantity.Text = "出库数量：" & Format(dblQuantity, "0")
txtQuantity.Left = msgHead.Left + msgHead.width - txtQuantity.width
mdblOutQuantity = dblQuantity
mdblInQuantity = 0
RefreshGrid
Me.Show vbModal
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 私有方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function RefreshGrid()
Dim lngRow As Long
Me.MousePointer = vbHourglass
msgBody.FixedCols = 0
'如果没有初始Grid
mclsGrid.ListSet.ViewId = mViewID
Set datItem.Resultset = GetList()
If Not datItem.Resultset Is Nothing Then
Set mclsGrid.Grid = msgBody
Set mclsGrid.HeadGrid = msgHead
Set mclsGrid.EditText = txtEdit
mclsGrid.SetEditText "出库_数量", ""
mclsGrid.SetEditText "出库_金额", ""
mclsGrid.ColOfs = 5
msgBody.ColWidth(1) = 0
msgBody.ColWidth(2) = 0
msgBody.ColWidth(3) = 0
msgBody.ColWidth(4) = 450
mclsGrid.SetupStyle
mclsGrid.ListSetToGrid
mclsGrid.SetTitle datItem.Resultset
' mclsGrid.ColSort(1) = True
' mclsGrid.ColSort(2) = True
' mclsGrid.Sort 2, 2
mdblInQuantity = 0
With msgBody
For lngRow = .FixedRows To .Rows - 1
If .TextMatrix(lngRow, mintColState) = "√" Then
If IsNumeric(.TextMatrix(lngRow, mintColOutQuantity)) Then
mdblInQuantity = mdblInQuantity + C2Dbl(.TextMatrix(lngRow, mintColOutQuantity))
End If
End If
Next lngRow
End With
Else
msgBody.Cols = 2
End If
Me.MousePointer = vbDefault
End Function
'生成列表结果集
Private Function GetList() As rdoResultset
Dim errNo As Long
Dim strSql As String
Dim strQCostDetail As String
Dim strQItemCostDetail As String
Dim intYear As Integer
Dim bytPeriod As Integer
On Error GoTo ErrHandle
intYear = GetintYear(frmCalcCost.cboCost(0).Text)
bytPeriod = GetbytPeriod(frmCalcCost.cboCost(0).Text)
strQCostDetail = "SELECT ItemActivity.strDate,ItemActivity.strReceiptNo,ItemActivity.lngReceiptNo," _
& "ItemActivityDetail.lngActivityDetailID,ItemActivity.lngActivityTypeID," _
& "Abs(ItemActivityDetail.dblQuantity)-NVL(CostDetail.dblSaleQuantity,0) As dblUnSaleQuantity," _
& "Abs(ItemActivityDetail.dblAmount+ItemActivityDetail.dblExpenseAmount)-NVL(CostDetail.dblSaleAmount,0) As dblUnSaleAmount " _
& "FROM ItemActivityDetail, ItemActivity, CostDetail " _
& "WHERE ItemActivityDetail.lngActivityID = ItemActivity.lngActivityID " _
& "AND ItemActivityDetail.lngActivityDetailID=CostDetail.lngActivityDetailID(+) " _
& "AND ItemActivityDetail.lngItemID=" & mlngItemID & " " _
& "AND NVL(CostDetail.intYear," & intYear & ")=" & intYear & " AND NVL(CostDetail.bytPeriod," & bytPeriod & ")=" & bytPeriod & " " _
& "AND (ItemActivityDetail.dblQuantity>0 AND ItemActivity.lngActivityTypeID IN (1,3,5,32,9,8,10,30,41) " _
& "OR ItemActivityDetail.dblQuantity<0 AND ItemActivity.lngActivityTypeID IN (11,21,13,15,16,19,22,31)) " _
& "AND ItemActivity.intYear=" & intYear & " AND ItemActivity.bytPeriod=" & bytPeriod & " " _
& "UNION " _
& "SELECT ItemActivity.strDate,ItemActivity.strReceiptNo,ItemActivity.lngReceiptNo," _
& "CostDetail.lngActivityDetailID,ItemActivity.lngActivityTypeID, " _
& "CostDetail.dblUnSaleQuantity-CostDetail.dblSaleQuantity As dblUnSaleQuantity," _
& "CostDetail.dblUnSaleAmount-CostDetail.dblSaleAmount As dblSaleAmount " _
& "FROM CostDetail,ItemActivityDetail,ItemActivity " _
& "WHERE CostDetail.lngActivityDetailID=ItemActivityDetail.lngActivityDetailID " _
& "AND ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
& "AND CostDetail.lngItemID=" & mlngItemID & " AND CostDetail.blnInit=1 " _
& "AND CostDetail.intYear=" & intYear & " AND CostDetail.bytPeriod=" & bytPeriod
strQItemCostDetail = "SELECT * FROM ItemCostDetail WHERE lngOutActivityDetailID=" & mlngOutID
strSql = "SELECT QCostDetail.lngActivityDetailID,NVL(QItemCostDetail.lngOutActivityDetailID,0) As ID," _
& "DECODE(QItemCostDetail.lngOutActivityDetailID," & mlngOutID & ",NVL(dblQuantity,0),0) As dblBakQuantity," _
& "DECODE(QItemCostDetail.lngOutActivityDetailID," & mlngOutID & ",NVL(dblAmount,0),0) As dblBakAmount," _
& "DECODE(DECODE(lngOutActivityDetailID," & mlngOutID & ",NVL(QItemCostDetail.dblQuantity,0),0),0,' ','√') As ""选择""," _
& mclsGrid.ListSet.SelectOfSql & " " _
& "FROM (" & strQCostDetail & ") QCostDetail,ActivityType,(" & strQItemCostDetail & ") QItemCostDetail " _
& "WHERE QCostDetail.lngActivityTypeID=ActivityType.lngActivityTypeID " _
& "AND QCostDetail.lngActivityDetailID=QItemCostDetail.lngInActivityDetailID(+) " _
& "AND dblUnSaleQuantity+NVL(dblQuantity,0)<>0"
strSql = Replace(strSql, "[OUTID]", mlngOutID & "")
Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
Exit Function
ErrHandle:
errNo = Errors.ErrorsDeal(True, Me)
Select Case errNo
Case edtResume: Resume
Case edtResumeNext: Resume Next
Case edtCanNotKnown
ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
End Select
End Function
'保存数据
Private Sub SaveCostDetail()
Dim lngRow As Long
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -