📄 日记.frm
字号:
VERSION 5.00
Begin VB.Form rji
Caption = "我的日记"
ClientHeight = 6270
ClientLeft = 60
ClientTop = 450
ClientWidth = 5820
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6270
ScaleWidth = 5820
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdClose
Caption = "关闭"
Height = 375
Left = 3720
TabIndex = 22
Top = 120
Width = 975
End
Begin VB.TextBox txtShowContent
BackColor = &H8000000F&
BorderStyle = 0 'None
Height = 1215
Left = 840
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 21
Top = 4800
Width = 4695
End
Begin VB.CommandButton cmdModify
Caption = "修改日记"
Height = 375
Left = 2640
TabIndex = 20
Top = 3120
Width = 975
End
Begin VB.TextBox txtDate
Height = 270
Left = 960
TabIndex = 13
Top = 240
Width = 1335
End
Begin VB.CommandButton cmdSearch
Caption = "查找日记"
Height = 375
Left = 2520
TabIndex = 12
Top = 120
Width = 975
End
Begin VB.CommandButton cmdWrite
Caption = "写日记"
Height = 375
Left = 1200
TabIndex = 11
Top = 3120
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "保存日记"
Height = 375
Left = 4080
TabIndex = 10
Top = 3120
Width = 975
End
Begin VB.TextBox txtContent
Height = 2055
Left = 960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 960
Width = 4575
End
Begin VB.OptionButton optWeather
Caption = "多云转晴"
Height = 180
Index = 5
Left = 4440
TabIndex = 7
Top = 600
Width = 1095
End
Begin VB.OptionButton optWeather
Caption = "晴转多云"
Height = 180
Index = 4
Left = 3360
TabIndex = 6
Top = 600
Width = 1095
End
Begin VB.OptionButton optWeather
Caption = "雪"
Height = 180
Index = 3
Left = 2760
TabIndex = 5
Top = 600
Width = 495
End
Begin VB.OptionButton optWeather
Caption = "雨"
Height = 180
Index = 2
Left = 2160
TabIndex = 4
Top = 600
Width = 495
End
Begin VB.OptionButton optWeather
Caption = "阴"
Height = 180
Index = 1
Left = 1560
TabIndex = 3
Top = 600
Width = 495
End
Begin VB.OptionButton optWeather
Caption = "晴"
Height = 180
Index = 0
Left = 960
TabIndex = 2
Top = 600
Value = -1 'True
Width = 495
End
Begin VB.Label lblShowWeather
Height = 255
Left = 840
TabIndex = 19
Top = 4440
Width = 1215
End
Begin VB.Label lblShowDate
Height = 255
Left = 840
TabIndex = 18
Top = 4080
Width = 1335
End
Begin VB.Label lblOldContent
Caption = "内容："
Height = 255
Left = 240
TabIndex = 17
Top = 4800
Width = 615
End
Begin VB.Label lblOldWeather
Caption = "天气："
Height = 255
Left = 240
TabIndex = 16
Top = 4440
Width = 615
End
Begin VB.Label lblOldDate
Caption = "日期："
Height = 255
Left = 240
TabIndex = 15
Top = 4080
Width = 615
End
Begin VB.Label Label4
Caption = "最 近 日 记"
Height = 255
Left = 2400
TabIndex = 14
Top = 3720
Width = 1095
End
Begin VB.Line Line2
BorderColor = &H80000005&
X1 = 0
X2 = 5760
Y1 = 3620
Y2 = 3620
End
Begin VB.Line Line1
BorderColor = &H80000010&
X1 = 0
X2 = 5760
Y1 = 3600
Y2 = 3600
End
Begin VB.Label lblContent
Caption = "内容："
Height = 255
Left = 240
TabIndex = 8
Top = 960
Width = 615
End
Begin VB.Label lblWeather
Caption = "天气："
Height = 255
Left = 240
TabIndex = 1
Top = 600
Width = 615
End
Begin VB.Label lblDate
Caption = "日期："
Height = 255
Left = 240
TabIndex = 0
Top = 240
Width = 615
End
End
Attribute VB_Name = "rji"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Weather As Integer
Dim DiaryID As Integer
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdModify_Click()
If Trim(txtDate.Text) <> "" Or Trim(txtContent.Text) <> "" Then
sql = "Select * from [个人日记] where [diary_id]=" & DiaryID
rs.Open sql, conn, 1, 3
rs.Fields("diary_date") = txtDate.Text
If optWeather(0).Value = True Then
Weather = 0
ElseIf optWeather(1).Value = True Then
Weather = 1
ElseIf optWeather(2).Value = True Then
Weather = 2
ElseIf optWeather(3).Value = True Then
Weather = 3
ElseIf optWeather(4).Value = True Then
Weather = 4
ElseIf optWeather(5).Value = True Then
Weather = 5
End If
rs.Fields("diary_weather") = Weather
rs.Fields("diary_content") = txtContent.Text
rs.Update
rs.Close
Set rs = Nothing
cmdWrite.Enabled = True
cmdModify.Enabled = False
cmdSave.Enabled = False
MsgBox "修改成功！", vbOKOnly + vbInformation, App.Title
Else
MsgBox "请把日记内容填写完整才能修改！"
End If
End Sub
Private Sub cmdWrite_Click()
cmdWrite.Enabled = False
cmdModify.Enabled = False
cmdSave.Enabled = True
txtDate.Text = Date
txtContent.Text = ""
txtContent.SetFocus
End Sub
Private Sub cmdSave_Click()
If Trim(txtDate.Text) = "" Or Trim(txtContent.Text) = "" Then
MsgBox "请把日记内容填写完整才能保存！"
Else
sql = "Select * from [个人日记] where [diary_date]=#" & txtDate.Text & "# and [id]=" & ID
rs.Open sql, conn, 1, 3
If rs.Fields("diary_date") = Date Then
MsgBox "今天的日记已经写过了！", vbOKOnly + vbExclamation, App.Title
rs.Close
Set rs = Nothing
Exit Sub
End If
If rs.EOF = False Then
MsgBox txtDate.Text & " 的日记已经写过了！", vbOKOnly + vbExclamation, App.Title
rs.Close
Set rs = Nothing
Exit Sub
End If
rs.AddNew
rs.Fields("id") = ID
rs.Fields("diary_date") = txtDate.Text
If optWeather(0).Value = True Then
Weather = 0
ElseIf optWeather(1).Value = True Then
Weather = 1
ElseIf optWeather(2).Value = True Then
Weather = 2
ElseIf optWeather(3).Value = True Then
Weather = 3
ElseIf optWeather(4).Value = True Then
Weather = 4
ElseIf optWeather(5).Value = True Then
Weather = 5
End If
rs.Fields("diary_weather") = Weather
rs.Fields("diary_content") = txtContent.Text
rs.Update
rs.Close
Set rs = Nothing
MsgBox "今天的日记成功保存了！", vbOKOnly + vbInformation, App.Title
Unload Me
End If
End Sub
Private Sub cmdSearch_Click()
If Trim(txtDate.Text) = "" Then
MsgBox "请输入要查询日记的日期！"
txtDate.SetFocus
Exit Sub
ElseIf IsDate(txtDate.Text) = False Then
MsgBox "不存在此日期或日期格式不正确！" & vbCr & vbCr & "正确格式示例：2005-8-8"
txtDate.SetFocus
txtDate.SelStart = 0
txtDate.SelLength = Len(txtDate.Text)
Exit Sub
Else
sql = "Select top 1 * from [个人日记] where [diary_date]=#" & txtDate.Text & "# and [id]=" & ID
rs.Open sql, conn, 1, 1
If rs.EOF Then
MsgBox txtDate.Text & " 没有写日记！", vbOKOnly + vbExclamation, App.Title
rs.Close
Set rs = Nothing
Exit Sub
Else
txtDate.Text = rs.Fields("diary_date")
If rs.Fields("diary_weather") = 0 Then
optWeather(0).Value = True
ElseIf rs.Fields("diary_weather") = 1 Then
optWeather(1).Value = True
ElseIf rs.Fields("diary_weather") = 2 Then
optWeather(2).Value = True
ElseIf rs.Fields("diary_weather") = 3 Then
optWeather(3).Value = True
ElseIf rs.Fields("diary_weather") = 4 Then
optWeather(4).Value = True
ElseIf rs.Fields("diary_weather") = 5 Then
optWeather(5).Value = True
End If
txtContent.Text = rs.Fields("diary_content")
DiaryID = rs.Fields("diary_id")
rs.Close
Set rs = Nothing
cmdWrite.Enabled = False
cmdModify.Enabled = True
cmdSave.Enabled = False
End If
End If
End Sub
Private Sub Form_Load()
Call CheckLogin(Me)
Call SetCenter(Me)
Call OpenDB
cmdWrite.Enabled = False
cmdModify.Enabled = False
cmdSave.Enabled = True
txtDate.Text = Date
sql = "Select top 1 * from [个人日记] where [id]=" & ID & " order by diary_date desc"
rs.Open sql, conn, 1, 1
If rs.EOF Then
MsgBox "你还没有写过日记，要坚持每天一记哟！"
Else
lblShowDate.Caption = rs.Fields("diary_date")
If rs.Fields("diary_weather") = 0 Then
lblShowWeather.Caption = "晴"
ElseIf rs.Fields("diary_weather") = 1 Then
lblShowWeather.Caption = "阴"
ElseIf rs.Fields("diary_weather") = 2 Then
lblShowWeather.Caption = "雨"
ElseIf rs.Fields("diary_weather") = 3 Then
lblShowWeather.Caption = "雪"
ElseIf rs.Fields("diary_weather") = 4 Then
lblShowWeather.Caption = "晴转多云"
ElseIf rs.Fields("diary_weather") = 4 Then
lblShowWeather.Caption = "多云转晴"
End If
txtShowContent.Text = rs.Fields("diary_content")
End If
rs.Close
Set rs = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CloseDB
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -