frmmain.frm

简单适用的日记本绝对好用

            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Index           =   4
         Left            =   1785
         TabIndex        =   10
         Top             =   990
         Width           =   195
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "五"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Index           =   5
         Left            =   2145
         TabIndex        =   9
         Top             =   990
         Width           =   195
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "六"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   195
         Index           =   6
         Left            =   2550
         TabIndex        =   8
         Top             =   990
         Width           =   195
      End
      Begin VB.Shape Shape1 
         Height          =   300
         Left            =   180
         Top             =   900
         Width           =   2655
      End
      Begin VB.Line Line1 
         X1              =   555
         X2              =   555
         Y1              =   915
         Y2              =   1170
      End
      Begin VB.Line Line2 
         X1              =   930
         X2              =   930
         Y1              =   900
         Y2              =   1170
      End
      Begin VB.Line Line3 
         X1              =   1335
         X2              =   1335
         Y1              =   900
         Y2              =   1170
      End
      Begin VB.Line Line4 
         X1              =   1695
         X2              =   1695
         Y1              =   900
         Y2              =   1170
      End
      Begin VB.Line Line5 
         X1              =   2055
         X2              =   2055
         Y1              =   900
         Y2              =   1170
      End
      Begin VB.Line Line6 
         X1              =   2460
         X2              =   2460
         Y1              =   900
         Y2              =   1170
      End
      Begin VB.Label lblYear 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "1998年"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C00000&
         Height          =   195
         Left            =   480
         TabIndex        =   7
         Top             =   450
         Width           =   690
      End
      Begin VB.Label lblMonth 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "9月"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C00000&
         Height          =   240
         Left            =   2010
         TabIndex        =   6
         Top             =   450
         Width           =   420
      End
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "天气情况："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4320
      TabIndex        =   20
      Top             =   260
      Width           =   975
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rs As Recordset
Dim CodeField As Field
Dim NameField As Field
Dim IfNull As Boolean
Function FindCode(FindStr As Date) As Boolean
FindCode = False
If Not (Rs.EOF And Rs.BOF) Then
    Rs.MoveFirst
End If
Do While Not Rs.EOF
    If Rs("date") = FindStr Then
        FindCode = True
        Exit Function
    End If
    Rs.MoveNext
Loop
End Function

Private Sub BackMonth_Click()
If Calendar1.Month > 1 Then
    Calendar1.Month = Calendar1.Month - 1
End If
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
End Sub

Private Sub BackYear_Click()
Calendar1.Year = Calendar1.Year - 1
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
End Sub

Private Sub Calendar1_AfterUpdate()
If FindCode(Calendar1.Value) Then
FillTxt
Else
ClearTxt
End If
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
End Sub

Private Sub cmdDel_Click()
Msg = "真的要删除该日记？"   ' 定义信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。
Title = "日记本"  ' 定义标题。
Help = "DEMO.HLP"   ' 定义帮助文件。
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' 用户按下“是”。
With Rs
.Delete
End With
End If
End Sub

Private Sub cmdExit_Click()
Msg = "真的要退出日记本？"   ' 定义信息。
Style = vbYesNo + vbInformation + vbDefaultButton2  ' 定义按钮。
Title = "日记本"  ' 定义标题。
Help = "DEMO.HLP"   ' 定义帮助文件。
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' 用户按下“是”。
Unload Me
End If
End Sub

Private Sub cmdSave_Click()
With Rs
If FindCode(Calendar1.Value) Then
.Edit
Else
.AddNew
End If
!weather = comboWeather.Text
!Memo = txtMemo.Text
!Date = Calendar1.Value
!UserCode = CurrUser
.Update
End With
End Sub

Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Set Rs = Dbs.OpenRecordset("select * from memo where usercode='" & CurrUser & "'")
Calendar1.Value = Now
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
comboWeather.AddItem ("晴")
comboWeather.AddItem ("多云")
comboWeather.AddItem ("阴")
comboWeather.AddItem ("雨")
With Rs
IfNull = FindCode(Calendar1.Value)
End With
If IfNull Then
FillTxt
Else
ClearTxt
End If
Me.Caption = "小小日记本" & Myname
End Sub

Private Sub NextMonth_Click()
If Calendar1.Month < 12 Then
    Calendar1.Month = Calendar1.Month + 1
End If
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
End Sub

Private Sub NextYear_Click()
Calendar1.Year = Calendar1.Year + 1
lblYear.Caption = Calendar1.Year & "年"
lblMonth.Caption = Calendar1.Month & "月"
End Sub

Sub FillTxt()
With Rs
comboWeather.Text = "" & !weather
txtMemo.Text = "" & !Memo
End With
End Sub

Sub ClearTxt()
comboWeather.Text = ""
txtMemo.Text = ""
End Sub