📄 frmseller.frm
字号:
TabIndex = 25
Top = 1800
Width = 975
End
Begin VB.TextBox txtSellname
Height = 285
Left = 1200
TabIndex = 23
Top = 360
Width = 3975
End
Begin VB.TextBox txtStep
Height = 285
Left = 1200
TabIndex = 22
Top = 1800
Width = 1095
End
Begin VB.TextBox txtHighprice
Height = 285
Left = 3960
TabIndex = 20
Top = 1440
Width = 1215
End
Begin VB.TextBox txtLowprice
Height = 285
Left = 1200
TabIndex = 18
Top = 1440
Width = 1095
End
Begin VB.TextBox txtQuality
Height = 285
Left = 3960
TabIndex = 16
Top = 1080
Width = 1215
End
Begin VB.TextBox txtServe
Height = 285
Left = 1200
TabIndex = 14
Top = 1080
Width = 1095
End
Begin VB.TextBox txtProduction
Height = 285
Left = 1200
TabIndex = 12
Top = 720
Width = 3975
End
Begin VB.Label Label8
Caption = "单位名称："
Height = 255
Left = 120
TabIndex = 24
Top = 360
Width = 1095
End
Begin VB.Label Label7
Caption = "让步幅度："
Height = 255
Left = 120
TabIndex = 21
Top = 1800
Width = 1095
End
Begin VB.Label Label6
Caption = "最高价格："
Height = 255
Left = 2880
TabIndex = 19
Top = 1440
Width = 1095
End
Begin VB.Label Label5
Caption = "最低价格："
Height = 255
Left = 120
TabIndex = 17
Top = 1440
Width = 1095
End
Begin VB.Label Label4
Caption = "质量系数："
Height = 255
Left = 2880
TabIndex = 15
Top = 1080
Width = 1095
End
Begin VB.Label Label3
Caption = "服务系数："
Height = 255
Left = 120
TabIndex = 13
Top = 1080
Width = 1095
End
Begin VB.Label Label2
Caption = "产品名称："
Height = 255
Left = 120
TabIndex = 11
Top = 720
Width = 1095
End
End
Begin VB.Label Label1
Caption = "第一步：查询物流买家信息"
Height = 375
Index = 0
Left = 120
TabIndex = 5
Top = 120
Width = 3735
End
End
End
Attribute VB_Name = "frmSeller"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sbHotColor As Long
Dim sbNormalColor As Long
Dim CurrentStep As Integer
Dim SelectedBuyer As String
Dim SellerSteps() As Integer
Dim Price() As Currency
Dim SumValue() As Currency
Dim editflag As Boolean
Private Sub CmdEditor_Click()
If editflag = False Then
editflag = True
CmdEditor.Caption = "保存"
Txtsellname.Enabled = True
txtProduction.Enabled = True
txtServe.Enabled = True
txtQuality.Enabled = True
txtLowprice.Enabled = True
txtHighprice.Enabled = True
txtStep.Enabled = True
Else
SaveSellerInfo
MsgBox "保存修改,可进行查询！", vbOKOnly Or vbInformation, "卖家"
editflag = False
End If
End Sub
Private Sub Form_Initialize()
Txtsellname.Enabled = False
txtProduction.Enabled = False
txtServe.Enabled = False
txtQuality.Enabled = False
txtLowprice.Enabled = False
txtHighprice.Enabled = False
txtStep.Enabled = False
editflag = False
End Sub
Private Sub cmdGo_Click()
SaveSellerInfo
SearchInfo
End Sub
Private Sub cmdNext_Click()
If CurrentStep < 2 Then
CurrentStep = CurrentStep + 1
GoToStep CurrentStep
End If
End Sub
Private Sub cmdPrevious_Click()
If CurrentStep > 0 Then
CurrentStep = CurrentStep - 1
GoToStep CurrentStep
End If
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
sbNormalColor = &H8000000F
sbHotColor = &H80FFFF
Me.Height = 6825
Me.Width = 8040
For i = 0 To 2
Container(i).Move 2160, 0, 5775, 5775
Next
GoToStep 0
Me.Caption = "当前登录：卖家 " & LogonUser
LoadSellerInfo
cmdPrevious.Enabled = False
cmdPrevious.Enabled = False
End Sub
Sub GoToStep(Index As Integer)
Dim ii As Integer
ii = CurrentStep
CurrentStep = Index
For i = 0 To 2
If i = Index Then
stepButton(i).BackColor = sbHotColor
Container(i).ZOrder 0
Else
stepButton(i).BackColor = sbNormalColor
End If
Next
cmdPrevious.Enabled = Not (Index = 0)
cmdNext.Enabled = Not (Index = 2)
If Index = 0 Then
Image1.Picture = ImageList1.ListImages(1).Picture
Image2.Picture = ImageList1.ListImages(1).Picture
End If
If Index = 1 Then
Call Process
Image1.Picture = ImageList1.ListImages(2).Picture
Image2.Picture = ImageList1.ListImages(1).Picture
End If
If Index = 2 Then
Call FinalStep
Image1.Picture = ImageList1.ListImages(2).Picture
Image2.Picture = ImageList1.ListImages(2).Picture
End If
End Sub
Private Sub LoadSellerInfo()
Dim RS
Set RS = CreateObject("ADODB.RecordSet")
StrSQL = "select * from sellerinfo where username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 1
If Not RS.EOF Then
Txtsellname = RS("sellname")
txtProduction = RS("production")
txtServe = RS("serve")
txtLowprice = RS("lowprice")
txtHighprice = RS("highprice")
txtQuality = RS("quality")
txtStep = RS("step")
End If
RS.Close
Set RS = Nothing
End Sub
Private Sub SaveSellerInfo()
Dim RS
Set RS = CreateObject("ADODB.RecordSet")
StrSQL = "select * from sellerinfo where username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 3
If Not RS.EOF Then
RS("sellname") = Txtsellname
RS("production") = txtProduction
RS("serve") = txtServe
RS("lowprice") = txtLowprice
RS("highprice") = txtHighprice
RS("quality") = txtQuality
RS("step") = txtStep
End If
RS.Update
RS.Close
Set RS = Nothing
End Sub
Private Sub SearchInfo()
Dim RS, i As Integer, n As Integer
Set RS = CreateObject("ADODB.RecordSet")
StrSQL = "select buyerinfo.* from buyerinfo, sellerinfo" & _
" where buyerinfo.production = sellerinfo.production" & _
" and sellerinfo.lowprice <= buyerinfo.highprice" & _
" and buyerinfo.serve<=sellerinfo.serve" & _
" and buyerinfo.quality <= sellerinfo.quality" & _
" and sellerinfo.username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 1
Debug.Print StrSQL
n = 1
ReDim SellerSteps(RS.RecordCount + 1)
listResult.ListItems.Clear
Do Until RS.EOF
listResult.ListItems.Add , RS("username"), n
listResult.ListItems(n).SubItems(1) = RS("username")
listResult.ListItems(n).SubItems(2) = RS("buyname")
listResult.ListItems(n).SubItems(3) = RS("production")
listResult.ListItems(n).SubItems(4) = RS("serve")
listResult.ListItems(n).SubItems(5) = RS("quality")
listResult.ListItems(n).SubItems(6) = RS("highprice")
SellerSteps(n) = RS("step")
RS.MoveNext
n = n + 1
Loop
RS.Close
Set RS = Nothing
End Sub
Private Sub Process()
Dim i As Integer, rCount As Integer
Dim BP As Currency, SP As Currency
rCount = listResult.ListItems.Count
ReDim Price(rCount)
For i = 1 To rCount
SP = txtHighprice
BP = listResult.ListItems(i).SubItems(6)
sstep = txtStep
bstep = SellerSteps(i)
Do Until BP >= SP
BP = BP + bstep
SP = SP - sstep
Loop
Price(i) = SP
Next
listProcess.ListItems.Clear
For i = 1 To rCount
listProcess.ListItems.Add , listResult.ListItems(i).SubItems(2), i
listProcess.ListItems(i).SubItems(1) = listResult.ListItems(i).SubItems(2)
listProcess.ListItems(i).SubItems(2) = listResult.ListItems(i).SubItems(3)
listProcess.ListItems(i).SubItems(3) = Price(i)
Next
End Sub
Private Sub FinalStep()
Dim i As Integer, rCount As Integer
Dim serveValue As Currency
Dim qualityValue As Currency
Dim sellerHighPrice As Currency
ListSum.Sorted = False
rCount = listResult.ListItems.Count
ReDim SumValue(rCount)
For i = 1 To rCount
serveValue = listResult.ListItems(i).SubItems(4)
qualityValue = listResult.ListItems(i).SubItems(5)
sellerHighPrice = txtHighprice
SumValue(i) = serveValue + qualityValue + 5 * Price(i) / sellerHighPrice
Next
ListSum.ListItems.Clear
For i = 1 To rCount
ListSum.ListItems.Add , listResult.ListItems(i).SubItems(2), i
ListSum.ListItems(i).SubItems(1) = listResult.ListItems(i).SubItems(1)
ListSum.ListItems(i).SubItems(2) = listResult.ListItems(i).SubItems(2)
ListSum.ListItems(i).SubItems(3) = Price(i)
ListSum.ListItems(i).SubItems(4) = listResult.ListItems(i).SubItems(4)
ListSum.ListItems(i).SubItems(5) = listResult.ListItems(i).SubItems(5)
ListSum.ListItems(i).SubItems(6) = SumValue(i)
Next
ListSum.Sorted = True
ListSum.SortKey = 6
ListSum.SortOrder = lvwDescending
End Sub
Private Sub listResult_Click()
If listResult.ListItems.Count > 0 Then
SelectedSeller = listResult.SelectedItem.SubItems(1)
cmdNext.Enabled = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -