📄 frmcustomerdiscountcard.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 frmCustomerDiscountCard
Caption = "调整折扣率"
ClientHeight = 5712
ClientLeft = 60
ClientTop = 348
ClientWidth = 8568
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5712
ScaleWidth = 8568
StartUpPosition = 2 '屏幕中心
Begin MSRDC.MSRDC datCustomer
Height = 324
Left = 1608
Top = 1440
Visible = 0 'False
Width = 1548
_ExtentX = 2731
_ExtentY = 572
_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 GATLCTRLLibCtl.CalEdit txtPaste
Height = 255
Left = 4200
OleObjectBlob = "frmCustomerDiscountCard.frx":0000
TabIndex = 11
Top = 120
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtSetting
Alignment = 1 'Right Justify
Height = 285
Left = 5790
TabIndex = 10
Top = 4770
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Caption = "计算"
Height = 350
Index = 5
Left = 5790
TabIndex = 7
Top = 5160
Width = 1215
End
Begin VB.ComboBox cboCustomer
Height = 276
Left = 1080
Style = 2 'Dropdown List
TabIndex = 1
Top = 120
Width = 2235
End
Begin VB.CommandButton cmdOKCancel
Caption = "条件选择"
Height = 350
Index = 3
Left = 7260
TabIndex = 4
Top = 1740
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Caption = "全部取消"
Height = 350
Index = 4
Left = 7260
TabIndex = 5
Top = 2130
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Caption = "全部选择"
Height = 350
Index = 2
Left = 7260
TabIndex = 3
Top = 1350
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Default = -1 'True
Height = 350
Index = 0
Left = 7260
Style = 1 'Graphical
TabIndex = 8
Tag = "1001"
Top = 510
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Cancel = -1 'True
Height = 350
Index = 1
Left = 7260
Style = 1 'Graphical
TabIndex = 9
Tag = "1002"
Top = 900
UseMaskColor = -1 'True
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid msgCustomer
Bindings = "frmCustomerDiscountCard.frx":0081
Height = 4005
Left = 60
TabIndex = 2
Top = 500
Width = 7095
_ExtentX = 12510
_ExtentY = 7049
_Version = 393216
FixedCols = 0
BackColor = 16777215
BackColorFixed = -2147483644
BackColorSel = -2147483646
BackColorBkg = 16777215
FocusRect = 2
End
Begin VB.Label lblTitle
Caption = $"frmCustomerDiscountCard.frx":009B
Height = 585
Index = 1
Left = 240
TabIndex = 6
Top = 4800
Width = 5715
End
Begin VB.Label lblTitle
Caption = "单位性质(&P)"
Height = 225
Index = 0
Left = 60
TabIndex = 0
Top = 150
Width = 1035
End
End
Attribute VB_Name = "frmCustomerDiscountCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 调整折扣率卡片
' 作者：欧中建
' 日期：1998.07.04
'
' 功能：调整选定的单位的折扣率
'
' 接口： ShowCard 显示和进入调整折扣率卡片
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Const mintViewId = 92 '视图ID
Private Const mintFormWidth = 8685 '窗体宽度
Private Const mintFormHeight = 6120 '窗体高度
Private mclsGridCustomer As Grid '主控对象
Private mlngGridRow As Long 'Grid类
Private mblnIsChangetxtPaste As Boolean '
Private mIsScroll As Boolean '是否滚动
Private mintRow As Integer 'GRID的行
Private lngX As Long '行坐标
Private lngY As Long '列坐标
'调用接口
Public Sub ShowCard()
Dim strSql As String
Dim intCounter As Integer
Set mclsGridCustomer = New Grid
Set mclsGridCustomer.Grid = msgCustomer
mclsGridCustomer.ListSet.ViewId = mintViewId
Set datCustomer.Resultset = GetAddCostList(mintViewId)
mclsGridCustomer.SetupStyle
mclsGridCustomer.ColOfs = 2
mclsGridCustomer.ListSetToGrid
InitComboBox
cboCustomer.ListIndex = 0
With msgCustomer
.HighLight = flexHighlightNever
.FocusRect = flexFocusNone
' .ColWidth(3) = 1500
' .ColWidth(4) = 2800
' .ColWidth(5) = 1130
' .ColWidth(6) = 1130
If .Rows > 1 Then
For intCounter = 1 To .Rows - 1
If .TextMatrix(intCounter, GetCol("单位性质")) = cboCustomer.Text Then
.RowHeight(intCounter) = 285
Else
.RowHeight(intCounter) = 0
End If
.Row = intCounter
.col = 5
.CellAlignment = 7
'.col = 25
'.CellAlignment = 7
Next intCounter
End If
' For intCounter = 2 To 2
' .ColWidth(intCounter) = 0
' Next intCounter
'.ScrollTrack = True
.ColAlignment(GetCol("新扣率％")) = 7
.ColAlignment(GetCol("单位性质")) = 1
End With
Me.Show vbModal
End Sub
Private Sub InitComboBox()
cboCustomer.Clear
cboCustomer.AddItem "供应商", 0
cboCustomer.AddItem "客户", 1
cboCustomer.AddItem "供销", 2
cboCustomer.AddItem "其它", 3
End Sub
Private Sub cboCustomer_Click()
Dim i As Integer
With msgCustomer
If .Rows > 1 Then
For i = 1 To .Rows - 1
If .TextMatrix(i, GetCol("单位性质")) = cboCustomer.Text Then
.RowHeight(i) = 285
Else
.RowHeight(i) = 0
End If
Next
End If
End With
End Sub
Private Sub cmdokcancel_Click(Index As Integer)
Dim intCounter As Integer
Dim intCounterRevert As Integer
Dim strSql As String
Dim blnExecSQL As Boolean
Dim intMsgReturn As Integer
Dim intNewRateCol As Integer
Dim intOldRateCol As Integer
intNewRateCol = GetCol("新扣率％")
intOldRateCol = GetCol("当前扣率％")
With msgCustomer
Select Case Index
Case 0 '确定
If txtPaste.Visible Then txtPaste_LostFocus
If .Rows = 1 Then Exit Sub
gclsBase.BaseWorkSpace.BeginTrans
For intCounter = .FixedRows To .Rows - 1
If .TextMatrix(intCounter, intNewRateCol) <> "" And .TextMatrix(intCounter, intNewRateCol) <> " " _
And CLng(.TextMatrix(intCounter, 0)) > 0 Then
strSql = "UPDATE Customer SET dblDiscountRate=" _
& CDbl(.TextMatrix(intCounter, intNewRateCol)) & " WHERE lngCustomerID=" _
& CLng(.TextMatrix(intCounter, 0))
blnExecSQL = gclsBase.ExecSQL(strSql)
If Not blnExecSQL Then
intMsgReturn = MsgBox("保存新扣率不成功。", _
vbExclamation + vbOKOnly, frmCustomerDiscountCard.Caption)
gclsBase.BaseWorkSpace.RollBacktrans
Exit Sub
End If
End If
Next intCounter
gclsBase.BaseWorkSpace.CommitTrans
gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomer
Unload Me
Case 1 '取消
Unload Me
Case 2 '全部选择
If .Rows = 1 Then Exit Sub
For intCounter = .FixedRows To .Rows - 1
If .RowHeight(intCounter) <> 0 Then
.TextMatrix(intCounter, 1) = "√"
End If
Next intCounter
Case 3 '条件选择
Dim i As Integer
Dim strWhereOf As String
Dim strFromOfSql As String
Dim blnIsOK As Boolean
Dim recTemplete As rdoResultset
If mclsGridCustomer.ListSet.ListID < 1 Then mclsGridCustomer.ListSet.SaveList
strWhereOf = Filter.ShowFilter(mclsGridCustomer.ListSet.ListID, 1, , , , , blnIsOK, , "条件选择")
strFromOfSql = mclsGridCustomer.ListSet.FromOfSql
If Not blnIsOK Then Exit Sub
If strWhereOf <> "" Then
strSql = "SELECT Customer.lngCustomerID " & strFromOfSql & " Where " & strWhereOf
Else
strSql = "SELECT Customer.lngCustomerID " & strFromOfSql
End If
Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
Do Until recTemplete.EOF
With msgCustomer
For i = 1 To .Rows - 1
If recTemplete!lngCustomerID = .TextMatrix(i, 0) Then .TextMatrix(i, 1) = "√"
Next
End With
recTemplete.MoveNext
Loop
recTemplete.Close
Filter.DelSelectedCond mclsGridCustomer.ListSet.ListID, 1
'调用筛选
'返回结果处理
Case 4 '全部取消
If .Rows = 1 Then Exit Sub
For intCounter = .FixedRows To .Rows - 1
If .RowHeight(intCounter) <> 0 Then
.TextMatrix(intCounter, 1) = ""
.TextMatrix(intCounter, intNewRateCol) = ""
End If
Next intCounter
Case 5 '计算
Dim dblRate As Double
If .Rows = 1 Then Exit Sub
'If (strRight(txtSetting.Text, 1) = "%" And Not IsNumeric(strLeft(txtSetting.Text, strLen(txtSetting.Text) - 1))) _
And Not IsNumeric(txtSetting.Text) Then Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -