NICK_SOURCE_FROM_BOARD

Submitted by sukoom2001 on Sat, 03/07/2009 - 00:36
  1. ' กำหนดรูปแบบตัวแปร
  2. Dim MidiPath As String
  3. Dim LyricPath As String
  4. Dim CursorPath As String
  5. Dim Change As Integer
  6. Dim SongStr As String
  7. Dim StartTime As Long
  8. Dim TotalCur As Integer
  9. Dim Lyric() As String
  10. Dim Cursor() As Integer
  11. Dim AllPath As String
  12. Dim n As Integer
  13. Dim tTime As Long
  14. Dim txtMidi As String, Bpm As Single, ppqn, Num, Den, Quarter As Double, Timebase
  15. Dim nDen As Integer
  16. Dim SetFontSize As Integer
  17. Dim cn As Integer
  18. Dim TCount As Integer
  19.  
  20. Private Declare Function GetTickCount Lib "kernel32" () As Long
  21.  
  22. Sub Delay(D As Single)
  23. Dim TimeStart As Single
  24. 'Delay for D seconds
  25. TimeStart = Timer
  26. Do
  27. Loop While Timer - TimeStart < D
  28. End Sub
  29.  
  30. ' เมื่อโหลดโปรแกรม
  31. Private Sub Form_Load()
  32. On Error Resume Next
  33. Form2.Show vbModal
  34. 'Text1.Text = "D:\Karaoke"
  35. Text1.Text = App.Path
  36. Picture1.Width = Me.Width ' กำหนดช่องแสดงเนื้อเพลงกว้างเท่ากับหน้าต่างปัจจุบัน
  37. Picture1.BackColor = &H80000001 ' สีพื้นของส่วนที่แสดงเนื้อร้อง
  38. AllPath = Text1.Text ' รับค่า Path ที่เก็บเพลงจาก Text1
  39. Change = 0 ' กำหนดค่าเริ่มต้นเป็น 0
  40. List2.Visible = False ' ซ่อน list2 ขณะเริ่มโปรแกรม
  41. Timer1.Enabled = True ' เริ่มนับเวลาทันทีของ Timer1
  42. Timer1.Interval = 200 ' ความเร็วในการเพิ่มตัวหนังสือ Title bar เลขน้อยยิ่งเร็ว
  43. Timer2.Enabled = False ' ปิดการนับเวลาของ Timer2
  44. Timer2.Interval = 1000 ' กำหนดการนับเวลา 1 เท่ากับ 1 วินาที
  45. Timer3.Interval = 1000 ' กำหนดการนับเวลา 1 เท่ากับ 1 วินาที
  46.  
  47. Call CheckDate ' เรียกส่วนย่อย CheckDate มาทำงาน
  48. Call LoadFile ' เรียกส่วนย่อย LoadFile มาทำงาน
  49. Call PlayBreak ' เรียกส่วนย่อย PlayBreak มาทำงาน
  50.  
  51. End Sub
  52.  
  53. ' ตรวจสอบวัน , วันที่ , เดือน , พ.ศ.
  54. Sub CheckDate()
  55. ' ตรวจสอบวันภาษาไทย
  56. If Weekday(Now) = 1 Then nDay = "วันอาทิตย์"
  57. If Weekday(Now) = 2 Then nDay = "วันจันทร์"
  58. If Weekday(Now) = 3 Then nDay = "วันอังคาร"
  59. If Weekday(Now) = 4 Then nDay = "วันพุธ"
  60. If Weekday(Now) = 5 Then nDay = "วันพฤหัสบดี"
  61. If Weekday(Now) = 6 Then nDay = "วันศุกร์"
  62. If Weekday(Now) = 7 Then nDay = "วันเสาร์"
  63.  
  64. ' ตรวจสอบเดือนภาษาไทย
  65. If Month(Now) = 1 Then Mon = "มกราคม"
  66. If Month(Now) = 2 Then Mon = "กุมภาพันธ์"
  67. If Month(Now) = 3 Then Mon = "มีนาคม"
  68. If Month(Now) = 4 Then Mon = "เมษายน"
  69. If Month(Now) = 5 Then Mon = "พฤษภาคม"
  70. If Month(Now) = 6 Then Mon = "มิถุนายน"
  71. If Month(Now) = 7 Then Mon = "กรกฎาคม"
  72. If Month(Now) = 8 Then Mon = "สิงหาคม"
  73. If Month(Now) = 9 Then Mon = "กันยายน"
  74. If Month(Now) = 10 Then Mon = "ตุลาคม"
  75. If Month(Now) = 11 Then Mon = "พฤศจิกายน"
  76. If Month(Now) = 12 Then Mon = "ธันวาคม"
  77.  
  78. Label8.Caption = nDay & " ที่ " & Day(Now()) & " " & Mon & " " & Year(Now) + 543 ' แสดงวัน เดือน ปี
  79.  
  80. End Sub
  81.  
  82. ' ตั้งค่าเลือกคุณภาพเสียงของ sound card
  83. Private Sub cmdSetSound_Click() ' เมื่อคลิกปุ่ม
  84. Timer2.Enabled = False
  85. MMControl1.Command = "close" ' สั่งปิดไฟล์ก่อน
  86. Shell "control.exe" & " mmsys.cpl,,2" ' โหลดส่วนตั้งค่า sound ของ window
  87. End Sub
  88.  
  89. ' ออกจากโปรแกรม
  90. Private Sub cmdExit_Click()
  91. MMControl1.Command = "close" ' สั่งปิดไฟล์ก่อน
  92. Unload Me ' หยุดการโหลดโปรแกรม
  93. End Sub
  94.  
  95. ' โหลดรายชื่อเพลงทั้งหมด
  96. Private Sub LoadFile()
  97. Dim SongName As String ' กำหนดค่าตัวแปร
  98. On Error Resume Next
  99. Open App.Path & "\" & "List.txt" For Input As #1 ' เปิดไฟล์ที่เก็บข้อมูลเพลง list.txt
  100. Do While Not EOF(1) ' ตรวจดูจนจบไฟล์
  101. Line Input #1, SongName ' นำคำที่ได้ไปเก็บใน SongName
  102. List1.AddItem " " & Mid(SongName, 10, Len(SongName) - 9) ' โหลดชื่อเพลงและนักร้องไปเก็บใน List1 โดยตัดตัวเลขชื่อไฟล์ออก
  103. List2.AddItem Left(SongName, 8) ' โหลดชื่อไฟล์เพลงไปเก็บใน List2 โดยตัดชื่อเพลงและนักร้องออก
  104. Loop ' ทำซ้ำ
  105. Close #1 ' ปิดไฟล์ที่เก็บข้อมูลเพลง
  106. End Sub
  107.  
  108. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  109. List1.Visible = False ' ซ่อน list1
  110. Frame1.Visible = False ' ซ่อน Frame1
  111. End Sub
  112.  
  113. Private Sub Label10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  114. List1.Visible = True ' แสดง list1
  115. End Sub
  116.  
  117. Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  118. Frame1.Visible = True ' แสดง Frame1
  119. End Sub
  120.  
  121. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  122. List1.Visible = False ' ซ่อน List1
  123. Frame1.Visible = False ' ซ่อน Frame1
  124. End Sub
  125.  
  126. ' เมื่อคลิก list1
  127. Private Sub List1_Click()
  128. List2.ListIndex = List1.ListIndex ' กำหนดการเลือก list2 เหมือน list1
  129. SongStr = RTrim(List2.Text) ' ชื่อไฟล์ midi
  130. MidiPath = AllPath & "\Song\" & Left(SongStr, 1) ' ตำแหน่งที่เก็บเพลง midi
  131. LyricPath = AllPath & "\Lyrics\" & Left(SongStr, 1) ' ตำแหน่งที่เก็บเนื้อเพลง
  132. CursorPath = AllPath & "\Cursor\" & Left(SongStr, 1) ' ตำแหน่งที่เก็บ cursor
  133.  
  134. Call PlayMidi ' เรียกส่วนย่อย PlayMidi มาทำงาน
  135.  
  136. End Sub
  137.  
  138. ' เล่นเพลง midi
  139. Private Sub PlayMidi()
  140. n = 3 ' ตัวนับเพื่อตรวจสอบบรรทัดของเนื้อร้อง
  141. cn = 0 ' ตัวนับเพื่อตรวจสอบตำแหน่งปัจจุบัน
  142. TCount = 0 ' ตัวนับเพื่อตรวจสอบค่าเวลาที่ผ่านไป
  143. Timer2.Enabled = True ' เริ่มจับเวลา timer2
  144. MMControl1.Command = "close" ' สั่งปิดไฟล์ที่โหลดไว้
  145. MMControl1.FileName = MidiPath & "\" & SongStr & ".mid" ' ที่เก็บเพลงและชื่อเพลงที่จะเล่น
  146. MMControl1.Command = "open" ' สั่งเปิดไฟล์ที่จะเล่น
  147. MMControl1.Command = "play" ' สั่งเล่นเพลงที่เปิดไว้
  148. MMControl1.TimeFormat = 0 ' กำหนดรูปแบบการแสดงเวลาเพลง
  149. MidiTime = MMControl1.TrackLength
  150. Min = Int(MidiTime / 1000 / 60) ' ความยาวเพลงที่เป็นนาที
  151. Sec = Int(MidiTime / 1000 - Min * 60) ' ความยาวเพลงที่เป็นวินาที
  152. StartTime = GetTickCount ' ตรวจสอบค่าเวลาที่นับได้
  153. tTime = 0
  154.  
  155. Call Read_Midi
  156. Call Read_Cursor
  157. Call Read_Lyrics
  158. ' Call ChangeCursor
  159.  
  160. On Error Resume Next
  161. Label2.Caption = MMControl1.FileName
  162. Label3.Caption = List1.Text
  163. n = 4
  164. Timer2.Interval = Int(ppqn / (768000 / Timebase)) * Quarter
  165. Label9.Caption = " Tempo = " & Int(Bpm) & " " & Num & "/" & nDen & " Time = " & Format(Min, "00") & ":" & Format(Sec, "00")
  166.  
  167. Call Lyrics_Show
  168.  
  169. End Sub
  170.  
  171. ' เมื่อเล่นจบเพลง
  172. Private Sub MMControl1_Done(NotifyCode As Integer)
  173. If ProgressBar1.Value = 100 Then
  174. Timer2.Enabled = False
  175. Timer3.Enabled = True
  176. ProgressBar1.Value = 0
  177. End If
  178. End Sub
  179.  
  180. ' เมื่อคลิกปุ่มหยุด
  181. Private Sub MMControl1_StopClick(Cancel As Integer)
  182. Timer2.Enabled = False
  183. ProgressBar1.Value = 0
  184. End Sub
  185.  
  186. Private Sub Text1_Change()
  187. AllPath = Text1.Text ' กำหนด path ใหม่
  188. Call LoadFile ' เรียกส่วนย่อยมาทำงาน
  189. End Sub
  190.  
  191. ' เล่นเพลง break
  192. Private Sub PlayBreak()
  193. Dim NumBreak As String
  194. Randomize ' กำหนดเป็นแบบสุ่มตัวเลข
  195. NumBreak = Int(9 * Rnd + 1) ' สุ่มหาค่าตัวเลข 1 ถึง 10
  196. MMControl1.Command = "close" ' ปิดไฟล์เพลง
  197. MMControl1.FileName = App.Path & "\Break\" & "Break" & NumBreak & ".mid" ' ชื่อไฟล์ที่กำลังเล่น
  198. MMControl1.Command = "open" ' เปิดไฟล์เพลง
  199. MMControl1.Command = "play" ' เล่นไฟล์เพลง
  200. Label2.Caption = MMControl1.FileName ' แสดงชื่อไฟล์ที่กำลังเล่น
  201. End Sub
  202.  
  203. ' แสดงเนื้อเพลงขณะเล่น
  204. Sub Lyrics_Show()
  205. Picture1.Cls ' ลบภาพข้อความเดิมทั้งหมด
  206. Picture1.FontSize = 70 ' ขนาดตัวอักษรเนื้อเพลง
  207. Picture1.BackColor = &H80000001 ' สีพื้นของส่วนที่แสดงเนื้อร้อง
  208.  
  209. ' ลดขนาดตัวอักษรให้พอดีกับบรรทัดบน
  210. If Picture1.TextWidth(Lyric(n)) > Picture1.Width - 100 Then
  211. Picture1.FontSize = Picture1.FontSize - 2
  212. End If
  213. ' ลดขนาดตัวอักษรให้พอดีกับบรรทัดล่าง
  214. If Picture1.TextWidth(Lyric(n + 1)) > Picture1.Width - 100 Then
  215. Picture1.FontSize = Picture1.FontSize - 2
  216. End If
  217.  
  218. ' ขอบตัวอักษรแถวบน
  219. Picture1.ForeColor = &H800000 ' กำหนดสีขอบเนื้อร้อง
  220. For i = 170 To 190 Step 5
  221. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  222. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  223. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  224. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  225. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) - 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  226. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  227. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  228. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) + 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  229. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  230. Next i
  231.  
  232. For i = 210 To 220 Step 5
  233. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  234. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  235. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  236. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  237. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) - 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  238. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  239. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  240. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) + 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  241. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  242. Next i
  243.  
  244. ' ตัวอักษรหลักแถวบน
  245. Picture1.ForeColor = &HFFFFFF ' กำหนดสีเนื้อร้องเป็นสีฟ้าสว่าง
  246. Picture1.CurrentY = 200 ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  247. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  248. Picture1.Print Lyric(n) ' แสดงเนื้อเพลง
  249.  
  250. ' ขอบตัวอักษรแถวล่าง
  251. Picture1.ForeColor = &H800000 ' กำหนดสีขอบเนื้อร้อง
  252. For i = 1570 To 1590 Step 5
  253. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  254. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  255. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  256. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  257. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) - 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  258. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  259. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  260. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) + 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  261. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  262. Next i
  263.  
  264. For i = 1610 To 1630 Step 5
  265. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  266. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  267. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  268. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  269. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) - 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  270. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  271. Picture1.CurrentY = i ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  272. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) + 30 ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  273. Picture1.Print Lyric(n + 1) ' แสดงเนื้อเพลง
  274. Next i
  275.  
  276. ' ตัวอักษรหลักแถวล่าง
  277. Picture1.ForeColor = &HFFFFFF ' กำหนดสีเนื้อร้องเป็นสีขาว
  278. Picture1.CurrentY = 1600 ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  279. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n + 1)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  280. Picture1.Print Lyric(n + 1) ' แสดงตำแหน่งปัจจุบันเนื้อเพลง
  281.  
  282. End Sub
  283.  
  284. ' ตัวจับเวลา 1
  285. Private Sub Timer1_Timer()
  286. Change = Change + 1 ' นับเพิ่มขึ้นที่ละ 1
  287. Form1.Caption = Mid("Thai Midi Karaoke V:1.0 Beta โดย ?????????? ????????@????????", 1, Change) ' แสดงข้อความแบบเพิ่มตัวอักษร
  288. If Change = 85 Then Form1.Caption = " ": Change = 0 ' ลบข้อความ และเริ่มนับใหม่
  289. End Sub
  290.  
  291. ' ตัวจับเวลา 2
  292. Private Sub Timer2_Timer()
  293. Dim CurrentTime As Long
  294. Dim MidiTime As Long
  295.  
  296. 'Determine elapsed and total times
  297. CurrentTime = GetTickCount
  298. TCount = TCount + 1
  299. 'Display times
  300. On Error Resume Next
  301. ' ตัวอักษรแสดงตำแหน่งขณะเล่น
  302. If cn = Len(Lyric(n)) Then ' ตรวจสอบจำนวนตัวหนังสือในบรรทัด
  303. n = n + 1 ' เพิ่มค่าจำนวนตัวอักษรเนื้อร้องขึ้นครั้งละ 1
  304. cn = 0 ' ตำแหน่งเนื้อร้องปัจจุบัน
  305. Call Lyrics_Show ' เรียกส่วนย่อยเพื่อขึ้นบรรทัดเนื้อร้องใหม่
  306. End If
  307.  
  308. ' MidiTime = .................... <== ตรงนี้ให้ใส่การตรวจสอบค่า midi time ปัจจุบัน (ผมยังทำไม่เสร็จ)
  309. ' If MidiTime = Cursor(n) Then cn = cn + 1 ' ถ้าค่า Midi Time ตรงกับค่าที่ได้จากไฟล์ *.cur ให้เพิ่มตำแหน่งตัวอักษร
  310. If TCount Mod 5 = 0 Then cn = cn + 1 ' ตรงนี้ผมแสดงให้ดูว่าตัวหนังสือเริ่มวิ่ง (ยังไม่ใช่คำสั่งที่ถูกต้อง)
  311. Picture1.ForeColor = &H100FFF ' สีแสดงเนื้อร้องขณะเล่นเพลง
  312. Picture1.CurrentY = 200 ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  313. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(Lyric(n)) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  314. Picture1.Print Left(Lyric(n), cn) ' แสดงตำแหน่งเนื้อร้องปัจจุบัน
  315.  
  316. If n = TotalCur Then
  317. Picture1.Cls ' ลบข้อความที่แสดงทั้งหมด
  318. Picture1.FontSize = 48 ' กำหนดขนาดตัวหนังสือ
  319. dload = "ดาวน์โหลดโปรแกรมและ VB Code ได้ที่" ' ข้อความที่แสดงแถวบน
  320. web = "www.????????????" ' ข้อความที่แสดงแถวล่าง
  321.  
  322. ' ตัวอักษรหลักแถวบน
  323. Picture1.ForeColor = &H100FFFF ' กำหนดสีบรรทัดบน
  324. Picture1.CurrentY = 200 ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  325. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(dload) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  326. Picture1.Print dload ' แสดง dload
  327.  
  328. ' ตัวอักษรหลักแถวล่าง
  329. Picture1.ForeColor = &H100FFFF ' กำหนดสีบรรทัดล่างเป็นสี......
  330. Picture1.CurrentY = 1000 ' กำหนดตำแหน่งแนวดิ่งเนื้อเพลง
  331. Picture1.CurrentX = (Picture1.Width / 2) - (Picture1.TextWidth(web) / 2) ' กำหนดตำแหน่งแนวนอนเนื้อเพลง
  332. Picture1.Print web ' แสดง web site
  333. End If
  334.  
  335. ProgressBar1.Value = Int((CurrentTime - StartTime) * 100 / MMControl1.TrackLength + 0.5)
  336.  
  337. End Sub
  338.  
  339. ' หน่วงเวลาระหว่างเพลงที่จบกับเพลงต่อไป
  340. Private Sub Timer3_Timer()
  341. Dim WaitTime As Integer
  342. WaitTime = 0 ' ค่าเริ่มนับจาก 0
  343. WaitTime = WaitTime + 1 ' เพิ่มการนับขึ้นที่ละ 1
  344. If WaitTime = 3 Then ' ถ้าค่าที่นับเป็น 3 วินาที
  345. Timer3.Enabled = False ' หยุดการนับเวลา timer3
  346. List1.ListIndex = List1.ListIndex + 1 ' เลื่อนตำแหน่งใน list1 ลงไป
  347. Call PlayMidi ' เรียกส่วนย่อยเล่นเพลง
  348. End If
  349. End Sub
  350.  
  351. ' ตรวจสอบเวลา
  352. Private Sub Timer4_Timer()
  353. Dim TimeNow As String
  354. TimeNow = Timeʹเวลาปัจจุบัน
  355. Label1.Caption = TimeNow ' แสดงเวลาปัจจุบัน
  356. End Sub
  357.  
  358. Private Sub cmdChangeCur_Click()
  359. List3.AddItem TCount
  360. End Sub
  361.  
  362. ' เปลี่ยนข้อความในบรรทัดแสดงเนื้อเพลง
  363. Sub ChangeCursor()
  364. On Error Resume Next ' ถ้าเกิดข้อผิดพลาดให้ข้ามไป
  365. n = n + 1 ' กำหนดการนับเพิ่มที่ละ 1
  366. Call Lyrics_Show
  367. End Sub
  368.  
  369. ' ตรวจสอบตำแหน่งเนื้อร้อง
  370. Sub Read_Cursor()
  371. On Error Resume Next
  372. ' ตัวแปร Tmpb1, Tmpb2 เป็น Byte อ่าน Data จาก CUR ที่ละ Byte มาประกอบกันเป็น WORD
  373. Dim Tmpb1 As Byte, Tmpb2 As Byte
  374. ReDim Cursor(0) ' เตรียม Array สำหรับเก็บค่าเวลา
  375. filenum = FreeFile ' เตรียมเปิด File โดยกำหนดเลขที่ไฟล์ว่าง
  376. Open CursorPath & "\" & SongStr & ".cur" For Random As filenum Len = 1
  377. TotalCur = 0 ' จำนวนตัวหนังสือเนื้อเพลง
  378. If Err = 0 Then
  379. Do Until EOF(filenum) ' ทำจนถึงสุดท้ายไฟล์
  380. Get filenum, , Tmpb1 ' Byte ที่ 1
  381. Get filenum, , Tmpb2 ' Byte ที่ 2
  382. If Not (Asc(Tmpb2) = 255) Then ' ท้ายไฟล์ Byte ที่เป็นเลขคู่ จะมีค่าเป็น &HFF
  383. ReDim Preserve Cursor(TotalCur + 1) ' ขยาย Array สำหรับเก็บค่าเวลา
  384. ' ใส่ ASC เพื่อถอดค่าที่อ่านมาได้เป็นตัวเลข เพราะค่า Byte ที่อ่านมาได้จะเป็น ตัวอักษรขนาด 1 Byte แล้วคูณด้วย 256 หรือ Shift 16 Bit
  385. Cursor(TotalCur) = Asc(Tmpb1) + Asc(Tmpb2) * 256
  386. List3.AddItem Asc(Tmpb1) + Asc(Tmpb2) * 256
  387. TotalCur = TotalCur + 1
  388. End If
  389. Loop
  390. Close #filenum
  391. End If
  392. End Sub
  393.  
  394. ' ตรวจสอบเนื้อเพลง
  395. Sub Read_Lyrics()
  396. On Error Resume Next
  397. filenum = FreeFile
  398. Open LyricPath & "\" & SongStr & ".lyr" For Input As filenum
  399. TotalCur = 0
  400. If Err = 0 Then
  401. Do Until EOF(filenum)
  402. ReDim Preserve Lyric(TotalCur + 1)
  403. Line Input #filenum, tmpstr
  404. Lyric(TotalCur) = tmpstr
  405. TotalCur = TotalCur + 1
  406. Loop
  407. Close #filenum
  408. End If
  409. End Sub
  410.  
  411. ' ตรวจสอบคุณสมบัติของไฟล์ midi
  412. Sub Read_Midi()
  413. On Error Resume Next ' เมื่อเกิดผิดพลาดให้ข้ามไป
  414. Open MidiPath & "\" & SongStr & ".mid" For Binary As #1 ' เปิดไฟล์เพื่อตรวจสอบ
  415. txtMidi = Space(LOF(1)) ' ตรวจสอบข้อความ
  416. Get #1, , txtMidi ' เก็บข้อความที่อ่านไว้
  417. Close #1 ' ปิดไฟล์ที่อ่าน
  418. ' ตรวจสอบอัตราส่วนจังหวะ
  419. k = InStr(1, txtMidi, Chr(255) & Chr(88))
  420. If k = 0 Then Exit Sub
  421. Num = Asc(Mid(txtMidi, k + 3, 1))
  422. Den = Asc(Mid(txtMidi, k + 4, 1))
  423. If Den = 1 Then nDen = 2
  424. If Den = 2 Then nDen = 4
  425. If Den = 3 Then nDen = 8
  426. If Den = 4 Then nDen = 16
  427. If Den = 5 Then nDen = 32
  428. If Den = 6 Then nDen = 64
  429. If Den = 7 Then nDen = 128
  430. If Den = 8 Then nDen = 256
  431. If Den = 9 Then nDen = 512
  432. If Den = 10 Then nDen = 1024
  433.  
  434. ' ตรวจสอบ tempo
  435. k = InStr(1, txtMidi, Chr(&HFF) & Chr(&H51))
  436. If k = 0 Then Exit Sub
  437. n1 = Hex(Asc(Mid(txtMidi, k + 3, 1)))
  438. If Len(n1) = 1 Then n1 = "0" & n1
  439. n2 = Hex(Asc(Mid(txtMidi, k + 4, 1)))
  440. If Len(n2) = 1 Then n2 = "0" & n2
  441. n3 = Hex(Asc(Mid(txtMidi, k + 5, 1)))
  442. If Len(n3) = 1 Then n3 = "0" & n3
  443. t1 = Hex(Asc(Mid(txtMidi, 13, 1)))
  444. If Len(t1) = 1 Then t1 = "0" & t1
  445. t2 = Hex(Asc(Mid(txtMidi, 14, 1)))
  446. If Len(t2) = 1 Then t2 = "0" & t2
  447. ppqn = CDec("&H" & n1 & n2 & n3)
  448. Bpm = 60000000 / ppqn ' ความเร็วจังหวะ tempo
  449. Timebase = CDec("&H" & t1 & t2) / 4
  450. Quarter = (ppqn / Timebase) / 4000
  451.  
  452. Label12.Caption = "ppqn = " & ppqn & " Timebase = " & Timebase & " Quarter = " & Quarter