I have a tiny code that extract the pixel color at 1 second and play a sound when detect the color code that i set it. Everything work fine but after 2 hours the program is closing without any error or else. The initial code was setted at 100 (0.1 sec) and after 20 minutes the same shutdown.
I think is the buffer problem because the timer command are executed each time every second but i dont know how to trick this situation because vb6 doesnt have cache or else.
Code:
Option Explicit
Private Const SND_APPLICATION = &H80
Private Const SND_ALIAS = &H10000
Private Const SND_ALIAS_ID = &H110000
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Const SND_LOOP = &H8
Private Const SND_MEMORY = &H4
Private Const SND_NODEFAULT = &H2
Private Const SND_NOSTOP = &H10
Private Const SND_NOWAIT = &H2000
Private Const SND_PURGE = &H40
Private Const SND_RESOURCE = &H40004
Private Const SND_SYNC = &H0
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Command1_Click()
Timer1.Enabled = True
Timer1.Interval = 1000
End Sub
Private Sub Command2_Click()
Form2.Show
End Sub
Private Sub Command3_Click()
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
End Sub
Private Sub Timer1_Timer()
Dim tPOS As POINTAPI
Dim sTmp As String
Dim lColor As Long
Dim lDC As Long
lDC = GetWindowDC(0)
Call GetCursorPos(tPOS)
lColor = GetPixel(lDC, Text1.Text, Text2.Text)
Label2.BackColor = lColor
Label5.Caption = tPOS.x
Label6.Caption = tPOS.y
sTmp = Right$("000000" & Hex(lColor), 6)
Caption = "Hello"
Label3.Caption = lColor
If Label3.Caption = Text4.Text Then
PlaySound Text3.Text, ByVal 0&, SND_FILENAME Or SND_ASYNC
Else
Label4.Caption = "nothing"
End If
End Sub