Selamat sore, bertemu lagi dengan saya Yanuar, kali ini saya akan menjelaskan mengenai bagaimana cara membuat alat yang bisa digunakan untuk mngendalikan file PPT(power point), sebenarnya bukan hanya file power point saja yang bisa dikendalikan oleh alat ini, file lain pun bisa misal game flash yang menggunakan kendali arrow left dan right, E-book, dan lainnya. Pada contoh ini saya hanya mencontohkan file power point saja karena gampang dan biasa di jumpai di masyarakat, Prinsip kerja alat ini sangatlah mudah yaitu ada dua buah tombol yang menggantikan fungsi dari arrow left dan arrow right melalui program visual basic 6.0. untuk lebih jelasnya berikut penjelasannya.
a. Minimum System
b. Rangkaian RS232
c. Program Bascom AVR
$regfile = "m16def.dat"
$crystal = 12000000
$baud = 9600
Ddrb.0 = 0
Ddrb.1 = 0
Ddrb.2 = 0
Portb.0 = 1
Portb.1 = 1
Portb.2 = 1
Dim A As Integer
Dim B As Integer
Dim C As Integer
A = 100
B = 200
C = 300
Do
If Pinb.0 = 0 Then
Do
Print A
Wait 1
Loop Until Pinb.0 = 1
End If
If Pinb.1 = 0 Then
Do
Print B
Wait 1
Loop Until Pinb.1 = 1
End If
If Pinb.2 = 0 Then
Do
Print C
Wait 1
Loop Until Pinb.2 = 1
End If
Loop
d. Program Visual Basic 6.0
DOWNLOAD
Option Explicit
Dim arrdata()
Dim TotalBaca As Integer
Dim BMI As Single
Dim Keterangan As String
Const MAKSBACA = 10
Dim sHari As String
Dim aHari
Private Sub berhenti_Click()
start.Enabled = True
berhenti.Enabled = False
TimerBaca.Enabled = False
End Sub
Private Sub Command1_Click()
Open "C:\Users\yanuar\Desktop" & "\project.txt" For Append As #1
Print #1, "======================"
Print #1, " Data dalam satu menit "
Print #1, "======================"
Print #1, "Tanggal = "; lbltanggal.Caption
Print #1, " Jam = "; lbljam.Caption
Print #1, " NIlai = "; Label1.Caption
Print #1,
Close #1
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Text1.Text = " "
Label1.Caption = " "
End Sub
Private Sub Form_Load()
Dim i As Byte
For i = 1 To 16
ComboCOM.AddItem (i)
Next i
aHari = Array("Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu")
End Sub
Private Sub start_Click()
Dim u As Integer
On Error GoTo ada_eror
MSComm2.CommPort = ComboCOM.Text
MSComm2.Settings = "9600,N,8,1"
MSComm2.RThreshold = 15
MSComm2.InputLen = 15
MSComm2.InputMode = comInputModeText
MSComm2.PortOpen = True ' buka port
ReDim arrdata(1 To MAKSBACA + 1)
For u = 1 To MAKSBACA
arrdata(u) = 0
Next
TotalBaca = 0
start.Enabled = False
berhenti.Enabled = True
TimerBaca.Enabled = True
ada_eror:
If ComboCOM.ListIndex < 1 Then
MsgBox "COM berada di Nomor : " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "ERROR"
start.Enabled = True
berhenti.Enabled = True
ComboCOM.Text = "Pilih COM"
End If
End Sub
Private Sub Timer1_Timer()
sHari = aHari(Abs(Weekday(Date) - 1))
lbltanggal.Caption = "" & sHari & "," & Format(Date, "dd mmmm yyyy")
lbljam.Caption = Format(Time, "hh:mm:ss")
End Sub
Private Sub TimerBaca_Timer()
Dim strInput As String
Dim strPotong As String
Dim singleInput As Single
Dim u As Integer
Dim keycode As Integer
Dim strKeyPressed As String 'inputted character
Dim strAscii As String 'Ascii number
strInput = MSComm2.Input
strPotong = strInput
Text1.Text = Text1.Text + strPotong + vbCrLf
singleInput = Val(strPotong)
Label1.Caption = singleInput
If TotalBaca >= MAKSBACA Then
TimerBaca.Enabled = False
If MSComm2.PortOpen = True Then MSComm2.PortOpen = False
Call berhenti_Click
End If
If Label1.Caption = "100" Then
Label2.Caption = "KANAN"
SendKeys "{LEFT}", True
ElseIf Label1.Caption = "200" Then
Label2.Caption = "KIRI"
SendKeys "{RIGHT}", True
ElseIf Label1.Caption = "300" Then
Label2.Caption = "SPACE"
SendKeys "{UP}", True
Else
Label2.Caption = "OK"
End If
End Sub
e. Cara agar saat Compile VB 6 "SendKeys" tidak error
- Pertama buat dulu file seperti diatas
- Setelah selesai pilih File -> Make namafile.exe (enter)
- Simpan disuatu tempat misal di drive D:
- Click kanan file.exe tersebut lalu pilih propertis
- Rubah Compatibility dengan men-check list pada Compatibility Mode lalu pilih Windows XP SP 2
- Program siap dijalankan
f. VIDEO HASILNYA
No comments:
Post a Comment