Mengontrol Relay melalui Rs-485 dgn vb6
Aplikasi ini digunakan untuk menyalakan dan mematikan sejumlah Ac (air condition) diruang produksi dengan cara mengganti switch dengan relay yang dikontrol dari PC. aplikasi ini juga bisa digunakan untuk keperluan lain.
Tampilan Menu Aplikasi:
Form Aplikasi Pengontrolan AC
Code program dalam Visual basic 6:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim status As Boolean
Dim responseText As String
'========================================
Public Intmax As Integer
Private lMinHeight As Long
Private lMinWidth As Long
Private bResizeOff As Boolean
'Private colMessages As String
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
'constants required by Shell_NotifyIcon API call:
Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
Const WM_RBUTTONDBLCLK = &H206
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_LBUTTONDBLCLK = &H203
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_MBUTTONDBLCLK = &H209
Const WM_MBUTTONDOWN = &H207
Const WM_MBUTTONUP = &H208
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Dim tar As Integer
Private nid As NOTIFYICONDATA
'========================================
Private Sub AC2_Click()
MSComm1.Output = "cC"
End Sub
Private Sub AC1of_Click()
MSComm1.Output = "bC"
lbStatus.Caption = "AC 1 OFF"
End Sub
Private Sub AC1ON_Click()
MSComm1.Output = "bB"
lbStatus.Caption = "AC 1 ON"
End Sub
Private Sub AC2of_Click()
MSComm1.Output = "cC"
lbStatus.Caption = "AC 2 OFF"
End Sub
Private Sub AC2ON_Click()
MSComm1.Output = "cB"
lbStatus.Caption = "AC 2 ON"
End Sub
Private Sub ACOFF_Click()
btnFan_Click
Sleep (3000)
MSComm1.Output = "bC"
lbStatus.Caption = "AC 2 MATI"
status = False
End Sub
Private Sub btnFan_Click()
MSComm1.Output = "bA"
lbStatus.Caption = "FAN AC 2 HIDUP"
End Sub
Private Sub btnOn_Click()
btnFan_Click
Sleep (3000)
MSComm1.Output = "bB"
lbStatus.Caption = "AC 2 HIDUP"
status = True
End Sub
Private Sub chk41_Click()
If chk41.Value = 0 Then
MSComm1.Output = "1C"
lbStatus.Caption = "AC FINAL COMP. MATI"
cmdac1on.BackColor = &H8000000F
cmdac1fan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4E_Click()
If chk4E.Value = 0 Then
MSComm1.Output = "EC"
lbStatus.Caption = "AC 4E Mati"
cmd4eon.BackColor = &H8000000F
cmd4Efan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4F_Click()
If chk4F.Value = 0 Then
MSComm1.Output = "FC"
lbStatus.Caption = "AC 4F Mati"
cmd4fon.BackColor = &H8000000F
cmd4ffan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4G_Click()
If chk4G.Value = 0 Then
MSComm1.Output = "GC"
lbStatus.Caption = "AC G Mati"
cmd4gon.BackColor = &H8000000F
cmd4gfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4H_Click()
If chk4H.Value = 0 Then
MSComm1.Output = "HC"
lbStatus.Caption = "AC DE STORAGE MATI"
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = &H8000000F
Else
lbStatus.Caption = "AC DE STORAGE AUTO"
End If
End Sub
Private Sub chk4I_Click()
If chk4I.Value = 0 Then
MSComm1.Output = "IC"
lbStatus.Caption = "AC 4I Mati"
cmd4ion.BackColor = &H8000000F
cmd4ifan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4J_Click()
If chk4J.Value = 0 Then
MsgBox "ac akan dimatikan"
MSComm1.Output = "JC"
lbStatus.Caption = "AC 4J Mati"
cmdac5on.BackColor = &H8000000F
cmdac5fan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4K_Click()
If chk4K.Value = 0 Then
MSComm1.Output = "KC"
lbStatus.Caption = "AC 4K Mati"
cmdac4on.BackColor = &H8000000F
cmdac4fan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4L_Click()
If chk4L.Value = 0 Then
MSComm1.Output = "LC"
lbStatus.Caption = "AC OFFICE MATI"
cmdacLon.BackColor = &H8000000F
cmdacLfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4M_Click()
If chk4M.Value = 0 Then
MSComm1.Output = "MC"
lbStatus.Caption = "AC PCB MATERIAL MATI"
cmdacMon.BackColor = &H8000000F
cmdacMfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4N_Click()
If chk4N.Value = 0 Then
MSComm1.Output = "NC"
lbStatus.Caption = "AC PART CONTROL MATI"
cmdacNon.BackColor = &H8000000F
cmdacNfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4O_Click()
If chk4O.Value = 0 Then
MSComm1.Output = "OC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4oon.BackColor = &H8000000F
cmd4ofan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4P_Click()
If chk4P.Value = 0 Then
MSComm1.Output = "PC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4pon.BackColor = &H8000000F
cmd4pfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4Q_Click()
If chk4Q.Value = 0 Then
MSComm1.Output = "QC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4qon.BackColor = &H8000000F
cmd4qfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4R_Click()
If chk4R.Value = 0 Then
MSComm1.Output = "RC"
lbStatus.Caption = "AC 4R Mati"
cmd4ron.BackColor = &H8000000F
cmd4rfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4S_Click()
If chk4S.Value = 0 Then
MSComm1.Output = "SC"
lbStatus.Caption = "AC REST AREA COMP. MATI"
cmd4son.BackColor = &H8000000F
cmd4Sfan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4T_Click()
If chk4T.Value = 0 Then
MSComm1.Output = "TC"
lbStatus.Caption = "AC REST AREA COMP. MATI"
cmd4Ton.BackColor = &H8000000F
cmd4TFan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4U_Click()
If chk4U.Value = 0 Then
MSComm1.Output = "UC"
lbStatus.Caption = "AC LINE D COMP. MATI"
cmd4uon.BackColor = &H8000000F
cmd4UFan.BackColor = &H8000000F
End If
End Sub
Private Sub chk4V_Click()
If chk4V.Value = 0 Then
MSComm1.Output = "VC"
lbStatus.Caption = "AC LINE D COMP. MATI"
cmd4Von.BackColor = &H8000000F
cmd4VFan.BackColor = &H8000000F
End If
End Sub
Private Sub closePort_Click()
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
closePort.Enabled = False
openPort.Enabled = True
enableChoice (True)
End If
End Sub
Private Sub enableChoice(state As Boolean)
portChoice.Enabled = state
baudChoice.Enabled = state
dataBitChoice.Enabled = state
stopBitChoice.Enabled = state
parityChoice.Enabled = state
timeOutBox.Enabled = state
End Sub
Private Sub Command1_Click()
responseBox = CStr(commandString)
End Sub
Private Sub cmd4Efan_Click()
MSComm1.Output = "EA"
lbStatus.Caption = "FAN AC 4E HIDUP"
cmd4eon.BackColor = &H8000000F
cmd4Efan.BackColor = vbGreen
End Sub
Private Sub cmd4eoff_Click()
MSComm1.Output = "EC"
lbStatus.Caption = "AC 4E Mati"
cmd4eon.BackColor = &H8000000F
cmd4Efan.BackColor = &H8000000F
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
End Sub
Private Sub cmd4eon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "EB"
lbStatus.Caption = "AC 4E HIDUP"
cmd4eon.BackColor = vbGreen
cmd4Efan.BackColor = &H8000000F
If chk4E.Value = 0 Then
chk4E.Value = 1
End If
End Sub
Private Sub cmd4ffan_Click()
Sleep (1000)
'MSComm1.Output = "FA"
lbStatus.Caption = "FAN AC 4F HIDUP"
cmd4fon.BackColor = &H8000000F
cmd4ffan.BackColor = vbGreen
End Sub
Private Sub cmd4foff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "FC"
lbStatus.Caption = "AC 4F Mati"
cmd4fon.BackColor = &H8000000F
cmd4ffan.BackColor = &H8000000F
End Sub
Private Sub cmd4fon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "FB"
lbStatus.Caption = "AC 4F HIDUP"
cmd4fon.BackColor = vbGreen
cmd4ffan.BackColor = &H8000000F
If chk4F.Value = 0 Then
chk4F.Value = 1
End If
End Sub
Private Sub cmd4gfan_Click()
Sleep (1000)
MSComm1.Output = "GA"
lbStatus.Caption = "FAN 4G HIDUP"
cmd4gon.BackColor = &H8000000F
cmd4gfan.BackColor = vbGreen
End Sub
Private Sub cmd4goff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "GC"
lbStatus.Caption = "AC G Mati"
cmd4gon.BackColor = &H8000000F
cmd4gfan.BackColor = &H8000000F
End Sub
Private Sub cmd4gon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "GB" 'cool
lbStatus.Caption = "AC 4G HIDUP"
cmd4gon.BackColor = vbGreen
cmd4gfan.BackColor = &H8000000F
If chk4G.Value = 0 Then
chk4G.Value = 1
End If
End Sub
Private Sub cmd4hfan_Click()
Sleep (1000)
MSComm1.Output = "HA"
lbStatus.Caption = "FAN AC DE STORAGE HIDUP"
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = vbGreen
End Sub
Private Sub cmd4hoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "HC"
lbStatus.Caption = "AC DE STORAGE MATI"
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = &H8000000F
End Sub
Private Sub cmd4hon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "HB"
lbStatus.Caption = "AC DE STORAGE HIDUP"
cmd4hon.BackColor = vbGreen
cmd4hfan.BackColor = &H8000000F
If chk4H.Value = 0 Then
chk4H.Value = 1
End If
End Sub
Private Sub cmd4ifan_Click()
Sleep (1000)
MSComm1.Output = "IA"
lbStatus.Caption = "FAN AC OFFICE HIDUP"
cmd4ion.BackColor = &H8000000F
cmd4ifan.BackColor = vbGreen
End Sub
Private Sub cmd4ioff_Click()
MSComm1.RTSEnable = True
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "IC"
lbStatus.Caption = "AC 4I Mati"
cmd4ion.BackColor = &H8000000F
cmd4ifan.BackColor = &H8000000F
MSComm1.RTSEnable = False
End Sub
Private Sub cmd4ion_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "IB"
lbStatus.Caption = "AC 4I HIDUP"
cmd4ion.BackColor = vbGreen
cmd4ifan.BackColor = &H8000000F
If chk4I.Value = 0 Then
chk4I.Value = 1
End If
End Sub
Private Sub cmd4ofan_Click()
MSComm1.Output = "OA"
lbStatus.Caption = "FAN AC 4E HIDUP"
cmd4oon.BackColor = &H8000000F
cmd4ofan.BackColor = vbGreen
End Sub
Private Sub cmd4ooff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "OC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4oon.BackColor = &H8000000F
cmd4ofan.BackColor = &H8000000F
End Sub
Private Sub cmd4oon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "OB"
lbStatus.Caption = "AC B/C PREP. HIDUP"
cmd4oon.BackColor = vbGreen
cmd4ofan.BackColor = &H8000000F
If chk4O.Value = 0 Then
chk4O.Value = 1
End If
End Sub
Private Sub cmd4pfan_Click()
MSComm1.Output = "PA"
lbStatus.Caption = "FAN B/C PREP. HIDUP"
cmd4pon.BackColor = &H8000000F
cmd4pfan.BackColor = vbGreen
End Sub
Private Sub cmd4poff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "PC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4pon.BackColor = &H8000000F
cmd4pfan.BackColor = &H8000000F
End Sub
Private Sub cmd4pon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "PB"
lbStatus.Caption = "AC B/C PREP. HIDUP"
cmd4pon.BackColor = vbGreen
cmd4pfan.BackColor = &H8000000F
If chk4P.Value = 0 Then
chk4P.Value = 1
End If
End Sub
Private Sub cmd4qfan_Click()
MSComm1.Output = "QA"
lbStatus.Caption = "FAN B/C PREP. HIDUP"
cmd4qon.BackColor = &H8000000F
cmd4qfan.BackColor = vbGreen
End Sub
Private Sub cmd4Qoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "QC"
lbStatus.Caption = "AC B/C PREP. MATI"
cmd4qon.BackColor = &H8000000F
cmd4qfan.BackColor = &H8000000F
End Sub
Private Sub cmd4qon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "QB"
lbStatus.Caption = "AC B/C PREP. HIDUP"
cmd4qon.BackColor = vbGreen
cmd4qfan.BackColor = &H8000000F
If chk4Q.Value = 0 Then
chk4Q.Value = 1
End If
End Sub
Private Sub cmd4rfan_Click()
MSComm1.Output = "RA"
lbStatus.Caption = "FAN AC 4R HIDUP"
cmd4rfan.BackColor = vbGreen
cmd4ron.BackColor = &H8000000F
End Sub
Private Sub cmd4roff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "RC"
lbStatus.Caption = "AC 4R Mati"
cmd4ron.BackColor = &H8000000F
cmd4rfan.BackColor = &H8000000F
End Sub
Private Sub cmd4ron_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "RB"
lbStatus.Caption = "AC 4R HIDUP"
cmd4ron.BackColor = vbGreen
cmd4rfan.BackColor = &H8000000F
If chk4R.Value = 0 Then
chk4R.Value = 1
End If
End Sub
Private Sub cmd4Sfan_Click()
MSComm1.Output = "SA"
lbStatus.Caption = "FAN REST AREA COMP. HIDUP"
cmd4son.BackColor = &H8000000F
cmd4Sfan.BackColor = vbGreen
End Sub
Private Sub cmd4Soff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "SC"
lbStatus.Caption = "AC REST AREA COMP. MATI"
cmd4son.BackColor = &H8000000F
cmd4Sfan.BackColor = &H8000000F
End Sub
Private Sub cmd4son_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "SB"
lbStatus.Caption = "AC REST AREA COMP. HIDUP"
cmd4son.BackColor = vbGreen
cmd4Sfan.BackColor = &H8000000F
If chk4S.Value = 0 Then
chk4S.Value = 1
End If
End Sub
Private Sub cmd4TFan_Click()
MSComm1.Output = "TA"
lbStatus.Caption = "FAN REST AREA COMP. HIDUP"
cmd4Ton.BackColor = &H8000000F
cmd4TFan.BackColor = vbGreen
End Sub
Private Sub cmd4Toff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "TC"
lbStatus.Caption = "AC REST AREA COMP. MATI"
cmd4Ton.BackColor = &H8000000F
cmd4TFan.BackColor = &H8000000F
'&H8000000F
End Sub
Private Sub cmd4Ton_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "TB"
lbStatus.Caption = "AC REST AREA COMP. HIDUP"
cmd4Ton.BackColor = vbGreen
cmd4TFan.BackColor = &H8000000F
If chk4T.Value = 0 Then
chk4T.Value = 1
End If
End Sub
Private Sub cmd4UFan_Click()
MSComm1.Output = "UA"
lbStatus.Caption = "FAN LINE D COMP. HIDUP"
'&H8000000F
cmd4uon.BackColor = &H8000000F
cmd4UFan.BackColor = vbGreen
End Sub
Private Sub cmd4Uoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "UC"
lbStatus.Caption = "AC LINE D COMP. MATI"
cmd4uon.BackColor = &H8000000F
cmd4UFan.BackColor = &H8000000F
End Sub
Private Sub cmd4uon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "UB"
lbStatus.Caption = "AC LINE D COMP. HIDUP"
'&H8000000F
cmd4uon.BackColor = vbGreen
cmd4UFan.BackColor = &H8000000F
If chk4U.Value = 0 Then
chk4U.Value = 1
End If
End Sub
Private Sub cmd4VFan_Click()
Sleep (1000)
MSComm1.Output = "VA"
lbStatus.Caption = "FAN LINE D COMP. HIDUP"
cmd4Von.BackColor = &H8000000F
cmd4VFan.BackColor = vbGreen
End Sub
Private Sub cmd4Voff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "VC"
lbStatus.Caption = "AC LINE D COMP. MATI"
cmd4Von.BackColor = &H8000000F
cmd4VFan.BackColor = &H8000000F
End Sub
Private Sub cmd4Von_Click()
' &H8000000F
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "VB"
lbStatus.Caption = "AC LINE D COMP. HIDUP"
cmd4Von.BackColor = vbGreen
cmd4VFan.BackColor = &H8000000F
If chk4V.Value = 0 Then
chk4V.Value = 1
End If
End Sub
Private Sub cmdac1fan_Click()
MSComm1.Output = "1A"
lbStatus.Caption = "FAN FINAL COMP.HIDUP"
cmdac1on.BackColor = &H8000000F
cmdac1fan.BackColor = vbGreen
End Sub
Private Sub cmdac1off_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "1C"
lbStatus.Caption = "AC FINAL COMP. MATI"
cmdac1on.BackColor = &H8000000F
cmdac1fan.BackColor = &H8000000F
End Sub
Private Sub cmdac1on_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "1B"
lbStatus.Caption = "AC FINAL COMP. HIDUP"
cmdac1on.BackColor = vbGreen
cmdac1fan.BackColor = &H8000000F
If chk41.Value = 0 Then
chk41.Value = 1
End If
End Sub
Private Sub cmdac4Bon_Click()
'MSComm1.Output = "AA"
'Sleep (2000)
MSComm1.Output = "AB"
lbStatus.Caption = "AC CABINET DEPAN HIDUP"
cmdac1on.BackColor = vbGreen
cmdac1on.Enabled = False
cmdac1off.Enabled = True
End Sub
Private Sub cmdac4fan_Click()
Sleep (1000)
MSComm1.Output = "KA"
cmdac4on.BackColor = &H8000000F
cmdac4fan.BackColor = vbGreen
End Sub
Private Sub cmdac4off_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "KC"
lbStatus.Caption = "AC 4K Mati"
cmdac4on.BackColor = &H8000000F
cmdac4fan.BackColor = &H8000000F
End Sub
Private Sub cmdac4on_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "KB"
lbStatus.Caption = "AC 4K HIDUP"
cmdac4on.BackColor = vbGreen
cmdac4fan.BackColor = &H8000000F
If chk4K.Value = 0 Then
chk4K.Value = 1
End If
End Sub
Private Sub cmdac5fan_Click()
Sleep (1000)
MSComm1.Output = "JA"
cmdac5on.BackColor = &H8000000F
cmdac5fan.BackColor = vbGreen
End Sub
Private Sub cmdac5off_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "JC"
lbStatus.Caption = "AC 4J Mati"
cmdac5on.BackColor = &H8000000F
cmdac5fan.BackColor = &H8000000F
End Sub
Private Sub cmdac5on_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "JB"
lbStatus.Caption = "AC 4J HIDUP"
cmdac5on.BackColor = vbGreen
cmdac5fan.BackColor = &H8000000F
If chk4J.Value = 0 Then
chk4J.Value = 1
End If
End Sub
Private Sub cmdacAfan_Click()
MSComm1.Output = "fA"
lbStatus.Caption = "FAN CABINET DEPAN HIDUP"
End Sub
Private Sub cmdacAon_Click()
'MSComm1.Output = "fA"
'Sleep (2000)
MSComm1.Output = "fB"
lbStatus.Caption = "AC FINAL COMP. HIDUP"
cmdac1on.BackColor = vbGreen
cmdac1on.Enabled = False
cmdac1off.Enabled = True
End Sub
Private Sub cmdacLfan_Click()
Sleep (1000)
MSComm1.Output = "LA"
lbStatus.Caption = "FAN AC OFFICE HIDUP"
cmdacLon.BackColor = &H8000000F
cmdacLfan.BackColor = vbGreen
txtpowerinput.Text = "12"
End Sub
Private Sub cmdacLoff_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "LC"
lbStatus.Caption = "AC OFFICE MATI"
cmdacLon.BackColor = &H8000000F
cmdacLfan.BackColor = &H8000000F
End Sub
Private Sub cmdacLon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "LB"
lbStatus.Caption = "AC OFFICE HIDUP"
cmdacLon.BackColor = vbGreen
cmdacLfan.BackColor = &H8000000F
If chk4L.Value = 0 Then
chk4L.Value = 1
End If
End Sub
Private Sub cmdacMfan_Click()
MSComm1.Output = "MA"
lbStatus.Caption = "FAN AC PCB MATERIAL HIDUP"
cmdacMon.BackColor = &H8000000F
cmdacMfan.BackColor = vbGreen
End Sub
Private Sub cmdacMoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "MC"
lbStatus.Caption = "AC PCB MATERIAL MATI"
cmdacMon.BackColor = &H8000000F
cmdacMfan.BackColor = &H8000000F
End Sub
Private Sub cmdacMon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "MB"
lbStatus.Caption = "AC PCB MATERIAL HIDUP"
cmdacMon.BackColor = vbGreen
cmdacMfan.BackColor = &H8000000F
If chk4M.Value = 0 Then
chk4M.Value = 0
End If
chk4M.Value = 1
End Sub
Private Sub cmdacNfan_Click()
MSComm1.Output = "NA"
lbStatus.Caption = "FAN AC PART CONTROL HIDUP"
cmdacNon.BackColor = &H8000000F
cmdacNfan.BackColor = vbGreen
End Sub
Private Sub cmdacNoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = "NC"
lbStatus.Caption = "AC PART CONTROL MATI"
cmdacNon.BackColor = &H8000000F
cmdacNfan.BackColor = &H8000000F
End Sub
Private Sub cmdacNon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = "NB"
lbStatus.Caption = "AC PART CONTROL HIDUP"
cmdacNon.BackColor = vbGreen
cmdacNfan.BackColor = &H8000000F
If chk4N.Value = 0 Then
chk4N.Value = 1
End If
End Sub
Private Sub cmdcompletefan_Click()
Sleep (1500)
MSComm1.Output = "1A"
Sleep (1500)
MSComm1.Output = "VA"
'=========================
Sleep (1500)
MSComm1.Output = "UA"
'========================
Sleep (1500)
MSComm1.Output = "TA"
'=========================
Sleep (1500)
MSComm1.Output = "SA"
'=========================
Sleep (1500)
MSComm1.Output = "RA"
'========================
Sleep (1500)
MSComm1.Output = "QA"
'=========================
Sleep (1500)
MSComm1.Output = "EA"
'=========================
Sleep (1500)
MSComm1.Output = "PA"
'=========================
Sleep (1500)
MSComm1.Output = "OA"
'=========================
lbcomplete.Caption = "SEMUA AC complete FAN"
End Sub
Private Sub cmdcompleteoff_Click()
Call complete_group1_off
Call complete_group2_off
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 7
End If
cmd4Von.BackColor = &H8000000F
cmd4uon.BackColor = &H8000000F
cmd4Ton.BackColor = &H8000000F
cmd4son.BackColor = &H8000000F
cmd4ron.BackColor = &H8000000F
cmd4qon.BackColor = &H8000000F
cmd4pon.BackColor = &H8000000F
cmd4oon.BackColor = &H8000000F
cmd4eon.BackColor = &H8000000F
cmdac1on.BackColor = &H8000000F
lbcomplete.Caption = "SEMUA AC complete MATI"
End Sub
Private Sub cmdcompleteon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 7
End If
Call complete_group1_on
Call complete_group2_on
cmd4Von.BackColor = vbGreen
cmd4uon.BackColor = vbGreen
cmd4Ton.BackColor = vbGreen
cmd4son.BackColor = vbGreen
cmd4ron.BackColor = vbGreen
cmd4qon.BackColor = vbGreen
cmd4pon.BackColor = vbGreen
cmd4oon.BackColor = vbGreen
cmdac1on.BackColor = vbGreen
cmd4eon.BackColor = vbGreen
lbcomplete.Caption = "SEMUA AC complete HIDUP"
End Sub
Private Sub cmdDEfan_Click()
Sleep (300)
MSComm1.Output = Trim(txttest.Text)
lbStatus.Caption = "FAN AC DE HIDUP"
cmdDEon.BackColor = &H8000000F
cmdDEfan.BackColor = vbGreen
End Sub
Private Sub cmdDEoff_Click()
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 1
End If
MSComm1.Output = Trim(txttest.Text)
lbStatus.Caption = "AC DE Mati"
cmdDEon.BackColor = &H8000000F
cmdDEfan.BackColor = &H8000000F
End Sub
Private Sub cmdDEon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 1
End If
MSComm1.Output = Trim(txttest.Text)
lbStatus.Caption = "AC DE HIDUP"
cmdDEon.BackColor = vbGreen
cmdDEfan.BackColor = &H8000000F
End Sub
Private Sub cmdlokasi_Click()
'peta.Show
End Sub
Private Sub cmdsemuafanon_Click()
cmdsemuaon.Enabled = True
Sleep (1500)
MSComm1.Output = "NA"
'==================
Sleep (1500)
MSComm1.Output = "MA"
'==================
Sleep (1500)
MSComm1.Output = "LA"
'=========================
Sleep (1500)
MSComm1.Output = "KA"
'=========================
Sleep (1500)
MSComm1.Output = "JA"
'=========================
Sleep (1500)
MSComm1.Output = "IA"
'==================
Sleep (1500)
MSComm1.Output = "HA"
'=========================
'Sleep (1500)
'MSComm1.Output = "GA"
'==================
Sleep (1500)
MSComm1.Output = "FA"
'=========================
'MSComm1.Output = "XA"
lbStatus.Caption = "SEMUA FAN AC PCB HIDUP"
cmdsemuaon.Enabled = True
cmd4eon.BackColor = &H8000000F
cmd4Efan.BackColor = vbGreen
cmd4fon.BackColor = &H8000000F
cmd4ffan.BackColor = vbGreen
cmd4gon.BackColor = &H8000000F
cmd4gfan.BackColor = vbGreen
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = vbGreen
cmd4ion.BackColor = &H8000000F
cmd4ifan.BackColor = vbGreen
cmdac5on.BackColor = &H8000000F
cmdac5fan.BackColor = vbGreen
cmdac4on.BackColor = &H8000000F
cmdac4fan.BackColor = vbGreen
cmdacLon.BackColor = &H8000000F
cmdacLfan.BackColor = vbGreen
cmdacMon.BackColor = &H8000000F
cmdacMfan.BackColor = vbGreen
cmdacNon.BackColor = &H8000000F
cmdacNfan.BackColor = vbGreen
cmdac1on.BackColor = &H8000000F
cmdac1fan.BackColor = vbGreen
End Sub
Private Sub cmdsemuaoff_Click()
Call pcb_group1_off
Call pcb_group2_off
Call LCD_off
Call office_off
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 7
End If
lbStatus.Caption = "SEMUA AC PCB MATI"
cmdsemuaon.Enabled = True
cmdsemuaon.BackColor = &H8000000F
'===========
cmd4eon.BackColor = &H8000000F
cmd4Efan.BackColor = &H8000000F
cmd4fon.BackColor = &H8000000F
cmd4ffan.BackColor = &H8000000F
cmd4gon.BackColor = &H8000000F
cmd4gfan.BackColor = &H8000000F
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = &H8000000F
cmd4ion.BackColor = &H8000000F
cmd4ifan.BackColor = &H8000000F
cmdac5on.BackColor = &H8000000F
cmdac5fan.BackColor = &H8000000F
cmdac4on.BackColor = &H8000000F
cmdac4fan.BackColor = &H8000000F
cmdacLon.BackColor = &H8000000F
cmdacLfan.BackColor = &H8000000F
cmdacMon.BackColor = &H8000000F
cmdacMfan.BackColor = &H8000000F
cmdacNon.BackColor = &H8000000F
cmdacNfan.BackColor = &H8000000F
'&H8000000F&
End Sub
Private Sub cmdsemuaon_Click()
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 7
End If
Call pcb_group1_on
Call pcb_group2_on
Call LCD_on
Call office_on
cmdsemuaon.BackColor = vbGreen
cmd4eon.BackColor = vbGreen
'&H8000000F&
'===========================
lbStatus.Caption = "AC PCB HIDUP"
cmdsemuaon.Enabled = False
cmdsemuaoff.Enabled = True
cmd4eon.BackColor = vbGreen
cmd4Efan.BackColor = &H8000000F
cmd4fon.BackColor = vbGreen
cmd4ffan.BackColor = &H8000000F
cmd4gon.BackColor = vbGreen
cmd4gfan.BackColor = &H8000000F
cmd4hon.BackColor = vbGreen
cmd4hfan.BackColor = &H8000000F
cmd4ion.BackColor = vbGreen
cmd4ifan.BackColor = &H8000000F
cmdac5on.BackColor = vbGreen
cmdac5fan.BackColor = &H8000000F
cmdac4on.BackColor = vbGreen
cmdac4fan.BackColor = &H8000000F
cmdacLon.BackColor = vbGreen
cmdacLfan.BackColor = &H8000000F
cmdacMon.BackColor = vbGreen
cmdacMfan.BackColor = &H8000000F
cmdacNon.BackColor = vbGreen
cmdacNfan.BackColor = &H8000000F
End Sub
Private Sub Command3_Click()
MSComm1.RTSEnable = False
End Sub
Private Sub cmdsimpan_Click()
SaveSetting App.Title, "Settings", "txtpagimasuk", txtpagimasuk
SaveSetting App.Title, "Settings", "txtpagioff", txtpagioff
SaveSetting App.Title, "Settings", "txtpagion", txtpagion
SaveSetting App.Title, "Settings", "txtsiangoff", txtsiangoff
SaveSetting App.Title, "Settings", "txtsiangon", txtsiangon
SaveSetting App.Title, "Settings", "txtsoreoff", txtsoreoff
SaveSetting App.Title, "Settings", "txtsoreon", txtsoreon
SaveSetting App.Title, "Settings", "txtsorepulang", txtsorepulang
SaveSetting App.Title, "Settings", "txtotsoremasuk", txtotsoremasuk
SaveSetting App.Title, "Settings", "txtmagriboff", txtmagriboff
SaveSetting App.Title, "Settings", "txtmagribon", txtmagribon
SaveSetting App.Title, "Settings", "txtotpulang", txtotpulang
SaveSetting App.Title, "Settings", "txtshiftmasuk", txtshiftmasuk
SaveSetting App.Title, "Settings", "txtmalamoff", txtmalamoff
SaveSetting App.Title, "Settings", "txtmalamon", txtmalamon
SaveSetting App.Title, "Settings", "txttengahmalamoff", txttengahmalamoff
SaveSetting App.Title, "Settings", "txttengahmalamon", txttengahmalamon
SaveSetting App.Title, "Settings", "txtdiniharioff", txtdiniharioff
SaveSetting App.Title, "Settings", "txttengahmalamoff", txttengahmalamoff
SaveSetting App.Title, "Settings", "txttengahmalamon", txttengahmalamon
SaveSetting App.Title, "Settings", "txtdiniharion", txtdiniharion
SaveSetting App.Title, "Settings", "txtmerahsiangoff", txtmerahsiangoff
SaveSetting App.Title, "Settings", "txtmerahsiangon", txtmerahsiangon
End Sub
Private Sub Command2_Click()
MSComm1.RTSEnable = True
End Sub
Private Sub Command4_Click()
MSComm1.RTSEnable = False
End Sub
Private Sub commandString_KeyPress(KeyAscii As Integer)
Dim rstr As String
If KeyAscii = 13 Then 'kalau ditekan enter
KeyAscii = 0 ' get rid of the normal beep sound
rstr = sendCommand(commandString.Text) 'MENGIRIM DAN AMBIL RESPON
If rstr = "" Then 'kalau ngga ada respon
Beep
appendlnResponse ("(Warning: No Response from AC)")
Else
appendlnResponse (rstr)
End If
End If
End Sub
Private Sub ExitButton_Click()
Call closePort_Click
' End
End Sub
Private Sub Form_Load()
txtpagimasuk = GetSetting(App.Title, "Settings", "txtpagimasuk", "")
txtpagioff = GetSetting(App.Title, "Settings", "txtpagioff", "")
txtpagion = GetSetting(App.Title, "Settings", "txtpagion", "")
txtsiangoff = GetSetting(App.Title, "Settings", "txtsiangoff", "")
txtsiangon = GetSetting(App.Title, "Settings", "txtsiangon", "")
txtsoreoff = GetSetting(App.Title, "Settings", "txtsoreoff", "")
txtsoreon = GetSetting(App.Title, "Settings", "txtsoreon", "")
txtsorepulang = GetSetting(App.Title, "Settings", "txtsorepulang", "")
txtotsoremasuk = GetSetting(App.Title, "Settings", "txtotsoremasuk", "")
txtmagriboff = GetSetting(App.Title, "Settings", "txtmagriboff", "")
txtmagribon = GetSetting(App.Title, "Settings", "txtmagribon", "")
txtotpulang = GetSetting(App.Title, "Settings", "txtotpulang", "")
txtshiftmasuk = GetSetting(App.Title, "Settings", "txtshiftmasuk", "")
txtmalamon = GetSetting(App.Title, "Settings", "txtmalamon", "")
txtmalamoff = GetSetting(App.Title, "Settings", "txtmalamoff", "")
txttengahmalamoff = GetSetting(App.Title, "Settings", "txttengahmalamoff", "")
txttengahmalamon = GetSetting(App.Title, "Settings", "txttengahmalamon", "")
txtdiniharioff = GetSetting(App.Title, "Settings", "txtdiniharioff", "")
txtdiniharion = GetSetting(App.Title, "Settings", "txtdiniharion", "")
txtmerahsiangoff = GetSetting(App.Title, "Settings", "txtmerahsiangoff", "")
txtmerahsiangon = GetSetting(App.Title, "Settings", "txtmerahsiangon", "")
Me.Icon = Me.Image1
lMinHeight = Me.Height
lMinWidth = Me.Width
lbStatus.Caption = "AC semua OFF"
'status = False
portChoice.ListIndex = 0
baudChoice.ListIndex = 3
dataBitChoice.ListIndex = 1
stopBitChoice.ListIndex = 0
parityChoice.ListIndex = 0
closePort.Enabled = False
tgl.Caption = Format(Now, "yyyy-MM-dd")
txtWaktu.Text = Format(Now, "hh:mm")
lbWaktu.Caption = txtWaktu.Text
txtday.Text = Format(Now, "dddd")
Sleep (200)
chkcompot.Value = 0
' chkcompshift.Value = 1
openPort_Click
MSComm1.RTSEnable = False
End Sub
Private Sub Form_Resize()
Dim lWidth As Long
Dim lHeight As Long
Const Unit = 105
'this is here so when the mnuShow_Click event is fired, the form wont minimize and hide again
If bResizeOff = False Then
If Me.WindowState = vbMinimized Then
Me.Hide
UpdateIcon NIM_ADD
Else
UpdateIcon NIM_DELETE
End If
End If
'generic resize logic
End Sub
Private Sub UpdateIcon(Value As Long)
' Used to add, modify and delete icon.
With nid
.cbSize = Len(nid)
.hWnd = Me.hWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
.szTip = App.Title & vbNullChar
End With
Shell_NotifyIcon Value, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Result As Long
Dim msg As Long
'really interesting stuff here...i got it from MSDN
If Me.ScaleMode = vbPixels Then
msg = X
Else
msg = X / Screen.TwipsPerPixelX
End If
'handles mouse events when form is minimized, hidden and icon is in the system tray
Select Case msg
Case WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
PopupMenu mnuAppPopup
Case WM_LBUTTONDBLCLK
mnuShow_Click
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_MBUTTONDBLCLK
Case WM_MBUTTONDOWN
Case WM_MBUTTONUP
Case WM_MOUSEMOVE
Case Else
End Select
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuPopWhenMin_Click()
'this menu item is used so that if it is checked and the app is in the system tray
'and a new message is recieved the app will unhide and show in normal state.
'if this menu item is unchecked and the app is in the system tray and the app recieves
'a new message, the icon will blink until the user brings it up from the tray to
'see the new message
If Me.mnuPopWhenMin.Checked = True Then
Me.mnuPopWhenMin.Checked = False
Else
Me.mnuPopWhenMin.Checked = True
End If
End Sub
Private Sub mnuShow_Click()
Dim Result As Long
'this menu event will unhide the app from the system tray and show it in a normal state
Me.Timerx.Enabled = False
Me.Icon = Me.Image1
UpdateIcon NIM_DELETE
bResizeOff = True
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hWnd)
Me.Show
bResizeOff = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
UpdateIcon NIM_DELETE
'Dim Response As Integer, msg As String
'If sock(Intmax).state = 7 Then
' Response = MsgBox("Jika Anda keluar, koneksi remote host" & vbCrLf _
' & "akan terputus. Anda yakin untuk keluar ?", vbQuestion + vbYesNo, "Keluar")
' Select Case Response
' Case vbNo
' Cancel = -1
' Exit Sub
' Case vbYes
'tcpClient.Close
'jika program berhenti, semua soket akan ditutup
'' close_all_sockets
'Unload wininfo
' Unload Me
' End Select
'End If
End Sub
Private Sub Timer1_Timer()
'group pcb
If txtWaktu.Text = "10:30" Or txtWaktu.Text = "10:40" Or txtWaktu.Text = "10:55" Or _
txtWaktu.Text = "11:15" Or txtWaktu.Text = "11:30" Or txtWaktu.Text = "10:40" _
Or txtWaktu.Text = "10:55" Or _
txtWaktu.Text = "08:00" Or txtWaktu.Text = "08:15" Or txtWaktu.Text = "08:25" _
Then
' switch ke fan
Sleep (1000)
MSComm1.Output = "LA"
lbStatus.Caption = "FAN AC Office HIDUP"
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = vbGreen
End If
If txtWaktu.Text = "10:35" Or txtWaktu.Text = "10:45" Or txtWaktu.Text = "11:00" Or _
txtWaktu.Text = "11:20" Or txtWaktu.Text = "11:35" Or txtWaktu.Text = "10:45" Or _
txtWaktu.Text = "08:05" Or txtWaktu.Text = "08:20" Or txtWaktu.Text = "08:30" _
Then
' switch ke
Sleep (1000)
MSComm1.Output = "LB"
lbStatus.Caption = "AC Office HIDUP"
cmd4hon.BackColor = &H8000000F
cmd4hfan.BackColor = vbGreen
End If
End Sub
Private Sub timerx_Timer()
Static bool As Boolean
'used to flash the icon when the app is in the system tray and a message is waiting for the user
If bool = True Then
Me.Icon = Me.Image1
bool = False
Else
Me.Icon = Me.Image2
bool = True
End If
UpdateIcon NIM_MODIFY
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnuAppPopup
End If
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnuAppPopup
End If
End Sub
Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnuAppPopup
End If
End Sub
Private Sub openPort_Click()
Dim sformat As String
If MSComm1.PortOpen = True Then Exit Sub
sformat = baudChoice.List(baudChoice.ListIndex) + "," _
+ Mid(parityChoice.List(parityChoice.ListIndex), 1, 1) + "," _
+ dataBitChoice.List(dataBitChoice.ListIndex) + "," _
+ stopBitChoice.List(stopBitChoice.ListIndex)
MSComm1.Settings = sformat
MSComm1.CommPort = portChoice.ListIndex + 1
MSComm1.PortOpen = True
appendlnResponse ("COM" + Str(MSComm1.CommPort) + _
": Open at " + MSComm1.Settings)
openPort.Enabled = False
closePort.Enabled = True
enableChoice (False)
End Sub
Private Sub appendlnResponse(s As String)
responseBox.Text = responseBox.Text + s + Chr(13) + Chr(10)
End Sub
Public Function sendCommand(cmd As String)
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
Call openPort_Click
If Mid(cmd, 1, 1) <> "@" Then
MSComm1.Output = Chr(5) ' send ctrl-E = chr(5)
If getCtrlE() = False Then ' should get a Ctrl-E in return
responseText = ""
Exit Function
End If
End If
MSComm1.Output = cmd + Chr(13)
Call getResponse ' get a response within timeout.
sendCommand = responseText ' return value fungsi sendcomand= text respon dari alat.
End Function
' This function append the ID and the FCS to the input string "cmd" and return
' the resultant string. cmd should not include the "*" character
Public Function appendFCS(ID As Integer, cmd As String)
Dim IDString As String
Dim FCSString As String
IDString = Hex(ID)
If Len(IDString) = 1 Then IDString = "0" + IDString
cmd = "@" + IDString + cmd
FCSString = Hex(computeFCS(cmd))
If Len(FCSString) = 1 Then FCSString = "0" + FCSString
cmd = cmd + FCSString + "*"
appendFCS = cmd ' returned string now contains @ID and FCS+"*"
End Function
' This function compute the FCS for the given input string "cmd" and return the
' computed FCS as an integer. This function may be called for verifying whether
' the received response string is error free.
Public Function computeFCS(cmd As String)
Dim Result As Integer
Dim length As Integer
Dim i As Integer
length = Len(cmd)
Result = Asc(Mid(cmd, 1, 1))
For i = 2 To length
Result = Result Xor Asc(Mid(cmd, i, 1))
Next
computeFCS = Result
End Function
' This function wait for a valid Ctrl-E from the PLC and return TRUE. If it does not
' receive within the specified timeout then it returns a FALSE
Private Function getCtrlE()
Dim inbuff As String
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If inbuff = Chr(5) Then
getCtrlE = True
Exit Function
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
getCtrlE = False
End Function
' This procecedure examine the serial input buffer to see if a CR-terminated string
' has been received. Once a completed string is received it is copied to the global variable
' "responseText" and the buffer will be cleared. If a completed string is not received
' within the time-out period then the procedure will return and the "responseText" string
' will remain an empty string
Private Sub getResponse()
Static responseBuffer As String
Dim inbuff As String
Dim length As Integer
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 500
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If Len(inbuff) > 0 Then
responseBuffer = responseBuffer + inbuff
length = Len(responseBuffer)
If Mid(responseBuffer, length, 1) = Chr(13) Then
responseText = Mid(responseBuffer, 1, length - 1) ' received a complete response string
responseBuffer = ""
Exit Sub
Else
End If
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
responseText = "test"
End Sub
Private Sub timerJam_Timer()
Dim argo, counter, countermenit As Double
Dim hargaperdetik, hargapermenit As Double
Dim hargasebelum As Integer
txtday.Text = Format(Now, "dddd")
tgl.Caption = Format(Now, "yyyy-MM-dd")
txtWaktu.Text = Format(Now, "hh:mm")
lbWaktu.Caption = txtWaktu.Text
HH.Caption = Left(txtWaktu.Text, 2)
MM.Caption = Mid(txtWaktu.Text, 4, 2)
SS.Caption = Right(txtWaktu.Text, 2)
'set waktu istirahat siang dan jam pulang hari jumat
If Trim(txtday.Text) = "Jumat" Or Trim(txtday.Text) = "Friday" Then
txtsiangon.Text = "12:45"
txtsorepulang.Text = "16:50"
txtotsoremasuk.Text = "16:55"
End If
If Trim(txtday.Text) = "Sabtu" Or Trim(txtday.Text) = "Saturday" Then
txtsiangon.Text = "12:30"
txtsorepulang.Text = "16:28"
txtotsoremasuk.Text = "16:31"
End If
If txtWaktu.Text = (txtsavingpagi.Text) Then ' 07:45
Call saving2_off
End If
If txtWaktu.Text = (txtsavingsubuh.Text) Then ' 05:15
Call saving1_off
End If
'normal shift 07:25 = 10:10 = 12:30 = 15:30 PCB dan Complete
'============================================
If txtWaktu.Text = Trim(txtpagimasuk.Text) Or _
txtWaktu.Text = Trim(txtpagion.Text) Or _
txtWaktu.Text = Trim(txtsiangon.Text) Or _
txtWaktu.Text = Trim(txtsoreon.Text) Then
'ON KAN AC PCB NORMAL
If (chkpcb1630.Value = 1) Then
Call pcb_group1_on
Call pcb_group2_on
Call LCD_on
Call office_on
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 7
End If
lbStatus.Caption = "Semua AC PCB Hidup"
End If
'ON kan Ac complete normal 7:25 ~ 16:30
If (chkcomp1630.Value = 1) Then
Call complete_group2_on
Call complete_group1_on
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 7
End If
lbcomplete.Caption = "SEMUA AC complete HIDUP"
End If
End If
'============================================
'waktu mati
'OfF KAN AC NORMAL 7:30 ~16:30
If txtWaktu.Text = Trim(txtpagioff.Text) Or _
txtWaktu.Text = Trim(txtsiangoff.Text) Or _
txtWaktu.Text = Trim(txtsoreoff.Text) Or _
txtWaktu.Text = Trim(txtsorepulang.Text) Then
'WAKTU MATI pcb NORMAL
If (chkpcb1630.Value = 1) Then
Call pcb_group1_off
Call pcb_group2_off
lbcomplete.Caption = "SEMUA AC complete MATI"
End If
'WAKTU MATI COMPLETE NORMAL
If (chkcomp1630.Value = 1) Then
'==============================
Call complete_group1_off
Call complete_group2_off
'==============================
lbcomplete.Caption = "SEMUA AC complete MATI"
End If
End If 'AKHIR OFFKAN NORMAL
'***************************************************************
'WAKTU MATI LCD office NORMAL
If txtWaktu.Text = Trim(txtpagioff.Text) Or _
txtWaktu.Text = Trim(txtmerahsiangoff.Text) Or _
txtWaktu.Text = Trim(txtmerahsoreoff.Text) Or _
txtWaktu.Text = Trim(txtsorepulang.Text) Then
'WAKTU MATI LCD office NORMAL
If (chklcd.Value = 1) Then
Call LCD_off
Call office_off
End If
End If
'******************************************************************
'WAKTU MATI LCD office NORMAL
If txtWaktu.Text = Trim(txtpagion.Text) Or _
txtWaktu.Text = Trim(txtmerahsiangon.Text) Or _
txtWaktu.Text = Trim(txtmerahsoreon.Text) Or _
txtWaktu.Text = Trim(txtpagimasuk.Text) Then
'WAKTU MATI LCD office NORMAL
If (chklcd.Value = 1) Then
Call LCD_on
Call office_on
End If
End If
'********************************************************************
'waktu OFF LONG SHIF 2 COMPLETE
If txtWaktu.Text = Trim(txtmalamoff.Text) Or _
txtWaktu.Text = Trim(txttengahmalamoff.Text) Or _
txtWaktu.Text = Trim(txtdiniharioff.Text) Then
If (chkpcbshift.Value = 1) Then
Call pcb_group1_off
Call pcb_group2_off
Call office_off
lbStatus.Caption = "SEMUA AC PCB MATI"
End If
If (chkcompshift.Value = 1) Then
Call complete_group1_off
Call complete_group2_off
lbcomplete.Caption = "SEMUA AC complete MATI"
End If
End If
'=================================================
'waktu ON LONG SHIF 2 PCB dan COMPLETE
If txtWaktu.Text = Trim(txtshiftmasuk.Text) Or _
txtWaktu.Text = Trim(txtmalamon.Text) Or _
txtWaktu.Text = Trim(txttengahmalamon.Text) Or _
txtWaktu.Text = Trim(txtdiniharion.Text) Then
If (chkpcbshift.Value = 1) Then
Call pcb_group1_on
Call pcb_group2_on
Call office_on
lbStatus.Caption = " SEMUA ac PCB hIDUP"
End If
If (chkcompshift.Value = 1) Then
Call complete_group1_on
Call complete_group2_on
lbcomplete.Caption = "SEMUA AC complete HIDUP"
End If
'============================================
End If '(PENUTUP IF PCB DAN COMPLETE LONG SHIFT)
'*********************************************************************
'AC ON WAKTU LEMBUR PCB DAN COMPLETE
If txtWaktu.Text = Trim(txtotsoremasuk.Text) Or _
txtWaktu.Text = Trim(txtmagribon.Text) Then
'ON KAN AC PCB
If (chkpcbot.Value = 1) Then
Call pcb_group1_on
Call pcb_group2_on
Call office_on
lbStatus.Caption = " SEMUA ac PCB hIDUP"
End If
'ON kan Ac complete
If (chkcompot.Value = 1) Then
Call complete_group1_on
Call complete_group2_on
lbcomplete.Caption = "SEMUA AC complete HIDUP"
End If
'chklcdot
If (chklcdot.Value = 1) Then
Call LCD_on
lbcomplete.Caption = "AC LCD HIDUP"
End If
If Val(txtacqty.Text) < 20 Then
txtacqty.Text = Val(txtacqty.Text) + 7
End If
End If
'============================================
'waktu mati
'OfF KAN AC PCB dan Complete LEMBUR SORE
If txtWaktu.Text = Trim(txtmagriboff.Text) Or _
txtWaktu.Text = Trim(txtotpulang.Text) Then
'WAKTU MATI pcb OT
If (chkpcbot.Value = 1) Then
Call pcb_group1_off
Call pcb_group2_off
Call LCD_off
Call office_off
lbStatus.Caption = "SEMUA AC pcb MATI"
End If
'WAKTU MATI COMPLETE
If (chkcompot.Value = 1) Then
Call complete_group1_off
Call complete_group2_off
lbcomplete.Caption = "SEMUA AC complete MATI"
End If
'=========================
If Val(txtacqty.Text) > 0 Then
txtacqty = Val(txtacqty) - 7
End If
'==============================
End If 'AKHIR OFFKAN NORMAL
txtcounter2.Text = Val(txtcounter2.Text) + 1
countermenit = Val(txtcounter2.Text)
If countermenit > 60 Then
txtcounterjam.Text = Round(countermenit / 60)
End If
'hargaperdetik = (Val(txtkwh.Text) / 3600) * Val(txtacqty) * Val(txtpowerinput.Text)
hargapermenit = (Val(txtkwh.Text) / 60) * Val(txtacqty) * Val(txtpowerinput.Text)
txthargadetik.Text = hargapermenit / 60
txthargamenit.Text = hargapermenit
txthargajam.Text = hargapermenit * 60
txtrupiah.Text = Round(Val(txtrupiah.Text) + hargapermenit)
End Sub
Private Sub complete_group1_on()
If (chk4O.Value = 1) Then
Sleep (2000)
MSComm1.Output = "OB"
cmd4oon.BackColor = vbGreen
End If
'==================
If (chk4Q.Value = 1) Then
Sleep (1500)
MSComm1.Output = "QB"
cmd4qon.BackColor = vbGreen
End If
'=========================
If (chk4S.Value = 1) Then
Sleep (2000)
MSComm1.Output = "SB"
cmd4son.BackColor = vbGreen
End If
'==================
If (chk4U.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UB"
cmd4uon.BackColor = vbGreen
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EB"
cmd4eon.BackColor = vbGreen
End If
End Sub
Private Sub complete_group1_off()
If (chk4O.Value = 1) Then
Sleep (2000)
MSComm1.Output = "OC"
End If
'==================
If (chk4Q.Value = 1) Then
Sleep (1500)
MSComm1.Output = "QC"
End If
'=========================
If (chk4S.Value = 1) Then
Sleep (2000)
MSComm1.Output = "SC"
End If
'==================
If (chk4U.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UC"
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EC"
End If
End Sub
Private Sub complete_group2_on()
'==================
If (chk4P.Value = 1) Then
Sleep (1500)
MSComm1.Output = "PB"
cmd4pon.BackColor = vbGreen
End If
'===============================
If (chk4R.Value = 1) Then
Sleep (2000)
MSComm1.Output = "RB"
cmd4ron.BackColor = vbGreen
End If
'=========================
If (chk4T.Value = 1) Then
Sleep (2000)
MSComm1.Output = "TB"
cmd4Ton.BackColor = vbGreen
End If
'============================
If (chk4V.Value = 1) Then
Sleep (2000)
MSComm1.Output = "VB"
cmd4Von.BackColor = vbGreen
End If
If (chk41.Value = 1) Then
Sleep (2000)
MSComm1.Output = "1B"
cmdac1on.BackColor = vbGreen
End If
End Sub
Private Sub complete_group2_off()
'==================
If (chk4P.Value = 1) Then
Sleep (1500)
MSComm1.Output = "PC"
End If
'===============================
If (chk4R.Value = 1) Then
Sleep (2000)
MSComm1.Output = "RC"
End If
'=========================
If (chk4T.Value = 1) Then
Sleep (2000)
MSComm1.Output = "TC"
End If
'============================
If (chk4V.Value = 1) Then
Sleep (2000)
MSComm1.Output = "VC"
End If
If (chk41.Value = 1) Then
Sleep (2000)
MSComm1.Output = "1C"
End If
End Sub
Private Sub pcb_group1_on()
'==================
If (chk4N.Value = 1) Then
Sleep (2000)
MSComm1.Output = "NB"
cmdacNon.BackColor = vbGreen
End If
'==================
'If (chk4L.Value = 1) Then
'Sleep (1500)
'MSComm1.Output = "LB"
'cmdacLon.BackColor = vbGreen
'End If
'=========================
If (chk4J.Value = 1) Then
Sleep (2000)
MSComm1.Output = "JB"
cmdac5on.BackColor = vbGreen
End If
'==================
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HB"
cmd4hon.BackColor = vbGreen
End If
End Sub
Private Sub pcb_group1_off()
If (chk4N.Value = 1) Then
Sleep (2000)
MSComm1.Output = "NC"
End If
'==================
'If (chk4L.Value = 1) Then
'Sleep (1500)
'MSComm1.Output = "LC"
'End If
'=========================
If (chk4J.Value = 1) Then
Sleep (2000)
MSComm1.Output = "JC"
End If
'==================
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HC"
End If
End Sub
Private Sub pcb_group2_on()
'=========================
'If (chk4G.Value = 1) Then
'Sleep (2000)
'MSComm1.Output = "GB"
'cmd4gon.BackColor = vbGreen
'End If
'=========================
If (chk4I.Value = 1) Then
Sleep (2000)
MSComm1.Output = "IB"
cmd4ion.BackColor = vbGreen
End If
'===============================
If (chk4K.Value = 1) Then
Sleep (2000)
MSComm1.Output = "KB"
cmdac4on.BackColor = vbGreen
End If
'==================
If (chk4M.Value = 1) Then
Sleep (1000)
MSComm1.Output = "MB"
cmdacMon.BackColor = vbGreen
End If
End Sub
Private Sub pcb_group2_off()
If (chk4G.Value = 1) Then
Sleep (2000)
MSComm1.Output = "GC"
End If
'=========================
If (chk4I.Value = 1) Then
Sleep (2000)
MSComm1.Output = "IC"
End If
'===============================
If (chk4K.Value = 1) Then
Sleep (2000)
MSComm1.Output = "KC"
End If
'==================
If (chk4M.Value = 1) Then
Sleep (1000)
MSComm1.Output = "MC"
End If
End Sub
Private Sub LCD_off() 'office_off()
If (chk4F.Value = 1) Then
Sleep (1000)
MSComm1.Output = "FC"
End If
End Sub
Private Sub LCD_on() '
If (chk4F.Value = 1) Then
Sleep (1000)
MSComm1.Output = "FB"
End If
End Sub
Private Sub office_off()
If (chk4L.Value = 1) Then
Sleep (1000)
MSComm1.Output = "LC"
End If
End Sub
Private Sub office_on()
If (chk4L.Value = 1) Then
Sleep (1000)
MSComm1.Output = "LB"
End If
End Sub
Private Sub saving1_off() 'U-Q-S-M-H-J-E
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UC"
End If
'==================
If (chk4Q.Value = 1) Then
Sleep (1500)
MSComm1.Output = "QC"
End If
'=========================
If (chk4T.Value = 1) Then
Sleep (2000)
MSComm1.Output = "SC"
End If
'==================
If (chk4M.Value = 1) Then
Sleep (2000)
MSComm1.Output = "MC"
End If
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HC"
End If
If (chk4J.Value = 1) Then
Sleep (2000)
MSComm1.Output = "JC"
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EC"
End If
End Sub
Private Sub saving1_on() 'U-Q-S-M-H-J-E
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UB"
End If
'==================
If (chk4Q.Value = 1) Then
Sleep (1500)
MSComm1.Output = "QB"
End If
'=========================
If (chk4T.Value = 1) Then
Sleep (2000)
MSComm1.Output = "SB"
End If
'==================
If (chk4M.Value = 1) Then
Sleep (2000)
MSComm1.Output = "MB"
End If
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HB"
End If
If (chk4J.Value = 1) Then
Sleep (2000)
MSComm1.Output = "JB"
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EB"
End If
End Sub
'======================
'saving2
'======================
Private Sub saving2_off() 'U-M-H-E
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UC"
End If
'==================
If (chk4M.Value = 1) Then
Sleep (2000)
MSComm1.Output = "MC"
End If
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HC"
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EC"
End If
End Sub
Private Sub saving2_on() 'U-Q-S-M-H-J-E
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "UB"
End If
'==================
If (chk4M.Value = 1) Then
Sleep (2000)
MSComm1.Output = "MB"
End If
If (chk4H.Value = 1) Then
Sleep (2000)
MSComm1.Output = "HB"
End If
If (chk4E.Value = 1) Then
Sleep (2000)
MSComm1.Output = "EB"
End If
End Sub
'=======================================================
Rangkain yang dikontrol:
Client Rs485
Code program untuk rangkaian di atas:
program
;slave rs485
ORG 50H
SWITCH_FAN EQU 41h ; fAN = “A”
SWITCH_ON EQU 42H ; ON = “B”
SWITCH_OFF EQU 43H ; OFF = “C”
ORG 50H
SWITCH_FAN EQU 41h ; fAN = “A”
SWITCH_ON EQU 42H ; ON = “B”
SWITCH_OFF EQU 43H ; OFF = “C”
;========================================================
SLAVE_ID EQU 61H ; alamat slave
;=========================================================
SLAVE_ID EQU 61H ; alamat slave
;=========================================================
SLAVE_ALL EQU 40H ; “@”
relay_A BIT P1.2 ; 000 p1.4 p1.3 p1.2 0 0
relay_B BIT P1.3
relay_C BIT P1.4
relay_A BIT P1.2 ; 000 p1.4 p1.3 p1.2 0 0
relay_B BIT P1.3
relay_C BIT P1.4
ORG 000H
LJMP START
LJMP START
; org 3h
; jmp intext0
; jmp intext0
; org 13h
; jmp intext1
; jmp intext1
org 0023h
LJMP ISR_SERIAL
LJMP ISR_SERIAL
ORG 30H
START:
CLR relay_C ;off
CLR relay_B
CLR relay_A
; ; 1 ; 0 ; 1 ; 0 0 0 0
MOV SCON,#50H ;SM0;SM1;SM2;REN;TB8;RB8;TI;RI
MOV TMOD,#22H ;T1 MODE 2 AUTO RELOAD GATE;CT;M1;M0
MOV TH1,#0FDH ;96K BPS
MOV TCON,#040H ;TF;TR1;TF0;TR0;IE1;IT1IE0;IT0
MOV PCON,#00H ;SM0D-;-;-;-;-;-;-;-;-;
MOV IE,#90H ;EA-ET2;ES;ET1;EX1;ET0;EX0 = 95=1001 0101
MOV IP,#00010000B ;PRIORITAS UTAMA INT SERIAL 90=1001 0000
START:
CLR relay_C ;off
CLR relay_B
CLR relay_A
; ; 1 ; 0 ; 1 ; 0 0 0 0
MOV SCON,#50H ;SM0;SM1;SM2;REN;TB8;RB8;TI;RI
MOV TMOD,#22H ;T1 MODE 2 AUTO RELOAD GATE;CT;M1;M0
MOV TH1,#0FDH ;96K BPS
MOV TCON,#040H ;TF;TR1;TF0;TR0;IE1;IT1IE0;IT0
MOV PCON,#00H ;SM0D-;-;-;-;-;-;-;-;-;
MOV IE,#90H ;EA-ET2;ES;ET1;EX1;ET0;EX0 = 95=1001 0101
MOV IP,#00010000B ;PRIORITAS UTAMA INT SERIAL 90=1001 0000
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; CLR relay_A ;0110H fan
; SETB relay_B
; SETB relay_C
; SETB relay_B
; SETB relay_C
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; ACALL DELAY10DETIK
; CLR relay_C ;off
; CLR relay_B
; CLR relay_A
; CLR relay_B
; CLR relay_A
jmp $ ;looping menunggu perintah….
;======================================================
;batas main program
;======================================================
;batas main program
;======================================================
;======================================================
; interupt service serial
;======================================================
ISR_SERIAL:
; interupt service serial
;======================================================
ISR_SERIAL:
JNB RI,$
MOV A,SBUF
CLR RI
CJNE A,#SLAVE_ID,SEMUA ; jika isi A bukan 12H
CHARKEDUA: JNB RI,$
MOV A, SBUF
CLR RI
MOV A,SBUF
CLR RI
CJNE A,#SLAVE_ID,SEMUA ; jika isi A bukan 12H
CHARKEDUA: JNB RI,$
MOV A, SBUF
CLR RI
CJNE A,#SWITCH_ON,BUKAN_SWITCHON
ACALL TURN_ON
AJMP KE_RETI
ACALL TURN_ON
AJMP KE_RETI
SEMUA: CJNE A,#SLAVE_ALL , KE_RETI
JMP CHARKEDUA
JMP CHARKEDUA
BUKAN_SWITCHON:
CJNE A,#SWITCH_OFF,KE_FAN
ACALL TURN_OFF
AJMP KE_RETI
CJNE A,#SWITCH_OFF,KE_FAN
ACALL TURN_OFF
AJMP KE_RETI
KE_FAN: CJNE A,#SWITCH_FAN,KE_RETI
ACALL SW_FAN
ACALL SW_FAN
KE_RETI:
RETI
RETI
;======================================================
; interupt service interupt ext0
;======================================================
;intext0: ;AC on
;PUSH ACC
;PUSH PSW
;ACALL TURN_ON
;POP PSW
;POP ACC
;reti
; interupt service interupt ext0
;======================================================
;intext0: ;AC on
;PUSH ACC
;PUSH PSW
;ACALL TURN_ON
;POP PSW
;POP ACC
;reti
;======================================================
; interupt service interupt ext1
;=====================================================
; interupt service interupt ext1
;=====================================================
;intext1: ;AC of
;PUSH ACC
;PUSH PSW
;ACALL TURN_OFF
;POP PSW
;POP ACC
;reti
;PUSH ACC
;PUSH PSW
;ACALL TURN_OFF
;POP PSW
;POP ACC
;reti
;==================================================
TURN_ON:
MOV A,P1
ANL A,#00011100B
CJNE A,#00010100B,NYALAKAN ;bit p1.0 & p1.1 dianggap 0
RET
MOV A,P1
ANL A,#00011100B
CJNE A,#00010100B,NYALAKAN ;bit p1.0 & p1.1 dianggap 0
RET
NYALAKAN: ACALL SW_FAN
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL SW_COOL
RET
RET
TURN_OFF:
MOV A,P1
ANL A,#00011100B
CJNE A,#00,MATIKAN
RET
MATIKAN:
ACALL SW_FAN
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
MOV A,P1
ANL A,#00011100B
CJNE A,#00,MATIKAN
RET
MATIKAN:
ACALL SW_FAN
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL DELAY10DETIK
ACALL SW_OFF
RET
RET
SW_OFF: CLR relay_A ;0000H
CLR relay_B
CLR relay_C
ret
CLR relay_B
CLR relay_C
ret
SW_FAN: CLR relay_A ;0110H
SETB relay_B
SETB relay_C
ret
SETB relay_B
SETB relay_C
ret
SW_COOL: SETB relay_A ;0101h
CLR relay_B
SETB relay_C
ret
CLR relay_B
SETB relay_C
ret
DELAY:
MOV R6,#255
DELAY1: DJNZ R6, DELAY1
MOV R6,#255
DELAY2: DJNZ R6, DELAY2
MOV R6,#255
DELAY3: DJNZ R6,DELAY3
RET
MOV R6,#255
DELAY1: DJNZ R6, DELAY1
MOV R6,#255
DELAY2: DJNZ R6, DELAY2
MOV R6,#255
DELAY3: DJNZ R6,DELAY3
RET
DELAY1MS: MOV R7,#255
CALL DELAY
CALL DELAY
CALL DELAY
DELAYLOOP: DJNZ R7,DELAYLOOP
RET
CALL DELAY
CALL DELAY
CALL DELAY
DELAYLOOP: DJNZ R7,DELAYLOOP
RET
DELAY1DETIK: MOV R5,#255
CALL DELAY1MS
CALL DELAY1MS
LOOP1DTK: DJNZ R5,LOOP1DTK
RET
CALL DELAY1MS
CALL DELAY1MS
LOOP1DTK: DJNZ R5,LOOP1DTK
RET
DELAY2DETIK: MOV R4,#255
CALL DELAY1DETIK
CALL DELAY1DETIK
CALL DELAY1DETIK
LOOP4DTK: DJNZ R4, LOOP4DTK
RET
CALL DELAY1DETIK
CALL DELAY1DETIK
CALL DELAY1DETIK
LOOP4DTK: DJNZ R4, LOOP4DTK
RET
DELAY5DETIK: MOV R3,#255
CALL DELAY2DETIK
CALL DELAY2DETIK
CALL DELAY2DETIK
LOOP5DTK: DJNZ R3, LOOP5DTK
RET
CALL DELAY2DETIK
CALL DELAY2DETIK
CALL DELAY2DETIK
LOOP5DTK: DJNZ R3, LOOP5DTK
RET
DELAY10DETIK: MOV R2,#255
CALL DELAY5DETIK
CALL DELAY5DETIK
CALL DELAY5DETIK
CALL DELAY5DETIK
LOOP10DTK: DJNZ R2, LOOP10DTK
RET
RET
end
;SCON=SM0;SM1;SM2;REN; TB8 ;RB8;TI ;RI;
;TMOD=GATE1;C/T;M1;M0; GATE0;C/T;M1 ;M0;
;TCON=TF1;TR1;TF0;TR0; IE1 ;IT1;IE0;IT0;
;PCON=SMOD;-;-;-; GF1 ;GF0;PD ;IDL;
;IE =EA;-;ET2;ES ; ET1 ;EX1;ET0;EX0
sumber: http://pccontrol.wordpress.com
;TMOD=GATE1;C/T;M1;M0; GATE0;C/T;M1 ;M0;
;TCON=TF1;TR1;TF0;TR0; IE1 ;IT1;IE0;IT0;
;PCON=SMOD;-;-;-; GF1 ;GF0;PD ;IDL;
;IE =EA;-;ET2;ES ; ET1 ;EX1;ET0;EX0
sumber: http://pccontrol.wordpress.com
download source-code nya lengkap klik dibawah ini :
gan, bisa minta skematik rangkaian n sourcecode nya. link nya dah g' bisa.
BalasHapus