VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 5116|回复: 11

[原创] 测试你是什么味道的[开源]

[复制链接]
 楼主| 发表于 2008-12-19 15:36:09 | 显示全部楼层 |阅读模式
测试 你是什么味道的

这个是早期写的程序了,在杂志上看到一个测试题,觉得有趣,就用VB程序写出来,很简单的东西。

你也来测测吧!

程序抓图

程序抓图

你是什么味道的.rar

253.74 KB, 下载次数: 568

源代码

评分

参与人数 1威望 +2 收起 理由
hovidelphic + 2

查看全部评分

本帖被以下淘专辑推荐:

发表于 2008-12-19 16:39:25 | 显示全部楼层
不错的东西
回复 支持 反对

使用道具 举报

发表于 2008-12-19 17:14:15 | 显示全部楼层

刚刚没事做,把楼主的程序做了一下盗版..
比起楼主的声音+图片的效果.. 我这个翻版的,仅能用迷你一点来形容了..
呵呵,具有可移植性哟, 你有其它的测试题目,相信随便改改就能用了..





  1. Option Explicit


  2. Private Type testQA
  3.     Q As String
  4.     A1 As String
  5.     A2 As String
  6.     G1 As String
  7.     G2 As String
  8. End Type

  9. Dim FlavorTest() As testQA, Qid As Long, SelA As Long

  10. Private Sub cmdNext_Click()
  11.     Dim QG As String
  12.     If cmdNext.Caption = "完成测试" Then Unload Me
  13.     QG = Choose(SelA + 1, Qid, FlavorTest(Qid).G1, FlavorTest(Qid).G2)
  14.     If IsNumeric(QG) Then
  15.         Qid = Val(QG)
  16.         Call ShowQ
  17.     Else
  18.         labQ.Height = 1500
  19.         optA(1).Visible = False
  20.         optA(2).Visible = False
  21.         cmdNext.Caption = "完成测试"
  22.         Select Case QG
  23.             Case Is = "A"
  24.                 Frame1.Caption = "A.你是属于水果香形象"
  25.                 labQ = "    你充满自由愉悦的气息,总是沉溺在游乐场当中,像个天真无邪的孩子。有你在的地方,整个气氛都会兴奋起来,所以你是聚会中不可或缺的人物。虽说你个性开朗,受到大部分人的喜爱,但别人一般认为难以跟你成为亲密好友,即是说,你给人的印象只是个搞笑能手。有些人觉得你爱玩弄别人,依赖性又强,所以不太愿意亲近你。不过,真正的你其实十分成熟稳重,正因透彻了解你的人不多,所以知已朋友也相当少。"
  26.             Case Is = "B"
  27.                 Frame1.Caption = "B.你是属于东方花香形象"
  28.                 labQ = "    你拥有强烈的自我意识及自己的世界,不会被他人玩弄于股掌之间,会利用自己的力量积极地达成愿望,给人有热情的印象。你不会跟朋友纠缠不清,再加上给人单独行动的印象,围绕在你周围的人都会觉得你是一个“带有神秘色彩的人物”。“神秘感”有时是相当有魅力的意思,但是人们对于你严密的防备以及自命清高的态度,感觉无法轻松地与你对谈而觉得你难以应付。甚而变成非必要不跟你接触,对你敬而远之的倾向。真正的你其实是相当温柔的,但是除非是与你相当亲近的人,否则是无法注意到你的优点。"
  29.             Case Is = "C"
  30.                 Frame1.Caption = "C.你是属于草香形象"
  31.                 labQ = "    你拥有非常坚强的意志,不依赖他人,给人独来独往的印象。你拥有旺盛的好奇心与丰富的感受性,是个过着知性生活的现代人。骤看下你是个自命清高,不好相处的人,但是一旦跟你交谈后,就知道你很好相处,等到交情加深之后,就更知道你其实拥有很爽快的个性。你所拥有的中性化魅力,让你不论在男性团体或女性团体都大受欢迎,不过你不喜欢让人看到你脆弱的一面。你外表上看来也许很冷静,但实际上却是热情如火。能够知道你真正本性的人,才能够跟你天长地久地交往下去。"
  32.             Case Is = "D"
  33.                 Frame1.Caption = "D.你是属于花香形象"
  34.                 labQ = "    你总是给人乐观、积极和勇于面对困难的感觉,而且温柔优雅,很懂得为他人设想,给人非常擅长维系人际关系的印象。这样的你让人既坚强又脆弱,尤其是你那关怀体贴的包容力,更让人觉得你相当有魅力,很值得信赖。你长期给人认为你是个“拜托做事绝不会拒绝”的人,所以特别容易让依赖心强、只顾自己利益的人利用。这些人因为看中我细心随和的一面,所以会故意亲近你,然后借故沾你便宜。"
  35.         End Select
  36.     End If
  37. End Sub

  38. Private Sub Form_Load()
  39.     Dim tmpStr$(), i&, j&
  40.     tmpStr$ = Split("你会把自己比喻成哪种花香? 浓郁的花香 清淡的花香 2 3 你会选择哪种香味的润唇膏? 水果味 薄荷味 4 5 你会把自己比喻为哪种花束? " & _
  41.                     "红色系的花束(如红色/粉红色/橙色) 非红色系的花束(如白色/蓝色/紫色) 2 5 你跟意中人首次约会用什么香水? 带有甜味的花香 清爽的水果" & _
  42.                     "香味 6 7 你较喜欢哪种味道? 盛夏乾燥的草味 雨後湿淋淋的草味 4 7 玫瑰和百合,你较喜欢哪种香味? 玫瑰 百合 8 9 你刚发现一瓶新款" & _
  43.                     "洗头水,你十分喜欢它的味道,那瓶子的形状是怎样? 圆形 长身形 6 10 当你情绪低落时,哪种味道最能抚慰你的心灵? 花香 森林的味道 " & _
  44.                     "11 12 你在收视超高的剧集中看见一个香包,它是什么颜色? 紫色 红色 8 12 市面刚推出了一种全新的香草味雪糕,你的看法是什么? 相当" & _
  45.                     "引人注意 不太引人注意 9 13 下列哪种味道会勾起你怀念的感觉? 面包香味 大自然的味道 14 15 如果月亮的光辉会发出味道,你嗅到後会联" & _
  46.                     "想起下列哪组形容词? 刺激/灿烂夺目/香味四溢 沉郁/弧独/踏实/安静 11 15 你较喜欢哪种香味? 香料 茶香 12 16 你对体味的看法是? 非" & _
  47.                     "常讨厌 如果是自己喜欢的味道就没有关系 17 18 你觉得什么香味较有助提神? 柑橘香 薄荷香 14 18 你喜欢异性身上有哪种香味? 香水味 " & _
  48.                     "自然肥皂 15 19 想起游乐场,你会想起哪种味道? 牛奶及葡萄 甜甜的糖果 20 21 如果要在房间燃点香薰,你喜欢哪一种形状的香薰? 三角" & _
  49.                     "锥形 棒状 17 21 你对於香水的看法是? 非常喜欢 不算十分喜欢 18 22 对於婴儿使用的肥皂系列香味有什么看法? 喜欢 不是特别喜欢 A B" & _
  50.                     " 你知道自己的味道吗? 不知道 知道 20 C 喜欢皮革的味道吗? 喜欢 讨厌 21 D")
  51.                
  52.     ReDim FlavorTest(1 To (UBound(tmpStr) + 1) / 5)
  53.     For i = 0 To UBound(tmpStr) Step 5
  54.         j = j + 1
  55.         FlavorTest(j).Q = Format(j, "第#题: ") & tmpStr(i)
  56.         FlavorTest(j).A1 = tmpStr(i + 1)
  57.         FlavorTest(j).A2 = tmpStr(i + 2)
  58.         FlavorTest(j).G1 = tmpStr(i + 3)
  59.         FlavorTest(j).G2 = tmpStr(i + 4)
  60.     Next
  61.     Qid = 1
  62.     cmdNext.Caption = "下一题"
  63.     ShowQ
  64. End Sub

  65. Sub ShowQ()
  66.     labQ = FlavorTest(Qid).Q
  67.     optA(0).Value = True
  68.     optA(1).Caption = FlavorTest(Qid).A1
  69.     optA(2).Caption = FlavorTest(Qid).A2
  70. End Sub

  71. Private Sub optA_Click(Index As Integer)
  72.     SelA = Index
  73. End Sub
复制代码
Ftest.PNG

FlavorTest.rar

11.54 KB, 下载次数: 429

回复 支持 反对

使用道具 举报

发表于 2008-12-19 17:15:13 | 显示全部楼层
  除了那一堆文字, 代码真的没几行哟..
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-12-19 17:37:07 | 显示全部楼层
原帖由 VB妮可 于 2008-12-19 17:14 发表

刚刚没事做,把楼主的程序做了一下盗版..
比起楼主的声音+图片的效果.. 我这个翻版的,仅能用迷你一点来形容了..
呵呵,具有可移植性哟, 你有其它的测试题目,相信随便改改就能用了..


我那大概是03年写的,那个时候我才刚刚拥有自己的电脑不太久呢。
你的代码比我的可强多了。
回复 支持 反对

使用道具 举报

发表于 2008-12-19 22:52:01 | 显示全部楼层
原帖由 VB妮可 于 2008-12-19 17:15 发表
  除了那一堆文字, 代码真的没几行哟..


妮可精益求精!
回复 支持 反对

使用道具 举报

发表于 2009-8-10 08:14:25 | 显示全部楼层
快不能加分了,纯支持下
回复 支持 反对

使用道具 举报

发表于 2009-10-4 18:09:32 | 显示全部楼层
顶一下
回复 支持 反对

使用道具 举报

发表于 2011-9-12 19:54:30 | 显示全部楼层
顶顶更健康
回复 支持 反对

使用道具 举报

发表于 2011-12-23 09:28:09 | 显示全部楼层
很有趣的 测试。。
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-10-14 11:21

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表