日记窗口.frm

一个桌面记事本 很方便使用 可以记日记

    Case 4
    Combo1.Text = "04月"
    Combo3.Text = "阴有雨"
    Case 5
    Combo1.Text = "05月"
    Combo3.Text = "阵雨"
    Case 6
    Combo1.Text = "06月"
    Combo3.Text = "晴"
    Case 7
    Combo1.Text = "07月"
    Combo3.Text = "炎热"
    Case 8
    Combo1.Text = "08月"
    Combo3.Text = "舒适"
    Case 9
    Combo1.Text = "09月"
    Combo3.Text = "阴转晴"
    Case 10
    Combo1.Text = "10月"
    Combo3.Text = "晴转阴"
    Case 11
    Combo1.Text = "11月"
    Combo3.Text = "凉快"
    Case 12
    Combo1.Text = "12月"
    Combo3.Text = "阴凉"
End Select
For i = 1 To 31
If i = a And i < 10 Then
Combo2.Text = "0" & i & "日"
Else
If i = a Then Combo2.Text = i & "日"
End If
Next

Filenamex1 = Text1.Text & "年" & Combo1.Text & Combo2.Text
If MsgBox("添加日记日期为：" & Filenamex1 & "[按确定YES继续，按否NO选定其他日期！]", vbYesNo) = vbNo Then Exit Sub
If Trim$(Filenamex1) = vbNullString Then MsgBox "你取消了当前操作！": Exit Sub

RichTextBox1.Text = vbNullString
RichTextBox1.Enabled = True
List1.Enabled = False
Command2.Enabled = False
Text1.Enabled = False
Combo1.Enabled = False
Combo2.Enabled = False

End Sub

Private Sub command3_Click()
Dim Mytext As String
Filenamex1 = Text1.Text & "年" & Combo1.Text & Combo2.Text
If Len(RichTextBox1.Text) < 8 Then MsgBox "日记内容少于8字，不能保存该日记。": Exit Sub
If Right$(Filenamex1, 4) = ".gui" Then Filenamex1 = Pathh & "\" & Filenamex1 Else Filenamex1 = Pathh & Filenamex1 & ".gui"
FalX = True
If FileExists(Filenamex1) = True Then

If Left$(Trim$(RichTextBox1.Text), 9) <> Left$(Text1.Text & "年" & Combo1.Text & Combo2.Text, 9) Then RichTextBox1.Text = Text1.Text & "年" & Combo1.Text & Combo2.Text & "  天气:" & Combo3.Text & "                                        " & RichTextBox1.Text
If MsgBox("警告：当日的日记已经存在！你决定修改此日期的日记吗？", vbYesNo) = vbNo Then Exit Sub
intForm = 9
intTo = Len(RichTextBox1.Text)
getseed (Password1)
mi
Else
If Left$(Trim$(RichTextBox1.Text), 9) <> Left$(Text1.Text & "年" & Combo1.Text & Combo2.Text, 9) Then RichTextBox1.Text = Text1.Text & "年" & Combo1.Text & Combo2.Text & "  天气:" & Combo3.Text & "                                        " & RichTextBox1.Text

intForm = 9
intTo = Len(RichTextBox1.Text)
getseed (Password1)
mi
End If
Text1.Enabled = True
Combo1.Enabled = True
Combo2.Enabled = True
List1.Enabled = True
Command2.Enabled = True
w = vbNullString
Form_Activate
bye:
Form6.MousePointer = 1
dirty = False
Exit Sub
End Sub

Private Sub command4_Click()
If List1.Text = vbNullString Then Exit Sub
If MsgBox("你确定要删除当天日记吗？", vbYesNo) = vbNo Then Exit Sub
Kill Pathh & "\" & List1.Text & ".gui"
Form_Activate
End Sub

Private Sub command5_Click()
If RichTextBox1.Enabled = False Then Exit Sub
RichTextBox1.Text = RichTextBox1.Text & Time
End Sub

Private Sub command6_Click()
If RichTextBox1.Text = vbNullString Then Exit Sub
Command6.Enabled = False
Command3.Enabled = False
Command2.Enabled = False
Command4.Enabled = False

xxxx.Enabled = False
Command7.Enabled = True
Command7.SetFocus
RichTextBox1.Font.Size = 4
End Sub

Private Sub command7_Click()
Command6.Enabled = True
Command3.Enabled = True
Command3.SetFocus
Command2.Enabled = True
Command4.Enabled = True
xxxx.Enabled = True
Command7.Enabled = False
RichTextBox1.Font.Size = 9
End Sub

Private Sub command8_Click()
MsgBox "本程序会根据用户密码对各自的日记进行加密，而且各用户密码亦作加密之后保存于数据库文件中，使用方法亦通俗易懂。按F3可以改变字体大小至肉眼几乎看不清楚的大小以防在写日记时旁人看到日记内容，按“隐藏日记内容”按钮则可将字体改到让自己都看不清的字体，只有写日记者本身知道已经输入的内容。用者可放心使用本软件；更详细的使用方法自己寻找，我就无须再作哆嗦；此软件由本皇爷个人编制！若有任何的提议或指教可联系[e-mail] 或QQ:282449283。"
End Sub

Private Sub command9_Click()
RichTextBox1.Text = vbNullString
End Sub

Private Sub delete001_Click()
command4_Click
End Sub

Private Sub exit001_Click()
Unload Me
End Sub

Private Sub Form_Activate()
Label5.Caption = vbNullString
Dim a As Long, i%
a = Val(Mid(Date, 8, 3))
If a < 0 Then a = -a
Text1.Text = Mid(Date, 1, 4)
RichTextBox1.Text = vbNullString
Select Case Val(Mid(Date, 6, 2))
    Case 1
    Combo1.Text = "01月"
    Combo3.Text = "寒冷"
    Case 2
    Combo1.Text = "02月"
    Combo3.Text = "冷"
    Case 3
    Combo1.Text = "03月"
    Combo3.Text = "小雨"
    Case 4
    Combo1.Text = "04月"
    Combo3.Text = "阴有雨"
    Case 5
    Combo1.Text = "05月"
    Combo3.Text = "阵雨"
    Case 6
    Combo1.Text = "06月"
    Combo3.Text = "晴"
    Case 7
    Combo1.Text = "07月"
    Combo3.Text = "炎热"
    Case 8
    Combo1.Text = "08月"
    Combo3.Text = "舒适"
    Case 9
    Combo1.Text = "09月"
    Combo3.Text = "阴转晴"
    Case 10
    Combo1.Text = "10月"
    Combo3.Text = "晴转阴"
    Case 11
    Combo1.Text = "11月"
    Combo3.Text = "凉快"
    Case 12
    Combo1.Text = "12月"
    Combo3.Text = "阴凉"
End Select
For i = 1 To 31
If i = a And i < 10 Then
Combo2.Text = "0" & i & "日"
Else
If i = a Then Combo2.Text = i & "日"
End If
Next
'创建日记列表
Dim l As Long
List1.Clear
Dim sfile As String
i = 2
'判断是否要加上“\”

Pathh = Pathh & "\"

sfile = Dir$(Pathh & "*.gui", vbHidden + vbSystem + vbReadOnly + vbDirectory)
While sfile <> vbNullString
    If sfile = "." Or sfile = ".." Then List1.Clear
    If Len(sfile) > 4 Then List1.AddItem Left$(sfile, Len(sfile) - 4)
    sfile = Dir$
Wend
If List1.ListCount = 0 Then RichTextBox1.Text = "没有记录日记，请添加。": RichTextBox1.Enabled = False
'MsgBox List1.ListCount - 1
Form6.Caption = "[" & frmLogin.Text4.Text & "]的日记。" & "你一共有[" & List1.ListCount & "]篇日记"
Form6.Width = 0
Timer2.Enabled = True
If RichTextBox1.Enabled = True Then RichTextBox1.SetFocus
End Sub

Private Sub Form_Load()
Me.Icon = frmLogin.Icon
Wid = 7
If Dir$(Pathh, vbDirectory) = "" Then MkDirs (Pathh)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And xxxx.Enabled = True Then PopupMenu xxxx, vbpopupmenucentralalign
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
Unload frmLogin
End Sub

Private Sub igpw1_Click()
RichTextBox1.Text = vbNullString
End Sub

Private Sub ivue1_Click()
command5_Click
End Sub

Private Sub IYUJ001_Click()
MsgBox "注意，此软件未支持繁体或某特殊的字符。", vbOKOnly, "注意事项。"
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And xxxx.Enabled = True Then PopupMenu xxxx, vbpopupmenucentralalign
End Sub

Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And xxxx.Enabled = True Then PopupMenu xxxx, vbpopupmenucentralalign
End Sub

Private Sub lfgc1_Click()
command1_Click
End Sub

Private Sub List1_Click()
FalX = False
Dim Mytext As String
Dim w
Filenamex1 = List1.Text & ".gui"
Filenamex1 = Pathh & Filenamex1
Open Filenamex1 For Input As #1
RichTextBox1 = vbNullString
While Not EOF(1)
Line Input #1, w

RichTextBox1.Text = RichTextBox1.Text + w + Chr(13) + Chr(10)
Wend
Close #1
intForm = 9
intTo = Len(RichTextBox1.Text) - 3
getseed (Password1)
mi
bye:
Form6.MousePointer = 1
dirty = False
w = vbNullString
Label5.Caption = List1.ListIndex + 1 & "/" & List1.ListCount
Text1.Text = Left$(List1.Text, 4)
If Right$(Mid(List1.Text, 6, 2), 1) = "月" Then Combo1.Text = Mid(List1.Text, 6, 2) Else Combo1.Text = Mid(List1.Text, 6, 3)
If Left$(Right$(List1.Text, 3), 1) = "月" Then Combo2.Text = Right$(List1.Text, 2) Else Combo2.Text = Right$(List1.Text, 3)
If Trim$(Mid(RichTextBox1.Text, 15, 4)) <> vbNullString Then Combo3.Text = Trim$(Mid(RichTextBox1.Text, 14, 6))
If Len(Combo3.Text) > 5 Then Combo3.Text = Right$(Combo3.Text, 4)
If Left$(Combo3.Text, 2) = "气:" Then Combo3.Text = Mid(Combo3.Text, 3, Len(Combo3.Text) - 2)
If Left$(Combo3.Text, 1) = ":" Then Combo3.Text = Mid(Combo3.Text, 2, Len(Combo3.Text) - 1)
If Left$(Combo3.Text, 3) = "天气:" Then Combo3.Text = Mid(Combo3.Text, 4, Len(Combo3.Text) - 3)
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And xxxx.Enabled = True Then PopupMenu xxxx, vbpopupmenucentralalign
End Sub

Private Sub lkty1_Click()
If List1.ListCount = 0 Then Exit Sub
Dim x As Long, i As Long
Dim a() As String
x = List1.ListCount
ReDim a(x) As String
x = 0
sfile = Dir$(Pathh & "*.gui", vbHidden + vbSystem + vbReadOnly + vbDirectory)
While sfile <> vbNullString
    If sfile = "." Or sfile = ".." Then Exit Sub
    If Len(sfile) > 4 Then a(x) = Left$(sfile, Len(sfile) - 4): x = x + 1
    sfile = Dir$
Wend

For i = 0 To x
RichTextBox1.Text = RichTextBox1.Text & a(i) & Chr(13)
Next
End Sub

Private Sub RichTextBox1_Change()
'If Len(RichTextBox1.Text) < 2 Then
End Sub

Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
Dim l As Long
If Tbc = True Then
    l = Len(RichTextBox1.Text)
    RichTextBox1.Text = vbNullString
    For i = 1 To l - 1
        RichTextBox1.Text = RichTextBox1.Text & " "
    Next
    RichTextBox1.Text = RichTextBox1.Text & KeyAscii
Text2.Text = Text2.Text & KeyAscii
End If
End Sub

Private Sub rtty1_Click()
If List1.ListCount = 0 Then Exit Sub
Dim x As Long, i As Long
Dim a() As String
x = List1.ListCount
ReDim a(x) As String
x = 0
sfile = Dir$(Pathh & "*.gui", vbHidden + vbSystem + vbReadOnly + vbDirectory)
While sfile <> vbNullString
    If sfile = "." Or sfile = ".." Then Exit Sub
    If Len(sfile) > 4 Then a(x) = Left$(sfile, Len(sfile) - 4): x = x + 1
    sfile = Dir$
Wend
RichTextBox1.Text = RichTextBox1.Text & "["
For i = 0 To x
RichTextBox1.Text = RichTextBox1.Text & a(i) & " "
Next
RichTextBox1.Text = Left$(RichTextBox1.Text, Len(RichTextBox1.Text) - 2) & "]"
End Sub

Private Sub Save001_Click()
command3_Click
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
If Len(Text1.Text) > 4 Then KeyAscii = 0
If Val(Text1.Text) > 9999 Then Text1.Text = Mid(Date, 1, 4)
End Sub

Private Sub Timer1_Timer()
Label1.Caption = Date & "->" & Time
End Sub

Private Sub Timer2_Timer()
Wid = Wid + 5
If Form6.Width >= 8745 Then Form6.Width = 8745: Timer2.Enabled = False: Exit Sub
Form6.Width = Form6.Width + Wid

End Sub

Private Sub ZZ11_Click()
command2_Click
End Sub

Private Sub zz22_Click()
command3_Click
End Sub

Private Sub zz33_Click()
command4_Click
End Sub

Private Sub zz44_Click()
Unload Me
End Sub

Private Sub zz55_Click()
Me.WindowState = 1
End Sub

Private Sub zz66_Click()
command8_Click
End Sub

Private Sub zz77_Click()
Form_Activate
End Sub