?? frmreturn1.frm
字號:
VERSION 5.00
Begin VB.Form frmReturn1
Caption = "還書信息"
ClientHeight = 5184
ClientLeft = 48
ClientTop = 348
ClientWidth = 6516
LinkTopic = "Form1"
ScaleHeight = 5184
ScaleWidth = 6516
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame2
Caption = "還書日期"
Height = 732
Left = 480
TabIndex = 14
Top = 3720
Width = 5052
Begin VB.ComboBox cboYear
Height = 288
Index = 0
Left = 1560
Style = 2 'Dropdown List
TabIndex = 17
Top = 240
Width = 765
End
Begin VB.ComboBox cboMonth
Height = 288
Index = 0
Left = 2760
Style = 2 'Dropdown List
TabIndex = 16
Top = 240
Width = 645
End
Begin VB.ComboBox cboDay
Height = 288
Left = 3840
Style = 2 'Dropdown List
TabIndex = 15
Top = 240
Width = 612
End
Begin VB.Label Label1
Caption = "請設(shè)置還書時間："
Height = 216
Index = 0
Left = 240
TabIndex = 21
Top = 240
Width = 2400
End
Begin VB.Label Label1
Caption = "月"
Height = 216
Index = 2
Left = 3480
TabIndex = 20
Top = 240
Width = 240
End
Begin VB.Label Label1
Caption = "年"
Height = 216
Index = 1
Left = 2400
TabIndex = 19
Top = 240
Width = 240
End
Begin VB.Label Label1
Caption = "日"
Height = 216
Index = 7
Left = 4560
TabIndex = 18
Top = 240
Width = 120
End
End
Begin VB.CommandButton cmdSave
Caption = "保存 (&S)"
Height = 375
Left = 2280
TabIndex = 8
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmdExit
Caption = "返回 (&X)"
Height = 375
Left = 4200
TabIndex = 7
Top = 4680
Width = 1215
End
Begin VB.Frame Frame1
Caption = "借書信息"
Height = 3372
Left = 120
TabIndex = 1
Top = 120
Width = 6252
Begin VB.TextBox txtItem
Height = 1920
Index = 0
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 13
Top = 1320
Width = 6012
End
Begin VB.ComboBox cboItem
Height = 288
Index = 0
Left = 960
Style = 2 'Dropdown List
TabIndex = 5
Top = 240
Width = 2175
End
Begin VB.ComboBox cboItem
Height = 288
Index = 1
Left = 960
Style = 2 'Dropdown List
TabIndex = 4
Top = 720
Width = 2175
End
Begin VB.ComboBox cboItem
Height = 288
Index = 2
Left = 3960
Style = 2 'Dropdown List
TabIndex = 3
Top = 240
Width = 2175
End
Begin VB.ComboBox cboItem
Height = 288
Index = 3
Left = 3960
Style = 2 'Dropdown List
TabIndex = 2
Top = 720
Width = 2175
End
Begin VB.Label Label2
Caption = "借書日期："
Height = 252
Index = 6
Left = 3360
TabIndex = 12
Top = 720
Width = 972
End
Begin VB.Label Label2
Caption = "備 注 信 息："
Height = 252
Index = 7
Left = 120
TabIndex = 11
Top = 1080
Width = 972
End
Begin VB.Label Label2
Caption = "讀者編號："
Height = 252
Index = 4
Left = 120
TabIndex = 10
Top = 240
Width = 972
End
Begin VB.Label Label2
Caption = "讀者姓名："
Height = 252
Index = 5
Left = 120
TabIndex = 9
Top = 720
Width = 972
End
Begin VB.Label Label2
Caption = "書籍名稱："
Height = 252
Index = 0
Left = 3360
TabIndex = 6
Top = 240
Width = 972
End
End
Begin VB.TextBox txtNo
Height = 270
Left = 960
TabIndex = 0
TabStop = 0 'False
Top = 4680
Visible = 0 'False
Width = 735
End
End
Attribute VB_Name = "frmReturn1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改動過記錄，ture為改過
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Dim BookID As String
Private Sub cboItem_Change(Index As Integer)
'有變化設(shè)置gblchange
mblChange = True
End Sub
Private Sub cboItem_Click(Index As Integer)
Dim mrcc As ADODB.Recordset
Dim MsgText As String
If gintBBmode = 1 Then
If Index = 1 Then
txtSQL = "select * from borrowinfo where returndate is null"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
cboItem(0).Clear
cboItem(0).AddItem mrcc!readerid
cboItem(0).ListIndex = 0
cboItem(2).Clear
cboItem(2).AddItem mrcc!bookname
cboItem(2).ListIndex = 0
cboItem(3).Clear
cboItem(3).AddItem mrcc!borrowdate
cboItem(3).ListIndex = 0
txtItem(0) = mrcc.Fields(7)
txtNo = mrcc!borrowno
BookID = mrcc.Fields(3)
End If
mrcc.Close
End If
End If
End Sub
Private Sub cmdSave_Click()
Dim intCount As Integer
Dim sMeg As String
Dim MsgText As String
Dim returnDate As String
Dim mrcd As ADODB.Recordset
Dim bYear As Integer
Dim eYear As Integer
Dim bDays As Integer
Dim eDays As Integer
Dim aDays As Integer
Dim uDays As Integer
If Trim(txtNo) = "" Then
MsgBox "請選擇借書信息！", vbOKOnly + vbExclamation, "警告"
cboItem(1).SetFocus
Exit Sub
End If
returnDate = Format(CDate(cboYear(0) & "-" & cboMonth(0) & "-" & cboDay), "yyyy-mm-dd")
If Trim(returnDate) = "" Then
MsgBox "請選擇還書日期！", vbOKOnly + vbExclamation, "警告"
cboYear(1).SetFocus
Exit Sub
End If
If gintBBmode = 2 Then
txtSQL = "select * from books where bookid = '" & Trim(BookID) & "'"
Set mrcd = ExecuteSQL(txtSQL, MsgText)
If Not mrcd.EOF Then
mrcd!putup = "y"
End If
mrcd.Update
mrcd.Close
End If
txtSQL = "select * from borrowinfo where borrowno = '" & Trim(txtNo) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(6) = Trim(returnDate)
txtSQL = "select * from books where bookid = '" & Trim(BookID) & "'"
Set mrcd = ExecuteSQL(txtSQL, MsgText)
If Not mrcd.EOF Then
mrcd!putup = " "
End If
mrcd.Update
mrcd.Close
End If
mrc.Update
mrc.Close
bYear = DatePart("yyyy", cboItem(3))
eYear = DatePart("yyyy", returnDate)
bDays = DatePart("y", cboItem(3))
eDays = DatePart("y", returnDate)
If bYear = eYear Then
aDays = eDays - bDays
Else
aDays = (eYear - bYear - 1) * 365 + (365 - bDays) + eDays
End If
txtSQL = "select readertype from readers where readerno = '" & Trim(cboItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
sMeg = mrc.Fields(0)
End If
mrc.Close
txtSQL = "select bookdays from readertype where typename = '" & Trim(sMeg) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
uDays = mrc.Fields(0)
End If
mrc.Close
If uDays < aDays Then
MsgBox "過期" & (aDays - uDays) & "天，罰款" & (0.1 * (aDays - uDays)) & "元！", vbOKOnly + vbExclamation, "警告"
End If
If gintBBmode = 1 Then
MsgBox "添加還書信息成功!", vbOKOnly + vbExclamation, "添加借書消息"
Unload Me
If flagBBedit Then
Unload frmReturn
End If
frmReturn.txtSQL = "select * from borrowinfo"
frmReturn.Show
Else
MsgBox "修改還書信息成功!", vbOKOnly + vbExclamation, "修改借書消息"
Unload Me
If flagBBedit Then
Unload frmReturn
End If
frmReturn.txtSQL = "select * from borrowinfo"
frmReturn.Show
End If
End Sub
Private Sub Form_Load()
Dim sSql As String
Dim intCount As Integer
Dim MsgText As String
Dim i As Integer
Dim j As Integer
If gintBBmode = 1 Then
Me.Caption = Me.Caption & "添加"
'初始化客房信息
txtSQL = "select DISTINCT readername from borrowinfo where returndate is null "
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboItem(1).AddItem Trim(mrc.Fields(0))
mrc.MoveNext
Loop
Else
MsgBox "沒人借書！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
mrc.Close
txtSQL = "select distinct datepart(yy,borrowdate) from borrowinfo where returndate is null "
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
With mrc
Do While Not .EOF
cboYear(0).AddItem .Fields(0)
.MoveNext
Loop
End With
cboYear(0).ListIndex = 0
For j = 1 To 12
cboMonth(0).AddItem j
Next j
cboMonth(0).Text = Month(Now())
For j = 1 To 31
cboDay.AddItem j
Next j
cboDay.Text = Day(Now())
Else
cmdSave.Enabled = False
End If
mrc.Close
ElseIf gintBBmode = 2 Then
Me.Caption = Me.Caption & "修改"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
txtNo = mrc!borrowno
For intCount = 0 To 1
cboItem(intCount).Clear
cboItem(intCount).AddItem mrc.Fields(intCount + 1)
cboItem(intCount).ListIndex = 0
Next intCount
BookID = mrc.Fields(3)
For intCount = 2 To 3
cboItem(intCount).Clear
cboItem(intCount).AddItem mrc.Fields(intCount + 2)
cboItem(intCount).ListIndex = 0
Next intCount
txtItem(0) = mrc.Fields(7)
End If
mrc.Close
txtSQL = "select distinct datepart(yy,borrowdate) from borrowinfo where returndate is not null "
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
With mrc
Do While Not .EOF
cboYear(0).AddItem .Fields(0)
.MoveNext
Loop
End With
cboYear(0).ListIndex = 0
For j = 1 To 12
cboMonth(0).AddItem j
Next j
cboMonth(0).Text = Month(Now())
For j = 1 To 31
cboDay.AddItem j
Next j
cboDay.Text = Day(Now())
Else
cmdSave.Enabled = False
End If
mrc.Close
End If
mblChange = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
gintBBmode = 0
End Sub
Private Sub txtItem_Change(Index As Integer)
'有變化設(shè)置gblchange
mblChange = True
End Sub
Private Sub txtItem_GotFocus(Index As Integer)
txtItem(Index).SelStart = 0
txtItem(Index).SelLength = Len(txtItem(Index))
End Sub
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub cmdExit_Click()
If mblChange And cmdSave.Enabled Then
If MsgBox("保存當(dāng)前記錄的變化嗎？", vbOKCancel + vbExclamation, "警告") = vbOK Then
'保存
Call cmdSave_Click
End If
End If
Unload Me
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -