📄 orderdetails.frm
字号:
VERSION 5.00
Object = "{8ED8CCC1-8472-46D0-93E7-F66929B98442}#2.0#0"; "XPCMD.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form Orderdetails
Caption = "Form1"
ClientHeight = 5670
ClientLeft = 1845
ClientTop = 2130
ClientWidth = 9885
LinkTopic = "Form1"
ScaleHeight = 5670
ScaleWidth = 9885
Begin VB.TextBox OrderNoText
Height = 375
Left = 4920
TabIndex = 7
Top = 3840
Width = 1935
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid OrderdetailsGrid
Bindings = "Orderdetails.frx":0000
Height = 2775
Left = 720
TabIndex = 0
Top = 840
Width = 8535
_ExtentX = 15055
_ExtentY = 4895
_Version = 393216
Cols = 9
FixedCols = 0
DataMember = "ComOrderdetails"
_NumberOfBands = 1
_Band(0).Cols = 9
_Band(0)._NumMapCols= 9
_Band(0)._MapCol(0)._Name= "租借号"
_Band(0)._MapCol(0)._RSIndex= 0
_Band(0)._MapCol(1)._Name= "会员ID"
_Band(0)._MapCol(1)._RSIndex= 1
_Band(0)._MapCol(2)._Name= "影片名称"
_Band(0)._MapCol(2)._RSIndex= 2
_Band(0)._MapCol(3)._Name= "影片类型"
_Band(0)._MapCol(3)._RSIndex= 3
_Band(0)._MapCol(4)._Name= "数量"
_Band(0)._MapCol(4)._RSIndex= 4
_Band(0)._MapCol(4)._Alignment= 7
_Band(0)._MapCol(5)._Name= "租借日期"
_Band(0)._MapCol(5)._RSIndex= 5
_Band(0)._MapCol(6)._Name= "应归还日期"
_Band(0)._MapCol(6)._RSIndex= 6
_Band(0)._MapCol(7)._Name= "实际归还日期"
_Band(0)._MapCol(7)._RSIndex= 7
_Band(0)._MapCol(8)._Name= "固定租金"
_Band(0)._MapCol(8)._RSIndex= 8
_Band(0)._MapCol(8)._Alignment= 7
End
Begin VB.Frame Frame1
Height = 1095
Left = 720
TabIndex = 1
Top = 4320
Width = 8535
Begin XPCmd.xpcmdbutton RefreshBT
Height = 495
Left = 3720
TabIndex = 9
Top = 360
Width = 1215
_ExtentX = 2143
_ExtentY = 873
Caption = " 刷 新"
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 XPCmd.xpcmdbutton xpcmdbutton1
Height = 495
Left = 7080
TabIndex = 3
Top = 360
Width = 1215
_ExtentX = 2143
_ExtentY = 873
Caption = " 离 开"
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 XPCmd.xpcmdbutton CancelBT
Height = 495
Left = 5400
TabIndex = 4
Top = 360
Width = 1215
_ExtentX = 2143
_ExtentY = 873
Caption = " 取 消"
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 XPCmd.xpcmdbutton DelteBT
Height = 495
Left = 1920
TabIndex = 5
Top = 360
Width = 1215
_ExtentX = 2143
_ExtentY = 873
Caption = " 删 除"
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 XPCmd.xpcmdbutton okBT
Height = 495
Left = 240
TabIndex = 6
Top = 360
Width = 1215
_ExtentX = 2143
_ExtentY = 873
Caption = " 确 定"
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
End
Begin VB.Label Label2
Caption = "您的租借ID号："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 2640
TabIndex = 8
Top = 3840
Width = 2010
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "租借信息"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 315
Left = 4080
TabIndex = 2
Top = 240
Width = 1260
End
End
Attribute VB_Name = "Orderdetails"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim com As Command
Dim rst As Recordset
Dim id, trueid, memid, vcdname, tablename, remoney, zhmoney, tbname As String
Private Sub CancelBT_Click()
rst.Open "delete orderdetails", con, adOpenDynamic, adLockBatchOptimistic
Unload Me
End Sub
Private Sub DelteBT_Click()
zhmoney = VCDView.MoneyListText.Text
MsgBox id
trueid = "00" & id + 1
MsgBox "00" & id + 1
Dim a As Integer
a = MsgBox("确定要删除第" & id + 1 & "条记录吗？！", vbYesNo, "提示信息")
'rst.Close
rst.Open "select * from orderdetails", con, adOpenDynamic, adLockBatchOptimistic
If a = 6 Then
'On Error GoTo err
'rst.Open "delete orderdetails where corderno='" & trueid & "'", con, adOpenDynamic, adLockBatchOptimistic
rst.Move (id)
rst.Delete
'rst.MoveNext
On Error GoTo err
If rst.EOF Then rst.MoveLast
rst.Close
MsgBox "信息删除成功！"
OrdertailsData.rsComOrderdetails.Requery
Set OrderdetailsGrid.DataSource = OrdertailsData
'On Error GoTo err
OrderdetailsGrid.Row = trueid
OrderdetailsGrid.Col = 1
memid = Trim(OrderdetailsGrid.Text)
MsgBox memid
OrderdetailsGrid.Col = 2
vcdname = Trim(OrderdetailsGrid.Text)
MsgBox vcdname
OrderdetailsGrid.Col = 3
tablename = Trim(OrderdetailsGrid.Text)
MsgBox tablename
Select Case tablename
Case "爱情"
tbname = "love"
Case "喜剧"
tbname = "comedy"
Case "卡通"
tbname = "cartoon"
Case "科幻"
tbname = "science"
Case "冒险"
tbname = "venture"
Case "动作"
tbname = "action"
Case "艺术"
tbname = "art"
Case "战争"
tbname = "war"
Case "广告"
tbname = "advertisement"
Case "恐怖"
tbname = "terror"
End Select
MsgBox tbname
OrderdetailsGrid.Col = 8
remoney = Trim(OrderdetailsGrid.Text)
MsgBox remoney
rst.Open "update " & tbname & " set istock=istock+1 where cname='" & vcdname & "'", con, adOpenDynamic, adLockBatchOptimistic
MsgBox "库存回复！"
VCDView.MoneyListText.Text = CDbl(remoney) + CDbl(zhmoney)
'rst.Open "update member set mmoney=mmoney+" & CInt(remoney) & " where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
MsgBox "账户回复！"
OrdertailsData.rsComOrderdetails.Requery
Set OrderdetailsGrid.DataSource = OrdertailsData
Else
Orderdetails.Show
rst.Close
End If
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub Form_Load()
Set com = New Command
Set rst = New Recordset
com.ActiveConnection = con
'rst.Open "select * from orderdetails", con, adOpenDynamic, adLockBatchOptimistic
OrdertailsData.rsComOrderdetails.Requery
Set OrderdetailsGrid.DataSource = OrdertailsData
OrderNoText.Text = VCDView.RentID.Text
With OrderdetailsGrid
.ColWidth(0) = 800
.ColWidth(1) = 800
.ColWidth(2) = 2000
.ColWidth(3) = 800
.ColWidth(4) = 500
.ColWidth(5) = 1000
.ColWidth(6) = 1000
.ColWidth(7) = 1000
.ColWidth(8) = 450
End With
End Sub
Private Sub OKBT_Click()
Dim a, cNO As String
a = MsgBox("请确定您要租借的以上影片是否正确！正确按是，要修改按否", vbYesNo, "系统提示")
If a = 6 Then
'addid
'cNO = OrderNoText.Text
'rst.Open "insert orders (corderno) values ('" & cNO & "')", con, adOpenDynamic, adLockBatchOptimistic
'rst.Close
rst.Open "insert into orders select * from orderdetails ", con, adOpenDynamic, adLockBatchOptimistic
MsgBox "您的租借信息已保存！请于两天后归还，如不按时归还，将从您的帐户扣去0.1元/盘/天！如果还要租借，请重新登陆！"
'rst.Close
rst.Open "delete orderdetails", con, adOpenDynamic, adLockBatchOptimistic
MsgBox "orderdetails删除成功！"
DelteBT.Enabled = False
Unload Me
Else
Orderdetails.Show
End If
End Sub
Private Sub OrderdetailsGrid_Click()
OrderdetailsGrid.Refresh
rows = OrderdetailsGrid.Row
MsgBox rows
id = VCDAdd.getid(rows - 2)
MsgBox id
OrdertailsData.rsComOrderdetails.Requery
Set OrderdetailsGrid.DataSource = OrdertailsData
'On Error GoTo err
'rst.Open
'rst.Move (id)
'Call display
'rst.Close
'Exit Sub
'err:
'MsgBox "数据表为空！没有记录可以显示！"
'MsgBox err.Description
'rst.Close
End Sub
Private Sub RefreshBT_Click()
OrdertailsData.rsComOrderdetails.Requery
Set OrderdetailsGrid.DataSource = OrdertailsData
End Sub
Private Sub xpcmdbutton1_Click()
Unload Me
End Sub
Public Sub addid()
Dim orderid As String
'Dim rst As Recordset
'Set rst = New Recordset
'On Error GoTo err
'com.ActiveConnection = con
rst.Open "select cOrderNo from orders", con, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
orderid = "00001"
Else
orderid = getid(Trim(rst!cOrderNo))
rst.MoveNext
Do While rst.EOF = False
If orderid = Trim(rst!cOrderNo) Then
orderid = getid(Trim(rst!cOrderNo))
rst.MoveNext
Else
Exit Do
End If
Loop
End If
OrderNoText.Text = orderid
'rst.MoveFirst
rst.Close
Exit Sub
err:
MsgBox "数据库还未连接！"
Unload Me
End Sub
Private Function getid(temp As String)
temp = temp + 1
If temp < 10 Then
getid = "0000" & temp
Exit Function
End If
If temp < 100 Then
getid = "000" & temp
Exit Function
End If
If temp < 1000 Then
getid = "00" & temp
Exit Function
End If
If temp < 10000 Then
getid = "0" & temp
Exit Function
Else
getid = temp
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -