下面這個測試是根據您一周內的情緒體驗，根據實踐活動回答：A：非常嫉妒；B：無所謂；C：有些嫉妒。

當你的戀人或配偶…… A B C 1. 突然收到異性的求愛訊號時……

2. 和異性好友交談時……

3. 帶有稱讚和羨慕的神氣討論異性的……

4. 在人際關係中比你處理得更好時……

5. 受到眾人的交口稱讚時……

6. 受到領導器重而升職時……

7. 在經濟收入上超過你時……

8. 在事業和工作上取得優異成績時……

9. 對你提起他（她）以前的戀人或曾經追求的異性時……

10.與他（她）的知已好友玩得盡情盡趣而你被冷落一旁時……

您的嫉妒傾向得分：

option explicit dim topic dim answer dim ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,ex9,ex10,ex11,ex12,ex13,ex14 dim ex15,ex16,ex17,ex18,ex19,ex20 sub res_onclick form_test1.reset form2.reset end sub '-------------------------------------------------------------------------- sub get_answer() dim count dim a count=0 '1 if ex1=1 then count=count+0 elseif ex1=2 then count=count+2 elseif ex1=3 then count=count+4 end if '2 if ex2=1 then count=count+0 elseif ex2=2 then count=count+2 elseif ex2=3 then count=count+4 end if '3 if ex3=1 then count=count+0 elseif ex3=2 then count=count+2 elseif ex3=3 then count=count+4 end if '4 if ex4=1 then count=count+0 elseif ex4=2 then count=count+2 elseif ex4=3 then count=count+4 end if '5 if ex5=1 then count=count+0 elseif ex5=2 then count=count+2 elseif ex5=3 then count=count+4 end if '6 if ex6=1 then count=count+0 elseif ex6=2 then count=count+2 elseif ex6=3 then count=count+4 end if '7 if ex7=1 then count=count+0 elseif ex7=2 then count=count+2 elseif ex7=3 then count=count+4 end if '8 if ex8=1 then count=count+0 elseif ex8=2 then count=count+2 elseif ex8=3 then count=count+4 end if '9 if ex9=1 then count=count+0 elseif ex9=2 then count=count+2 elseif ex9=3 then count=count+4 end if '10 if ex10=1 then count=count+0 elseif ex10=2 then count=count+2 elseif ex10=3 then count=count+4 end if 'end switch topic=count answer="說明你的嫉妒心過於強烈，不利於愛情健康成長。要消解你的嫉妒感，全靠別人的幫助是不夠的，根本辦法在於自我洞察和內剩只有建立自我開放的心理結構，才能擺脫自私的囚室，得到真誠幸福的愛情。" if count>=20 then answer="說明你的嫉妒心過於淡漠，對愛情生活將會喪失關切感，進而與愛侶關係鬆散。因為沒有嫉妒的愛情就不成為真正的愛情。只有不時地向戀人或配偶顯露出你的一絲妒意，才見你的愛心。" end if if count >=30 then answer="說明你善於使用合理嫉妒的藝術。並以些建構起你的和諧溫馨的愛之天地。對於瞭解自己，也瞭解愛侶的人來說，合理嫉妒是偉大的存在。" end if end sub '--------------------------------------------------- sub ok_OnClick dim x,mymsg,theform dim myex(11) dim ch set theform=Document.form_test1 ch=true for x=1 to 10 myex(x)=false next for x=0 to 2 if (form_test1.ex1(x).checked) then myex(1)=true ex1=form_test1.ex1(x).value end if if (form_test1.ex2(x).checked) then myex(2)=true ex2=form_test1.ex2(x).value end if if (form_test1.ex3(x).checked) then myex(3)=true ex3=form_test1.ex3(x).value end if if (form_test1.ex4(x).checked) then myex(4)=true ex4=form_test1.ex4(x).value end if if (form_test1.ex5(x).checked) then myex(5)=true ex5=form_test1.ex5(x).value end if if (form_test1.ex6(x).checked) then myex(6)=true ex6=form_test1.ex6(x).value end if if (form_test1.ex7(x).checked) then myex(7)=true ex7=form_test1.ex7(x).value end if if (form_test1.ex8(x).checked) then myex(8)=true ex8=form_test1.ex8(x).value end if if (form_test1.ex9(x).checked) then myex(9)=true ex9=form_test1.ex9(x).value end if if (form_test1.ex10(x).checked) then myex(10)=true ex10=form_test1.ex10(x).value end if next for x=1 to 10 if not myex(x) then mymsg=msgbox("在提交之前請完整輸入",48,"請完整輸入") ch=false exit for end if next 'ch=true 'topic="aassssssssssssssssssssssssssssssssssssssssssss" 'answer="bbasdasaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" if ch then get_answer() document.form2.text1.value =topic document.form2.text2.value=answer end if end sub