<%if Request.Form("cmdPredict")<>"" then '------------------------------------------------------------------------ Dim MaxDay,StrDay,StrMonth,StrYear,longDay Dim longMonth,longYear Dim Lunar Dim TmpStr,Result strDay = Cint(request("lstDay")) strMonth = Cint(request("lstMonth")) strYear = Cint(request("lstYear")) strTime=request("strTime") '-------------------------------------------------------------------------------------------------------- ' ตรวจสอบตกฟาก ถ้าเกิด ก่อน หมโมงเช้า ถือว่ายังเป็นวันเก่าอยู่ '-------------------------------------------------------------------------------------------------------- If Cint(Left(strTime, 2)) < 6 Then If Cint(StrDay) = 1 Then Select Case (StrMonth - 1) Case 0 'Go Bacl Last year StrDay = "31" StrYear = Cstr(StrYear - 1) StrMonth = "12" Case 2 If leapyear(StrYear) = True Then StrDay = "29" Else StrDay = "28" End If StrMonth = CStr(StrMonth - 1) Case 3, 5, 7, 8, 10 StrDay = "31" StrMonth = cStr(StrMonth - 1) Case 4, 6, 9, 11 StrDay = 30 StrMonth = cStr(StrMonth - 1) End Select Else StrDay = cStr(StrDay - 1) End If End If If strMonth = 1 Then MaxDay = 31 ElseIf strMonth = 2 Then If leapyear(StrYear) = True Then MaxDay = 29 Else MaxDay = 28 End If ElseIf strMonth = 3 Then MaxDay = 31 ElseIf strMonth = 4 Then MaxDay = 30 ElseIf strMonth = 5 Then MaxDay = 31 ElseIf strMonth = 6 Then MaxDay = 30 ElseIf strMonth = 7 Then MaxDay = 31 ElseIf strMonth = 8 Then MaxDay = 31 ElseIf strMonth = 9 Then MaxDay = 30 ElseIf strMonth = 10 Then MaxDay = 31 ElseIf strMonth = 11 Then MaxDay = 30 ElseIf strMonth = 12 Then MaxDay = 31 End If If StrDay > MaxDay Then 'MsgBox "กรุณาป้อน วันอีกครั้ง !", , "ป้อนวันผิดพลาด" 'Exit Sub End If If StrYear < 2400 Or StrYear > 2574 Then ' MsgBox "กรุณาป้อน ปีอีกครั้ง ในช่วง ๒๔๐๐ ถึง ๒๕๗๔", , "ป้อนปีผิดพลาด" ' Exit Sub End If '--------------------------------------------------------------------------------------------------------- Lunar = Solar2Lunar(StrDay, StrMonth, StrYear) 'Response.Write("Lunar=" & Lunar & "
") arrLunar=split(Lunar,",") Lunar_Day=arrLunar(0) Lunar_Month=arrLunar(1) Lunar_Year=arrLunar(2) Lunar_DayOfWeek=arrLunar(3) '---------------------------------------------------------------------------------------------------------- ' Prepare data for label on Form '---------------------------------------------------------------------------------------------------------- '------------------------------- 'วัน '------------------------------ Select Case Cint(Lunar_DayofWeek) Case 1 strLunarDate = "วันอาทิตย์ " Case 2 strLunarDate = "วันจันทร์ " Case 3 strLunarDate = "วันอังคาร " Case 4 strLunarDate = "วันพุธ " Case 5 strLunarDate = "วันพฤหัส " Case 6 strLunarDate = "วันศุกร์ " Case 7 strLunarDate = "วันเสาร์ " End Select '------------------------------- ' ค่ำ '------------------------------- If Lunar_Day > 15 Then strLunarDate = strLunarDate & "แรม " & (Cint(Lunar_Day) - 15) & " ค่ำ" Else strLunarDate = strLunarDate & "ขึ้น " & Cint(Lunar_Day) & " ค่ำ" End If '-------------------------- 'เดือน '-------------------------- Select Case Cint(Lunar_Month) Case 1 strLunarDate = strLunarDate & " เดือน อ้าย" Case 2 strLunarDate = strLunarDate & " เดือน ยี่" Case 3 strLunarDate = strLunarDate & " เดือน สาม" Case 4 strLunarDate = strLunarDate & " เดือน สี่" Case 5 strLunarDate = strLunarDate & " เดือน ห้า" Case 6 strLunarDate = strLunarDate & " เดือน หก" Case 7 strLunarDate = strLunarDate & " เดือน เจ็ด" Case 8 strLunarDate = strLunarDate & " เดือน แปด" Case 9 strLunarDate = strLunarDate & " เดือน เก้า" Case 10 strLunarDate = strLunarDate & " เดือน สิบ" Case 11 strLunarDate = strLunarDate & " เดือน สิบเอ็ด" Case 12 strLunarDate = strLunarDate & " เดือน สิบสอง" End Select '--------------------------- 'ปี '--------------------------- Select Case Cint(Lunar_Year) Case 1 strLunarDate = strLunarDate & " ปีชวด" Case 2 strLunarDate = strLunarDate & " ปีฉลู" Case 3 strLunarDate = strLunarDate & " ปีขาล" Case 4 strLunarDate = strLunarDate & " ปีเถาะ" Case 5 strLunarDate = strLunarDate & " ปีมะโรง" Case 6 strLunarDate = strLunarDate & " ปีมะเส็ง" Case 7 strLunarDate = strLunarDate & " ปีมะเมีย" Case 8 strLunarDate = strLunarDate & " ปีมะแม" Case 9 strLunarDate = strLunarDate & " ปีวอก" Case 10 strLunarDate = strLunarDate & " ปีระกา" Case 11 strLunarDate = strLunarDate & " ปีจอ" Case 12 strLunarDate = strLunarDate & " ปีกุน" End Select '--------------------------------------------------------------------------------------------------------- 'คำนวณเศษ '--------------------------------------------------------------------------------------------------------- 'เศษพระจอมเกล้า ท่านให้เอาวัน เดือน ปี บวกเข้าด้วยกัน นับปีชวด เป็นต้น เดือนอ้ายเป็นต้น 'วันอาทิตย์เป็นต้น ถ้ามีเศษเกินกว่า 10 ขึ้นไป ต้องเอา 10 หัก ออกเสมอ เอาเศษแค่ 10 เป็นจำนวนทาย ดังนี้ '-------------------------------------------------------------------------------------------------------- Result = ((Cint(Lunar_DayofWeek) + Cint(Lunar_Month) + Cint(Lunar_Year))*7) Mod 12 Select Case Result Case 1 strResult = " เศษ ๑ พึงขนาดตำนานกล่าว    วัดโดยยาวหกนิ้วไม่ใช่สั้น

" + _ "ทั้งยศศักดิ์เจ้าชู้ไม่ชั่วครัน    หัวใจนั้นชอบเล่นไม่เคล้นคลึง

" + _ "จะสาวแก่แม่หม้ายไม่วายนึก    พอแก่คึกชั่วครู่ต้องสู้ถึง

" + _ "แม้เจ็บตัวหิ้วหัวมิกลัวคะนึง    เฝ้าแต่คลึงคลอดคร่ำอยู่ร่ำไป

" Case 2 strResult = " เศษ ๒ ในตำราว่าเจ็ดนิ้ว    มักเป็นนิ่วเหือดฝีมีมากหลาย

" + _ "องคชาตเอียงปรากฏคดข้างซ้าย    ไม่พอใจคู่ขาคราร่วมควง

" + _ "ทางยศศักดิ์ฐานเทียบเปรียบกับเขา    ตามบุญเก่าทำไว้ไม่ต้องห่วง

" + _ "ก็มีบ้างตามตำรามิใช่ลวง    เพียงพระหลวงแล้วไซร้ต้องได้ครัน

" Case 3 strResult = " เศษ ๓ กามราคะแสนแรงร้าย    อดไม่ได้สักวันเดียวเสียวกระสัน

" + _ "รูปร่างพอสันทัดทั้งกลัดมัน    ไม่ยาวสั้นพอเหมาะจำเพาะทาง

" + _ "แต่ชะตาวาสนาไม่อาภัพ    พอจะนับดีได้ไม่ขัดขวาง

" + _ "แต่มีชั่วปนมาน่าระคาง    เพียงขั้นกลางอยู่บุญกรรมที่ทำมา

" Case 4 strResult = " เศษ ๔ ในตำราว่ามียศ    แน่ปรากฏหญิงชายใจใฝ่หา

" + _ "รูปพรรณสันทัดจัดเอาว่า    พอจะอาศัยได้คราใช้งาน

" + _ "แต่ตอนหัวไยหมวกไม่มีใส่    แลดูใสบานเบิกเลิกถึงกั่น

" + _ "ถ้ามีเมียมักนอกใจให้รำคาญ    เพราะหัวสั้นชวนเมียระเหี่ยใจ

" Case 5 strResult = " เศษ ๕ ว่าเลิคประเสร็จศรี    เพราะมีปัญญาเทียบบ่าไหล่

" + _ "อันว่าชะตาวาสนาพอพาไป    ตามแต่ได้ผลบุญที่จุนเจือ

" + _ "ส่วนทรัพย์ถ้าเป็นคฤหัสถ์    ต้องแค้นขัดหายากลำบากเหลือ

" + _ "แต่มักเลิศตัณหาพาร้ายเจือ    ส่วนแท่งเนื้อนั้นหนอพอตัวตน

" Case 6 strResult = " เศษ ๖ ยกตำราขึ้นมาอ้าง    เรื่องในทางเกี้ยวเลี้ยวลัดไม่ขัดสน

" + _ "แต่ในจิตไม่ได้เป็นตัวตน    พอสมผลแล้วก็หลบไม่พบพา

" + _ "อันปัญญายิ่งปัญหาใดสถิตอยู่    ทั้งเหลี่ยมคูพร้อมอำนาจวาสนา

" + _ "วงพักตร์งามนักหนอลออตา    ส่วนยาวว่าหกนิ้วเขตเศษยังมี

" Case 7 strResult = " เศษ ๗ แน่นักประจักษ์ต้อง    เจ็ดนิ้วสองกระเบียดเหยีดเต็มที่

" + _ "คราเริ่มงานหญ้าสะท้านหวั่นฤดี    แทบลุกหนีเพราะแสบไส้ในอุทร

" + _ "อันความดีก็มีพอแต่    พอกันแก้เสนียดภัยอันร้ายก่อน

" + _ "พึ่งตนได้ไม่ต้องอนาทร    คราวเดือดร้อนเพราะปัญญานั้นพาไป

" Case 8 strResult = " เศษ ๘ ในตำราว่ายาวเยี่ยม    แปดนิ้วเทียมแบบครูดูไฉน

" + _ "ช่างยาวเหลือคราคิดพินิจไป    เหมือนสากใหญ่ปลายแบ่งตระหง่านบาน

" + _ "ในชีวิตจิตจ่อแต่ยอดชู้    หญิงไม่สู้ต้องขยาดไม่อาจหาญ

" + _ "อันอาชีพเริ่มพึ่งราชการ    แม้จะนานเหนื่อยหน่อยต้องได้ดี

" Case 9 strResult = " เศษ ๙ ว่าเลิศประเสริฐสุข    ไม่มีทุกข์มาตัดสุขี

" + _ "ไม่ค่อยคิดถึงเรื่องโลกีย์    ครองชีวีละม้ายคล้ายพระเชียว

" + _ "อันรูปพรรณส่วนฐานประมาณนั้น    ว่าอ้วนอั๋นแลหาไม่น่าเหลียว

" + _ "แต่ว่าจะอ่อนเปลี้ยเสียทีเดียว    บางคราวเปลี่ยวเกิดสนุกจึงลุกชี้

" Case 10 strResult = " เศษ ๑๐ เมียมักจะรักใคร่    ช่างจี้ไชดูดูประจู๋ ประจี๋

" + _ "ทั้งรูปร่างเกลียวกลมสมอินทรีย์    ทั่วบ้านมีลูกเต้าเต็มเหย้าเรือน

" + _ "ไม่ค่อยคิดอื่นไกลหากินเศษ    เกินขอบเขตนอนบ้านหาไม่เหมือน

" + _ "พริกถ้วยเก่าแล้วเล่าไม่แชเชือน    ไม่เบื่อเบือนเชือนแชแน่เสียจริง

" Case 11 strResult = " เศษ ๑๑ มิพูดเท็จเท่ากิ่งก้อย    กะจ้อยร่อยนิดเดียวกระหนุงกระหนิง

" + _ "แต่มีบทประโลมโฉมประวิง    ดีเด็ดจริงนารีติดไม่คิดแช

" + _ "ถึงจะสั้นแต่พิษสงพริกขี้หนู    จิตใจสู้ทรหดกำหนดแน่

" + _ "ไม่หันเหเรรวนหรือปรวนแปร    เป็นเอกแท้แต่หญิงเสียจริงละ

" Case 0 strResult = " เศษ ๑๒ พูนเพิ่มเฉลิมเลิศ    แสนประเสร็ฐหญิงใดถ้าได้ปะ

" + _ "สิบสองนิ้วยาวเฟื้อยดูเลื้อยละ    สั้นพอกะลงมาสักเก้านิ้ว

" + _ "หญิงใดได้ดูแล้วชูชื่น    ระรื่นรสตามเมื่อยามหิว

" + _ "เฝ้าอิงแอบแนบชิดไม่บิดพลิ้ว    ชะตาลิ่วลอยเมฆฌป็นเอกเอย

" End Select end if%> ตำราบุรุษลักษณะ