www.pudn.com > love expert.zip > Form1.frm
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00FFC0FF&
BorderStyle = 1 'Fixed Single
Caption = "恋爱专家"
ClientHeight = 5505
ClientLeft = 150
ClientTop = 435
ClientWidth = 7275
ForeColor = &H00C243C2&
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5505
ScaleWidth = 7275
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame7
BackColor = &H00FFC0FF&
Height = 4935
Left = 240
TabIndex = 76
Top = 120
Visible = 0 'False
Width = 5175
Begin VB.TextBox Text8
BackColor = &H00C0FFFF&
Height = 4575
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 77
Top = 240
Width = 4935
End
End
Begin VB.Timer Timer1
Interval = 400
Left = 480
Top = 5040
End
Begin VB.TextBox Text2
Height = 270
Left = 1320
TabIndex = 0
Top = 240
Width = 1215
End
Begin VB.TextBox Text3
Height = 270
Left = 3960
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.Frame Frame1
Height = 255
Left = 0
TabIndex = 25
Top = -220
Width = 7300
End
Begin VB.Frame Frame3
BackColor = &H00FFC0FF&
BorderStyle = 0 'None
Height = 5130
Left = 5760
TabIndex = 26
Top = 0
Width = 1455
Begin VB.Frame Frame5
BackColor = &H00FFC0FF&
BorderStyle = 0 'None
Height = 4440
Left = 120
TabIndex = 27
Top = 5500
Width = 1215
Begin VB.Label Label39
BackColor = &H00FFC0FF&
Caption = "那么，请您来看“爱情知识“"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 3855
Index = 1
Left = 720
TabIndex = 75
Top = 360
Width = 375
End
Begin VB.Label Label39
BackColor = &H00FFC0FF&
Caption = "您想有更多的泡MM 的知识吗？"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 3735
Index = 0
Left = 240
TabIndex = 74
Top = 360
Width = 375
End
End
Begin VB.Frame Frame4
BackColor = &H00FFC0FF&
BorderStyle = 0 'None
Height = 3255
Left = 120
TabIndex = 28
Top = 720
Width = 1215
Begin VB.CommandButton Command1
Caption = "生成"
Height = 375
Left = 240
TabIndex = 22
Top = 1680
Width = 735
End
Begin VB.CommandButton Command2
Caption = "清除"
Height = 375
Left = 240
TabIndex = 30
TabStop = 0 'False
Top = 2280
Width = 735
End
Begin VB.CommandButton Command3
Caption = "保存"
Enabled = 0 'False
Height = 375
Left = 240
TabIndex = 24
Top = 2880
Width = 735
End
Begin VB.ListBox List1
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 900
ItemData = "Form1.frx":0442
Left = 0
List = "Form1.frx":0444
TabIndex = 29
TabStop = 0 'False
Top = 480
Width = 1215
End
Begin VB.Label Label9
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "情书种类"
Height = 180
Left = 240
TabIndex = 31
Top = 120
Width = 720
End
End
Begin VB.Shape Shape1
BorderColor = &H00C000C0&
Height = 375
Index = 0
Left = 50
Shape = 4 'Rounded Rectangle
Top = 150
Width = 1370
End
Begin VB.Label Label7
BackColor = &H00FFC0FF&
Caption = " 写情书"
ForeColor = &H000000FF&
Height = 180
Left = 90
MouseIcon = "Form1.frx":0446
MousePointer = 99 'Custom
TabIndex = 33
Top = 255
Width = 1365
End
Begin VB.Shape Shape1
BorderColor = &H00C000C0&
Height = 375
Index = 1
Left = 45
Shape = 4 'Rounded Rectangle
Top = 4680
Width = 1365
End
Begin VB.Label Label8
BackColor = &H00FFC0FF&
Caption = " 爱情知识"
ForeColor = &H000000FF&
Height = 180
Left = 0
MouseIcon = "Form1.frx":0750
MousePointer = 99 'Custom
TabIndex = 32
Top = 4780
Width = 1440
End
End
Begin VB.Frame Frame6
BackColor = &H00FFC0FF&
Caption = "预览"
Height = 2055
Left = 240
TabIndex = 73
Top = 2880
Width = 5175
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
ForeColor = &H000000FF&
Height = 1695
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 23
Top = 240
Width = 4935
End
End
Begin VB.Frame Frame2
BackColor = &H00FFC0FF&
Caption = "资料填写"
Height = 2055
Index = 2
Left = 240
TabIndex = 47
Top = 720
Visible = 0 'False
Width = 5175
Begin VB.TextBox Text6
Height = 270
Index = 0
Left = 2040
TabIndex = 6
Top = 270
Width = 3015
End
Begin VB.TextBox Text6
Height = 270
Index = 1
Left = 2400
TabIndex = 7
Top = 700
Width = 2655
End
Begin VB.TextBox Text6
Height = 270
Index = 2
Left = 2400
TabIndex = 8
Top = 1155
Width = 2655
End
Begin VB.TextBox Text6
Height = 270
Index = 3
Left = 2760
TabIndex = 9
Top = 1610
Width = 2295
End
Begin VB.Label Label31
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "只要一想到她就像："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 51
Top = 315
Width = 1755
End
Begin VB.Label Label32
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您俩认为最浪漫的地方："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 50
Top = 750
Width = 2145
End
Begin VB.Label Label33
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您俩认为最无聊的地方："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 49
Top = 1200
Width = 2145
End
Begin VB.Label Label34
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "若现在你们要看电影，会看："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 48
Top = 1650
Width = 2535
End
End
Begin VB.Frame Frame2
BackColor = &H00FFC0FF&
Caption = "资料填写"
Height = 2055
Index = 3
Left = 240
TabIndex = 57
Top = 720
Visible = 0 'False
Width = 5175
Begin VB.TextBox Text7
Height = 270
Index = 8
Left = 3960
TabIndex = 18
Top = 1680
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 7
Left = 1200
TabIndex = 17
Top = 1680
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 6
Left = 3960
TabIndex = 16
Top = 1320
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 5
Left = 2040
TabIndex = 15
Top = 1320
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 4
Left = 3960
TabIndex = 14
Top = 960
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 3
Left = 1200
TabIndex = 13
Top = 960
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 2
Left = 3960
TabIndex = 12
Top = 600
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 1
Left = 2160
TabIndex = 11
Top = 600
Width = 615
End
Begin VB.TextBox Text7
Height = 270
Index = 0
Left = 2400
TabIndex = 10
Top = 240
Width = 615
End
Begin VB.Label Label30
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 1920
TabIndex = 72
Top = 1725
Width = 195
End
Begin VB.Label Label29
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 4680
TabIndex = 71
Top = 1725
Width = 195
End
Begin VB.Label Label28
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "最短时间："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3000
TabIndex = 70
Top = 1725
Width = 975
End
Begin VB.Label Label27
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "最长时间："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 69
Top = 1725
Width = 975
End
Begin VB.Label Label26
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "次"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 4680
TabIndex = 68
Top = 1365
Width = 195
End
Begin VB.Label Label25
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您主动约她："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 2760
TabIndex = 67
Top = 1365
Width = 1170
End
Begin VB.Label Label24
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "共有多少次约会？："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 66
Top = 1365
Width = 1755
End
Begin VB.Label Label23
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 2040
TabIndex = 65
Top = 1005
Width = 195
End
Begin VB.Label Label22
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 4680
TabIndex = 64
Top = 1005
Width = 195
End
Begin VB.Label Label21
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "最短时间："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3000
TabIndex = 63
Top = 1005
Width = 975
End
Begin VB.Label Label20
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "最长时间："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 62
Top = 1005
Width = 975
End
Begin VB.Label Label19
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "次"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 4680
TabIndex = 61
Top = 645
Width = 195
End
Begin VB.Label Label18
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "其中您打："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3000
TabIndex = 60
Top = 645
Width = 975
End
Begin VB.Label Label17
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "共打了多少次电话？："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 59
Top = 645
Width = 1950
End
Begin VB.Label Label16
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您和她相识了多少天？："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 58
Top = 285
Width = 2145
End
End
Begin VB.Frame Frame2
BackColor = &H00FFC0FF&
Caption = "资料填写"
Height = 2055
Index = 0
Left = 240
TabIndex = 52
Top = 720
Width = 5175
Begin VB.TextBox Text4
Height = 270
Index = 0
Left = 2040
TabIndex = 2
Top = 360
Width = 2895
End
Begin VB.TextBox Text4
Height = 270
Index = 1
Left = 2040
TabIndex = 3
Top = 720
Width = 2895
End
Begin VB.TextBox Text4
Height = 270
Index = 2
Left = 2040
TabIndex = 4
Top = 1080
Width = 2895
End
Begin VB.TextBox Text4
Height = 270
Index = 3
Left = 2040
TabIndex = 5
Top = 1440
Width = 2895
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "请形容一下她的头发：："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 56
Top = 405
Width = 2145
End
Begin VB.Label Label13
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "请描述一下她的眼睛："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 55
Top = 765
Width = 1950
End
Begin VB.Label Label14
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "写下她最性感的部位："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 54
Top = 1125
Width = 1950
End
Begin VB.Label Label15
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "请判断一下她的性格："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 120
TabIndex = 53
Top = 1485
Width = 1950
End
End
Begin VB.Frame Frame2
BackColor = &H00FFC0FF&
Caption = "资料填写"
Height = 2055
Index = 1
Left = 240
TabIndex = 42
Top = 720
Visible = 0 'False
Width = 5175
Begin VB.TextBox Text5
Height = 270
Index = 0
Left = 2040
TabIndex = 19
Top = 315
Width = 1095
End
Begin VB.TextBox Text5
Height = 270
Index = 1
Left = 2520
TabIndex = 20
Top = 840
Width = 2415
End
Begin VB.TextBox Text5
Height = 270
Index = 2
Left = 2880
TabIndex = 21
Top = 1440
Width = 2055
End
Begin VB.Label Label35
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您认为它有一双"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 46
Top = 360
Width = 1365
End
Begin VB.Label Label36
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "眼睛"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3480
TabIndex = 45
Top = 360
Width = 390
End
Begin VB.Label Label37
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您认为美丽的东西都应该"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 44
Top = 885
Width = 2145
End
Begin VB.Label Label38
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "若她是一朵美丽的花，你愿她"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 43
Top = 1485
Width = 2535
End
End
Begin VB.Label Label10
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "您的大名："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 360
TabIndex = 41
Top = 285
Width = 975
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "你爱人的芳名："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 2640
TabIndex = 40
Top = 285
Width = 1365
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "这个月是："
Height = 180
Left = 600
TabIndex = 39
Top = 5280
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00FFC0FF&
ForeColor = &H00FF0000&
Height = 180
Left = 1560
TabIndex = 38
Top = 5280
Width = 90
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "应该送别人："
Height = 180
Left = 2520
TabIndex = 37
Top = 5280
Width = 1080
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00FFC0FF&
ForeColor = &H000000FF&
Height = 180
Left = 3720
TabIndex = 36
Top = 5280
Width = 90
End
Begin VB.Label Label5
AutoSize = -1 'True
BackColor = &H00FFC0FF&
Caption = "含义："
Height = 180
Left = 4800
TabIndex = 35
Top = 5280
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
BackColor = &H00FFC0FF&
ForeColor = &H00C243C2&
Height = 180
Left = 5640
TabIndex = 34
Top = 5280
Width = 90
End
Begin VB.Line Line1
BorderColor = &H00C000C0&
X1 = 5640
X2 = 5640
Y1 = 0
Y2 = 5160
End
Begin VB.Line Line2
BorderColor = &H00C000C0&
X1 = 0
X2 = 7320
Y1 = 5160
Y2 = 5160
End
Begin VB.Menu File
Caption = "文件"
Begin VB.Menu NewFile
Caption = "全部清除"
Shortcut = ^N
End
Begin VB.Menu Save
Caption = "保存情书"
Enabled = 0 'False
Shortcut = ^S
End
Begin VB.Menu n1
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出"
Shortcut = ^E
End
End
Begin VB.Menu Knoledge
Caption = "爱情知识"
Begin VB.Menu Knoledge1
Caption = "情人节的由来"
End
Begin VB.Menu Knoledge2
Caption = "巧克力爱情物语"
End
Begin VB.Menu Knoledge3
Caption = "送花的数目含义"
End
Begin VB.Menu Knoledge5
Caption = "花代表的心思"
End
End
Begin VB.Menu About
Caption = "关于"
Begin VB.Menu About1
Caption = "关于本软件"
Shortcut = ^H
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
'Const SND_LOOP = &H8
Const SND_MEMORY = &H4
'Const SND_NOSTOP = &H10
Dim SoundBuffer() As Byte
'Dim BackSound() As Byte
Dim wFlags As Long
Dim Increase As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As Any, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub About1_Click()
Beep
frmAbout.Show 1
End Sub
Private Sub Command1_Click()
If List1.Selected(0) Then
If Text2.Text = "" Or Text3.Text = "" Or Text4(0).Text = "" Or Text4(1).Text = "" Or Text4(2).Text = "" Or Text4(3).Text = "" Then
MsgBox "不要这么心急！还没添完", vbOKOnly, "错误"
Exit Sub
End If
Text1.Locked = False
Text1.Text = "Dear " + Text3.Text + Chr(13) + Chr(10) + "我的宝贝，你可知道," + Chr(13) + Chr(10) + _
"我是多么的爱你?" + Chr(13) + Chr(10) + _
"你那" + Text4(0).Text + "的头发,它是那样的令人陶醉，" + Chr(13) + Chr(10) + _
"更不用说你那对" + Text4(1).Text + "的眼睛，" + Chr(13) + Chr(10) + _
"它让我如此的痴迷, _" + Chr(13) + Chr(10) + _
"就好象一汪秋水频频荡漾，又似夜晚的繁星点点闪亮。" + Chr(13) + Chr(10) + _
"但最令我疯狂的，还是你那" + Text4(2).Text + "，" + Chr(13) + Chr(10) + _
"它总是充满了诱惑，让我产生犯罪的念头，" + Chr(13) + Chr(10) + _
"每当我有意或无意间轻触到它的时候，我的全身便燃起了熊熊烈火。" + Chr(13) + Chr(10) + _
"请饶恕我的口不择言，我是如此疯狂地爱着你。" + Chr(13) + Chr(10) + _
"如果你认为我仅仅是爱你的外表，那么你错了，" + Chr(13) + Chr(10) + _
"你是如此的" + Text4(3).Text + "，" + Chr(13) + Chr(10) + _
"这些才是我爱你的真正原因?" + Chr(13) + Chr(10) + _
"啊，我的宝贝，救救我这颗已被神箭射穿的心灵吧！" + Chr(13) + Chr(10) + _
"让我们珍惜这份情缘，" + Chr(13) + Chr(10) + _
"携起手来，" + Chr(13) + Chr(10) + _
"一起走向永远，永远......" + Chr(13) + Chr(10) + _
" 爱你的： " + _
Text2.Text
Command3.Enabled = True
Save.Enabled = True
Exit Sub
End If
If List1.Selected(1) Then
If Text2.Text = "" Or Text3.Text = "" Or Text5(0).Text = "" Or Text5(1).Text = "" Or Text5(2).Text = "" Then
MsgBox "不要这么心急！还没添完", vbOKOnly, "错误"
Exit Sub
End If
Text1.Locked = False
Text1.Text = "亲爱的" + Text3.Text + Chr(13) + Chr(10) + "你仿佛有一种魔力," + Chr(13) + Chr(10) + "使我每次见到你都会感到自己的心在狂跳不止," + Chr(13) + Chr(10) + "我知道你根本没有意识到我的存在," + Chr(13) + Chr(10) + "但你的容颜," + Chr(13) + Chr(10) + "已在我逐渐变冷的心中点燃了熊熊烈火," + Chr(13) + Chr(10) + "好几次我想鼓起勇气想你表明心中的感受," + Chr(13) + Chr(10) + "区被你那一双" + Text5(0).Text + "眼睛压了回去," + Chr(13) + Chr(10) + "我是如此的害怕看你的双眼," + Chr(13) + Chr(10) + "只好把话留在心里?" + Chr(13) + Chr(10) + "我努力的强迫自己不去想你," + Chr(13) + Chr(10) + "不要打扰你平静的生活," + Chr(13) + Chr(10) + "尽管如此,当我闭上双眼," + Chr(13) + Chr(10) + "你的身影又浮现在我的眼前?" + Chr(13) + Chr(10) + "我挥手让他散去," + Chr(13) + Chr(10) + "他却纹丝不动," + Chr(13) + Chr(10) + "我终于明白," + Chr(13) + Chr(10) + _
"你对于我来说不只是一阵过眼云烟," + Chr(13) + Chr(10) + _
"而是深深的印在了我的每一个角落?" + Chr(13) + Chr(10) + _
"在我的心中,有一件为你敞开们的小屋," + Chr(13) + Chr(10) + _
"它的名字叫'爱' ," + Chr(13) + Chr(10) + _
"我始终把他藏在那最温暖的角落," + Chr(13) + Chr(10) + _
"等待着你能住在里面我期望有一天," + Chr(13) + Chr(10) + _
"你也能把你的心扉向我敞开," + Chr(13) + Chr(10) + _
"不要让我的梦想一个美丽的泡泡一样破灭," + Chr(13) + Chr(10) + "美丽的东西都是应该" + Text5(1).Text + ",对吗?" + Chr(13) + Chr(10) + "让我的梦想变成现实吧!" + Chr(13) + Chr(10) + "不要让他在折磨我," + Chr(13) + Chr(10) + "我会付出我的一切,关心你,爱护你," + Chr(13) + Chr(10) + "让你这朵美丽的花朵," + Text5(2) + Chr(13) + Chr(10) + "哪怕是有狂风暴雨,," + Chr(13) + Chr(10) + "我的温暖都会在你身边!," + Chr(13) + Chr(10) + " 爱你的：" + Text2.Text
Command3.Enabled = True
Save.Enabled = True
Exit Sub
End If
If List1.Selected(2) Then
If Text2.Text = "" Or Text3.Text = "" Or Text6(0).Text = "" Or Text6(1).Text = "" Or Text6(2).Text = "" Or Text6(3).Text = "" Then
MsgBox "不要这么心急！还没添完", vbOKOnly, "错误"
Exit Sub
End If
Text1.Locked = False
Text1.Text = "亲爱的" + Text3.Text + Chr(13) + Chr(10) + "我的身体里有一百座的核子反应炉" + Chr(13) + Chr(10) + "只要一想到你就像" + Text6(0).Text + "般" + Chr(13) + Chr(10) + "心形的眼珠即时著了火 '泡'你是我今晚的任务" + Chr(13) + Chr(10) + "围绕围绕著你跑了360个400米 我是个真爱的超人 你是地球" + Chr(13) + Chr(10) + "我是我是我是苍蝇你是果冻 完美地跌倒最重要 我为你俯冲" + Chr(13) + Chr(10) + "荷尔蒙是威力最大的爆炸 把你的理智我的害羞都冲垮" + Chr(13) + Chr(10) + "可不可以靠近过来说说爱 要知道冷漠是最没礼貌的落後态度" + Chr(13) + Chr(10) + "让我让我对你发射我最强烈的温柔 烧烧的痞子电磁波" + Chr(13) + Chr(10) + "恋爱是青春嘴里的一颗糖 我来替你剥开外面的包装" + Chr(13) + Chr(10) + "抱著我如果你尴尬很紧张 我用最美的Pose带你到" + Text6(1).Text + Chr(13) + Chr(10) + "噢!让我让我对你发射我最强烈的温柔 喔!烧烧的痞子电磁波" + Chr(13) + Chr(10) + "啊!发呆是最危险的自虐狂 寂寞是最邪恶的地狱谷耶!" + Chr(13) + Chr(10) + "让我们离开无 聊聊的" + Text6(2).Text + _
"飞到电影院看《" + Text6(3) + "》!" + Chr(13) + Chr(10) + "让我让我对你发射我最强烈的温柔 烧烧的痞子电磁波" + Chr(13) + Chr(10) + _
"呵呵呵!呵呵呵!呵呵呵呵呵!" + Chr(13) + Chr(10) + _
" 爱你的：" + Text2.Text
Command3.Enabled = True
Save.Enabled = True
Exit Sub
End If
If List1.Selected(3) Then
If Text2.Text = "" Or Text3.Text = "" Or Text7(0).Text = "" Or Text7(1).Text = "" Or Text7(2).Text = "" Or Text7(3).Text = "" Or Text7(4).Text = "" Or Text7(5).Text = "" Or Text7(6).Text = "" Or Text7(7).Text = "" Or Text7(8).Text = "" Then
MsgBox "不要这么心急！还没添完", vbOKOnly, "错误"
Exit Sub
End If
Text1.Locked = False
Text1.Text = "亲爱的" + Text3.Text + Chr(13) + Chr(10) + "我们的感情，在十一届三中全会以来党的一系列正确方针政策的指引下在党的亲切关怀下，在领导的亲自过问下，" + Text7(0).Text + "年来正沿着健康的道路蓬勃发展，这主要表现在：" + Chr(13) + Chr(10) + "一、我们共通话" + Text7(1).Text + _
"次。平均每" + Str(Val(Text7(0).Text) / Val(Text7(1).Text)) + "天一次。其中，我给你打了" + Text7(2).Text + "次，占" + Format(Val(Text7(2).Text) / Val(Text7(1).Text), "0%") + "；你给我打了" + Str(Val(Text7(1).Text) - Val(Text7(2).Text)) + "次，占" + Format(1 - Val(Text7(2).Text) / Val(Text7(1).Text), "0%") + "；每次通话最长的达" + Text7(3).Text + "分钟，最短的也有" + Text7(4).Text + "分钟......" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"二、我们约会共" + Text7(5).Text + "次，平均每" + Str(Val(Text7(0).Text) / Val(Text7(5).Text)) + "天一次。其中我主动约你" + Text7(6).Text + "次，占" + Format(Val(Text7(6).Text) / Val(Text7(5).Text), "0%") + "；你约我" + Str(Val(Text7(5).Text) - Val(Text7(6).Text)) + "次，占" + Format(1 - Val(Text7(6).Text) / Val(Text7(5).Text), "0%") + " ；每次约会最长的达" + Text7(7).Text + "小时，最短的也有" + Text7(8).Text + "小时......" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"以上充分证明了一年的交往我们已形成了爱情的共识，我们爱情的主流是互相了解、互相关心、互相帮助，是平等互利的。" + Chr(13) + Chr(10) + "当做任何事物都是一分为二的，缺点的存在是不可避免的，" + Chr(13) + Chr(10) + "我们两人虽然都是积极的，但是从以上的数据发展还不太平衡，积极性还存在一定的差距，这是前进中的缺点。" + Chr(10) + Chr(13) + "我相信在新的一年里，我们一定回发扬成绩，克服缺点，再接再厉，携手前进，开创我们爱情的新局面......" + Chr(13) + Chr(10) + _
"因此，我提出三点意见供你参考：" + Chr(13) + Chr(10) + _
"一是要围绕一个'爱'字......" + Chr(13) + Chr(10) + _
"二是要狠抓一个'亲'字......" + Chr(13) + Chr(10) + _
"三是要落实一个'合'字......" + Chr(13) + Chr(10) + _
"让我们宏扬团结拼搏坚韧不拔的精神，共同振兴我们的爱情，争取我们的爱情达到一个新的高度，登上一个新台阶。" + Chr(13) + Chr(10) + "本着'我们的婚事我们办，办好婚事为我们'的精神共创辉煌。" + Chr(13) + Chr(10) + _
" 爱你的：" + Text2.Text
Command3.Enabled = True
Save.Enabled = True
Exit Sub
End If
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text1.Locked = True
If List1.Selected(0) Then
For i = 0 To 3
Text4(i).Text = ""
Next i
End If
If List1.Selected(1) Then
For i = 0 To 2
Text5(i).Text = ""
Next i
End If
If List1.Selected(2) Then
For i = 0 To 3
Text6(i).Text = ""
Next i
End If
If List1.Selected(3) Then
For i = 0 To 8
Text7(i).Text = ""
Next i
End If
Command3.Enabled = False
Save.Enabled = False
End Sub
Private Sub Command3_Click()
On Error Resume Next
filehandle = FreeFile
'CommonDialog1.Filter = "Text Files|*.txt|All Files (*.*)|*.*"
'CommonDialog1.ShowSave
'If CommonDialog1.FileName <> "" Then
' Open CommonDialog1.FileName For Output As #filehandle
' Print #filehandle, Text1.Text
' Close #filehandle
'End If
'Exit Sub
'Err:
'MsgBox "因为控件没有发现，所以文件保存为在程序同路径下 LoveExpert.txt文件", vbOKOnly, "抱歉！"
MsgBox "文件保存为在程序同路径下 LoveExpert.txt文件", vbOKOnly, "文件保存结果！"
Open App.Path + "\LoveExpert.txt" For Append As #filehandle
Print #filehandle, Text1.Text
Close #filehandle
End Sub
Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
If App.PrevInstance = True Then
Beep
End
End If
Form1.Visible = True
SoundBuffer = LoadResData(101, "CUSTOM")
wFlags = SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY 'Or SND_NOSTOP
'BackSound = LoadResData(102, "CUSTOM")
mciSendString "close MyWav", vbNullString, 0, 0
mciSendString "open " & App.Path & "\why.mid alias MyWav", vbNullString, 0, 0
mciSendString "play MyWav FROM 0", vbNullString, 0, 0
i = Month(Date)
Select Case i
Case 1
Label2.Caption = "一月"
Label4.Caption = "水仙花"
Label6.Caption = "尊敬"
Case 2
Label2.Caption = "二月"
Label4.Caption = "紫罗兰"
Label6.Caption = "诚实，谦让"
Case 3
Label2.Caption = "三月"
Label4.Caption = "郁金香"
Label6.Caption = "爱的倾诉"
Case 4
Label2.Caption = "四月"
Label4.Caption = "康乃馨"
Label6.Caption = "纯粹的爱情"
Case 5
Label2.Caption = "五月"
Label4.Caption = "蔷薇"
Label6.Caption = "美、爱，恋情"
Case 6
Label2.Caption = "六月"
Label4.Caption = "杷子"
Label6.Caption = "我的幸福"
Case 7
Label2.Caption = "七月"
Label4.Caption = "剑兰"
Label6.Caption = "谨慎，坚固"
Case 8
Label2.Caption = "八月"
Label4.Caption = "大莉花"
Label6.Caption = "华丽"
Case 9
Label2.Caption = "九月"
Label4.Caption = "龙胆花"
Label6.Caption = "在你伤心时我尤其爱你"
Case 10
Label2.Caption = "十月"
Label4.Caption = "大波斯菊"
Label6.Caption = "少女的纯洁与爱情"
Case 11
Label2.Caption = "十一月"
Label4.Caption = "菊花"
Label6.Caption = "高尚，清高"
Case 12
Label2.Caption = "十二月"
Label4.Caption = "卡特丽亚"
Label6.Caption = "美人"
End Select
List1.AddItem "传统型"
List1.AddItem "无敌型"
List1.AddItem "思春型"
List1.AddItem "革命数码型"
List1.Selected(0) = True
Frame7.ForeColor = &HFF&
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
mciSendString "close MyWav", vbNullString, 0, 0
frmAbout.Show
End Sub
Private Sub Knoledge1_Click()
Call Label8_Click
Frame7.Visible = True
Frame7.Caption = "情人节的由来"
Text8.Text = " 情人节的来历" + Chr(13) + Chr(10) + _
" 中国人现在用近乎狂热的热情过起了圣诞节一样，情人节也已经悄悄渗透到了无数年轻人的心目当中，成为中国传统节日之外的又一个重要节日。情人节的来历和意义可能并不一定为大多数人所知。下面所要介绍的，不过是众多关于情人节的传说中的一个。" + Chr(13) + Chr(10) + " 在古罗马时期，二月十四日是为表示对约娜的尊敬而设的节日。约娜是罗马众神的皇后，罗马人同时将她尊奉为妇女和婚姻之神。接下来的二月十五日则被称为“卢帕撒拉节”，是用来对约娜治下的其他众神表示尊敬的节日。" + Chr(13) + Chr(10) + " 在古罗马，年轻人和少女的生活是被严格分开的。然而，在卢帕撒拉节，小伙子们可以选择一个自己心爱的姑娘的名字刻在花瓶上。这样，过节的时候，小伙子就可以与自己选择的姑娘一起跳舞，庆祝节日。如果被选中的姑娘也对小伙子有意的话，他们便可一直配对，而且最终他们会坠入爱河并一起步入教堂结婚。后人为此而将每年的二月十四日定为情人节。" + Chr(13) + Chr(10) + _
" 在西方，情人节不但是表达情意的最佳时刻，也是向自己心爱的人求婚的最佳时刻。在这一点上，情人节体现出的，不正是古罗马人设计这个节日的本意吗？ 公元三世纪时，古罗马有一位暴君叫 克劳多斯（Claudius）。离暴君的宫殿不远，有一座非常漂亮的神庙。修士瓦沦丁（Valentine） 就住在这里。罗马人非常崇敬他，男女老幼，不论贫富贵贱，总会群集在他的周围，在祭坛的熊熊圣火前，聆听瓦沦丁的祈祷。" + Chr(13) + Chr(10) + "古罗马的战事一直连绵不断，暴君克劳多斯征召了大批公民前往战场，人们怨声载道。男人们不愿意离开家庭，小伙子们不忍与情人分开。克劳多斯暴跳如雷，他传令人们不许举行婚礼，甚至连所有已订了婚的也马上要解除婚约。许多年轻人就这样告别爱人，悲愤地走向战场。年轻的姑娘们也由于失去爱侣，抑郁神伤。 瓦沦丁对暴君的虐行感到非常难过。当一对情侣来到神庙请求他的帮助时，瓦沦帝尼在神圣的祭坛前为它们悄悄地举行了婚礼。人们一传十，十传百，很多人来到这里，在瓦沦丁的帮助下结成伴侣。" + Chr(13) + Chr(10) + _
" 消息终于传进了宫殿，传到了暴君的耳里。克劳多斯又一次暴跳如雷，他命令士兵们冲进神庙，将瓦沦丁从一对正在举行婚礼的新人身旁拖走，投入地牢。人们苦苦哀求暴君的劾免，但都徒劳而返。瓦沦丁终于在地牢里受尽折磨而死。悲伤的朋友们将他安葬于圣普拉 教堂。那一天是2月14日，那一年是公元270年。 另外的版本似乎没有这一个精彩。传说中瓦沦丁是最早的基督徒之一，那个时代做一名基督徒意味着危险和死亡。为掩护其他殉教者，瓦沦丁被抓住，投入了监牢。在那里他治愈了典狱长女儿失明的双眼。当暴君听到着一奇迹时，他感到非常害怕，于是将瓦沦丁斩首示众。据传说，在行刑的那一天早晨，瓦沦丁给典狱长的女儿写了一封情意绵绵的告别信，落款是:From your Valentine （寄自你的瓦沦丁） 历史学家们更愿意刨根揪底，他们关于情人节的演绎似乎令人信服。其实远远早于公元270年，当罗马城刚刚奠基时，周围还是一片荒野，成群的狼四处游荡。在罗马人崇拜的众神中，畜牧神卢波库斯（Lupercus）掌管着对牧羊人和羊群的保护。每年二月中，罗马人会举行盛大的典礼来庆祝牧神节。那时的日历与现在相比，要稍微晚一些，所以牧神节实际上是对即将来临的春天的庆祝。" + Chr(13) + Chr(10) + _
" 也有人说这个节日是庆祝 法乌努斯" + Chr(13) + Chr(10) + _
" 神（Faunus），它类似于古希腊人身羊足，头上有角的潘神（ Pan ），主管畜牧和农业。 牧神节的起源实在是过于久远了，连公元前一世纪的学者们都无法确认。但是这一节日的重要性是不容置疑的。 例如史料记载，安东尼（Mark Antony）就是在公元前44年的牧神节上将王冠授与凯撒（Julius Caesar）的。" + Chr(13) + Chr(10) + "每年的二月十五日，修士们会聚集在罗马城中巴沦丁Palantine）山上的一个洞穴旁，据说在这里，古罗马城的奠基者 （Romilus andRemus）被一只母狼扶育长大。在节日的各项庆典中，有一项是年轻的贵族们，手持羊皮鞭，在街道上奔跑。年轻妇女们会聚集在街道两旁，祈望羊皮鞭抽打到她们头上。人们相信这样会使她们更容易生儿育女。在拉丁语中，羊皮鞭被叫做 februa，鞭打叫做 fabruatio， 实际上都含有'纯洁'的意思。二月的名字（February）就是由此而来。" + Chr(13) + Chr(10) + _
" 随着罗马势力在欧洲的扩张，牧神节的习俗被带到了现在的法国和英国等地。人们最乐此不疲的一项节日活动类似于摸彩。年轻女子们的名字被放置于盒子内，然后年轻男子上前抽取。抽中的一对男女成为情人，时间是一年或更长。 基督教的兴起使人们纪念众神的习俗逐渐淡漠。教士们不希望人们放弃节日的欢乐，于是将牧神节（Lupercalia）改成瓦沦丁节（ Valentine's Day），并移至二月十四日。这样，关于瓦沦丁修士的传说和古老的节日就被自然地结合在一起。这一节日在中世纪的英国最为流行。未婚男女的名字被抽出后，他们会互相交换礼物，女子在这一年内成为男子的Valentine。 在男子的衣袖上会绣上女子的名字，照顾和保护该女子于是成为该男子的神圣职责。" + Chr(13) + Chr(10) + _
" 有史可查的现代意义上的瓦沦丁情人是在十五世纪早期。法国年轻的奥尔良大公在阿根科特（Agincourt）战役中被英军俘虏，然后被关在伦敦塔中很多年。他写给妻子很多首情诗，大约60首保存至今。用鲜花做瓦沦丁节的信物在大约两百年后出现。法王亨利四世（Henry IV）的一个女儿在瓦沦丁节举行了一个盛大的晚会。所有女士从选中她做Valentine的男士那里获得一束鲜花。 就这样，延续着古老的意大利，法国和英国习俗，我们得以在每年的二月十四日向自己的朋友传递爱的信息。鲜花，心形糖果，用花边和摺穗掩盖了送物人名字的信物，不仅仅是代表着一份份真挚的爱，更是对敢于反抗暴政的瓦沦丁修士的最好缅怀。"
End Sub
Private Sub Knoledge2_Click()
Call Label8_Click
Frame7.Visible = True
Frame7.Caption = "巧克力爱情物语"
Text8.Text = " 巧克力爱情物语" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 正如花有花语，巧克力也有自己的爱情物语，送不同的巧克力表示不同的意义，不妨仔细看看：" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 牛奶巧克力 表示你觉得对方很纯品，很乖巧，是个可爱的小精灵。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 黑巧克力 表示你觉得对方有个性，很神秘，深不可测。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 白巧克力 表示你觉得对方超凡脱俗，不食人间烟火。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 果仁巧克力 表示你觉得与对方一起很温馨，很想随时陪伴左右。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 心型巧克力 表示“我心属于你”。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 卡通巧克力 表示你很欣赏对方的天真烂漫?" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
" 带玩具的巧克力 表示你与对方的关系正介于情人和朋友之间?"
End Sub
Private Sub Knoledge3_Click()
Call Label8_Click
Frame7.Visible = True
Frame7.Caption = "送花的数目含义"
Text8.Text = " 送花的数目含义 " + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"1 朵 唯一的爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"2 朵 你侬我侬" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"3 朵 我爱你" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"4 朵 誓言与承诺" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"5 朵 无悔" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "6 朵 顺利" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "7 朵 喜相逢" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "8 朵 弥补" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"9 朵 长相守" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "10 朵 完美的你(你)" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"11 朵 一心一意;最美" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "12 朵 比翼双飞" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"13 朵 暗恋" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "17 朵 好聚好散" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"20 朵 两情相悦" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "21 朵 最爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"22 朵 双双对对" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "24 朵 无时无刻想著你" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"33 朵 我爱你;三生三世" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "36 朵 我心属於你" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"44 朵 至死不渝" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "50 朵 无悔的爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"56 朵 吾爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "57 朵 吾爱吾妻" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"66 朵 细水长流" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "77 朵 求婚" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"88 朵 用心弥补" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "99 朵 天长地久" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"100 朵 白头偕老;爱你一万年" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "101 朵 直到永远" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "108 朵 无尽的爱 " + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "144 朵 爱你生生世世" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"365 朵 天天想你 " + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "999 朵 天长地久" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"1001 朵 直到永远 "
End Sub
Private Sub Knoledge5_Click()
Call Label8_Click
Frame7.Visible = True
Frame7.Caption = "花代表的心思"
Text8.Text = " 花 语" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"三色篓：思慕、想念我 雏 菊：愉快、纤细、幸福 矢车菊：幸福" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "福禄考：一致同意 瓜叶菊：快活 矮牵牛：（白）存在、（紫）情" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "蕾香蓟: 相信得到答覆 花菱草: 不要拒绝我 美人樱: 诱惑" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "勿忘草：永志勿望 霞 草：（红）期待的喜悦 六佬刎：可怜、同情" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "报春花：初恋、希望 鼠尾草：（白）精力充沛（红）心在燃烧、（紫）智慧" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "松叶菊: 情息 天竺葵: 诈欺?不实 西番莲: 圣爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "曼陀罗：诈情、骗受 滨 蓟：孤独 海石竹：体谅、贴心" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "香 蒌: 贞淑?芍 药: 善羞?愤怒 福寿草: 回想 君子兰: 高贵" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "华 草: 服从 非洲菊: 神秘 金莲花: 不稳定?心绪不宁" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "郁金香：爱的表现" + _
"鸢 尾: 使者?爱的传达 风信子: 游戏?内心的喜悦 " + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "白头翁：（白）真实、（红）恋爱、（黄）绝交、（紫）信澄 小苍兰：纯洁" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "娄斗菜：（白）愚钝、（红）挂虑、（紫）胜利 德国鸢尾：神圣" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "孤挺花：多话、多嘴 百 合：尊敬、纯洁 陆莲花：迷人的魅力" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "高雪轮: 骗子 风铃草: 诚信 虞美人: 抚慰" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "翟 麦: 野心 根节兰: 长寿 康乃馨: 伤心" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "黑种草：清新的爱 海 棠：善感 松虫草：追念" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "蝴蝶花：反抗 荷 花：君子 黑百合：诅咒" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "扶 桑：热情 牵牛花：稍纵即逝 石 蒜：冷清、孤独" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "木 莲: 高尚 毛地黄: 晃言 加得利亚兰: 神秘?高贵" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "石 榴：风饶 亚 麻：优美朴实 野蔷薇：自由" + _
"旋 花：恩赐 忍 冬：背弃 茴 香：思念" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "熏衣草：清雅、女人味 柳穿鱼：纤细 卷 耳：快乐" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "橙 花：爱慕 海 芋：纯洁 莲 翘：别碰我" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "梨 花：纯情 罂 粟：华丽、高贵 桃 花：爱慕" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "凤尾眷：思念 杏 花：拜访我 铁线莲：雅致" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "秋水仙: 遗忘 酢酱草: 我不会放弃您?欢悦 燕子花: 幸运到来" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "紫 藤：热恋、欢迎 社鹃花：爱的快乐、节制 茶 花：（红）谦逊、美德、可爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金省花: 谦逊?卑下 隶棠花: 高洁 山东窗: 待续?耐久" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金鱼草：傲慢 雪 柳：殊胜 金缕梅：咒文、灵感" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "紫丁香：（紫）初恋的感激（红）爱苗滋生、纯真 桔梗花：柔情、嫉妒" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"百日草: 思念亡友 香石竹: 热心 万寿菊: 自卑" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "鸡冠花：不死 飞燕草：正义、自由 茑 萝：好管闲事" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "千日红: 不朽?不灭 凤仙花: 纪念 彩叶苋: 绝恋" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金鸡菊：竞争心 麦杆菊：永久不变 蜀 葵：热恋、单纯" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "红 花: 差别?区别 金针花: 宣告?妩媚 玻璃菊: 闺女?追想" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "蓬莴菊：占有恋人，真实的爱 千屈菜：悲哀 大岩洞：绝望。" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "球根海棠：亲切、单相思 火炬花：思念之苦 鹿 葱：肉体的快乐" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "铃 兰：幸福 纯洁、纤细、处女的骄做 萍蓬草：崇高" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "百于莲：恋爱的造访、恋爱的通讯 睡 莲：淡泊 姜 兰：无聊" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "溪 荪: 愤慨 玉蝉花: 爱的音讯 洋玉兰: 自然的爱?威严" + _
"八仙花：自私 紫 薇：雄辩 桅子花：闲雅、清静、幸福者" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "夹竹桃：（桃）咒骂、 竹 ：志节、节操 榆 ：尊严、爱国心" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "柳: 追悼?死亡 柏: 死亡?阴影 桑: 不寻常" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "橄 榄：智慧、和平 月 桂：胜利 法国梧桐：天才" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "圣 柳：犯罪 唐 桧：大胆、无远虑 长春藤：诡计" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "橡 ：权威 文 竹：哀戚 武 竹：飘逸" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "青 苔：谦逊 棕 桐：荣耀 菩 提：安宁" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "蒲公英: 勇气 马鞭草: 正义?期待 翠茱花: 祝你幸福" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "雷丝花: 纯洁?幸运 古代稀: 虚荣 千舌草: 初恋" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "天人菊：团结 孔雀草：嫉妒、悲爱 石 竹：急切、莽撞" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金盏花：期望 翠 菊：远虑 紫罗兰：忠实" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"蒲包花: 富贵 香碗豆: 俊美?回忆 叶牡丹: 利益" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "紫茉莉：臆测、猜忌 黄蜀葵：单恋、信任 昙 花：夜之美人" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "吊钟花：趣味、嗜好 紫 苑：反省、追想 龙 胆：正义、清高" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "虎耳草: 情爱 红蜀葵: 温和 月见草: 美人?魔法" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "美人蕉：坚实 葱 兰：期待，洁白的爱 番红花：青春的快乐" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "水 仙：自尊 仙客来：疑惑、猜忌 瑞 香：欢乐、不死" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金银花：献爱，诚爱 梅 花：高洁 素 馨：幸福、亲切" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "夹竹桃：（桃）咒骂、（黄）深刻的友情 紫 葳：女性、名誉" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "玫 瑰：美、爱、恋（白）恋的心声、诚心敬爱（红）美丽、贞节、模范。（黄）不贞、嫉妒" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "羽扇豆: 母性爱?妩媚 长春花: 追忆 向日葵: 崇拜?敬慕" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
"大波斯菊：（白）纯洁（红）多情 山 查：希望 紫 荆：背叛、疑惑" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "洋桔梗：富放感情、感动 牡 丹：富贵 樱 花：欢乐" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "蜡 梅：慈爱心 茶 梅：（红）清雅、谦让、（白）理想的爱" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "球 葱：无限悲哀 雪 片：纯洁 串铃花：悲恋" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "东 菊：别离 球 葱：无限悲哀 串铃花：悲恋" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "金栗兰: 隐约之美 金栗兰: 隐约"
End Sub
Private Sub Label7_Click()
On Error Resume Next
If Shape1(1).Top >= 4680 Then
Exit Sub
End If
Timer1.Enabled = False
Frame4.Visible = True
'mciSendString "close MyWav", vbNullString, 0, 0
sndPlaySound SoundBuffer(0), wFlags
While Shape1(1).Top < 4680
Label8.Top = Label8.Top + 50
Shape1(1).Top = Shape1(1).Top + 50
Frame5.Top = Shape1(1).Top + Shape1(1).Height
Wend
Save.Enabled = True
NewFile.Enabled = True
Frame7.Visible = False
mciSendString "close BackSound", vbNullString, 0, 0
End Sub
Private Sub Label8_Click()
On Error Resume Next
If Shape1(1).Top <= Shape1(0).Top + Shape1(0).Height + 20 Then
Exit Sub
End If
sndPlaySound SoundBuffer(0), wFlags
While Shape1(1).Top > Shape1(0).Top + Shape1(0).Height + 20
Label8.Top = Label8.Top - 50
Shape1(1).Top = Shape1(1).Top - 50
Frame5.Top = Shape1(1).Top + Shape1(1).Height
Wend
Frame4.Visible = False
Save.Enabled = False
NewFile.Enabled = False
Timer1.Enabled = True
Frame7.Visible = True
'DoEvents
'mciSendString "close MyWav", vbNullString, 0, 0
'mciSendString "open e:\music\why.mid alias MyWav", vbNullString, 0, 0
'mciSendString "play MyWav", vbNullString, 0, 0
End Sub
Private Sub List1_Click()
For i = 0 To 3
If List1.Selected(i) Then
Frame2(i).Visible = True
Else
Frame2(i).Visible = False
End If
Next i
End Sub
Private Sub New_Click()
Text1.Text = ""
Text1.Locked = True
Text2.Text = ""
Text3.Text = ""
For i = 0 To 3
Text4(i).Text = ""
Next i
For i = 0 To 2
Text5(i).Text = ""
Next i
For i = 0 To 3
Text6(i).Text = ""
Next i
For i = 0 To 8
Text7(i).Text = ""
Next i
End Sub
Private Sub NewFile_Click()
Text1.Locked = True
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
For i = 0 To 3
Text4(i).Text = ""
Next i
For i = 0 To 2
Text5(i).Text = ""
Next i
For i = 0 To 3
Text6(i).Text = ""
Next i
For i = 0 To 8
Text7(i).Text = ""
Next i
Command3.Enabled = False
Save.Enabled = False
End Sub
Private Sub Save_Click()
Call Command3_Click
End Sub
Private Sub Text1_Change()
If Text1.Locked = True Then
Text1.Text = ""
End If
End Sub
Private Sub Text1_GotFocus()
If Text1.Text <> "" Then
Text1.Locked = False
Else
Text1.Locked = True
End If
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then
If KeyCode = 65 Or KeyCode = 97 Then
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End If
If KeyCode = 67 Or KeyCode = 99 Then
Clipboard.Clear
Clipboard.SetText (Text1.SelText)
End If
If KeyCode = 86 Or KeyCode = 118 Then
Text1.Text = Left(Text1.Text, Text1.SelStart + Text1.SelLength + 2) + Clipboard.GetText + Mid(Text1.Text, Text1.SelStart + Text1.SelLength + Len(Clipboard.GetText) - 3, Len(Text1.Text) - Text1.SelStart + Text1.SelLength)
End If
If KeyCode = 88 Or KeyCode = 120 Then
Text1.Text = Left(Text1.Text, Text1.SelStart) + Mid(Text1.Text, Text1.SelStart + Text1.SelLength + 3, Len(Text1.Text) - Text1.SelStart - Text1.SelLength)
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text4_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text5_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text6_Change(Index As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text6_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Text7_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Timer1_Timer()
Dim S As String
If Shape1(1).Top < 4680 Then
If Label39(0).ForeColor <= &H1010FF Then
Increase = &H80800
ElseIf Label39(0).ForeColor >= &HEFEFFF Then
Increase = -&H80800
End If
Label39(0).ForeColor = Label39(0).ForeColor + Increase
Label39(1).ForeColor = Label39(1).ForeColor - Increase
End If
S = String(256, Chr(0))
mciSendString "status MyWav mode", S, Len(S), 0
If Left(S, 7) = "stopped" Or Left(S, 2) = "停止" Then
mciSendString "seek MyWav to start", vbNullString, 0, 0
mciSendString "play MyWav", vbNullString, 0, 0
End If
End Sub