欢迎访问infoheader的Blog——年华似水浪淘沙
E-mail:infoheader@gmail.com
GTalk:infoheader@gmail.com
来自fanfou:

2008年12月30日星期二

VB表达式计算函数(修正1)

有问题请联系我。
感谢Aegisys[0GiNr]发现未检查减法运算的错误
感谢iceboy发现小数识别的错误


'函数:Calc(Exp As String) As Double
'用于计算包含括号、四则运算的字符串表达式

'infoheader版权所有,转载、使用请注明出处
'Blog:infoheader.blogspot.com
'E-mail:infoheader@gmail.com
'仅供技术交流使用,严禁用于商业用途

'叠代深度(调试用)
'Public Deep As Integer

Public CalcErr As String

Public Function Calc(ByVal Exp As String) As Double
CalcErr = ""
'去空格
Exp = Replace(Exp, " ", "")
'去掉最外括号
While Left(Exp, 1) = "(" And Right(Exp, 1) = ")"
Exp = Mid(Exp, 2, Len(Exp) - 2)
Wend
'括号配对检查
Dim I As Integer, CountL As Integer, CountR As Integer, Chr As String
For I = 1 To Len(Exp)
Chr = Mid(Exp, I, 1)
If Chr = "(" Then
CountL = CountL + 1
ElseIf Chr = ")" Then
CountR = CountR + 1
End If
Next
If CountL <> CountR Then
CalcErr = "括号不匹配"
Exit Function
End If
'计算
Calc = CalcA(Exp)
End Function

Public Function CalcA(ByVal Exp As String) As Double
'Deep = Deep + 1
'(1+2)*3+4*5+2=?
'(1+2)*(3+4)+5=?
'(1+2)*((3+4)*5)+3=?
'11111012222211100

DoEvents '防止死机
Dim LvS As Integer

'循环变量
Dim I As Integer, J As Integer

'对于纯数值
Dim Temp As String, Temp2 As String
Temp = Str(Val(Exp))
Temp2 = Replace(Temp, ".", "0.")
Exp = Trim(Exp)
If Trim(Temp) = Exp Or Trim(Temp2) = Exp Then
CalcA = Val(Exp)
GoTo LAB_END
ElseIf Exp = "" Then '对于空(负号)
CalcA = 0
GoTo LAB_END
End If

'Dim AscN As Integer
'For I = 1 To Len(Exp)
' AscN = Asc(Mid(Exp, I, 1))
' If AscN > 57 Or AscN < ascn =" 47" ascn =" 44" calca =" Val(Exp)" i =" 1" lvs =" I" currentlv =" 0:" lvmb =" False" i =" LvS" currentlv =" CurrentLv"> LvM Then
LvM = CurrentLv
LvMS = I '最大级别启始点
LvMB = True
End If
ElseIf Mid(Exp, I, 1) = ")" Then
CurrentLv = CurrentLv - 1
If LvMB Then
LvME = I '最大级别结束点
LvMB = False
End If
End If
'Lv(I) = CurrentLv '存储级别(优化备用)
Next
'计算最高级括号
Exp = Left(Exp, LvMS - 1) & CalcA(Mid(Exp, LvMS + 1, LvME - LvMS - 1)) & Right(Exp, Len(Exp) - LvME)
CalcA = CalcA(Exp)
GoTo LAB_END

LAB_A2:
'对于没有括号的表达式
'加减法跳转
Dim AscS As Integer
For I = 1 To Len(Exp)
If Mid(Exp, I, 1) = "+" Then GoTo LAB_B1
If Mid(Exp, I, 1) = "-" And I > 1 Then
AscS = Asc(Mid(Exp, I - 1, 1))
If AscS >= Asc("0") And AscS < i =" 1" exp =" CalcA(Left(Exp," calca =" CalcA(Exp)" exp =" Str(CalcA(Left(Exp," calca =" CalcA(Exp)" i =" 1" exp =" Str(CalcA(Left(Exp," calca =" CalcA(Exp)" exp =" Str(CalcA(Left(Exp," calca =" CalcA(Exp)" deep =" Deep">

2008年12月27日星期六

VB表达式计算函数

今天自己写的一个函数,没想到会用了将近两个小时……
还没有进行优化,估计这个函数的效率不怎么样。
没有错误检查功能。如果表达式有问题,那么结果是不可预知的。
写完后调试了半天,检查出多处错误。
如果发现还存在问题请告诉我。
感谢声明:感谢Aegisys[0GiNr]发现未检查减法运算的错误

'函数:Calc(Exp As String) As Double
'用于计算包含括号、四则运算的字符串表达式

'infoheader版权所有,转载、使用请注明出处
'Blog:infoheader.blogspot.com
'E-mail:infoheader@gamil.com
'仅供技术交流使用,严禁用于商业用途


Public Function Calc(Exp As String) As Double
'去空格
Exp = Replace(Exp, " ", "")
'去掉最外括号
While Left(Exp, 1) = "(" And Right(Exp, 1) = ")"
Exp = Mid(Exp, 2, Len(Exp) - 2)
Wend
Calc = CalcA(Exp)
End Function

Public Function CalcA(Exp As String) As Double
'Deep = Deep + 1
'(1+2)*3+4*5+2=?
'(1+2)*(3+4)+5=?
'(1+2)*((3+4)*5)+3=?
'11111012222211100

DoEvents '防止死机
Dim LvS As Integer

'循环变量
Dim I As Integer, J As Integer

'对于纯数值
If Trim(Str(Val(Exp))) = Trim(Exp) Then
CalcA = Val(Exp)
GoTo LAB_END
ElseIf Exp = "" Then '对于空(负号)
CalcA = 0
GoTo LAB_END
End If

'Dim AscN As Integer
'For I = 1 To Len(Exp)
' AscN = Asc(Mid(Exp, I, 1))
' If AscN > 57 Or AscN < 43 Or AscN = 47 Or AscN = 44 Then GoTo LAB_NUM
'Next
'CalcA = Val(Exp)
'GoTo LAB_END
'LAB_NUM:

'括号跳转
For I = 1 To Len(Exp)
If Mid(Exp, I, 1) = "(" Then
LvS = I
GoTo LAB_A1
End If
Next
GoTo LAB_A2

LAB_A1:
'对于有括号的表达式
'存储级别(优化备用)
'Dim Lv() As Integer
'ReDim Lv(Len(Exp)) As Integer
'当前级别,最大级别,最大级别启始,结束,判定
Dim CurrentLv As Integer, LvM As Integer, LvMS As Integer, LvME As Integer, LvMB As Boolean

CurrentLv = 0: LvMB = False
'定级
For I = LvS To Len(Exp)
If Mid(Exp, I, 1) = "(" Then
CurrentLv = CurrentLv + 1
If CurrentLv > LvM Then
LvM = CurrentLv
LvMS = I '最大级别启始点
LvMB = True
End If
ElseIf Mid(Exp, I, 1) = ")" Then
CurrentLv = CurrentLv - 1
If LvMB Then
LvME = I '最大级别结束点
LvMB = False
End If
End If
'Lv(I) = CurrentLv '存储级别(优化备用)
Next
'计算最高级括号
Exp = Left(Exp, LvMS - 1) & CalcA(Mid(Exp, LvMS + 1, LvME - LvMS - 1)) & Right(Exp, Len(Exp) - LvME)
CalcA = CalcA(Exp)
GoTo LAB_END

LAB_A2:
'对于没有括号的表达式
'加减法跳转
Dim AscS As Integer
For I = 1 To Len(Exp)
If Mid(Exp, I, 1) = "+" Then GoTo LAB_B1
If Mid(Exp, I, 1) = "-" And I > 1 Then
AscS = Asc(Mid(Exp, I - 1, 1))
If AscS >= Asc("0") And AscS < Asc("9") Then GoTo LAB_B1
End If
Next
GoTo LAB_B2
LAB_B1:
'对于有加减法的表达式
For I = 1 To Len(Exp)
'计算加减法
If Mid(Exp, I, 1) = "+" Then
Exp = CalcA(Left(Exp, I - 1)) + CalcA(Right(Exp, Len(Exp) - I))
CalcA = CalcA(Exp)
GoTo LAB_END
ElseIf Mid(Exp, I, 1) = "-" Then
Exp = Str(CalcA(Left(Exp, I - 1)) - CalcA(Right(Exp, Len(Exp) - I)))
CalcA = CalcA(Exp)
GoTo LAB_END
End If
Next
LAB_B2:
'对于没有加减法的表达式
For I = 1 To Len(Exp)
'计算乘除法
If Mid(Exp, I, 1) = "*" Then
Exp = Str(CalcA(Left(Exp, I - 1)) * CalcA(Right(Exp, Len(Exp) - I)))
CalcA = CalcA(Exp)
GoTo LAB_END
ElseIf Mid(Exp, I, 1) = "/" Then
Exp = Str(CalcA(Left(Exp, I - 1)) / CalcA(Right(Exp, Len(Exp) - I)))
CalcA = CalcA(Exp)
GoTo LAB_END
End If
Next
LAB_END:
'Deep = Deep - 1
End Function

还有一个星期……

  就要放假回家了。怎么感觉这么快大一的一半就过完了呢……
  还是头一次用HTML写Blog,不太熟悉。
  这段时间学习上感觉没有太大的收获,比较失败。我想还是要多看点儿书吧。

2008年12月24日星期三

无题

  别人在想什么,有的时候我都懒得去想。这是一个无穷无尽的问题——你永远都得不到完整的解答。思想是一直在变化的,你变,别人也变。变化了就需要重新揣测别人的想法。于是一直需要揣测他人。这是一个深奥的问题,同时也很无聊——可是我们都要去做,实际上我们都在做。
  我有些佩服某些哲人了。从万变之中找到不变,确实是一种可行的方法,虽然这"不变"有不正确的风险。寻求本质是他们的目标。可是在我看来,对于我讲这是一件很困难的事情。或许我需要试着这样做。我们都是在独立思考,那么我当然可以有选择思考什么的权力。

无题

2008年12月19日星期五

丢失了又回来

今天中午把书包丢到食堂了……
一个书包,一件雨衣,一个乒乓球拍,一副眼镜,几个笔记本,文具纸张若干,硬币若干……
下午去找,没有找到……
本来以为真的丢了……
抱着一丝希望,晚上又去找,终于找到了……

2008年12月16日星期二

论文小结

论文小结
  虽然这次论文时间紧促,定题、调查、成文仅仅用了三周,但是各位同学都投入了十分的热情。期间多次召开小组会议讨论问题,大家都很投入,为了讨论出一个比较理想的结果,两次在路边寒冷的夜里持续会议三个余小时。这种精神值得发扬。
  首先,我们讨论了论文的题目。每个人都提出了自己喜欢的题目及想法,最终本着有可行性、题目新颖、值得调查的原则,我们选定了研究大学生人际吸引因素这个课题。之后我们讨论了论文的流程,最终决定先查阅相关资料,对人际吸引有初步了解后策划调查问卷,然后分析结果、成文。第三次会议我们根据查阅资料的结果,综合自己的分析,确认了多个研究方面,设计了问卷并复印了300份。随后在学校各个地点发放问卷,一个星期时间收回了280份。期间我们同时针对问卷设计了统计分析程序,在收回问卷之后进行了问卷录入计算机的工作,得到了统计结果。最终我们根据结果写成了论文,并前后三次修改论文。
  通过这次调查以及论文的写作,我们学习了做调查、写论文的具体方法,并且进行了实践,锻炼了自己的实践能力。我们通过充分的合作,得到了最终的结果,体现了合作的优势。论文中得到的结果,不仅仅是为了论文,也为我们的人际交往指明了方向。
小组组长:infoheader
二○○八年十二月十六日

2008年12月13日星期六

高考前的随笔——十年一叹

(从旧Blog复制而来)


高考前的随笔——十年一叹(一)
2008年06月30日 星期一 下午 04:11
高考之前我在电子词典上记下的随笔,有的是自己写的,有的是抄来的,或者无聊,或者有所感悟,总之是存下来了一堆txt文档,日期是文件名,今天想起来了,就都贴出来。算是一种回忆吧。
本来有很多的,后来电子辞典丢了一次文件,08年2月之前的文件没有存下来,就只剩下这些了。
08 02 13
我不知要写些什么.我将写些什么.然而犹豫之间,我知了.或许,我要用一辈子的时间来写,写一切的平淡与辉煌,写一切的孤寂与忧伤:那将是生命.
08 02 20
哦,我的梦 Can you hear me/ Can you hear me/ Through the dark night/ Far away 你能听到我吗/ 你能听到我吗/ 穿过哪遥远的黑夜 I am dying/ Forever crying/ To be with you/ Who can say 我在死去/ 永恒地哭泣/ 来和你在一起/ 有谁说得出 ——《Sailing》 那是无声的哭泣.在那湛蓝的天空下,哪里又是我的归处?我只能在苍茫的大地之中寻求一片净土,看世事沧桑,待年华虚度.
08 02 22
柳梢青·送卢梅坡 刘过 泛菊怀深,吹梅角远,同在京城.聚散匆匆,云边孤雁,水上浮萍.教人怎不伤情?觉几度、魂飞梦惊.后夜相思,尘随马去,月逐舟行.
08 02 25
来也匆匆去也匆匆恨不能相逢/ 爰也匆匆恨也匆匆一切都是梦/ 狂笑一声长叹一声/ 快活一生悲哀一生/ 谁与我生死与共 ——《刀剑如梦》
08 02 27
飘飘何所似天地一沙鸥
08 02 28
江楼旧感 赵嘏独上江楼思渺然月光如水水如天同来望月人何处风景依稀似去年
杳杳寒山道 寒山杳杳寒山道,落落冷涧滨.啾啾常有鸟,寂寂更无人.淅淅风吹雨,纷纷雪积身.朝朝不见日,岁岁不知春.
08 04 01
金子总会发光的. 就让岁月来洗礼,让事实来说话: 年华似水浪淘沙
08 04 03
摸鱼儿--雁邱词 元好问 问世间情是何物,直教生死相许。天南地北双飞客,老翅几回寒暑。欢乐趣,离别苦,就中更有痴儿女。君应有语,渺万里层云,千山暮雪,只影向谁去。 横汾路,寂寞当年箫鼓,荒烟依旧平楚。招魂楚些何嗟及,山鬼暗啼风雨。天也妒,未信与,莺儿燕子俱黄土。千秋万古,为留待骚人,狂歌痛饮,来访雁邱处。
虫儿飞 黑黑的天空低垂/ 两两的繁星悄随/ 虫儿飞/ 虫儿飞/ 你在思念谁 天上的星星流泪/ 地上的玫瑰枯萎/ 冷风吹/ 冷风吹/ 只要有你陪 虫儿飞/ 花儿垂/ 一双有一对才美/ 不怕天黑/ 只怕心碎/ 不管累不累/ 也不管东南西北


高考前的随笔——十年一叹(二)
2008年06月30日 星期一 下午 04:15
08 04 06 明天一模. 也不知该想什么.一模意味着还有60天高考,也就是两个月.很快就会过去的.两个月之后,我又当去哪里?
08 04 07
明天. 理综?理综.理综…… 得理综者得天下,成也理综败也理综! 心中有些颤抖.但是没有退路了. 那就前进!
今天我/寒夜里看雪飘过/怀着冷却了的心窝飘远方/风雨里追赶/雾里分不清影踪/天空海阔你与我/可会变(谁没在变) 多少次/迎着冷眼与嘲笑/从没有放弃过心中的理想/一刹那仿佛/若有失失的感觉/不知不觉已变淡/心里爱(谁明白我) 原谅我这一生不拘放纵爱自由/也会怕有一天会跌倒oh no/被弃了理想谁人都可以/哪会怕有一天只你共我 ——《海阔天空》
08 04 15
头痛.我把左手平在桌上,右手放在左手上,下巴无力地支左右手上.我感到我的心跳,连同我一起振动.不,振动的不是我,而是整个世界.08 04 16
咫尺天涯
08 04 17
夜深忽梦少年事,梦啼妆泪红阑干.——《琵琶行》
08 04 20
(有这个文件,但是是空的。为什么我也忘了。)
08 05 13
鹧鸪天 苏轼林断山明灯隐墙乱蝉衰草小池塘翻空白鸟时时见照水红渠冉冉香村舍边 古城旁杖藜徐步转斜阳殷勤昨夜三更雨又得浮生一日凉

2008年12月12日星期五

轻轻

  听着音乐,《Kiss the rain》。轻轻的旋律,透露着一丝宁静,空荡,又有一丝不甘平静。
  这到底是怎样一种感觉,说不清。
  然而我可以肯定,这是轻轻的旋律,轻轻的。
  这或许只是一个人的世界,或许不是。然而这是轻轻的旋律,如此的柔和舒缓,如此的清新。柔和却又清脆,清脆的恰到好处。
  它轻轻地洗净了一天的烦躁,干干净净,什么东西都不留下,只剩下空空荡荡的虚无。
  洗去了我的世界,我的情感,一切的世俗。这将是一个渺小生命的救赎。没有肉体,只有精神依然飘荡。
  似乎只有失去才能得到。失去世界,换得另一个世界。
  我是谁已失去了意义。我只是存在于我的世界,这世界就是我。

  上面的文字是昨天写的,今天再在后面添加一首我会永远记住的一首歌。这首歌对于我有着很大的意义。



如果流浪是你的天赋/ 那么你一定是我最美的追逐/ 如果爱情是你的游牧/ 拥有过是不是该满足/ 谁带我踏上孤独的丝路/ 追逐你的脚步/ 谁带我离开孤独的丝路/ 感受你的温度/ 我将眼泪流成天山上面的湖/ 让你疲倦时能够扎营停驻/ 羌笛声胡旋舞为你笑为你哭/ 爱上你的全部放弃我的全部/ 爱上了你之后我开始领悟/ 陪你走了一段最唯美的国度/ 爱上了你之后我从来不哭/ 谁是谁的幸福/ 我从来不在乎/ 谁是谁的旅途/ 我只要你记住/ 星星就是穷人的珍珠/ 你的笑支撑着我虔诚的最初/ 狂风沙是我单薄衣服/ 穿越过亚细亚的迷雾/ 谁带我踏上孤独的丝路/ 追逐你的脚步/ 谁带我离开孤独的丝路/ 感受你的温度/ 我将眼泪流成天山上面的湖/ 让你疲倦时能够扎营停驻/ 羌笛声胡旋舞为你笑为你哭/ 爱上你的全部放弃我的全部/ 爱上了你之后我开始领悟/ 陪你走了一段最唯美的国度/ 爱上了你之后我从来不哭/ 谁是谁的幸福/ 我从来不在乎/ 谁是谁的旅途/ 我只要你记住/ 云破日出/ 你是那道光束/ 带着平凡的我/ 走过奇迹旅途/ 爱上了你之后我开始领悟/ 陪你走了一段最唯美的国度/ 爱上了你之后我从来不哭/ 谁是谁的幸福/ 我从来不在乎/ 爱上了你之后我开始领悟/ 陪你走了一段最唯美的国度/ 爱上了你之后我从来不哭/ 谁是谁的幸福/ 我从来不在乎/ 谁是谁旅途/ 我只要/ 我只要/ 你记住

2008年12月11日星期四

随便写一点

  没什么。
  随便写一点什么。
  大学生活也有几个月了。适应不适应自己也说不清楚。到底是怎样的呢?总之,谁都是在想着过去的事情,做着现在的事情。
  过去的已经过去了,只留下一些记忆的碎片,一点一点。
  不知道这些记忆的碎片有什么真实的意义。或许,它没有意义。也许有。可是那都已经不重要。因为不论如何,那都已经成为过去了。当然不止我,很多人都是这样。也有人写,让过去成为过去,重新开始一个新的天地吧。我觉得那不可能。过去是一种经历,是生命过程的一段历史,它永远都会存在,永远不能抹杀。
  现在当然很好。很好。在以前从来没有感受到这样在高素质的人群中的感觉,可是现在有这种感觉了。可是这又怎样呢?也没有什么重要的。
  不知道自己在写什么……真是混乱。

2008年12月10日星期三

问卷调查统计程序代码更新

继续复制粘贴。
继续On Error Resume Next。
继续堆垃圾。
继续修正各种臭虫。
继续使用某种情况下会不稳定的设计方案。


'Current: 1 to 17, integer
'What's special:
'3 - TextBox - input a integer
'5, 7, 8, 9, 10, 11 - MultiSelect - max 3 selections
Dim Current As Integer
Dim CurrentN As Integer
Dim CountC As Integer
'
Dim Sel(1 To 17, 1 To 11) As CheckBox
Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
Dim SelName(1 To 17, 1 To 11) As String '记录选项名称

Sub Sel_Click()
Debug.Print "C"
End Sub

Sub BuildReport()
' 'On Error GoTo Err1
' On Error Resume Next
' Text1.Text = ""
' Dim iI As Integer, iJ As Integer
' For iJ = 1 To 17
' For iI = 1 To 11
' Text1.Text = Text1.Text & " " & SelS(iJ, iI)
' Sel(iJ, iI).Caption = SelS(iJ, iI)
''Err1:
' Next
' Text1.Text = Text1.Text & Chr(13) & Chr(10)
' Next
End Sub

Sub LoadA(LNum As Integer)
On Error Resume Next
CurrentN = LNum
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
For iJ = 1 To 17
If SelA(iJ, iI, LNum) = True Then
Sel(iJ, iI).Value = 1
Else
Sel(iJ, iI).Value = 0
End If
Next
Next
End Sub

Sub SaveA()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
For iJ = 1 To 17
SelA(iJ, iI, CurrentN) = Sel(iJ, iI).Value
If Sel(iJ, iI).Value = 1 Then
SelS(iJ, iI) = SelS(iJ, iI) + 1
End If
Next
Next
End Sub

Sub SSelC()
Select Case Current
Case 4:
SSel.Top = Label1(0).Top
Case 5:
SSel.Top = Label1(1).Top
Case 6:
SSel.Top = Label1(2).Top
Case 7:
SSel.Top = Label1(3).Top
Case 8:
SSel.Top = Label1(4).Top
Case 9:
SSel.Top = Label1(5).Top
Case 10:
SSel.Top = Label1(6).Top
Case 11:
SSel.Top = Label1(7).Top
Case 12:
SSel.Top = Label1(8).Top
Case 13 To 17:
SSel.Top = Label1(9).Top
Case Else
SSel.Top = 0
End Select
End Sub

Private Sub A_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub B_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub C_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub Command1_Click()
' BuildReport
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

'based on sex
Private Sub Command2_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(1, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command3_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(2, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command4_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(3, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command5_Click()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 17
For iJ = 1 To 11
Sel(iI, iJ).Caption = SelName(iI, iJ)
Next
Next
End Sub
Sub SaveFile(FileN As String)
LStat.Caption = "开始保存……"
DoEvents
SaveA
'write these items:
'Dim Current As Integer
'Dim CurrentN As Integer
'Dim CountC As Integer
' x Dim Sel(1 To 17, 1 To 11) As CheckBox
'Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
'Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
' x Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
' x Dim SelName(1 To 17, 1 To 11) As String '记录选项名称
Open App.Path & "\" & FileN For Output As #1
Write #1, Current, CurrentN, CountC
Dim iI As Integer, iJ As Integer, iK As Integer
For iK = 1 To 300
For iI = 1 To 17
For iJ = 1 To 11
Write #1, SelA(iI, iJ, iK)
Next
Next
Next
For iI = 1 To 17
For iJ = 1 To 11
Write #1, SelS(iI, iJ)
Next
Next
Close #1
LStat.Caption = "保存完毕"

End Sub

Private Sub Command6_Click()
SaveFile "dat.txt"
End Sub

Private Sub Command7_Click()
LStat.Caption = "开始读取"
DoEvents
'read these items:
'Dim Current As Integer
'Dim CurrentN As Integer
'Dim CountC As Integer
' x Dim Sel(1 To 17, 1 To 11) As CheckBox
'Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
'Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
' x Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
' x Dim SelName(1 To 17, 1 To 11) As String '记录选项名称
Dim Tmp
Open App.Path & "\dat.txt" For Input As #2
Input #2, Current, CurrentN, CountC
Dim iI As Integer, iJ As Integer, iK As Integer
For iK = 1 To 300
For iI = 1 To 17
For iJ = 1 To 11
Input #2, Tmp
SelA(iI, iJ, iK) = Tmp
Next
Next
Next
For iI = 1 To 17
For iJ = 1 To 11
Input #2, Tmp
SelS(iI, iJ) = Tmp
Next
Next
Close #2
LoadA CurrentN
SSelC
LStat = "读取完毕"
End Sub

Private Sub Command8_Click()
SaveA
Dim Pg As Integer
Pg = Val(Text2.Text)
If Pg < 1 Or Pg > 300 Then Exit Sub
Current = Pg
SSel.Top = 0
Current = 1
CountC = 0
LoadA Pg
End Sub

Private Sub Command9_Click()
If MsgBox("确认清空报表数据?", vbYesNo, "确认清空") = vbYes Then
Text1.Text = ""
End If
End Sub

Private Sub D_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub E_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub F_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
LStat.Caption = "调试信息 问卷:" & CurrentN & " 当前选项:" & Current & " 当前副选项:" & CountC + 1
Dim kK As Integer
'撤消
If KeyCode = 38 Then
CountC = 0
If Current >= 2 Then Current = Current - 1
SSelC
Exit Sub
End If
'特殊判别
If KeyCode = 110 Then '.
kK = 11
ElseIf KeyCode = 96 Then '0
kK = 10
ElseIf KeyCode >= 97 And KeyCode <= 97 + 8 Then
kK = KeyCode - 97 + 1
Else
Exit Sub
End If
'If Current = 3 Then
' T.Text = Chr(KeyCode)
' Current = Current + 1
' SSelC
' Exit Sub
'End If
On Error GoTo Err1
Sel(Current, kK).Value = 1 'Checked
'MultiSelect
Select Case Current
Case 5, 7, 8, 9, 10, 11:
If CountC >= 2 Then
CountC = 0
Current = Current + 1
Else
CountC = CountC + 1
End If
Case Else
Current = Current + 1
End Select
'Finish
If Current > 17 Then
Current = 1
SaveA
CurrentN = CurrentN + 1
LoadA CurrentN
End If
SSelC
Exit Sub
Err1:
MsgBox "Error", vbOKOnly, "Error"
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
Set Sel(1, iI) = A(iI - 1)
Set Sel(2, iI) = B(iI - 1)
Set Sel(3, iI) = T(iI - 1)
Set Sel(4, iI) = C(iI - 1)
Set Sel(5, iI) = D(iI - 1)
Set Sel(6, iI) = E(iI - 1)
Set Sel(7, iI) = F(iI - 1)
Set Sel(8, iI) = G(iI - 1)
Set Sel(9, iI) = H(iI - 1)
Set Sel(10, iI) = I(iI - 1)
Set Sel(11, iI) = J(iI - 1)
Set Sel(12, iI) = K(iI - 1)
Set Sel(13, iI) = L(iI - 1)
Set Sel(14, iI) = M(iI - 1)
Set Sel(15, iI) = N(iI - 1)
Set Sel(16, iI) = O(iI - 1)
Set Sel(17, iI) = P(iI - 1)
Next
'back up items
For iI = 1 To 17
For iJ = 1 To 11
SelName(iI, iJ) = Sel(iI, iJ).Caption
Next
Next
CurrentN = 1
Current = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
SaveAD
SaveFile "E " & Year(Date) & "." & Month(Date) & "." & Day(Date) & " " & Hour(Time) & "." & Minute(Time) & ".txt"
End Sub

Private Sub G_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub H_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub I_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub J_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub K_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub L_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub M_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub N_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub O_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub P_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub Paper_KeyDown(KeyCode As Integer, Shift As Integer)
Form_KeyDown KeyCode, Shift
End Sub

Private Sub Paper_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
LStat.Caption = "调试信息 问卷:" & CurrentN & " 当前选项:" & Current & " 当前副选项:" & CountC + 1
End Sub


Private Sub T_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SaveAD
End Sub

Private Sub Timer1_Timer()
LT.Caption = Val(LT.Caption) - 1
If Val(LT.Caption) = 0 Then
SaveA
SaveFile Year(Date) & "." & Month(Date) & "." & Day(Date) & " " & Hour(Time) & "." & Minute(Time) & ".txt"
LT.Caption = "10"
End If
End Sub

Sub SaveAD()
TT.Enabled = True
End Sub

Private Sub TT_Timer()
SaveA
TT.Enabled = False
End Sub

2008年12月9日星期二

问卷统计程序代码

混乱啊混乱。很多为了省事而产生的名称。功能一般。不少内部的Ctrl+C/V。
不过至少说明了我还会写一些简单的程序……


'Current: 1 to 17, integer
'What's special:
'3 - TextBox - input a integer
'5, 7, 8, 9, 10, 11 - MultiSelect - max 3 selections
Dim Current As Integer
Dim CurrentN As Integer
Dim CountC As Integer
'
Dim Sel(1 To 17, 1 To 11) As CheckBox
Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
Dim SelName(1 To 17, 1 To 11) As String '记录选项名称

Sub BuildReport()
'On Error GoTo Err1
On Error Resume Next
Text1.Text = ""
Dim iI As Integer, iJ As Integer
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelS(iJ, iI)
Sel(iJ, iI).Caption = SelS(iJ, iI)
'Err1:
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Sub LoadA(LNum As Integer)
On Error Resume Next
CurrentN = LNum
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
For iJ = 1 To 17
If SelA(iJ, iI, LNum) = True Then
Sel(iJ, iI).Value = 1
Else
Sel(iJ, iI).Value = 0
End If
Next
Next
End Sub

Sub SaveA()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
For iJ = 1 To 17
SelA(iJ, iI, CurrentN) = Sel(iJ, iI).Value
If Sel(iJ, iI).Value = 1 Then
SelS(iJ, iI) = SelS(iJ, iI) + 1
End If
Next
Next
End Sub

Sub SSelC()
Select Case Current
Case 4:
SSel.Top = Label1(0).Top
Case 5:
SSel.Top = Label1(1).Top
Case 6:
SSel.Top = Label1(2).Top
Case 7:
SSel.Top = Label1(3).Top
Case 8:
SSel.Top = Label1(4).Top
Case 9:
SSel.Top = Label1(5).Top
Case 10:
SSel.Top = Label1(6).Top
Case 11:
SSel.Top = Label1(7).Top
Case 12:
SSel.Top = Label1(8).Top
Case 13 To 17:
SSel.Top = Label1(9).Top
Case Else
SSel.Top = 0
End Select
End Sub

Private Sub Command1_Click()
BuildReport
End Sub

'based on sex
Private Sub Command2_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(1, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command3_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(2, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command4_Click(Index As Integer)
On Error Resume Next
Dim iI As Integer, iJ As Integer, iK As Integer
'统计
For iI = 1 To 17
For iJ = 1 To 11
SelSt(iI, iJ) = 0
Next
Next
For iK = 1 To 300
If SelA(3, Index + 1, iK) = True Then
For iI = 1 To 17
For iJ = 1 To 11
If SelA(iI, iJ, iK) = True Then SelSt(iI, iJ) = SelSt(iI, iJ) + 1
Next
Next
End If
Next
'显示
For iJ = 1 To 17
For iI = 1 To 11
Text1.Text = Text1.Text & " " & SelSt(iJ, iI)
Sel(iJ, iI).Caption = SelSt(iJ, iI)
Next
Text1.Text = Text1.Text & Chr(13) & Chr(10)
Next
End Sub

Private Sub Command5_Click()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 17
For iJ = 1 To 11
Sel(iI, iJ).Caption = SelName(iI, iJ)
Next
Next
End Sub

Private Sub Command6_Click()
LStat.Caption = "开始保存……"
DoEvents
SaveA
'write these items:
'Dim Current As Integer
'Dim CurrentN As Integer
'Dim CountC As Integer
' x Dim Sel(1 To 17, 1 To 11) As CheckBox
'Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
'Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
' x Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
' x Dim SelName(1 To 17, 1 To 11) As String '记录选项名称
Open App.Path & "\dat.txt" For Output As #1
Write #1, Current, CurrentN, CountC
Dim iI As Integer, iJ As Integer, iK As Integer
For iK = 1 To 300
For iI = 1 To 17
For iJ = 1 To 11
Write #1, SelA(iI, iJ, iK)
Next
Next
Next
For iI = 1 To 17
For iJ = 1 To 11
Write #1, SelS(iI, iJ)
Next
Next
Close #1
LStat.Caption = "保存完毕"
End Sub

Private Sub Command7_Click()
LStat.Caption = "开始读取"
DoEvents
'read these items:
'Dim Current As Integer
'Dim CurrentN As Integer
'Dim CountC As Integer
' x Dim Sel(1 To 17, 1 To 11) As CheckBox
'Dim SelA(1 To 17, 1 To 11, 1 To 300) As Boolean '全部问卷
'Dim SelS(1 To 17, 1 To 11) As Integer '总体统计用
' x Dim SelSt(1 To 17, 1 To 11) As Integer '分类统计用
' x Dim SelName(1 To 17, 1 To 11) As String '记录选项名称
Dim Tmp
Open App.Path & "\dat.txt" For Input As #2
Input #2, Current, CurrentN, CountC
Dim iI As Integer, iJ As Integer, iK As Integer
For iK = 1 To 300
For iI = 1 To 17
For iJ = 1 To 11
Input #2, Tmp
SelA(iI, iJ, iK) = Tmp
Next
Next
Next
For iI = 1 To 17
For iJ = 1 To 11
Input #2, Tmp
SelS(iI, iJ) = Tmp
Next
Next
Close #2
LoadA CurrentN
SSelC
LStat = "读取完毕"
End Sub

Private Sub Command8_Click()
Dim Pg As Integer
Pg = Val(Text2.Text)
If Pg < 1 Or Pg > 300 Then Exit Sub
Current = Pg
SSel.Top = 0
Current = 1
CountC = 0
LoadA Pg
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
LStat.Caption = "调试信息 问卷:" & CurrentN & " 当前选项:" & Current & " 当前副选项:" & CountC + 1
Dim kK As Integer
'撤消
If KeyCode = 38 Then
CountC = 0
If Current >= 2 Then Current = Current - 1
SSelC
Exit Sub
End If
'特殊判别
If KeyCode = 110 Then '.
kK = 11
ElseIf KeyCode = 96 Then '0
kK = 10
ElseIf KeyCode >= 97 And KeyCode <= 97 + 8 Then
kK = KeyCode - 97 + 1
Else
Exit Sub
End If
'If Current = 3 Then
' T.Text = Chr(KeyCode)
' Current = Current + 1
' SSelC
' Exit Sub
'End If
On Error GoTo Err1
Sel(Current, kK).Value = 1 'Checked
'MultiSelect
Select Case Current
Case 5, 7, 8, 9, 10, 11:
If CountC >= 2 Then
CountC = 0
Current = Current + 1
Else
CountC = CountC + 1
End If
Case Else
Current = Current + 1
End Select
'Finish
If Current > 17 Then
Current = 1
SaveA
CurrentN = CurrentN + 1
LoadA (CurrentN)
End If
SSelC
Exit Sub
Err1:
MsgBox "Error", vbOKOnly, "Error"
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim iI As Integer, iJ As Integer
For iI = 1 To 11
Set Sel(1, iI) = A(iI - 1)
Set Sel(2, iI) = B(iI - 1)
Set Sel(3, iI) = T(iI - 1)
Set Sel(4, iI) = C(iI - 1)
Set Sel(5, iI) = D(iI - 1)
Set Sel(6, iI) = E(iI - 1)
Set Sel(7, iI) = F(iI - 1)
Set Sel(8, iI) = G(iI - 1)
Set Sel(9, iI) = H(iI - 1)
Set Sel(10, iI) = I(iI - 1)
Set Sel(11, iI) = J(iI - 1)
Set Sel(12, iI) = K(iI - 1)
Set Sel(13, iI) = L(iI - 1)
Set Sel(14, iI) = M(iI - 1)
Set Sel(15, iI) = N(iI - 1)
Set Sel(16, iI) = O(iI - 1)
Set Sel(17, iI) = P(iI - 1)
Next
'back up items
For iI = 1 To 17
For iJ = 1 To 11
SelName(iI, iJ) = Sel(iI, iJ).Caption
Next
Next
CurrentN = 1
Current = 1
End Sub

Private Sub Paper_KeyDown(KeyCode As Integer, Shift As Integer)
Form_KeyDown KeyCode, Shift
End Sub

Private Sub Paper_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
LStat.Caption = "调试信息 问卷:" & CurrentN & " 当前选项:" & Current & " 当前副选项:" & CountC + 1
End Sub

2008年12月8日星期一

自动灌水软件代码

从我在0Gsns的日志复制过来的。
==================================================================
今天无聊到底了。。。于是去hnubbs灌水了。。。于是就有了这个软件。

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
'Private Const MOUSEEVENTF_RIGHTDOWN = &H8
'Private Const MOUSEEVENTF_RIGHTUP = &H10

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Sub Command1_Click()
SendKeys "{PGDN}", 100
ML
SendKeys Text1.Text
SendKeys "^{enter}", 100
End Sub

Private Sub Command2_Click()
Timer1.Enabled = Not Timer1.Enabled
Command2.Caption = Timer1.Enabled
End Sub

Private Sub Command3_Click()
List1.AddItem Text1.Text
End Sub

Private Sub Command4_Click()
On Error Resume Next
List1.RemoveItem List1.ListIndex
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim I As Integer, N As Integer, T As String
Open App.Path & "\list.txt" For Input As #1
Input #1, N
For I = 1 To N
Input #1, T
List1.AddItem T
Next
Close #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Dim I As Integer
Open App.Path & "\list.txt" For Output As #1
Write #1, List1.ListCount
For I = 0 To List1.ListCount - 1
Write #1, List1.List(I)
Next
Close #1
End Sub

Private Sub HScroll1_Change()
Label1.Caption = "速度:" & HScroll1.Value & "秒/次"
Timer1.Interval = HScroll1.Value * 1000
End Sub

Private Sub Image1_Click()
Shell "explorer.exe http://www.0ginr.com/"
End Sub

Private Sub Label3_Click()
Shell "explorer.exe http://bbs.hnubbs.com/"
End Sub

Private Sub Timer1_Timer()
Text1.Text = List1.List(Int(Rnd() * List1.ListCount))
Command1_Click
End Sub

Private Sub ML()
Dim MouseCurPos As POINTAPI
GetCursorPos MouseCurPos
mouse_event MOUSEEVENTF_LEFTDOWN, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标左键按下
mouse_event MOUSEEVENTF_LEFTUP, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标左键弹出
End Sub

准备在假期再写一个C++教程

VB转型C++的那个比较失败,所以想重新写一个常规教程。

2008年12月7日星期日

不知道广告对于blog有什么要求……

反正申请了……看看吧……

2008年12月5日星期五

初步测试完毕。启用新Blog。

应该没有什么问题了,启用新Blog。
修改了在百度的那个Blog的板式,发布了搬家公告。

发个图

学校,岳麓山,穿石坡湖。

歌词:别哭,我最爱的人

别哭我最爱的人

今夜我如昙花绽放

在最美的一霎那凋落

你的泪也挽不回地枯萎

别哭我最爱的人

可知我将不会再醒

在最美的夜空中眨眼

我的眸是最闪亮的星光

是否记得我骄傲地说

这世界我曾经来过

不要告诉我永恒是什么

我在最灿烂的瞬间毁灭

别哭我最爱的人

今夜我如昙花绽放

在最美的一霎那凋落

你的泪也挽不回地枯萎

别哭我最爱的人

可知我将不会再醒

在最美的夜空中眨眼

我的眸是最闪亮的星光

是否记得我骄傲地说

这世界我曾经来过

不要告诉我成熟是什么

我在刚开始的瞬间结束

别哭我最爱的人

今夜我如昙花绽放

在最美的一霎那凋落

你的泪也挽不回地枯萎

是否记得我骄傲地说

这世界我曾经来过

不要告诉我永恒是什么

我在最灿烂的瞬间毁灭

别哭我最爱的人

今夜我如昙花绽放

在最美的一霎那凋落

你的泪也挽不回地枯萎

2008年12月4日星期四

Blogger第一帖

打算在这里安家了……