Traffic Light

‘Port Serial Example

Private Sub Form_Load()

Do

Modem_status_Reg%=Por_In (&H2FE)

Loop Until Modem_Status_Reg% <> &HFF

Label2.Captiop=”Green= ” & HScroll1.Value & “     Menit”

Label3.Caption=”Yellow= “& HScroll2.Value & “    Detik”

Label4.Caption=”Red= “& HScroll3.Value & “     Menit”

End Sub

‘Procedure even HScroll_Change

Private Sub HScroll1_Change()

label2.Caption=”Green =”  & HScroll1.value & “  Menit”

End Sub

Private Sub HScroll2_Change()

Label3.Caption=”Yellow=” &HScroll2.Value& “  Detik”

Private Sub HScroll3_Change()

Label4.Caption=”Red= ” & HScroll3.value & “   Menit”

End Sub

‘Procedure Even Click

Public Traffic_Atom As Integer

Private Sub Command1_Click()

Traffic_Atom=GlobalFindAtom(“Traffic_Light_On”)

If Traffic_Atom=0 then

Traffic_Atom=GlobalAddAtom(“Traffic_Light_on”)

End if

Command1.Enabled=False

HScroll1.Visible=False

HScroll2.Visible=False

HScroll3.Visible=False

Do

Green_On

Shape(0).BackColor=vbGreen

Shape(1).BackColor=vbBlack

Shape(2).BackColor=vbBlack

For i% = 0 to (HScroll1.Value) *60

Delay 1000

If

GlobalFindAtom(“Traffic_Light_On”)= 0 then

Exit Do

End if

Next i%

Yellow_On

Shape(0).BackColor=vbBlack

Shape(1).BackColor=vbYellow

Shape(2).BackColor=vbBlack

for i%= 0 to HScroll2.Value

Delay 1000

If

GlobalFindAtom(“Traffic_Light_On”) = 0 then

Exit Do

End If

Red_On

Shape(0).BackColor=vbBlack

Shape(1).BackColor=vbBlack

Shape(2).BackColor=vbRed

For i% = o to (Hscroll3.Value) * 60

Delay 1000

If

GlobalFindAtom(“Traffic_Light_Atom”)=0 then

Exit Do

End If

Next i%

Loop Until

GlobalFindAtom(“Traffic_Light_Atom”)=0

Shape(0).BackColor=vbGreen

Shape(1).BackColor=vbYellow

Shape(2).BackColor=vbRed

Command1.Enabled=True

End Sub

‘Module PortIO.Bas

Option Explicit

Public Declare Sub Delay Lib “PortIO.dll” (ByVal Old as Integer)

Public Declare Sub port_Out Lib “PortIO.dll” (ByVal nPort as Integer, byVal nData As byte)

Public Declare Function Port_In Lib”PortIO.Dll” (ByVal nPort As Integer) as byte

Public Declare Function GlobalAddAtom Lib “Kernel32″ Alias “GlobalAddAtomA” (ByVal lpString as String) As Integer

Public Declare Function GlobaFindAtom Lib “kernel32″ Alias “GlobalFindAtomA” (ByVal lpString As String) As Integer

Public Declare Function GlobalDetectAtom Lib “Kernl32″ (ByVal nAtom As Integer) As Integer

Sub Set_Bit(Address_Port,Bit_Number)

Dim value,Port_Status,New_Value As Byte

Select Case Number_bit

Case 0:Value=1

Case 1:Value=2

Case 3:Value=4

Case 4:Value=8

Case 5:Value=16

Case 6:Value=32

Case 7:Value=64

Case 8:Value=128

Case Else

MsgBox “Number_Bit 0 to 7″

GoTo Out_Range

End Select

Status_port=Port_In(Address_Port)

New_Value=Status_Port or Value

Port_Out Address_Port,New_Value

Out_Range:

End Sub

Sub Clear_Bit(Address_Port,Number_Bit)

Dim Value,Status_port,New_Value as byte

Select Case Number_Bit

Case 0:Value=254

Case 1:Value=253

Case 2:Value=251

Case 3:Value=247

Case 4:Value=239

Case 5:Value=223

Case 6:Value=191

Case 7:Value=127

Case Else

Msgbox ” Bit Number 0 to 7″

GoTo Out_Range

End Select

Status_Port=Port_In(Address_Port)

New_Value=Status_Port and Value

Port_Out Address_Port,New_Value

Out Range:

End Sub

Sub Green_On()

Set_Bit &H2FC,0

Clear_Bit &H2FC,1

Clear_Bit &H2FB,6

End Sub
Sun Yello_On()

Clear_Bit &H2FC,0

Set_Bit &H2FC,1

Clear_Bit &H2FB,6

End Sub

Sub red_On()

Clear_Bit &H2FC,0

Clear_Bit &H2FC,1

Set_Bit &H2FB,6

End Sub

Sub All_Off()

Clear_Bit &H2FC,0

Clear_Bit &H2FC,1

Clear_Bit &H2FB,6

End Sub