Gambar: Setting feed pada blogger >> side menu Settings >> Other |
Wednesday, December 26, 2012
Blogging - Mengenal 2 Jenis Feed Blogger
Sunday, December 23, 2012
JavaScript Events: OnMouseOver OnMouseOut - Blogging
Mengenai event pada javascript atau lainnya - Apa yang dimaksud event dalam pemrograman? hmm...apa ya, begini saja agar mudah terhook dengan memory, kita terjemahkan saja secara harfiah bahwa event itu adalah terjadinya sebuah peristiwa.
Untuk mempermudah pemahaman, maka kita ambil dua contoh event yang terdapat pada javascript yaitu event OnMouseOver dan event OnMouseOut. Berdasarkan terjemahan tadi di atas, maka event OnMouseEver bisa kita terjemahkan saja terjadinya peristiwa [pointer mouse di atas objek] sedangkan event OnMouseOut bisa kita terjemahkan terjadinya peristiwa [pointer mouse di luar objek], dan sebagainya.
Apakah Kegunaan Event itu?
Event berguna sebagai trigger/pemicu/eksekusi/menjalankan kode lainnya yang berada di bawahnya.
Contoh Fungsi Yang Dipanggil Melalui Events
Di bawah merupakan contoh fungsi javascript yang dipanggil melalui events onmousehover dan events onmouseout:< script type = 'text/javascript' >
function mousehover(x) {
x.style.overflow = "auto" ;
}
function mouseout(x) {
x.style.overflow = "hidden" ;
}
< / script >
<DIV style="HEIGHT: 330px; OVERFLOW: hidden" onmouseover=mousehover(this) onmouseout=mouseout(this) expr:class='"widget-content " + data:display + "-label-widget-content"'></DIV>
Friday, December 21, 2012
Contoh Sederhana Bekerja Dengan TabStrip - VB6
Bekerja dengan objek TabStrip dalam pengkodean VB6, maka tidak akan terlepas dari yang dinamakan Container. Diantara container yang banyak digunakan untuk keperluan ini adalah PictureBox. TabStrip berbeda dengan SSTab, TabStrip memerlukan tambahan kode untuk menampilkan objek-objek yang berada di bawah tab-nya.
Berikut merupakan contoh sederhana bagaimana bekerja dengan TabStrip. TabStrip yang digunakan dalam contoh adalah TabStrip yang berada pada komponen COMCTL32.OCX. Dengan mempergunakan COMCTL32.OCX maka tampilannya dapat mengikuti style window yang ada. Karena di dalam pengkodeannya akan banyak melakukan resize terhadap beberapa objek, cobalah untuk mempertimbangkan posting saya sebelumnya di sini.
Gambar: Tampilan tabstrip yang berada di bawah tabstrip lagi. |
Download: Source Code VB6 - Contoh sederhana menggunakan TabStrip.
Method .Move Jauh Lebih Cepat - VB6 Tips
Menjelaskan bahwa method .Move yang terdapat pada objek jauh lebih cepat dibandingkan setting pada properties - Apabila Anda bekerja dengan tampilan yang terdapat pada VB6 dan pada tampilan tersebut banyak melakukan resize terhadap objek misalnya: Form melakukan resize terhadap Container1 (PictureBox), Container1 melakukan resize terhadap Container2 (PictureBox), Container2 melakukan resize terhadap Container3, dan seterusnya hingga akhirnya Container terakhir melakukan resize terhadap objek-objek. Barulah Anda menyadari sebuah ketidakstabilan karena menggunakan kode seperti yang dicontohkan di bawah ini:
Private Sub Picture1_Resize()
With Text1
.Left = 0
.Top = 0
.Width = Picture1.ScaleWidth
.Height = Picture1.ScaleHeight
End With
End Sub
Sebaiknya kode di atas Anda ganti saja dengan menggunakan methode move seperti yang dicontohkan di bawah ini:
Private Sub Picture1_Resize()Atau sebaiknya buatlah sebuah method reusable seperti di bawah ini:
With Text1
.Move 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
End With
End Sub
Public Sub SetSameSize(Parent, Child)Contoh penggunaan dari method di atas:
With Child
.Move 0, 0, Parent.ScaleWidth, Parent.ScaleHeight
End With
End Sub
Private Sub Picture1_Resize()
SetSameSize Picture1, Text1
End Sub
Ngomong-ngomong mengapa method move lebih cepat? tentu saja karena ia hanya memerlukan satu kali proses dan langsung memanggil fungsi API, sementara setting properties membutuhkan bebarapa kali proses disebabkan OOP dan Class-nya.
Thursday, December 20, 2012
Context Menu Untuk File Ber-ektensi VBL - VB6 OCX
Gambar: Lisensi tidak ditemukan untuk komponen shadow.ocx |
Hal tersebut terjadi karena Anda tidak memiliki lisensi untuk menggunakan shadow.ocx pada saat design time dan hanya diperbolehkan melihat demonya saja. Sekarang kita bermain pura-pura, pura-puranya Anda telah membeli lisensi dari saya, kemudian saya memberikan lisensinya berupa file ber-ektensi .vbl atau tepatnya lisensi.vbl.
Download: Lisensi.VBL
Apa Yang Harus Dilakukan Dengan Lisensi.VBL
Memasukan lisensi key yang terdapat pada file lisensi.vbl ke dalam registry agar Anda dapat menggunakan file shadow.ocx tersebut pada saat design time, tetapi bagaimana caranya? Kita ambil dua cara termudah:- Mengganti ektensi .vbl dengan ektensi .reg kemudian double klik
- Membuat context menu untuk file .vbl dengan cara mengetik file registry di bawah ini pada notepad:
REGEDIT4[HKEY_CLASSES_ROOT\.vbl]
@="VisualBasic.VBLFile"
[HKEY_CLASSES_ROOT\VisualBasic.VBLFile]
@="Visual Basic Control License File"
[HKEY_CLASSES_ROOT\VisualBasic.VBLFile\shell\open]
@="&Insert License"
Nama file: Shadow.OCX
GUID: A434183A-F9E0-4DFA-AB7B-7538C391A576
License Key: kkgdjdikddedddfdieikpdfkqesjgdjdkdpj
VB6 Code: Menggunakan ( := ) dalam Coding VB6
Dikarenakan VB6 identik dengan VBA office dalam artian keduanya menggunakan bahasa yang sama, kebutuhan runtime file yang sama, dan sebagainya (yang berbeda hanya objek-objek saja), maka apa yang ada dalam VBA tentu bisa dijalankan dalam VB6. Salah satunya adalah tanda (:=) walau jarang sekali melihatnya dalam pengkodean VB6.
Tanda (:=) merupakan pemberitahuan kepada compiler bahwa sebuah argumen optional telah diisi dengan nilai tertentu. Agar lebih jelasnya berikut merupakan contoh sebuah function yang memiliki 26 argument optional (argumen yang memiliki 2 opsi, boleh diisi atau tidak):
Option Explicit 'Sebuah function dengan 26 argument, nama argument dari a s/d z Private Function Test(Optional a, Optional b, Optional c, Optional d, Optional e _ , Optional f, Optional g, Optional h, Optional i, Optional j, Optional k, Optional l _ , Optional m, Optional n, Optional o, Optional p, Optional q, Optional r, Optional s _ , Optional t, Optional u, Optional v, Optional w, Optional x, Optional y, Optional z) MsgBox o MsgBox z 'Kode dan seterusnya End FunctionMaka untuk memanggil fungsi di atas bisa seperti ini:
Private Sub Command1_Click() Call Test(, , , , , , , , , , , , , , 6, , , , , , , , , , , 1) End SubAtau seperti ini:
Private Sub Command2_Click() Call Test(o:=6, z:=1) 'Call disini berguna untuk memudahkan pembacaan kode End SubAtau seperti ini (dengan membalikan, argumen z di depan dan argumen o di belakang):
Private Sub Command3_Click() Call Test(z:=1, o:=6) End SubAtau seperti ini (tanpa call):
Private Sub Command4_Click() Test z:=1, o:=6 'tanpa Call juga bisa berjalan kok End SubMana yang menurut Anda praktis?
Tuesday, December 18, 2012
Blogging - Merapikan Kode XML Dengan Mudah - XML Tidy
Struktur XML (Extensible Markup Language) memiliki tag pembuka juga tag penutup, memiliki parent (induk), dari parent ini kemudian memiliki child (anak), dari child ini memiliki child lagi, dan seterusnya. Sehingga secara tidak langsung parent yang tadi bisa menjadi grandfather, tak terkecuali uncle serta aunt, berikut daughter and son.
Berdasarkan dari cara penulisannya maka format XML ini memungkinkan untuk dibaca oleh kedua belah pihak, baik manusia maupun mesin (compiler/interpreter). Salah satu dari sekian banyak yang menggunakan XML diantaranya adalah template blogger.
Nah, apabila Anda menemukan kode XML misalnya widget yang kurang terformat rapi, dan menyebabkan ia hanya mudah dibaca oleh satu pihak saja yaitu mesin, maka ada cara yang paling mudah untuk merapikannya yaitu dengan menggunakan software editor Notepadd++. Adapun caranya adalah sebagai berikut:
- Copykan potongan code XML tersebut ke Notepad++
- Pada Notepad++ klik menu TextFX >> TextFX HTML Tidy >> Tidy: Reindent XML, seperti pada gambar di bawah ini:
Gambar: Merapikan kode XML - XML Tidy dengan Notepad++ |
Dengan dirapikannya kode XML tersebut, maka struktrurnya menjadi logis, mudah untuk dibaca kedua belah pihak (manusia dan mesin), sehingga menjadi mudah untuk diedit.
Contoh XML yang belum dirapikan:
<b:includable id=breadcrumb var="posts">Contoh XML yang sudah dirapikan:
<b:if cond="data:blog.homepageUrl == data:blog.url">
<b:else></b:else><b:if cond='data:blog.pageType == "item"'>
<DIV class=breadcrumbs>Browse » <A rel=tag expr:href="data:blog.homepageUrl">Beranda</A>
<b:loop var="post" values="data:posts"><b:if cond="data:post.labels">
<b:loop var="label" values="data:post.labels"><b:if cond='data:label.isLast == "true"'> »
<A rel=tag expr:href="data:label.url"><?xml:namespace prefix = data /><data:label.name></data:label.name></A>
</b:if></b:loop>» <SPAN><data:post.title></data:post.title></SPAN>
</b:if></b:loop></DIV><b:else></b:else><b:if cond='data:blog.pageType == "archive"'>
<DIV class=breadcrumbs>Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Arsip untuk <data:blog.pageName></data:blog.pageName></DIV><b:else></b:else>
<b:if cond='data:blog.pageType == "index"'>
<DIV class=breadcrumbs>
<b:if cond='data:blog.pageName == ""'>
Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Seluruh Artikel
<b:else></b:else>
Browse » <A expr:href="data:blog.homepageUrl">Beranda</A> » Artikel Pada Kategori <data:blog.pageName></data:blog.pageName>
</b:if></DIV></b:if></b:if></b:if></b:if></b:includable>
<b:includable id=breadcrumb var="posts">
<b:if cond="data:blog.homepageUrl == data:blog.url">
<b:else></b:else>
<b:if cond='data:blog.pageType == "item"'>
<DIV class=breadcrumbs>Browse »
<A rel=tag expr:href="data:blog.homepageUrl">Beranda</A>
<b:loop var="post" values="data:posts">
<b:if cond="data:post.labels">
<b:loop var="label" values="data:post.labels">
<b:if cond='data:label.isLast == "true"'>»
<A rel=tag expr:href="data:label.url">
<data:label.name></data:label.name>
</A></b:if>
</b:loop>»
<SPAN>
<data:post.title></data:post.title>
</SPAN></b:if>
</b:loop></DIV>
<b:else></b:else>
<b:if cond='data:blog.pageType == "archive"'>
<DIV class=breadcrumbs>Browse »
<A expr:href="data:blog.homepageUrl">Beranda</A>»
Arsip untuk
<data:blog.pageName></data:blog.pageName></DIV>
<b:else></b:else>
<b:if cond='data:blog.pageType == "index"'>
<DIV class=breadcrumbs>
<b:if cond='data:blog.pageName == ""'>Browse »
<A expr:href="data:blog.homepageUrl">Beranda</A>»
Seluruh Artikel
<b:else></b:else>Browse »
<A expr:href="data:blog.homepageUrl">Beranda</A>»
Artikel Pada Kategori
<data:blog.pageName></data:blog.pageName></b:if>
</DIV>
</b:if>
</b:if>
</b:if>
</b:if>
</b:includable>
Wednesday, December 12, 2012
Mengirim SMS Menggunakan Modem Wavecom - VB6 Code
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
With MSComm1
.CommPort = 7 'Port disesuaikan terhadap modem Wavecom yang terdeteksi
.Settings = "115200,n,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
Sleep 1000
MSComm1.Output = TxtMessage.Text & Chr(26)
End Sub
Caranya:
- Buatlah 2 TextBox masing-masing diberi nama TxtNumber dan TxtMessage
- Tambahkan OCX Microsoft Comm Control 6.0 (MSComm)
- Tambahkan satu CommandButton dengan nama default.
Mengirim SMS Disertai Verifikasi Terkirim - VB Source Code
Option ExplicitDemikian mengenai cara mengirim SMS menggunakan modem wavecom melalui aplikasi VB6 yang ditambahkan fitur verifikasi, semoga bermanfaat.
Dim strBuffer As String
Private Sub Command1_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 7
.Settings = "115200,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
Delay 1
MSComm1.Output = TxtMessage.Text & Chr(26)
If WaitForSuccess Then
MsgBox "SMS telah terkirim", vbInformation + vbOKOnly
Else
MsgBox "SMS gagal terkirim", vbCritical, "SMS Gagal"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
End Select
Debug.Print strBuffer
End Sub
Private Function WaitForSuccess() As Boolean
Dim i As Integer
Dim strInput As String
Dim strPart As String
Dim c As String, b As String
For i = 1 To 5
Do
Delay 1
c = strBuffer
strBuffer = ""
If c = "" Then Exit Do
b = strInput & c
Loop
strPart = b
strInput = strInput & strPart
If InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0 Then Exit For
If strPart = "" Then
Delay 1
End If
Next
WaitForSuccess = InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0
End Function
Private Sub Delay(ByVal HowLong As Date)
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents
Wend
End Sub
Fungsi Wait Sleep Tanpa Windows API - VB6 Code
Fungsi sleep menggunakan Sleep Kernel32.dll:
- Mem-freeze GUI (membekukan tampilan)
- Hitungan dalam millisecond
Fungsi sleep kali ini (lebih tepatnya delay time):
- Tidak mem-freeze GUI
- Hitungan dalam second
Adapun fungsi sleep atau wait tanpa fungsi API adalah sebagai berikut:
Private Sub Sleep(ByVal HowLong As Date)Jika Anda mau bereksperimen maka buatlah kodenya seperti di bawah ini kemudian bandingkan antara fungsi sleep Kernel32.dll dengan fungsi sleep tanpa API.
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents
Wend
End Sub
Option ExplicitDemikianlah seputar fungsi sleep atau wait, menggunakan API dan tanpa menggunakan API.
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Label1.Caption = "Mulai menjalankan fungsi sleep atau wait"
Label1.Refresh
Sleep 5 'sleep/wait/hentikan eksekusi kode ke baris berikutnya selama 5 detik
Label1.Caption = "Terhenti selama 5 detik"
End Sub
Private Sub Command2_Click()
Dim frm As New Form1
frm.Show
End Sub
Private Sub Timer1_Timer()
Static i As Integer
Caption = i
i = i + 1
End Sub
Private Sub Sleep(ByVal HowLong As Date)
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents
Wend
End Sub
Option Explicit
Private Function Sleep(mSecs As Long) As Double
Dim Duration!
Duration! = Timer + mSecs
Do Until Timer > Duration!
DoEvents
Loop
End Function
Private Sub Command1_Click()
Sleep 0.9
MsgBox "Test"
End Sub
VB6 Code - Fungsi Sleep Atau Wait Yang Diperbaiki
Mengenai fungsi sleep atau wait dalam VB6 yang telah diperbaiki - Fungsi sleep disini berbeda dengan fungsi sleep sebelumnya yang menggunakaan salah satu API kernel32 klik disini atau tanpa API klik disini. Keunggulan dari fungsi sleep kali ini adalah:
- Tidak memfreeze GUI (jadi jika ada objek visual, maka ia akan terefresh dengan baik)
- Hitungan dalam millisecond.
Adapun fungsi sleep yang telah diperbaiki dengan menggunakan VB6 adalah sebagai berikut:
Option ExplicitDemikian fungsi sleep dalam VB6 dengan menggunakan timer API. Semoga bermanfaat.
Private mCancel As Boolean
Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
ptX As Long
ptY As Long
End Type
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Sub TimerProc()
mCancel = True
End Sub
Public Sub Wait(frm As Form, mSecs As Long)
Dim MyMsg As MSG
Dim TimerID As Long
TimerID = SetTimer(frm.hwnd, ObjPtr(frm), mSecs, AddressOf TimerProc)
mCancel = False
Do While Not mCancel
GetMessage MyMsg, 0, 0, 0
TranslateMessage MyMsg
DispatchMessage MyMsg
Loop
KillTimer frm.hwnd, TimerID
End Sub
VB6 SMS Gateway: Mendeteksi Port Modem Secara Otomatis
Mengenai cara mendeteksi port modem secara otomatis menggunakan VB6 - Pada project sebelumnya klik disini dan disini. Kita telah berhasil mengirimkan SMS menggunakan modem GSM secara sederhana. Akan tetapi karena sederhana kedua project tersebut tidak diperlengkapi dengan deteksi port modem secara otomatis, sehingga untuk mengetahui port modem Anda lakukan langkah di bawah ini:
- Klik tombol start (sebelah kiri bawah)
- Selanjutnya klik Settings >> Control Panel >> System
- Klik tab Hardware Klik tombol Device Manager
- Klik Node Ports (COM & LPT)
- Carilah di sana akan ada port modem Wavecom Anda.
Sungguh merepotkan sekali, setiap kali port modemnya berubah kita harus selalu mengulangi dan mengulangi langkah-langkah di atas. Mulai saat ini, tinggalkan cara di atas, dan beralihlah pada deteksi port modem secara otomatis. Adapun kode untuk mendeteksi port modem secara otomatis menggunakan VB6 adalah sebagai berikut:
Option ExplicitDemikian cara mendeteksi port modem secara otomatis menggunakan VB6, jika modemnya lebih dari 1, misalnya 2, 3, 8, 15 sampai tak terhingga, Anda hanya perlu sedikit memodifikasi kodenya. Semoga bermanfaat.
Dim strBuffer As String
Dim intPortNumber As String
Private Sub Command2_Click()
On Error Resume Next
Dim i As Integer
For i = 1 To 20
If MSComm1.PortOpen Then MSComm1.PortOpen = False
intPortNumber = i
MSComm1.CommPort = i
MSComm1.PortOpen = True
MSComm1.Output = "AT" & vbCrLf
Wait Me, 50
Next
End Sub
Private Sub Form_Load()
With MSComm1
.Settings = "115200,n,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
End Select
Do
strBuffer = strBuffer & MSComm1.Input
Loop While MSComm1.InBufferCount
If InStr(1, strBuffer, "OK") > 0 Then
Caption = "COM" & intPortNumber
Text1.Text = intPortNumber
End If
End Sub
VB6 SMS Gateway: Menambahkan Fitur Auto Reply
Option ExplicitDemikian contoh kode VB6 untuk membalas SMS baru secara otomatis, Anda dapat memodifikasi kodenya untuk disesuaikan dengan kebutuhan.
Dim strBuffer As String
Dim blnFirstLoad As Boolean
Private Sub Command1_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.PortOpen = True
.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
.Output = TxtMessage.Text & Chr(26)
End With
End Sub
Private Sub Form_Load()
With MSComm1
.CommPort = 7 'port disesuaikan atau beri kode auto detect port modem
.Settings = "115200,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.NullDiscard = True
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
Do
strBuffer = strBuffer & MSComm1.Input
Loop While MSComm1.InBufferCount
If InStr(1, strBuffer, "+CMGR") Then
If InStr(1, strBuffer, "OK") Then
Text1.Text = strBuffer
End If
End If
If InStr(1, strBuffer, "+CMTI") > 0 Then
If Right(strBuffer, 1) = vbLf Then
Dim s() As String
s = Split(strBuffer, ",")
Debug.Print s(UBound(s))
ReadSMSByIndex Trim$(s(UBound(s)))
Delay 1
Command1_Click 'Auto reply
strBuffer = ""
End If
End If
End Select
End Sub
Private Sub ReadSMSByIndex(Index As Integer)
strBuffer = ""
MSComm1.Output = "AT+CMGR=" & Index & vbCrLf 'baca SMS yang berada di index ke-1
End Sub
Private Sub Delay(ByVal HowLong As Date)
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents
Wend
End Sub
VB6 SMS Gateway: Contoh Mengekspor PhoneBook ke Excel
Private Sub ExportToExcel(PhoneBook As String)
Dim ExcelObj As New Excel.Application
Dim ExcelBook As Excel.Workbook
Dim ExcelSheet As Excel.Worksheet
Dim i As Integer
Set ExcelBook = ExcelObj.Workbooks.Add
Set ExcelSheet = ExcelBook.Worksheets(1)
Dim s() As String
Dim r As String
s = Split(PhoneBook, vbCrLf & "+CPBR:")
With ExcelSheet
.Columns("A:A").ColumnWidth = 7
.Columns("B:B").ColumnWidth = 16
.Columns("C:C").ColumnWidth = 16
.Columns("D:D").ColumnWidth = 16
For i = 1 To UBound(s)
If s(i - 1) <> "" Then
r = Split(s(i - 1), ",")(0)
If InStr(1, r, "+CPBR:") > 0 Then
r = Split(Split(s(i - 1), ",")(0), ":")(1)
Else
r = Split(Split(s(i - 1), ",")(0), ":")(0)
End If
.Cells(i, 1) = r
.Cells(i, 2) = Split(s(i - 1), ",")(1)
.Cells(i, 3) = Split(s(i - 1), ",")(2)
.Cells(i, 4) = Split(s(i - 1), ",")(3)
End If
Next
End With
ExcelObj.Visible = True
End Sub
VB6 SMS Gateway: AT Command Tester Sederhana
Option Explicit
Dim strBuffer As String
Private Sub cmdSend_Click()
txtResult.Text = ""
txtProcess.Text = ""
strBuffer = ""
If UCase$(Left$(txtATCommand.Text, 2)) <> "AT" Then
MSComm1.Output = txtATCommand.Text & Chr(26)
Else
MSComm1.Output = txtATCommand.Text & vbCrLf
End If
End Sub
Private Sub Form_Load()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 7
.Settings = "115200,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
End Select
txtProcess.Text = strBuffer
txtProcess.SelStart = Len(txtProcess.Text)
Do
strBuffer = strBuffer & MSComm1.Input
Loop While MSComm1.InBufferCount
If InStr(1, strBuffer, "OK") > 0 Then
txtResult.Text = strBuffer
txtResult.SelStart = Len(txtResult.Text)
ElseIf InStr(1, strBuffer, "ERROR") Then
txtResult.Text = strBuffer
strBuffer = ""
End If
End Sub
Download: Source Code
Monday, December 10, 2012
VB6 Code - Memahami KeyWord ByVal dan ByRef
Option ExplicitCoba bedakan dengan yang ini
Private Sub Form_Load()
Dim iNumber As Integer
iNumber = 1
MsgBox TampilkanPesan(iNumber)
End Sub
Function TampilkanPesan(ByVal Pesan As String) As String
TampilkanPesan = Pesan
End Function
Fungsinya akan menampilkan error yakni argumen yang tidak sama (cocok/mismatch)
Private Sub Form_Load()Untuk mengatasi error di atas maka cocokan saja argumennya yakni
Dim iNumber As Integer
iNumber = 1
MsgBox TampilkanPesan(iNumber)
End Sub
Function TampilkanPesan(Pesan As String) As String
TampilkanPesan = Pesan
End Function
dengan mengubah variable iNumber yang asalnya integer menjadi String
Private Sub Form_Load()Atau Anda beri statement ByVal pada argumen fungsinya
Dim iNumber As String
iNumber = 1
'sekarang tidak akan terjadi error karena type datanya sama yakni string
MsgBox TampilkanPesan(iNumber)
End Sub
Function TampilkanPesan(Pesan As String) As String
TampilkanPesan = Pesan
End Function
Private Sub Form_Load()Maka kesimpulannya:
'Dim iNumber As String
iNumber = 1
'sekarang tidak akan terjadi error karena type datanya sama yakni string
MsgBox TampilkanPesan(iNumber)
End Sub
Function TampilkanPesan(ByVal Pesan As String) As String
TampilkanPesan = Pesan
End Function
- Secara default Visual Basic 6.0 telah menyertakan ByRef pada argumen walaupun kita tidak menuliskannya, terkecuali secara explicit kita menuliskan ByVal pada argumen tersebut.
- Penggunaan ByVal akan memaksa sebuah argumen untuk dijadikan data type tertentu sebagai contoh:
- ByVal Pesan As String maka pesan akan dipaksa untuk memiliki data type string.
- Penggunaan KeyWord ByVal menjadikan sebuah argumen tidak lagi memiliki hubungan dengan variable yang melewatinya. Sebagai contoh:
Dim i as integer
i = 1
Msgbox TampilkanPesan(i)
Msgbox i 'maka i disini, tetap saja memiliki nilai satu.
Function TampilkanPesan(ByVal Pesan As String) As String
Pesan = 2
TampilkanPesan = Pesan
End Function
VB6 Code - Memahami ParamArray Pada Sebuah Argumen
Option ExplicitBagaimana? Sukses! Selanjutnya hilangkan ParamArray, sehingga kodenya menjadi:
Private Sub Form_Load()
MsgBox TampilkanPesan("Pesan 1", "Pesan 2", "Pesan 3", "Pesan dst")
End Sub
Function TampilkanPesan(ParamArray Pesan() As Variant)
TampilkanPesan = Pesan(1) & " dan " & Pesan(2) & " dan " & Pesan(3)
End Function
Option ExplicitBagaimana? Error!
Private Sub Form_Load()
MsgBox TampilkanPesan("Pesan 1", "Pesan 2", "Pesan 3", "Pesan dst")
End Sub
Function TampilkanPesan(Pesan() As Variant)
TampilkanPesan = Pesan(1) & " dan " & Pesan(2) & " dan " & Pesan(3)
End Function
Maka kesimpulannya:
Dengan menggunakan ParamArray maka argumen dari sebuah fungsi dapat menampung beberapa/banyak data atau katakanlah berubah menjadi array. Tetapi harus diingat aturan dari ParamArray ini, yaitu:
- Harus berType Data Variant.
- Jika Argumen lebih dari satu, maka ParamArray wajib ditempatkan di akhir.
- Hanya satu ParamArray yang diperbolehkan dalam sebuah fungsi.
Nah, sekarang Anda telah memahami ParamArray dalam Visual Basic 6.0.
VB6 - Memahami KeyWord Optional Pada Sebuah Argumen
Option ExplicitApa yang terjadi? Error! mengapa? karena argumen yang kedua tidak bersifat optional, sehingga mau tidak mau kita harus mengisinya. Selanjutnya copy dan pastekan kode berikut:
Private Sub Form_Load()
MsgBox TampilkanPesan("Pesan pertama")
End Sub
Private Function TampilkanPesan(PesanPertama As String, PesanKedua As String)
TampilkanPesan = PesanPertama & " dan " & PesanKedua
End Function
Option ExplicitApa yang terjadi, Sukses! tidak menampilkan pesan error. Selanjutnya copy dan pastekan kode berikut:
Private Sub Form_Load()
MsgBox TampilkanPesan("Pesan pertama")
End Sub
Private Function TampilkanPesan(PesanPertama As String, Option PesanKedua As String)
TampilkanPesan = PesanPertama & " dan " & PesanKedua
End Function
Option ExplicitApa yang terjadi, Sukses! tidak menampilkan pesan error!
Private Sub Form_Load()
MsgBox TampilkanPesan("Pesan pertama")
End Sub
Private Function TampilkanPesan(PesanPertama As String, Option PesanKedua As String="Pesan kedua")
TampilkanPesan = PesanPertama & " dan " & PesanKedua
End Function
Maka kesimpulannya:
Sebuah argumen yang disertai Optional memiliki dua pilihan: boleh diisi atau tidak.
VB6 Code - Memahami Recursive Function (Fungsi Recursive)
Private Sub Form_Load()Dalam contoh kode di atas, fungsi tersebut memanggil dirinya sendiri (yang diberi warna merah).Untuk keperluan fungsi recursive ada beberapa hal yang harus diperhatikan, yaitu: Pemberian KeyWord ByVal (coba Anda hilangkan ByVal maka apa yang terjadi?) Fungsi recursive harus ditutup/diakhiri jika tidak, maka fungsi tersebut akan menampilkan error yakni Runtime Error '28' Out Of Stack Space. Mengapa? karena fungsi tersebut terus menerus memanggil fungsinya tanpa memiliki akhir, kapan ia harus berhenti. Sebagai contoh kode yang error, copy dan pastekan code berikut:
MsgBox Factorial(9)
End Sub
Function Factorial (ByVal MyVar As Integer) ' Function declaration.
MyVar = MyVar - 1
If MyVar = 0 Then
Factorial = 1
Exit Function
End If
Factorial = Factorial(MyVar) * (MyVar + 1)
End Function
Private Sub Form_Load()Kode di atas akan mengalami error, mengapa? karena kode tersebut tidak memiliki akhir (terus menerus memanggil dirinya sendiri). Seperti halnya kalimat di bawah ini: Jika sekolah maka libur, dan jika libur maka sekolah. Lho? kapan sekolah dan kapan liburnya!
MsgBox Factorial(9)
End Sub
Function Factorial(ByVal MyVar As Integer) ' Function declaration.
MyVar = MyVar - 1
If MyVar = 0 Then
Factorial = 1
End If
Factorial = Factorial(MyVar) * (MyVar + 1)
End Function
VB6 Code - Fungsi Untuk Menampilkan Dialog Shutdown
Jika Anda ingin menggunakan metode Late Binding maka gantilah kode berikut:
Dim Sh as new Shell32.Shell
Menjadi:
Dim Sh as Object
Set Sh = CreateObject("Shell.Application")
Option Explicit
Sub ShowShutDown()
Dim sh As New Shell32.Shell
sh.ShutdownWindows
Set sh = Nothing
End Sub
'Contoh penggunaan
Private Sub Command1_Click()
Call ShowShutDown
End Sub
VB6 Code - Fungsi Untuk Me-Restore Seluruh Windows
Jika Anda ingin menggunakan metode Late Binding maka gantilah kode berikut:
Dim Sh as new Shell32.Shell
Menjadi:
Dim Sh as Object
Set Sh = CreateObject("Shell.Application")
Sub RestoreAll()
Dim sh As New Shell32.Shell
sh.UndoMinimizeALL
Set sh = Nothing
End Sub
'Contoh Penggunaan Procedure Untuk Me-Minimize Seluruh Windows
Private Sub Form_Load()
RestoreAll
End Sub
VB6 Code - Fungsi Untuk Menampilkan BrowseForFolder
Jika Anda ingin menggunakan metode Late Binding maka gantilah kode berikut:
Dim Sh as new Shell32.Shell
Dim Folder As Shell32.Folder
Menjadi:
Dim Sh as Object
Dim Folder
Set Sh = CreateObject("Shell.Application")
Function BrowseForFolder(Title As String, Optional RootFolder = "") As String
On Error Resume Next
Dim sh As New Shell32.Shell
Dim Folder As Shell32.Folder
Set Folder = sh.BrowseForFolder(Me.hwnd, "Open", 1, RootFolder)
SelectFolder = Folder.Items.Item.Path
set sh = nothing
set Folder = nothing
End Function
'Berikut contoh penggunaan Fungsi Untuk Menampilkan BrowseForFolder
Private Sub Command1_Click()
'jika ingin mengeksplore "c:\" saja
MsgBox SelectFolder("Open Folder", "c:\")
'Jika ingin mengeksplore directory keseluruhan
MsgBox SelectFolder("Open Folder")
End Sub
VB Code - Fungsi Untuk Mendapatkan Directory My Documents
'Fungsi untuk mendapatkan directory My Documents:
Function GetDocumentsPath() As String
GetDocumentsPath = Environ("USERPROFILE") & "\My Documents"
End Function
'Contoh penggunaan Fungsi untuk mendapatkan directory My Documents:
Private Sub Form_Load()
MsgBox GetDocumentsPath
End Sub
VB6 Code - Mendapatkan Directory Common Files
'Fungsi untuk mendapatkan directory common files:
Function GetCommonPath() As String
GetCommonPath = Environ("CommonProgramFiles")
End Function
'Contoh penggunaan fungsi untuk mendapatkan directory common files:
Private Sub Form_Load()
MsgBox GetCommonPath
End Sub
VB6 Code - Mendapatkan Directory Application Data
'Fungsi untuk mendapatkan Aplication Data:
Function GetAppDataPath() As String
GetAppDataPath = Environ("AppData")
End Function
'Contoh penggunaan fungsi untuk mendapatkan application data:
Private Sub Form_Load()
MsgBox GetAppDataPath
End Sub
VB6 Code - Mendapatkan Directory All User Profile
'Fungsi untuk mendapatkan directory All User Profile
Function GetAllUserPath() As String
GetAllUserPath = Environ("AllUsersProfile")
End Function
'Contoh penggunaan fungsi untuk mendapatkan directory All User Profile
Private Sub Form_Load()
MsgBox GetAllUserPath
End Sub
VB6 Code - Fungsi Untuk Mendapatkan Directory Temporary
'Fungsi untuk mendapatkan directory temporary
Function GetTempPath() As String
GetTempPath= Environ("Temp")
End Function
'Contoh penggunaan fungsi untuk mendapatkan directory temporary
Private Sub Form_Load()
MsgBox GetTempPath
End Sub
Fungsi Untuk Mendapatkan Directory System | Visual Basic 6.0
'Fungsi untuk mendapatkan directory systemAtau Anda dapat menggunakan fungsi di bawah ini:
Function GetSystemPath() As String
GetSystemPath = Environ("WinDir") & "\System32"
End Function
'Fungsi untuk mendapatkan directory system
Function GetSystemPath() As String
GetSystemPath = Environ("SystemRoot") & "\System32"
End Function
'Contoh penggunaan fungsi untuk mendapatkan directory system
Private Sub Form_Load()
MsgBox GetSystemPath
'Maka akan ditampilkan C:\Windows\System32 jika Anda menginstall _
windows pada drive C:\ atau D:\Windows\System32 jika Anda _
menginstall windows pada drive D:\ dan seterusnya.
End Sub
VB6 Code - Fungsi Untuk Mendapatkan Directory Windows
'Fungsi untuk mendapatkan directory windowsBagaimana dengan menggunakan fungsi API? bukankah lebih cepat? ehm... pertanyaan yang perlu dipertimbangkan, terutama jika kita menggunakan komputer dengan kecepatan processor di bawah Pentium I semisal DX 386.
Function GetWinPath() As String
GetWinPath = Environ("WinDir")
End Function
'Contoh penggunaan fungsi untuk mendapatkan directory windows
Private Sub Form_Load()
MsgBox GetWinPath
'Maka akan ditampilkan C:\Windows jika Anda menginstall windows pada _
drive C:\ atau D:\Windows jika Anda menginstall windows pada drive D:\ _
dan seterusnya.
End Sub
VB6 Code - Fungsi Untuk Menggenapkan/Membulatkan Bilangan
Fungsi untuk menggenapkan bilangan
Private Function Genapkan(ByVal Number As Double, Optional Range = 10) As doubleContoh Fungsi untuk menggenapkan bilangan dalam sebuah aplikasi:
Genapkan = (Round((Number / Range) + 0.49)) * Range
End Function
Private Sub Form_Load()
MsgBox Genapkan(456565656, 10) 'ini untuk menggenapkan puluhan
MsgBox Genapkan(456565656, 100) 'ini untuk menggenapkan ratusan
MsgBox Genapkan(456565656, 1000) 'ini untuk menggenapkan ribuan
MsgBox Genapkan(456565656, 10000) 'ini untuk menggenapkan puluhan ribu
MsgBox Genapkan(456565656, 100000) 'ini untuk menggenapkan ratusan ribu
MsgBox Genapkan(456565656, 1000000) 'ini untuk menggenapkan jutaan
MsgBox Genapkan(456565656, 10000000) 'ini untuk menggenapkan pulahan juta
'dan seterusnya
End Sub
VB6 Code - Fungsi Untuk Menjadikan Kalimat Judul
Fungsi untuk menjadikan kalimat judul
Function TitleCase(txt) As StringContoh penggunaan fungsi untuk menjadikan kalimat judul
TitleCase = StrConv(txt, vbProperCase)
End Function
Private Sub Form_Load()
MsgBox TitleCase("FUNGSI UNTUK MENJADIKAN KALIMAT JUDUL")
'Maka akan ditampilkan: Fungsi Untuk Menjadikan Kalimat Judul
'dengan huruf besar pada seluruh awal kata
End Sub
VB6 Code - Fungsi Untuk Mengecilkan Seluruh Huruf
Fungsi untuk mengecilkan seluruh huruf:
Function LowerCase(txt As String) As StringContoh penggunaan Fungsi untuk mengecilkan seluruh huruf:
LowerCase = StrConv(txt, vbLowerCase)
End Function
Private Sub Form_Load()
MsgBox LowerCase("Fungsi Untuk Mengecilkan Seluruh Huruf")
'Maka akan ditampilkan fungsi untuk mengecilkan seluruh huruf
End Sub
VB6 Code - Menjadikan Seluruh Kapital
'Fungsi untuk membesarkan seluruh huruf
Function UpperCase(txt As String) As String
UpperCase = StrConv(txt, vbUpperCase)
End Function
'Contoh penggunaan Fungsi untuk membesarkan seluruh huruf:
Private Sub Form_Load()
MsgBox UpperCase("Fungsi Untuk Membesarkan Seluruh Huruf")
'Maka akan ditampilkan FUNGSI UNTUK MEMBESARKAN SELURUH HURUF
'dengan huruf besar seluruhnya
End Sub
VB6 Code - Add-Ins Tools VB6.0 Toolbar Resizer 1.0
Download: Toolbar Resizer 1.0
Cara menggunakan:
- Register terlebih dahulu Toolbar Resizer 1.0 dengan cara mendouble klik file install.bat
- Klik menu file Add-ins selanjutnya klik Add-Ins Manager, cari Add-ins dengan nama Toolbar Resizer 1.0.
- Pilih Toolbar yang telah diisi gambar yang berasal dari ImageList.
- Sesuaikan ukurannya dengan cara memilih item yang tersedia dalam ComboBox Toolbar Resizer 1.0.
Toolbar Resizer 1.0 dibuat oleh http://khoiriyyah.blogspot.com
VB6 Code - Merubah ukuran dan tanggal file secara random
Ternyata virus exe yang dibuat dengan menggunakan bahasa pemrograman Visual Basic 6.0 (baca: klasik). Hanya sayang kurang asyik setelah di search, ternyata file size serta date created seluruhnya sama (sehingga menjadi aurat bagi virus tersebut), mungkin pembuat virus tersebut lupa menambahkan beberapa baris untuk merubah ukuran (size kb) serta tanggal pembuatannya (date created) secara random. Sebenarnya merubah ukuran, tanggal pembuatan tidaklah sulit. Anda dapat mendownloadnya pada link di bawah ini (:
Download: Merubah ukuran dan tanggal file secara random
Tapi bagaimanapun juga virus tersebut sudah merepotkan dan cukup mengganggu aktivitas.
VB6 Code - Mengunci Proses Program (LockWindowUpdate)
Untuk melihat kinerjanya, buatlah project kemudian copy paste source code dibawah ini:
'--------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'--------------------------------------------------------------------
Option Explicit
Private Declare Function LockWindowUpdate Lib "USER32" (ByVal hwndLock As Long) As Long
'Tanpa fungsi LockWindowUpdate
Private Sub Command1_Click()
Dim i As Integer
Label1.Caption = 1
For i = 1 To 2000
Label1.Caption = i
DoEvents
Next
End Sub
'Dengan fungsi LockWindowUpdate
Private Sub Command2_Click()
Label1.Caption = 1
MsgBox "Perhatikan sekarang label caption berubah menjadi angka 1"
LockWindowUpdate Form1.hWnd
'Ini identik dengan fungsi di atas Private Sub Command1_Click()
'Hanya ditambahkan fungsi LockWindowUpdate pada line code sebelumnya
Dim i As Integer
For i = 1 To 2000
Label1.Caption = i
DoEvents
Next
LockWindowUpdate 0
MsgBox "Tidak terjadi flicker (gambar berkedip) dan lebih cepat bukan?"
End Sub
VB6 Code - Merubah Keyboard Dari Inggris Ke Arab
'-------------------------------------------------------------------------------Kode di atas tentunya sangat berguna sekali pada membuat aplikasi-aplikasi arabic dengan Visual Basic 6.0, dengan demikian kalimat:
'http://khoiriyyah.blogspot.com
'Asep Hibban
'-------------------------------------------------------------------------------
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" ByVal pwszKLID As String, ByVal flags As Long) As Long
Private Const KLF_ACTIVATE = &H1
Private Sub Command1_Click()
LoadKeyboardLayout "00000401", KLF_ACTIVATE 'pindah ke arab
Text1.Alignment = vbRightJustify
Text1.SetFocus
End Sub
Private Sub Command2_Click()
LoadKeyboardLayout "00000409", KLF_ACTIVATE 'pindah ke inggris
Text1.Alignment = vbLeftJustify
Text1.SetFocus
End Sub
Private Sub Text2_GotFocus()
LoadKeyboardLayout "00000409", KLF_ACTIVATE 'pindah ke inggris
Text2.Alignment = vbLeftJustify
End Sub
Private Sub Text3_GotFocus()
LoadKeyboardLayout "00000401", KLF_ACTIVATE 'pindah ke arab
Text3.Alignment = vbRightJustify
End Sub
Ingat! sebelum Anda mengetik, pindahkah terlebih dahulu pada posisi arabic
sudah tidak diperlukan lagi.
Download: How To Change Keyboard Layout To Arabic
Menukar Caption CommandButton Melalui VB6 Code
Berikut ini contoh merubah menukar Caption CommandButton dari Start menjadi Stop dan sebaliknya dari Stop menjadi Start.
Option ExplicitApabila kita terjemahkan logika di atas ke dalam bahasa manusia kira-kira seperti berikut: apabila Command1.Caption bernilai Start maka ganti Command1.Caption menjadi bernilai Stop, (Else) jika tidak Command1.Caption bernilai Start (alias Command1.Caption bernilai Stop) maka ganti Command1.Caption menjadi bernilai Start.
Private Sub Form_Load()
Command1.Caption = "Start" 'Set nilai awal Caption dengan start
End Sub
Private Sub Command1_Click()
If Command1.Caption = "Start" Then
Command1.Caption = "Stop"
Else
Command1.Caption = "Start"
End If
End Sub
Demikian cara menukar Caption yang terdapat pada sebuah CommandButton menggunakan kode yang dibuat dalam bahasa pemrograman Visual Basic 6.0.
VB6 - Menampilkan Sebuah Form Dari Form Yang Lain
Private Sub Command1_Click()Sederhana bukan? Nah, demikian mengenai cara menampilkan sebuah form dari form yang lain menggunakan VB6 Code. Semoga bermanfaat.
Form2.Show
End Sub
Menghapus Seluruh Isi TextBox Menggunakan For Each - VB6
Berikut adalah cara menghapus seluruh text yang terdapat pada TextBox menggunakan VB6 code:
Option ExplicitDemikianlah cara menghapus seluruh text yang terdapat pada object TextBox secara sekaligus menggunakan perulangan For .. Each.
Private Sub Command1_Click()
ClearAllTextbox
End Sub
Private Sub ClearAllTextbox()
Dim t As Control
For Each t In Me.Controls
If TypeOf t Is TextBox Then
t.Text = ""
End If
Next
End Sub
Menambah dan Menghilangkan Item Pada ListBox - VB6 Code
Berikut merupakan contoh menambah dan mengurangi item yang disertai komentar secukupnya agar mudah dipahami.
Option ExplicitDemikian mengenai cara menambah dan mengurangi sebuah item pada object ListBox bahasa pemrograman Visual Basic 6.0.
Private Sub Form_Load()
List1.AddItem "a" 'tambah item huruf a
List1.AddItem "b" 'tambah item huruf b
List1.AddItem "c" 'tambah item huruf c
End Sub
Private Sub Command1_Click()
List1.RemoveItem 0 'hilangkan item yang memiliki index 0 (paling atas)
End Sub
VB6 Code - Mengurangi dan Menambah Item Pada ComboBox
Berikut contoh Code VB6 untuk menambah dan mengurangi item yang terdapat pada ComboBox:
Option Explicit Private Sub Form_Load() Combo1.AddItem "a" 'tambah item huruf a Combo1.AddItem "b" 'tambah item huruf b Combo1.AddItem "c" 'tambah item huruf c End Sub Private Sub Command1_Click() Combo1.RemoveItem 0 'hilangkan item yang memiliki index 0 (paling atas) End SubDemikian VB6 Code mengenai cara menambah dan mengurangi item pada object ComboBox. Semoga bermanfaat.
Cara Menampilkan MessageBox Melalui VB6 Code
Private Sub cmdShowMessageBox_Click()
MsgBox "Hello world", vbInformation, "Sample"
End Sub
Sunday, December 9, 2012
Blogging - Memposting Artikel ke Blogger Menggunakan VB6
Tentu Anda bertanya mengapa membuat aplikasi sepele seperti ini, sementara diluar sana banyak sekali software-software weblog client dari mulai yang gratis hingga berbayar dari fitur sederhana hingga canggih contohnya: BlogDesk, BlogJet, Chrysanth WebStory, Ecto, LIPIDr Blog Client, Microsoft Word 2007, Post2Blog, QTM, Qumana, RocketPost, Semagic, Zoundry Raven, w.bloggar,WB Editor, Windows Live Writer, WordPress Comments notifier. Ada banyak alasan, salah satu alasan yang paling utama adalah mudah untuk dimodikasi (tambah kode disana, disini, disitu, tambah database ini, itu, tambah fitur ini, itu dan sebagainya) maksudnya dimodifikasi untuk disesuaikan dengan kebutuhan.
VB6 Blogger Poster |
Jika Anda berminat harga source codenya Rp. 40.000 (empat puluh ribu)
Download: VB6 Blogger Poster
Catatan:
- Aplikasi di atas banyak sekali berhubungan dengan kode-kode XML, mengenai kode-kode XML saya sendiri telah memposting ala kadarnya di sini, selain itu tentu saja pemahaman mengenai Blogger API.
- Aplikasi ini mendukung juga draft, posting terjadwal, serta kategori.
Thursday, December 6, 2012
VB6 Code - Menambah Internet Explorer Pada Saat Runtime
Option Explicit
Private IE As VBControlExtender
Private Sub Form_Load()
On Error GoTo IEMissing
Set IE = Form1.Controls.Add("Shell.Explorer", "wcIE")
IE.Visible = True
If Not IE Is Nothing Then
IE.object.silent = True
IE.object.Navigate "http://khoiriyyah.blogspot.com"
End If
IEMissing:
End Sub
Private Sub Form_Resize()
If Not IE Is Nothing Then
IE.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End If
End Sub
VB6 Code - Mengcapture Gambar Dari WebCam
Public Const WS_CHILD As Long = &H40000000 Public Const WS_VISIBLE As Long = &H10000000 Public Const WM_USER As Long = &H400 Public Const WM_CAP_START As Long = WM_USER Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10 Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11 Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50 Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52 Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41 Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25 Public Declare Function capCreateCaptureWindow _ Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _ (ByVal lpszWindowName As String, ByVal dwStyle As Long _ , ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long _ , ByVal nHeight As Long, ByVal hwndParent As Long _ , ByVal nID As Long) As Long Public Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _ , ByVal wParam As Long, ByRef lParam As Any) As Long Dim hCap As Long Private Sub cmd4_Click() Dim sFileName As String Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&) With CDialog .CancelError = True .Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt .Filter = "Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*" .ShowSave sFileName = .FileName End With Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName)) DoFinally: Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&) End Sub Private Sub Cmd3_Click() Dim temp As Long temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&) End Sub Private Sub Cmd1_Click() hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0) If hCap <> 0 Then Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0) Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&) Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&) End If End Sub Private Sub Cmd2_Click() Dim temp As Long temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&) End Sub Private Sub Form_Load() cmd1.Caption = "Start &Cam" cmd2.Caption = "&Format Cam" cmd3.Caption = "&Close Cam" cmd4.Caption = "&Save Image" End Sub
VB Fungsi API - Mengetahui Ukuran Screen Yang Sebenarnya
Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Public Function ScreenWidth() As Single Dim R As RECT GetWindowRect GetDesktopWindow(), R ScreenWidth = R.Right * Screen.TwipsPerPixelX End Function Public Function ScreenHeight() As Single Dim R As RECT GetWindowRect GetDesktopWindow(), R ScreenHeight = R.Bottom * Screen.TwipsPerPixelY End Function
Wednesday, December 5, 2012
VB6 Code - Encrypt Decrypt String Yang Disertai Password
'Fungsi untuk meng-encrypt string Public Function EncryptText(strText As String, ByVal strPwd As String) Dim i As Integer, c As Integer Dim strBuff As String If Len(strPwd) Then For i = 1 To Len(strText) c = Asc(Mid$(strText, i, 1)) c = c + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1)) strBuff = strBuff & Chr$(c And &HFF) Next i Else strBuff = strText End If EncryptText = strBuff End Function 'Fungsi untuk men-decrypt string Public Function DecryptText(strText As String, ByVal strPwd As String) Dim i As Integer, c As Integer Dim strBuff As String If Len(strPwd) Then For i = 1 To Len(strText) c = Asc(Mid$(strText, i, 1)) c = c - Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1)) strBuff = strBuff & Chr$(c And &HFF) Next i Else strBuff = strText End If DecryptText = strBuff End Function
VB Fungsi API - Memilih Seluruh Item ListBox
Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Const LB_SETSEL = &H185 Private Sub Command1_Click() If List1.SelCount Then SendMessage List1.hwnd, LB_SETSEL, False, ByVal True End If End Sub Private Sub Command2_Click() SendMessage List1.hwnd, LB_SETSEL, True, ByVal True End Sub Private Sub Form_Load() 'populate listbox Dim i As Long Me.Show List1.Visible = False Me.Refresh For i = 1 To 10000 List1.AddItem i Next List1.Visible = True End Sub
Everything - Search Engine Yang Cepat Untuk Windows
Apa yang dimaksud dengan everything?
Everything merupakan software mesin pencari untuk windows. Everything dapat mencari file atau folder dengan cepat tanpa harus menunggu.
Mengapa everything berbeda dengan mesin pencari yang lain?
- File instalasi kecil
- Interface yang sederhana dan mudah digunakan
- Peng-index-an file yang sangat cepat
- Pencarian file yang sangat cepat (bahkan sampai jutaan file sekalipun)
- Loading yang cepat
- Penggunaan resource yang minimal
- Database (hasil peng-index-an) yang tersimpan pada hardisk berukuran sangat kecil
- Update secara real time (apabila komputer Anda terhubung ke internet)
Gambar: Everything search engine software |
Everything merupakan software yang bersifat freeware. Software everything dapat digunakan untuk Windows 2000, XP, 2003, Vista, 2008 and Windows 7. Jika Anda tertarik ingin mencoba software everything, silakan kunjungi tautan di samping: Everything Search Engine.