📄 计事本.frm
字号:
VERSION 5.00
Begin VB.Form Form6
Appearance = 0 'Flat
BackColor = &H00C0E0FF&
BorderStyle = 0 'None
Caption = "简单的计事本"
ClientHeight = 7005
ClientLeft = 2880
ClientTop = 1260
ClientWidth = 7590
Icon = "计事本.frx":0000
LinkTopic = "Form6"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7005
ScaleWidth = 7590
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame1
BackColor = &H00D8D7D5&
Caption = "Frame1"
Height = 6135
Left = 240
TabIndex = 0
Top = 600
Width = 7095
Begin VB.Frame Frame3
Appearance = 0 'Flat
BackColor = &H00D8D7D5&
ForeColor = &H80000008&
Height = 1575
Left = 120
TabIndex = 3
Top = 240
Width = 6855
Begin VB.ComboBox Combo3
Appearance = 0 'Flat
Height = 300
Left = 5400
TabIndex = 10
Text = "Combo3"
Top = 720
Width = 855
End
Begin VB.ComboBox Combo2
Appearance = 0 'Flat
Height = 300
Left = 3240
TabIndex = 9
Text = "Combo2"
Top = 720
Width = 855
End
Begin VB.ComboBox Combo1
Appearance = 0 'Flat
Height = 300
Left = 1560
TabIndex = 8
Text = "Combo1"
Top = 720
Width = 855
End
Begin VB.CommandButton Command3
BackColor = &H0080FF80&
Caption = "关 闭"
Height = 375
Left = 5400
Style = 1 'Graphical
TabIndex = 7
Top = 1080
Width = 855
End
Begin VB.CommandButton Command2
BackColor = &H0080FF80&
Caption = "删 除"
Height = 375
Left = 3240
Style = 1 'Graphical
TabIndex = 6
Top = 1080
Width = 855
End
Begin VB.CommandButton Command1
BackColor = &H0080FF80&
Caption = "添 加"
Height = 375
Left = 1560
Style = 1 'Graphical
TabIndex = 5
Top = 1080
Width = 855
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 375
Left = 600
TabIndex = 4
Top = 240
Width = 6135
End
Begin VB.Label Label4
BackColor = &H00C0E0FF&
BackStyle = 0 'Transparent
Caption = "星期："
Height = 255
Left = 4800
TabIndex = 14
Top = 720
Width = 615
End
Begin VB.Label Label3
BackColor = &H00C0E0FF&
BackStyle = 0 'Transparent
Caption = "日："
Height = 375
Left = 2880
TabIndex = 13
Top = 720
Width = 375
End
Begin VB.Label Label2
BackColor = &H00C0E0FF&
BackStyle = 0 'Transparent
Caption = "月："
Height = 255
Left = 1200
TabIndex = 12
Top = 720
Width = 495
End
Begin VB.Label Label1
BackColor = &H00C0E0FF&
BackStyle = 0 'Transparent
Caption = "计事："
Height = 255
Left = 120
TabIndex = 11
Top = 360
Width = 855
End
End
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H00D8D7D5&
Caption = "显示事件："
ForeColor = &H80000008&
Height = 4095
Left = 120
TabIndex = 1
Top = 1920
Width = 6855
Begin VB.ListBox List1
Appearance = 0 'Flat
Height = 3630
Left = 120
TabIndex = 2
Top = 240
Width = 6615
End
End
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "简单的计事本"
ForeColor = &H00FFFFFF&
Height = 375
Left = 2760
TabIndex = 15
Top = 240
Width = 2655
End
Begin VB.Image Image2
Height = 495
Left = 7080
Top = 0
Width = 495
End
Begin VB.Image Image1
Height = 6975
Left = 0
Picture = "计事本.frx":27A2
Stretch = -1 'True
Top = 0
Width = 7575
End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim we As Recordset
Dim nn As String, zyk As Database, zyh As Recordset, zyzd As Field
Dim zytable As TableDef, zyn As Field
Dim s As String
Dim ss As String, sss As String, wsrsgl As Workspace
Dim j As Integer
Dim i As Integer
Dim aa As String
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Sub form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Private Sub Command1_Click()
On Error GoTo bo
Dim wsrsgl As Workspace
Set wsrsgl = DBEngine.Workspaces(0)
If Text1.Text <> "" Then
aa = Combo1.Text & "月" & Combo2.Text & "日" & " 星期" & Combo3.Text & " " & Text1.Text
Else
MsgBox "请输入内容", 36, "提示"
Text1.SetFocus
Exit Sub
End If
Set zyk = OpenDatabase(App.Path & "\database\jsb.mdb")
Set zytable = zyk.TableDefs("记事")
Set zyh = zyk.OpenRecordset("记事")
zyh.AddNew
zyh.Fields("记录内容") = aa
zyh.Update
List1.AddItem aa
Text1.Text = ""
Text1.SetFocus
Exit Sub
bo:
MsgBox "记录内容超过范围!", vbDefaultButton1, "系统提示"
Text1.Text = ""
Text1.SetFocus
End Sub
Private Sub Command2_Click()
On Error GoTo bo
If List1.ListCount <= 0 Then
MsgBox "所有的事件都被删除了！", vbInformation, "提示"
Exit Sub
End If
If List1.Selected(List1.ListIndex) = True Then
Dim db As Database
Dim dbtbale As TableDef
Dim dbre As Recordset
If Dir(App.Path & "\database\jsb.mdb") <> "" Then
Set db = OpenDatabase(App.Path & "\database\jsb.mdb")
Set dbtable = db.TableDefs("记事")
Set dbre = db.OpenRecordset("记事")
For i = 0 To dbre.RecordCount - 1
If dbre.Fields(0) = List1.List(List1.ListIndex) Then
dbre.Delete
'List2.List(List2.ListIndex)
Exit For
End If
dbre.MoveNext
Next
Else
Exit Sub
End If
If List1.ListIndex >= 0 Then
List1.RemoveItem List1.ListIndex
End If
End If
Exit Sub
bo:
MsgBox "所有的事件都被删除了！", vbInformation, "提示"
Text1.SetFocus
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
For i = 1 To 12
Combo1.AddItem i
Next
For i = 1 To 31
Combo2.AddItem i
Next
Combo3.AddItem "一"
Combo3.AddItem "二"
Combo3.AddItem "三"
Combo3.AddItem "四"
Combo3.AddItem "五"
Combo3.AddItem "六"
Combo3.AddItem "天"
a = Weekday(Date)
Combo1.Text = Month(Date)
Combo2.Text = Day(Date)
If a = 1 Then Combo3.Text = "一"
If a = 2 Then Combo3.Text = "二"
If a = 3 Then Combo3.Text = "三"
If a = 4 Then Combo3.Text = "四"
If a = 5 Then Combo3.Text = "五"
If a = 6 Then Combo3.Text = "六"
If a = 7 Then Combo3.Text = "天"
If Dir(App.Path & "\database\jsb.mdb") = "" Then
Set zyk = CreateDatabase(App.Path & "\database\jsb.mdb", dbLangGeneral, dbVersion30)
Set zytable = zyk.CreateTableDef("记事")
Set zyzdd = zytable.CreateField("记录内容", dbText, 200)
zytable.Fields.Append zyzdd
zyk.TableDefs.Append zytable
Else
Set zyk = OpenDatabase(App.Path & "\database\jsb.mdb")
Set zytable = zyk.TableDefs("记事")
Set zyh = zyk.OpenRecordset("记事")
gg = zyh.RecordCount
If gg < 0 Then Exit Sub
For i = 1 To gg
List1.AddItem zyh.Fields(0)
zyh.MoveNext
Next
End If
End Sub
Private Sub Image2_Click()
Unload Me
End Sub
Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -