情书生成器.frm

vb编写的情书生成器

Private Sub mnuColorFont_Click()
On Error GoTo err
CommonDialog1.Color = Text1.ForeColor
CommonDialog1.ShowColor
Text1.ForeColor = CommonDialog1.Color
err:
End Sub

Private Sub mnuCopy_Click()
Clipboard.SetText Text1.SelText
End Sub

Private Sub mnuCopyAll_Click()
Clipboard.SetText Text1.Text
End Sub

Private Sub mnuCut_Click()
Clipboard.SetText Text1.SelText
Text1.SelText = ""
End Sub

Private Sub mnuCutAll_Click()
Clipboard.SetText Text1.Text
Text1.Text = ""
End Sub

Private Sub mnuDaMian_Click()
Dim a As String
a = InputBox("请您在这里签个名！", "修改", textF)
If a = "" Then
    Exit Sub
Else
    textF = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub mnuDay_Click()
exitnext = False
If Text1.Visible = True Then loadDayture = True
Unload Me
Day.Show
End Sub

Private Sub mnuDelete_Click()
Text1.SelText = ""
End Sub

Private Sub mnuDeleteAll_Click()
Dim msg As Integer
msg = MsgBox("删除全部内容吗？", 1 + 32, "确认")
If msg = 1 Then Text1.Text = ""
End Sub

Private Sub mnuExit_Click()
exitnext = True
Unload Me
End Sub
Private Sub mnuFanMing_Click()
Dim a As String
a = InputBox("您白雪公主的芳名改过了吗？", "修改", textA)
If a = "" Then
    Exit Sub
Else
    textA = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub mnuFont_Click()
On Error GoTo err
CommonDialog1.Flags = cdlCFScreenFonts + cdlCFEffects
CommonDialog1.Color = Text1.ForeColor
CommonDialog1.FontName = Text1.FontName
CommonDialog1.FontBold = Text1.FontBold
CommonDialog1.FontItalic = Text1.FontItalic
CommonDialog1.FontSize = Text1.FontSize
CommonDialog1.FontUnderline = Text1.FontUnderline
CommonDialog1.FontStrikethru = Text1.FontStrikethru
CommonDialog1.ShowFont
Text1.ForeColor = CommonDialog1.Color
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
Text1.FontSize = CommonDialog1.FontSize
Text1.FontName = CommonDialog1.FontName
Text1.FontUnderline = CommonDialog1.FontUnderline
Text1.FontStrikethru = CommonDialog1.FontStrikethru
Printer.ForeColor = CommonDialog1.Color
Printer.FontBold = CommonDialog1.FontBold
Printer.FontName = CommonDialog1.FontName
Printer.FontItalic = CommonDialog1.FontItalic
Printer.FontSize = CommonDialog1.FontSize
Printer.FontUnderline = CommonDialog1.FontUnderline
Printer.FontStrikethru = CommonDialog1.FontStrikethru
err:
End Sub

Private Sub mnuFrint_Click()
Printer.Print Text1.Text
Printer.EndDoc
End Sub


Private Sub mnuMoReng_Click()
Text1.FontName = "楷体_GB2312"
Text1.ForeColor = &H80000008
Text1.BackColor = &H80000005
Text1.FontSize = 12
Text1.FontBold = False
Text1.FontItalic = False
Text1.FontUnderline = False
Text1.FontStrikethru = False
End Sub

Private Sub mnuNewLove_Click()
Dim msg As Integer
If 内容 = Text1.Text Then
go1:
    exitnext = False
    Unload Me
    Form1.Show
    Exit Sub
Else
    msg = MsgBox("内容已修改，是否保存？", 4 + 32, "确认")
    If msg = 7 Then
        GoTo go1
    Else
        mnuSave_Click
        GoTo go1
    End If
End If
End Sub

Private Sub mnuNewText_Click()
Dim msg As Integer
If 内容 = Text1.Text Then
go1:
    Text1.Text = ""
    open1 = False
    Exit Sub
Else
    msg = MsgBox("内容已修改，是否保存？", 4 + 32, "确认")
    If msg = 7 Then
        GoTo go1
    Else
        mnuSave_Click
        GoTo go1
    End If
End If
End Sub

Private Sub mnuOpen_Click()
On Error GoTo err
If 内容 = Text1.Text Then
err1:
    CommonDialog1.DialogTitle = "打开情书"
    CommonDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
    CommonDialog1.ShowOpen
    Open CommonDialog1.filename For Input As #1
    Dim a As String
    Do While Not EOF(2)
        a = a & Input(1, #2)
    Loop
    Text1.Text = a
    Close (1)
    内容 = Text1.Text
    open1 = True
Else
    Dim msg As Integer
    msg = MsgBox("内容已修改，是否保存？", 3 + 32, "确认")
    If msg = 2 Then
        GoTo err
    ElseIf msg = 6 Then
        mnuSave_Click
    Else
        Exit Sub
    End If
End If
err:
End Sub

Private Sub mnuPageset_Click()
On Error GoTo err
CommonDialog1.ShowPrinter
CommonDialog1.Copies = 1
err:
End Sub

Private Sub mnuSave_Click()
On Error GoTo err
If open1 = True Then
    Open CommonDialog1.filename For Output As #1
    Print #1, Text1.Text
    Close (1)
    内容 = Text1.Text
Else
    mnuSaveAs_Click
End If
err:
End Sub

Private Sub mnuSaveAs_Click()
On Error GoTo err
CommonDialog1.DialogTitle = "另存情书为"
CommonDialog1.Flags = &H2
CommonDialog1.ShowSave
Open CommonDialog1.filename For Output As #1
Print #1, Text1.Text
Close (1)
内容 = Text1.Text
open1 = True
err:
End Sub

Private Sub mnuStart_Click()
Label1.Visible = False
Text1.Visible = True
mnuStart.Enabled = False
mnuOpen.Enabled = True
mnuNewText.Enabled = True
mnuCut.Enabled = True
mnuCopy.Enabled = True
mnuDelete.Enabled = True
mmnupaste.Enabled = True
mnuCutAll.Enabled = True
mnuDeleteAll.Enabled = True
mnuCheckAll.Enabled = True
mnuColor1.Enabled = True
mnuFont1.Enabled = True
mnuTime.Enabled = True
mnuStop.Enabled = True
End Sub

Private Sub mnuStop_Click()
Label1.Caption = Text1.Text
Label1.FontBold = Text1.FontBold
Label1.FontItalic = Text1.FontItalic
Label1.FontUnderline = Text1.FontUnderline
Label1.FontStrikethru = Text1.FontStrikethru
Text1.Visible = False
Label1.Visible = True
mnuStart.Enabled = True
mnuOpen.Enabled = False
mnuNewText.Enabled = False
mnuCut.Enabled = False
mnuCopy.Enabled = False
mnuDelete.Enabled = False
mmnupaste.Enabled = False
mnuCutAll.Enabled = False
mnuDeleteAll.Enabled = False
mnuCheckAll.Enabled = False
mnuColor1.Enabled = False
mnuFont1.Enabled = False
mnuTime.Enabled = False
mnuStop.Enabled = False
End Sub

Private Sub mnuTime_Click()
Text1.SelText = CStr(Now)
End Sub

Private Sub mnuTuofu_Click()
Dim a As String
a = InputBox("您白雪公主今天去理发店了？", "修改", textB)
If a = "" Then
    Exit Sub
Else
    textB = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub mnuXingGang_Click()
Dim a As String
a = InputBox("您白雪公主最性感是...", "修改", textD)
If a = "" Then
    Exit Sub
Else
    textD = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub mnuXingGe_Click()
Dim a As String
a = InputBox("您白雪公主的性格？", "修改", textE)
If a = "" Then
    Exit Sub
Else
    textE = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub mnuYingJing_Click()
Dim a As String
a = InputBox("您白雪公主的眼睛很迷你吧！", "修改", textC)
If a = "" Then
    Exit Sub
Else
    textC = a
End If
加载内容
Text1.Text = 内容
Label1.Caption = 内容
End Sub

Private Sub Timer1_Timer()
If Text1.Text = "" Or Text1.Text = "" Then
    mnuFrint.Enabled = False
Else
    mnuFrint.Enabled = True
End If
End Sub