Membuat suatu tombol kelihatan diklik/ditekan melalui coding.
Persiapan:
1. Buat 1 Project baru dengan 1 Form, 1 Module, dan 3
Commandbutton.
2. Ketik coding berikut ke dalam editor form dan module yang
bersangkutan.
Ketika Anda mengklik Command2, Command1 akan kelihatan
ditekan (masuk ke dalam).
Ketika Anda mengklik Command3, Command1 akan kelihatan
normal kembali.
Ketikkan coding berikut ini pada Modul.
Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal
wParam As Long, lParam As Any) As Long
Public Const BM_SETSTATE = &HF3
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Ketikkan Coding berikut ini pada Form.
Private Sub Command2_Click() 'Command1 kelihatan masuk
‘ke dalam (ditekan)
Call SendMessage(Command1.hwnd, BM_SETSTATE, 1, _ByVal 0&)
End Sub
Private Sub Command3_Click() 'Command1 normal kembali.
Call SendMessage(Command1.hwnd, BM_SETSTATE, 0, _ByVal 0&)
End Sub
Selamat mencoba dan berkreasi dengan ide kamu...
20 November 2008
Menekan Tombol di Form Lain
Menekan tombol yang terdapat di dalam form lainnya. Jika tombol di
Form1 ditekan, maka tombol di Form2 juga akan bereaksi, dengan
memunculkan suatu pesan.
Persiapan:
1. Buat 1 Project baru dengan 2 Form.
2. Pada Form1 dan Form2 masing-masing buat 1 Commandbutton.
3. Ketik coding berikut ke dalam editor form yang bertalian.
Ketikkan coding berikut ini pada form.
Ketikkan Coding di form1
Private Sub Command1_Click()
Form2.Command1.Value = True
End Sub
Ketikkan Coding di Form2
Private Sub Command1_Click()
MsgBox "Tombol di Form2 diklik juga...", vbInformation,"Konfirmasi"
Selamat mencoba dan kembangkan dengan idemu..
Form1 ditekan, maka tombol di Form2 juga akan bereaksi, dengan
memunculkan suatu pesan.
Persiapan:
1. Buat 1 Project baru dengan 2 Form.
2. Pada Form1 dan Form2 masing-masing buat 1 Commandbutton.
3. Ketik coding berikut ke dalam editor form yang bertalian.
Ketikkan coding berikut ini pada form.
Ketikkan Coding di form1
Private Sub Command1_Click()
Form2.Command1.Value = True
End Sub
Ketikkan Coding di Form2
Private Sub Command1_Click()
MsgBox "Tombol di Form2 diklik juga...", vbInformation,"Konfirmasi"
Selamat mencoba dan kembangkan dengan idemu..
05 November 2008
Program kirim SMS melalui PC
Perangkat
1. HP (Hanya untuk model nokia)
2. Connecting Device (Seperti : Infrared, Kabel data, or Bluetooth)
3. Download dan install program Nokia PC Connectivity SDK yang sesuai dengan model ponsel Nokia yang kamu gunakan.
Prosedur
1. Install semua alat koneksi (seperti :Infrared, DataCable, or Bluetooth) kedalam PC
Perhatian : Pastikan setelah terinstall alat koneksi dengan HP terhubung dengan baik
2. Install program aplikasi Nokia PC COnnectivity.
3. Buka VB dan kemudian mulai dengan membuat project baru
4. Add komponen Nokia dalam menu preferences yang ada di VB
5. Kemudian isi dengan Script dibawah ini
Private Sub cmdSend_Click()
On Error GoTo ErrorTrap
Dim message As String
message = txtMsg.Text
Select Case chkUnicode.Value
Case vbUnchecked
If (Len(message) > SMS_TEXT_MAX_SIZE) Then
pMsgPart1 = Left(message, SMS_CONCATENATED_TEXT_MAX_SIZE)
pMsgPart2 = Right(message, Len(message) - SMS_CONCATENATED_TEXT_MAX_SIZE)
SendConcatenatedMessage
Exit Sub
End If
Case vbChecked
If (Len(message) > SMS_UNICODE_MAX_SIZE) Then
pMsgPart1 = Left(message, SMS_CONCATENATED_UNICODE_MAX_SIZE)
pMsgPart2 = Right(message, Len(message) - SMS_CONCATENATED_UNICODE_MAX_SIZE)
SendConcatenatedMessage
Exit Sub
End If
Case Else
MsgBox ("Select coding scheme")
End Select
Dim smsEntry As NokiaCLMessaging.ShortMessageItem
Set smsEntry = New NokiaCLMessaging.ShortMessageItem
smsEntry.Type = SHORTMESSAGE_TYPE_GSM_SUBMIT
Set pIGSMSubmit = smsEntry.TypeProperties
pIGSMSubmit.message = txtMsg.Text
pIGSMSubmit.DestinationAddress = txtDestination.Text
pIGSMSubmit.ServiceCenterAddress = txtMsgCenter.Text
pIGSMSubmit.ProtocolID = 0
If (chkUnicode.Value = vbChecked) Then
pIGSMSubmit.DataCodingScheme = CODING_SCHEME_UNICODE
Else
pIGSMSubmit.DataCodingScheme = CODING_SCHEME_TEXT
End If
pIGSMSubmit.ValidityPeriodRelative = 255
Call pSMSAdapter.SendSMS(SHORTMESSAGE_ROUTE_TYPE_ANY, pIGSMSubmit)
'Insert your code here to store the sent message in the database.
MsgBox "Message Sent TO " & txtDestination.Text & vbCrLf & "With Reference Number: " & pIGSMSubmit.MessageReference, vbOKOnly, "Message Sent"
Exit Sub
ErrorTrap:
If Err.Number = -2147467259 Or Err.Number = -2147467259 Then
End If
MsgBox Err.Description, vbInformation, "SMS Cannot Send"
End Sub
Nah mudah bukan? Silakan kamu kembangkan sendiri dari aplikasi yang sudah dibuat penulis...
1. HP (Hanya untuk model nokia)
2. Connecting Device (Seperti : Infrared, Kabel data, or Bluetooth)
3. Download dan install program Nokia PC Connectivity SDK yang sesuai dengan model ponsel Nokia yang kamu gunakan.
Prosedur
1. Install semua alat koneksi (seperti :Infrared, DataCable, or Bluetooth) kedalam PC
Perhatian : Pastikan setelah terinstall alat koneksi dengan HP terhubung dengan baik
2. Install program aplikasi Nokia PC COnnectivity.
3. Buka VB dan kemudian mulai dengan membuat project baru
4. Add komponen Nokia dalam menu preferences yang ada di VB
5. Kemudian isi dengan Script dibawah ini
Private Sub cmdSend_Click()
On Error GoTo ErrorTrap
Dim message As String
message = txtMsg.Text
Select Case chkUnicode.Value
Case vbUnchecked
If (Len(message) > SMS_TEXT_MAX_SIZE) Then
pMsgPart1 = Left(message, SMS_CONCATENATED_TEXT_MAX_SIZE)
pMsgPart2 = Right(message, Len(message) - SMS_CONCATENATED_TEXT_MAX_SIZE)
SendConcatenatedMessage
Exit Sub
End If
Case vbChecked
If (Len(message) > SMS_UNICODE_MAX_SIZE) Then
pMsgPart1 = Left(message, SMS_CONCATENATED_UNICODE_MAX_SIZE)
pMsgPart2 = Right(message, Len(message) - SMS_CONCATENATED_UNICODE_MAX_SIZE)
SendConcatenatedMessage
Exit Sub
End If
Case Else
MsgBox ("Select coding scheme")
End Select
Dim smsEntry As NokiaCLMessaging.ShortMessageItem
Set smsEntry = New NokiaCLMessaging.ShortMessageItem
smsEntry.Type = SHORTMESSAGE_TYPE_GSM_SUBMIT
Set pIGSMSubmit = smsEntry.TypeProperties
pIGSMSubmit.message = txtMsg.Text
pIGSMSubmit.DestinationAddress = txtDestination.Text
pIGSMSubmit.ServiceCenterAddress = txtMsgCenter.Text
pIGSMSubmit.ProtocolID = 0
If (chkUnicode.Value = vbChecked) Then
pIGSMSubmit.DataCodingScheme = CODING_SCHEME_UNICODE
Else
pIGSMSubmit.DataCodingScheme = CODING_SCHEME_TEXT
End If
pIGSMSubmit.ValidityPeriodRelative = 255
Call pSMSAdapter.SendSMS(SHORTMESSAGE_ROUTE_TYPE_ANY, pIGSMSubmit)
'Insert your code here to store the sent message in the database.
MsgBox "Message Sent TO " & txtDestination.Text & vbCrLf & "With Reference Number: " & pIGSMSubmit.MessageReference, vbOKOnly, "Message Sent"
Exit Sub
ErrorTrap:
If Err.Number = -2147467259 Or Err.Number = -2147467259 Then
End If
MsgBox Err.Description, vbInformation, "SMS Cannot Send"
End Sub
Nah mudah bukan? Silakan kamu kembangkan sendiri dari aplikasi yang sudah dibuat penulis...
Membuat program Port Scanner
Disini penulis mencoba membuat program Port Scanner, dan komponen yang dibutuhkan untuk membuat port scanner adalah :
2 Text boxes ( Text1,Text2 )
1 ListBox ( List1 )
3 Command Buttons ( Command1, Command2, Command3 )
1 Timer ( Timer1 )
1 Winsock Component ( Winsock1 )
Jika kamu tidak tahu tempat dimana mengaktifkan komponen lihat gambar berikut
Setelah tampil jendela komponen silakan kamu mencari komponen yang bernama "Microsoft Winsock Control 6.0 (SP6)"
Berikut contoh komponen yang sudah ditemukan
Oke sekarang silakan membuat form seperti dibawah ini atau kamu bisa membuat sendiri desain formnya dengan ide kamu sendiri
Dan Berikut untuk kode lebih jelasnya
Code Explanation:-
Jika port sudah discan maka hasilnya akan tampil di listbox
Selamat mencoba dan mengembangkan sendiri...
2 Text boxes ( Text1,Text2 )
1 ListBox ( List1 )
3 Command Buttons ( Command1, Command2, Command3 )
1 Timer ( Timer1 )
1 Winsock Component ( Winsock1 )
Jika kamu tidak tahu tempat dimana mengaktifkan komponen lihat gambar berikut
Setelah tampil jendela komponen silakan kamu mencari komponen yang bernama "Microsoft Winsock Control 6.0 (SP6)"
Berikut contoh komponen yang sudah ditemukan
Oke sekarang silakan membuat form seperti dibawah ini atau kamu bisa membuat sendiri desain formnya dengan ide kamu sendiri
Dan Berikut untuk kode lebih jelasnya
Code:
Private Sub Form_Load()
Timer1.Interval = 1
Timer1.Enabled = False
Text2.Text = "0"
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Winsock1.Close
Text2.Text = Text2.Text + 1
Winsock1.RemoteHost = Text1.Text
Winsock1.RemotePort = Text2.Text
Winsock1.Connect
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
Text2.Text = "0"
End Sub
Private Sub Command3_Click()
List1.Clear
End Sub
Private Sub Winsock1_Connect()
List1.AddItem Winsock1.RemotePort & " is open!"
End Sub
Code:
Private Sub Form_Load()
Timer1.Interval = 1
Timer1.Enabled = False
Text2.Text = "0"
End Sub
Code:
Private Sub Timer1_Timer()
On Error Resume Next
Winsock1.Close
Text2.Text = Text2.Text + 1
Winsock1.RemoteHost = Text1.Text
Winsock1.RemotePort = Text2.Text
Winsock1.Connect
End Sub
Code:
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Code:
Private Sub Command2_Click()
Timer1.Enabled = False
Text2.Text = "0"
End Sub
Code:
Private Sub Command3_Click()
List1.Clear
End Sub
Code:
Private Sub Winsock1_Connect()
List1.AddItem Winsock1.RemotePort & " is open!"
End Sub
Selamat mencoba dan mengembangkan sendiri...
Latihan membuat game dengan VB
Kali ini kita kita akan belajar membuat game yang nantinya bisa kamu kembangkan sendiri.Penulis hanya membuat sample ini supaya kamu bisa menciptakan sendiri game yang lebih bagus.Game ini sangat simple dengan tampilan 2 dimensi menggunakan scipt kode di VB. Ada tiga option yang bisa dipilih yaitu :
1) Start
2) Options
3) The Game
Komponen yang digunakan
1) Timer Control
2) Picture Control
3) Label Control
4) Windows Media ocx
Untuk bermain game ini hanya menggunakan tombol arah serta tombol spasi. Silakan mencoba sendiri..
Dan berikut sample codenya
Option Explicit
Dim u, d, l, r, showm As Boolean
Dim x, y As Integer
Dim mx, my As Integer
Dim ex, ey As Integer
Dim score As Long
Dim fuel As Integer
Dim es As Integer
Private Sub Form_Load()'MediaPlayer1.playerApplication = App.Path & "\sfx\fire.wav"
'MediaPlayer2.FileName = App.Path & "\sfx\Explosion.wav"
'MediaPlayer3.FileName = App.Path & "\sfx\mainsound.mp3"lblScore.Caption = "0"x = 0
y = 0ex = -100
ex = -100es = 10fuel = 1
End Sub
Private Sub Form_Paint()
shooter.SetFocus
End Sub
Private Sub shooter_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 49 Then speed = speed - 1
If speed <= 0 Then speed = 0 If speed > 30 Then speed = 30
If KeyCode = 50 Then speed = speed + 1
If KeyCode = vbKeyLeft Then l = True
If KeyCode = vbKeyRight Then r = True
If KeyCode = vbKeyUp Then u = True
If KeyCode = vbKeyDown Then d = True
If KeyCode = vbKeySpace Then
If Not showm Then
fireit
End If
End If
If KeyCode = vbKeyEscape Then Unload Me: End
End Sub
Private Sub shooter_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyLeft Then l = False
If KeyCode = vbKeyRight Then r = False
If KeyCode = vbKeyUp Then u = False
If KeyCode = vbKeyDown Then d = False
End Sub
Private Sub Timer1_Timer()Static ch As Boolean
ch = Not chIf ch Then
shooter.Picture = Picture2.Picture
Else
shooter.Picture = Picture3.Picture
End If
End Sub
Private Sub
Timer2_Timer()
If l Then
x = x - speed
If x < x =" 0" x =" x">= Me.ScaleWidth - 100 Then x = Me.ScaleWidth - 100
End If
If u Then
y = y - speed
If y < y =" 0" y =" y">= Me.ScaleHeight - 100 Then y = Me.ScaleHeight - 100
End If
Label5.Caption = "X = " & x
Label6.Caption = "Y = " & y
shooter.Left = x
shooter.Top = y
Label3.Caption = CStr(speed)
If showm Then
mx = mx + 20
If mx > Me.ScaleWidth Then
showm = False
fire.Visible = False
End If
fire.Left = mx
fire.Top = my
If (my > ey And my <> ex) Then
score = score + 10
showm = False
SetEn
End If
Else
fire.Visible = False
End If
ex = ex - es
en.Left = ex
If ex < -200 Then SetEn en.Top = ey End If lblScore = CStr(score) Label8.Caption = "EX = " & ex Label7.Caption = "EY = " & ey If (y > ey - 40 And y <> ex And x < fuel =" fuel"> 1 Then MediaPlayer2.Play
Picture1.BackColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
SetEn Select Case fuel
Case 2
Image1.Picture = LoadPicture(App.Path & "\data\fuel50.gif")
Case 3
Image1.Picture = LoadPicture(App.Path & "\data\fuel20.gif")
Case 4
Image1.Picture = LoadPicture(App.Path & "\data\game-over.gif")
End Select
If fuel = 4 Then
MsgBox "Game Over", vbCritical, "Shooter"
Unload Me
Form2.Show
End If
End If
End Sub
Private Sub fireit()
'MediaPlayer1.Play
showm = Truemx = shooter.Left + 100
my = shooter.Top + 50
fire.Visible = True
End Sub
Public Sub SetEn()
ey = Int(Rnd * Me.ScaleHeight) - 100
ex = Me.ScaleWidth
en.Left = ex
en.Top = ey
End Sub
Private Sub Timer3_Timer()
es = es + 5
End Sub
Berikut source code yang sudah jadi download
Langganan:
Postingan (Atom)