📄 frmbuyer.frm
字号:
Width = 1095
End
Begin VB.TextBox txtBuyname
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 = "frmBuyer"
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 SelectedSeller 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 = "保存"
Txtbuyname.Enabled = True
txtProduction.Enabled = True
txtServe.Enabled = True
txtQuality.Enabled = True
txtLowprice.Enabled = True
txtHighprice.Enabled = True
txtStep.Enabled = True
Else
SaveBuyerInfo
MsgBox "保存修改,可进行查询！", vbOKOnly Or vbInformation, "买家"
editflag = False
End If
End Sub
Private Sub CmdExit_Click()
End
End Sub
Private Sub cmdGo_Click()
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 Form_Initialize()
Txtbuyname.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 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
LoadBuyerInfo
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 LoadBuyerInfo()
Dim RS
Set RS = CreateObject("ADODB.RecordSet")
StrSQL = "select * from buyerinfo where username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 1
If Not RS.EOF Then
Txtbuyname = RS("buyname")
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 SaveBuyerInfo()
Dim RS
Set RS = CreateObject("ADODB.RecordSet")
StrSQL = "select * from buyerinfo where username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 3
If Not RS.EOF Then
RS("buyname") = Txtbuyname
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 sellerinfo.* from sellerinfo, buyerinfo" & _
" where sellerinfo.production = buyerinfo.production" & _
" and sellerinfo.lowprice <= buyerinfo.highprice" & _
" and sellerinfo.serve >= buyerinfo.serve" & _
" and sellerinfo.quality >= buyerinfo.quality" & _
" and buyerinfo.username = '" & LogonUser & "'"
RS.Open StrSQL, ConnStr, 1, 1
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("sellname")
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
BP = txtLowprice
SP = listResult.ListItems(i).SubItems(6)
bstep = txtStep
sstep = 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 Integer
Dim qualityValue As Integer
Dim sellerHighPrice As Integer
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 = listResult.ListItems(i).SubItems(6)
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)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -