📄 frmcalcdiscdetail.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 = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmCalcDiscDetail
BorderStyle = 1 'Fixed Single
Caption = "折扣计算"
ClientHeight = 5550
ClientLeft = 45
ClientTop = 330
ClientWidth = 8745
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5550
ScaleWidth = 8745
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdOkCancel
Default = -1 'True
Height = 350
Index = 0
Left = 7500
Style = 1 'Graphical
TabIndex = 0
Tag = "1001"
Top = 300
UseMaskColor = -1 'True
Width = 1210
End
Begin VB.CommandButton cmdOkCancel
Cancel = -1 'True
Height = 350
Index = 1
Left = 7500
Style = 1 'Graphical
TabIndex = 1
Tag = "1002"
Top = 690
UseMaskColor = -1 'True
Width = 1210
End
Begin VB.CommandButton cmdOkCancel
Height = 350
Index = 2
Left = 7500
Style = 1 'Graphical
TabIndex = 2
Tag = "1021"
Top = 1080
UseMaskColor = -1 'True
Width = 1210
End
Begin VB.Frame Frame1
Caption = "计算结果(&R)"
Height = 1635
Left = 60
TabIndex = 4
Top = 3840
Width = 7365
Begin VB.CheckBox ChkAdjust
Caption = "手工调价(&A)"
Height = 255
Left = 150
TabIndex = 6
Top = 1275
Visible = 0 'False
Width = 1305
End
Begin VB.TextBox txtResult
Height = 975
Left = 90
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 210
Width = 7185
End
Begin GATLCTRLLibCtl.CalEdit calPrice
Height = 285
Left = 2160
OleObjectBlob = "frmCalcDiscDetail.frx":0000
TabIndex = 8
Top = 1260
Width = 1815
End
Begin MSForms.OptionButton OptReturn
Height = 330
Index = 1
Left = 6210
TabIndex = 11
Top = 1230
Width = 1125
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "1984;582"
Value = "0"
Caption = "单价优先"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.OptionButton OptReturn
Height = 330
Index = 0
Left = 5100
TabIndex = 10
Top = 1230
Width = 1125
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "1984;582"
Value = "1"
Caption = "金额优先"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "误差控制(&C)"
Height = 180
Left = 4080
TabIndex = 9
Top = 1305
Width = 990
End
Begin VB.Label lblPrice
AutoSize = -1 'True
Caption = "价格(&P)"
Height = 180
Left = 1500
TabIndex = 7
Top = 1305
Width = 630
End
End
Begin MSFlexGridLib.MSFlexGrid GrdCol
Bindings = "frmCalcDiscDetail.frx":0081
Height = 3435
Left = 60
TabIndex = 3
Top = 300
Width = 7365
_ExtentX = 12991
_ExtentY = 6059
_Version = 393216
Cols = 20
FixedCols = 0
RowHeightMin = 270
BackColorBkg = -2147483643
GridColor = -2147483633
GridColorFixed = -2147483640
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
End
Begin MSRDC.MSRDC Data1
Height = 330
Left = 7500
Top = 5130
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_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.Label lblTitle
AutoSize = -1 'True
Caption = "单位："
Height = 180
Index = 0
Left = 120
TabIndex = 13
Top = 60
Visible = 0 'False
Width = 540
End
Begin VB.Label lblTitle
AutoSize = -1 'True
Caption = "币种："
Height = 180
Index = 1
Left = 1410
TabIndex = 12
Top = 60
Visible = 0 'False
Width = 540
End
End
Attribute VB_Name = "frmCalcDiscDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private frmName As Form
Private strColName() As String
Private mlngCurrDec As Long
Private strCurrDec As String
Private strPriceDec As String
Private blnSucceed As Boolean
Private lngItemID As Long
Private lngRowno As Long
Private strDate As String
Private lngAccountID As Long
Private lngCurrencyID As Long
Private lngCustomerID As Long
Private DiscInfos As Collection
Private dblRowData() As Double
Private blnCanAdjustDisc As Boolean
Private dblFactor As Double
Private dblRate As Double
Private dblQuantity As Double
Private dblPriceTax As Double
Private dblPriceNoDisc As Double
Private dblCurrAmount As Double
Private dblDiscAmount As Double
Private dblNowDiscRate As Double
Private bytOrder() As Byte
Private blnByOrder As Boolean
Private Const blnDiscMethod = True '计算方式：True 预付款/(1-贴息)=折扣 ,False 预付款*(1+贴息)=折扣
Private mclsGrid As Grid
Private xlngColNo() As Long
Private blnLoading As Boolean
Private mblnByMouse As Boolean
Private blnNotFirstMouse As Boolean
Private m_blnFirst As Boolean
Public Function ShowMe(frmTmp As Form, DiscInfosTmp As Collection, Optional blnByMouse As Boolean = True) As Boolean
Dim i As Integer
Dim strSql As String
Dim recTmp As rdoResultset
mblnByMouse = blnByMouse
Set frmName = frmTmp
If UCase(frmName.Name) = "FRMSALEORDER" Then
blnByOrder = True
Else
blnByOrder = False
End If
Set DiscInfos = DiscInfosTmp
GetDiscOrder bytOrder(), 13
lngCustomerID = C2lng(frmName.lblHead(0).Tag)
lngRowno = frmName.GrdCol.Row
' strSql = "SELECT lngARAccountID FROM Customer WHERE lngCustomerID=" & lngCustomerID
If blnByOrder Then
lngItemID = C2lng(frmName.GrdCol.TextMatrix(lngRowno, 24))
dblFactor = ConvertFactor(C2lng(frmName.GrdCol.TextMatrix(lngRowno, 25)), lngItemID)
strDate = frmName.lblField(3).Caption
lngCurrencyID = frmName.getFieldID(9)
dblRate = C2Dbl(frmName.lblField(8).Caption)
dblQuantity = NumberConvert(frmName.GrdCol.TextMatrix(frmName.GrdCol.Row, 3), dblFactor)
strSql = "SELECT lngARAccountID FROM Customer WHERE lngCustomerID=" & lngCustomerID
Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If recTmp.BOF And recTmp.EOF Then
recTmp.Close
Set recTmp = Nothing
Exit Function
End If
lngAccountID = recTmp(0)
recTmp.Close
Else
lngItemID = C2lng(frmName.TextOfGrid(lngRowno, 28))
dblFactor = ConvertFactor(C2lng(frmName.TextOfGrid(lngRowno, 31)), lngItemID)
strDate = frmName.lblField(2).Caption
lngAccountID = frmName.getFieldID(5)
' If lngAccountID = 0 Then
' Set recTmp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
' If recTmp.BOF And recTmp.EOF Then
' recTmp.Close
' Set recTmp = Nothing
' Exit Function
' End If
' lngAccountID = recTmp(0)
' frmName.setFieldID 5, lngAccountID
' End If
lngCurrencyID = frmName.getFieldID(7)
dblRate = C2Dbl(frmName.lblField(6).Caption)
dblQuantity = NumberConvert(frmName.TextOfGrid(frmName.GrdCol.Row, 5), dblFactor)
End If
If blnCurrencyInDirect(lngCurrencyID) Then
dblRate = 1 / dblRate
End If
strSql = "SELECT dblSalePrice1,dblNoDiscAmount1 FROM Item WHERE lngItemID=" & lngItemID
Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If recTmp.BOF And recTmp.EOF Then
recTmp.Close
Set recTmp = Nothing
Exit Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -