?? frmretreat.frm
字號:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
Begin VB.Form frmRetreat
BorderStyle = 4 'Fixed ToolWindow
Caption = "退貨登記"
ClientHeight = 4515
ClientLeft = 45
ClientTop = 285
ClientWidth = 7875
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4515
ScaleWidth = 7875
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Frame fraRetreat
Height = 4545
Left = 30
TabIndex = 1
Top = -60
Width = 7815
Begin VB.TextBox txtRID
BackColor = &H00C0FFFF&
Height = 285
Left = 1110
Locked = -1 'True
TabIndex = 14
TabStop = 0 'False
Top = 3578
Width = 1725
End
Begin ComctlLib.ListView lsvList
Height = 2955
Left = 210
TabIndex = 0
Top = 570
Width = 7365
_ExtentX = 12991
_ExtentY = 5212
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327680
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MouseIcon = "frmRetreat.frx":0000
NumItems = 0
End
Begin VB.CommandButton cmdAddRetreat
Caption = "登記到數(shù)據(jù)庫(&L)"
Default = -1 'True
Height = 315
Left = 4710
TabIndex = 6
Top = 3960
Width = 1605
End
Begin VB.CommandButton cmdAddRetreatCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 315
Left = 6330
TabIndex = 7
Top = 3960
Width = 1215
End
Begin VB.TextBox txtDay
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 7050
TabIndex = 5
Top = 3578
Width = 285
End
Begin VB.TextBox txtMonth
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 6510
TabIndex = 4
Top = 3578
Width = 285
End
Begin VB.TextBox txtYear
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5730
TabIndex = 3
Top = 3578
Width = 525
End
Begin VB.TextBox txtRCount
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 3870
TabIndex = 2
Top = 3578
Width = 1005
End
Begin VB.Label lblRID
AutoSize = -1 'True
Caption = "退貨編號:"
Height = 180
Left = 210
TabIndex = 15
Top = 3630
Width = 810
End
Begin VB.Label lblDay
AutoSize = -1 'True
Caption = "日"
Height = 180
Left = 7380
TabIndex = 13
Top = 3630
Width = 180
End
Begin VB.Label lblMonth
AutoSize = -1 'True
Caption = "月"
Height = 180
Left = 6840
TabIndex = 12
Top = 3630
Width = 180
End
Begin VB.Label lblYear
AutoSize = -1 'True
Caption = "年"
Height = 180
Left = 6300
TabIndex = 11
Top = 3630
Width = 180
End
Begin VB.Label lblRDate
AutoSize = -1 'True
Caption = "日期:"
Height = 180
Left = 5190
TabIndex = 10
Top = 3630
Width = 450
End
Begin VB.Label lblRCount
AutoSize = -1 'True
Caption = "數(shù)量:"
Height = 180
Left = 3330
TabIndex = 9
Top = 3630
Width = 450
End
Begin VB.Label lblSelRetreat
AutoSize = -1 'True
Caption = "從已登記的出售交易中退貨: (有 X 的表示不能進行退貨)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 270
TabIndex = 8
Top = 300
Width = 4335
End
End
End
Attribute VB_Name = "frmRetreat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Customer As String
Dim Product As String
Dim model As String
Dim OCount As Long
Dim RCount As Long
Dim ODate As Date
Public clmX As ColumnHeader
Public itmX As ListItem
Public i As Integer
Private Sub SetRetreatID()
Set rdoRS = rdoConn.OpenResultset("select count(r_id) c from retreat")
RowsInTable = rdoRS.rdoColumns("c")
RID = "R" & Format(RowsInTable + 1, "000000000")
txtRID.Text = RID
rdoRS.Close
End Sub
Public Sub IfCanAddRetreat()
Dim CanAddRetreat As Boolean
CanAddRetreat = txtRCount.Text <> "" _
And txtYear.Text <> "" And txtMonth.Text <> "" And txtDay.Text <> ""
If CanAddRetreat Then
cmdAddRetreat.Enabled = True
Else
cmdAddRetreat.Enabled = False
End If
End Sub
Public Sub FillList()
Dim found As Boolean
On Error GoTo ErrorHandle
lsvList.ListItems.Clear
i = 1
Set rdoRS = rdoConn.OpenResultset("select o_id,s_id,p_name,p_model,c_name,o_count,r_count,o_date from store,output,product,customer" _
& " where output.p_id=product.p_id and output.c_id=customer.c_id and store.p_id=product.p_id" _
& " order by o_id", rdUseServer, rdConcurRowver)
With rdoRS
While Not .EOF
Set itmX = lsvList.ListItems.Add(, , "")
If .rdoColumns("r_count") = .rdoColumns("o_count") Then itmX.Text = "X"
itmX.Tag = 7
itmX.SubItems(1) = .rdoColumns("o_id")
itmX.SubItems(2) = .rdoColumns("c_name")
itmX.SubItems(3) = .rdoColumns("p_name")
itmX.SubItems(4) = .rdoColumns("p_model")
itmX.SubItems(5) = .rdoColumns("o_count")
itmX.SubItems(6) = .rdoColumns("r_count")
itmX.SubItems(7) = .rdoColumns("o_date")
.MoveNext
Wend
End With
Exit Sub
ErrorHandle:
ShowErr
End Sub
Private Sub cmdAddRetreat_Click()
Dim found As Boolean
On Error GoTo ErrorHandle
rdoConn.BeginTrans
'向退貨表格添加記錄
Set rdoRS = rdoConn.OpenResultset("select * from retreat", rdUseServer, rdConcurRowver)
With rdoRS
.AddNew
.rdoColumns("r_id") = txtRID.Text
.rdoColumns("o_id") = OID
.rdoColumns("r_count") = CLng(txtRCount.Text)
.rdoColumns("r_date") = CDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtDay.Text)
.Update
End With
rdoRS.Close
'修改銷售表的r_count字段
Set rdoRS = rdoConn.OpenResultset("select r_count " _
& "from output " _
& "where o_id='" & OID & "'", rdUseServer, rdConcurRowver)
With rdoRS
.Edit
.rdoColumns("r_count") = .rdoColumns("r_count") + CLng(txtRCount.Text)
.Update
.Close
End With
'修改業(yè)務員業(yè)績
Set rdoRS = rdoConn.OpenResultset("select b_trades,o_price,r_count " _
& "from businessman,output " _
& "where output.o_id='" & OID & "' and output.b_id=businessman.b_id", _
rdUseServer, rdConcurRowver)
With rdoRS
.Edit
.rdoColumns("b_trades") = .rdoColumns("b_trades") - .rdoColumns("o_price") * CLng(txtRCount.Text)
.Update
.Close
End With
'修改庫存
Set rdoRS = rdoConn.OpenResultset("select * from store", rdUseServer, rdConcurRowver)
With rdoRS
While Not found And Not .EOF
If .rdoColumns("s_id") = SID Then
.Edit
.rdoColumns("s_count") = .rdoColumns("s_count") + CLng(txtRCount.Text)
.Update
found = True
Else
.MoveNext
End If
Wend
End With
rdoRS.Close
rdoConn.CommitTrans
MsgBox "退貨數(shù)據(jù)已登記到數(shù)據(jù)庫。", vbInformation, "Data Manager"
FillList
txtRCount.Text = ""
cmdAddRetreat.Enabled = False
txtRCount.Enabled = False
SetRetreatID
Exit Sub
ErrorHandle:
ShowErr
End Sub
Private Sub cmdAddRetreatCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
txtYear.Text = Year(Now)
txtMonth.Text = Month(Now)
txtDay.Text = Day(Now)
ShowStatus ("退貨登記")
lsvList.View = lvwReport
Set clmX = lsvList.ColumnHeaders.Add(, , , 10)
Set clmX = lsvList.ColumnHeaders.Add(, , "銷售編號", 1000)
Set clmX = lsvList.ColumnHeaders.Add(, , "客戶", 600)
Set clmX = lsvList.ColumnHeaders.Add(, , "商品", 800)
Set clmX = lsvList.ColumnHeaders.Add(, , "型號", 800)
Set clmX = lsvList.ColumnHeaders.Add(, , "數(shù)量", 400)
Set clmX = lsvList.ColumnHeaders.Add(, , "已退貨數(shù)量", 800)
Set clmX = lsvList.ColumnHeaders.Add(, , "日期", 600)
cmdAddRetreat.Enabled = False
txtRCount.Enabled = False
On Error GoTo ErrorHandle
Set rdoConn = New rdoConnection
rdoConn.Connect = ConnectID
rdoConn.EstablishConnection rdDriverNoPrompt, False
SetRetreatID
FillList
Exit Sub
ErrorHandle:
ShowErr
End Sub
Private Sub Form_Unload(Cancel As Integer)
ShowStatus ("")
End Sub
Private Sub lsvList_ItemClick(ByVal Item As ComctlLib.ListItem)
Dim found As Boolean
On Error GoTo ErrorHandle
OID = lsvList.SelectedItem.SubItems(1)
OCount = lsvList.SelectedItem.SubItems(5)
RCount = lsvList.SelectedItem.SubItems(6)
For k = 1 To lsvList.ListItems.Count
If lsvList.ListItems(k).SubItems(5) = lsvList.ListItems(k).SubItems(6) Then
lsvList.ListItems(k).Text = "X"
Else
lsvList.ListItems(k).Text = ""
End If
Next k
found = False
If lsvList.SelectedItem.Text <> "X" Then
lsvList.SelectedItem.Text = "=>"
Set rdoRS = rdoConn.OpenResultset("select o_id,s_id from store,output,product,customer" _
& " where output.p_id=product.p_id and output.c_id=customer.c_id and store.p_id=product.p_id" _
& " order by o_id")
While Not rdoRS.EOF And Not found
If rdoRS.rdoColumns("o_id") = OID Then
found = True
SID = rdoRS.rdoColumns("s_id")
Else
rdoRS.MoveNext
End If
Wend
rdoRS.Close
Else
txtRCount.Enabled = False
Err.Description = "該銷售交易已全部退貨,不能再次退貨。"
Err.Number = 3002
Err.Raise 3002
End If
txtRCount.Enabled = True
Exit Sub
ErrorHandle:
ShowErr
End Sub
Private Sub txtDay_Change()
IfCanAddRetreat
End Sub
Private Sub txtMonth_Change()
IfCanAddRetreat
End Sub
Private Sub txtRCount_Change()
On Error GoTo ErrorHandle
If txtRCount.Text <> "" Then
If CInt(txtRCount.Text) > OCount - RCount Then
Err.Description = "退貨數(shù)量大于交易數(shù)量!"
Err.Number = 3001
Err.Raise 3001
End If
End If
IfCanAddRetreat
Exit Sub
ErrorHandle:
ShowErr
txtRCount.Text = ""
End Sub
Private Sub txtYear_Change()
IfCanAddRetreat
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -