Lihat pada gambar berikut ini :

Setelah kita klik icon form yang berada pada sudut atas sebelah kiri, akan muncul menu pada control box. Untuk menambahkan menu tersebut, silahkan ikuti langkah-langkah berikut :

Object yang diperlukan :
1 Buah Form
1 Buah Module

Masukkan kode dibawah ini pada Module1 (Code) :
[sourcecode language='vb']
Option Explicit
Public Const WM_SYSCOMMAND As Long = &H112&
Public Const IDM_ABOUT As Long = 1&
Public Const IDM_WHO As Long = 2&
Public procOld As Long
Public Declare Function CallWindowProc& Lib “user32″ Alias “CallWindowProcA” (ByVal lpPrevWndFunc&, _
ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Public Function MenuProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_SYSCOMMAND
If wParam = IDM_ABOUT Then _
MsgBox “Contoh isi menu Programmer”, _
vbInformation, “Menu Programmer”

If wParam = IDM_WHO Then _
MsgBox “Contoh isi Custom Menu”, _
vbInformation, “Custom Menu”
End Select
MenuProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
End Function
[/sourcecode]

Masukkan kode dibawah ini pada Form1 (Code) :
[sourcecode language='vb']
Option Explicit
Private Const SC_SIZE As Long = &HF000&
Private Const SC_MOVE As Long = &HF010&
Private Const SC_CLOSE As Long = &HF060&
Private Const SC_MINIMIZE As Long = &HF020&
Private Const SC_MAXIMIZE As Long = &HF030&
Private Const SC_NEXTWINDOW As Long = &HF040&
Private Const SC_PREVWINDOW As Long = &HF050&
Private Const MF_BYCOMMAND As Long = &H0&
Private Const MF_STRING As Long = &H0&
Private Const MF_SEPARATOR As Long = &H800&
Private Const GWL_WNDPROC As Long = (-4&)
Private Declare Function GetSystemMenu& Lib “user32″ (ByVal hWnd&, ByVal bRevert&)
Private Declare Function DeleteMenu& Lib “user32″ (ByVal hMenu&, _
ByVal nPosition&, ByVal wFlags&)

Private Declare Function AppendMenu& Lib “user32″ Alias “AppendMenuA” (ByVal hMenu&, _
ByVal wFlags&, ByVal wIDNewItem&, lpNewItem As Any)

Private Declare Function SetWindowLong& Lib “user32″ Alias “SetWindowLongA” (ByVal hWnd&, _
ByVal nIndex&, ByVal dwNewLong&)

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
Screen.MousePointer = vbHourglass
Dim hSysMenu&
hSysMenu = GetSystemMenu(hWnd, False)
Call DeleteMenu(hSysMenu, SC_CLOSE, MF_BYCOMMAND)
Call DeleteMenu(hSysMenu, SC_SIZE, MF_BYCOMMAND)
Call DeleteMenu(hSysMenu, SC_MOVE, MF_BYCOMMAND)
Call DeleteMenu(hSysMenu, SC_MAXIMIZE, MF_BYCOMMAND)
Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, ByVal “&Programmer”)
Call AppendMenu(hSysMenu, MF_SEPARATOR, False, ByVal 0&)
Call AppendMenu(hSysMenu, MF_STRING, IDM_WHO, ByVal “&Contoh Custom Menu”)
procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MenuProc)
Screen.MousePointer = vbDefault

cantgetsysmenu:
If Err Then
Err.Clear
MsgBox “Tidak bisa menambahkan menu”, vbExclamation, “Menu System”
Resume cantgetsysmenu
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, procOld)
End Sub
[/sourcecode]

Download Contoh Project

claim token :  6GUB32BQMUMS

Object yang diperlukan :
1 Buah Form
1 Module, Name : Module1
2 Buah Timer, Name : Timer1, Interval : 100 dan Timer2, Interval : 10
1 Buah ShockwaveFlash, Name : ShockwaveFlash1

File pendukung yang diperlukan :
1 Buah file yang berektensi .swf

Keterangan :
Untuk memunculkan object Shockwave Flash pada toolbox, silahkan masuk ke menu Project – Components…, kemudian cari control yang bernama Shockwave Flash. Jika control tersebut tidak ada, silahkan install program Macromedia Flash untuk mendapatkan control Shockwave Flash.

Masukkan kode dibawah ini pada Module1 (Code) :
[sourcecode language='vb']
Public Declare Function GetWindowLong Lib “user32″ Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib “user32″ Alias “SetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib “user32″ (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_ALPHA = &H2

Public Function TranslucentForm(frm As Form, TranslucenceLevel As Byte) As Boolean
SetWindowLong frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
TranslucentForm = Err.LastDllError = 0
End Function
[/sourcecode]

Masukkan kode dibawah ini pada Form1 (Code) :
[sourcecode language='vb']
Option Explicit
Dim x As Byte
Dim g As Byte

Private Sub Form_Load()
ShockwaveFlash1.Movie = App.Path & “\Pembukaan.swf” ‘Letakkan file flash (.swf) pada folder aplikasi anda, jika nama nya berbeda, silahkan ubah dan sesuaikan dengan nama file flash anda
ShockwaveFlash1.Play
g = 255
End Sub

Private Sub Timer1_Timer()
x = x + 1
If x >= 50 Then
Timer1.Enabled = False
Timer2.Enabled = True
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next

If g >= 101 Then
TranslucentForm Me, g
Else
If g <= 0 Then
TranslucentForm Me, 5
TranslucentForm Me, 3
TranslucentForm Me, 1
TranslucentForm Me, 0
Timer2.Enabled = False

Unload Me
Form2.Show
End If
End If
g = g - 1
End Sub
[/sourcecode]

Download Contoh Project

Object yang diperlukan :
1 Buah Form
1 Buah CommandButton, Name : Command1
2 Buah Label, Name : Label1 dan Label2
1 Buah Timer, Name : Timer1

Masukkan kode berikut ini pada Form1 (Code) :
[sourcecode language='vb']
Private Sub Command1_Click()
If Command1.Caption = “Stop” Then
Command1.Caption = “Start”
Timer1.Enabled = False
Else
Command1.Caption = “Stop”
Timer1.Enabled = True
End If
End Sub

Private Sub Form_Load()
Label1.Caption = Format(Now, “hh:mm:ss”)
Label2.Caption = Format(Now, “DDDD, dd MMMM yyyy”)
End Sub

Private Sub Timer1_Timer()
Label1.Caption = Format(Now, “hh:mm:ss”)
Label2.Caption = Format(Now, “DDDD, dd MMMM yyyy”)
End Sub
[/sourcecode]

Download Contoh Project

PopUp Menu pada suatu form akan terlihat jika kita klik kanan pada badan form tersebut. Langkah-langkah dalam membuat PopUp Menu tersebut adalah sebagai berikut:

1. Buat 2 buah Form, simpan dengan nama file dan Name-nya : Form1 dan Form2
2. Klik kanan pada badan Form1 kemudian pilih Menu Editor
3. Buat struktur menu seperti berikut :
   Caption : Contoh, Name : MnuContoh, Type Kepala Menu
   Caption : Buka Form 2, Name : MnuForm2, Type Sub Menu
   Caption : - , Name : MnuGaris, Type Sub Menu
   Caption : Keluar, Name : MnuKeluar, Type Sub Menu
   Sehingga yang tampil pada menu editor akan terlihat seperti pada gambar berikut:

Menu Editor

Masukkan kode berikut ini pada Form1 Code :
[sourcecode language='vb']
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu MnuContoh, , , , MnuKeluar
End If
End Sub
Private Sub mnukeluar_Click()
End
End Sub
Private Sub mnuform2_Click()
Form2.Show
End Sub
[/sourcecode]
Jalankan form1 tersebut kemudian klik kanan pada badan form1.

Download Contoh Project

Beberapa program di control panel yang dimaksud yaitu, Region And Language, Add/Remove Programs, Date and Time, System Properties, Mouse Properties, Keyboard Properties, Internet Properties, Display Properties, Sound Properties, Game Controller. Selain dari program-program tersebut di tambahkan beberapa utilities yang sering digunakan pada sebuah aplikasi seperti Empty Recycling Bin, Open CD-Rom, Control Panel, Clean Drive, Task Manager, Registry Windows dan Windows Explorer.

Object yang diperlukan :

• 1 Buah Form
• 17 Buah CommandButton
  Name : Command1, Caption : Region and Language
  Name : Command2, Caption : Add/Remove Programs
  Name : Command3, Caption : Date and Time
  Name : Command4, Caption : System Properties
  Name : Command5, Caption : Mouse Properties
  Name : Command6, Caption : Keyboard Properties
  Name : Command7, Caption : Internet Properties
  Name : Command8, Caption : Display Properties
  Name : Command9, Caption : Sound Properties
  Name : Command10, Caption : Game Controller
  Name : Command11, Caption : Empty Recycling Bin
  Name : Command12, Caption : Open CD-Rom
  Name : Command13, Caption : Control Panel
  Name : Command14, Caption : Clean Drive
  Name : Command15, Caption : Task Manager
  Name : Command16, Caption : Registry Windows
  Name : Command17, Caption : Explorer

Masukkan kode dibawah ini pada Form1 Code:
[sourcecode language='vb']
Private Declare Function SHEmptyRecycleBin Lib “shell32.dll” Alias “SHEmptyRecycleBinA” (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function mciSendString Lib “winmm.dll” Alias “mciSendStringA” (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub Command1_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0″, 5)
End Sub

Private Sub Command10_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL joy.cpl”)
End Sub

Private Sub Command12_Click()
Dim lngReturn As Long
Dim strReturn As Long
lngReturn = mciSendString(“set CDAudio door open”, strReturn, 127, 0)
End Sub

Private Sub Command11_Click()
Dim retvaL
retvaL = SHEmptyRecycleBin(Form1.hWnd, “”, SHERB_NOPROGRESSUI)
End Sub

Private Sub Command13_Click()
Shell MyWindowSys & “control.exe”, 1
End Sub

Private Sub Command14_Click()
Shell MyWindowSys & “cleanmgr.exe”, 1
End Sub

Private Sub Command15_Click()
Shell MyWindowSys & “taskmgr.exe”, 1
End Sub

Private Sub Command16_Click()
Shell MyWindowDir & “regedit.exe”, 1
End Sub

Private Sub Command17_Click()
Shell MyWindowDir & “Explorer.exe /e,/select, ” & MyWindowSys, 1
End Sub

Private Sub Command2_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1″, 5)
End Sub

Private Sub Command3_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL timedate.cpl”, 5)
End Sub

Private Sub Command4_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1″, 5)
End Sub

Private Sub Command5_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL main.cpl @0″, 5)
End Sub

Private Sub Command6_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL main.cpl @1″, 5)
End Sub

Private Sub Command7_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0″, 5)
End Sub

Private Sub Command8_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0″, 5)
End Sub

Private Sub Command9_Click()
Dim dblreturn
dblreturn = Shell(“rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1″, 5)
End Sub
[/sourcecode]

Download Contoh Project

Lihat pada gambar berikut:

Gambar tersebut adalah tampilan pop up menu pada saat klik kanan di drive harddisk komputer kita. Lihat, terdapat shortcut yang ditandai bernama Program-Ku. Untuk memasukkan shortcut program pada menu pop up drive di windows explorer seperti gambar diatas, lakukan langkah-langkah berikut…

Object yang diperlukan:
1 Buah Form
1 Buah CommandButton, Name : Command1

Masukkan kode dibawah ini pada Form1 Code:
[sourcecode language='vb']
Private Const Lokasi = “HKEY_CLASSES_ROOT”
Private Const NamaFile = “”
Private Const IsiFile = “Program-Ku”
Private Const lngRegKeyROOT = &H80000000 ‘ Cap4 : HKEY_CURRENT_USER
Private Const strRegKeyName = “Drive\Shell\Boediardjo”
Private Const strTempRegKeyRoot = Lokasi

‘Alternatif lain untuk lngRegKeyRoot
‘&H80000000 >> HKEY_CLASSES_ROOT
‘&H80000001 >> HKEY_CURRENT_USER
‘&H80000002 >> HKEY_LOCALS_MACHINE
‘&H80000003 >> HKEY_USERS
‘&H80000004 >> HKEY_CURRENT_CONFIG

Private Const strRegKeyName2 = “Drive\Shell\Boediardjo\Command”
‘contoh alamat program kita, silahkan di ubah dengan syarat file yang berekstensi .exe
Private Const IsiFile2 = “C:\Windows\System32\NOTEPAD.exe”
‘Dim NamaFile As String
‘Dim IsiFile
Private Const KEY_ALL_ACCESS = &H2003F

Dim lngKeyDataType As Long
Dim KeyDataValue

Private Declare Function RegOpenKeyEx Lib “advapi32″ Alias “RegOpenKeyExA” ( _
ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib “advapi32.dll” Alias “RegSetValueExA” ( _
ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib “advapi32″ (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” ( _
ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib “advapi32″ Alias “RegQueryValueExA” ( _
ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Sub Command1_Click()
Call SetKeyDataValue(lngRegKeyROOT, strRegKeyName, lngKeyDataType, NamaFile, IsiFile)
Call SetKeyDataValue(lngRegKeyROOT, strRegKeyName2, lngKeyDataType, NamaFile, IsiFile2)
End Sub

Private Sub SetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, KeyDataType As Long, KeyValueName As String, KeyValueDate As Variant)

Dim OpenKey As Long, SetValue As Long, hKey As Long

OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, hKey)

If (OpenKey <> 0) Then
Call RegCreateKey(RegKeyRoot, RegKeyName, hKey)
End If
KeyDataType = 1
SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))

SetValue = RegCloseKey(hKey)
MsgBox “Alamat Registry yang dibuat: ” & vbCr & “[" & strTempRegKeyRoot & "\" & RegKeyName & "\" & KeyValueName & "]“, vbInformation + vbOKOnly, App.Title
End Sub
[/sourcecode]

Download Contoh Project

Tulisan ini akan sangat membantu jika kita sedang membangun program pengolahan kata, karena secara umum serta tanpa disadari kita sering melakukan proses ini “Cut, Copy & Paste”, selain itu juga dapat membantu dalam mengoptimalkan program kita.

Object yang diperlukan :

• 1 buah form
• 5 buah Command Button
  Name : CmdCut, Caption : Cut
  Name : CmdCopy, Caption : Copy
  Name : CmdPaste, Caption : Paste
  Name : Cmd CmdClearClip, Caption : Clear Clipboard
  Name : CmdUndo, Caption : Undo

Masukkan kode berikut pada Form1 Code :
[sourcecode language='vb']
Private Sub CmdCut_Click()
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Me.Text1.Text)
Clipboard.SetText Text1.SelText
Text1.SelText = “”
End Sub

Private Sub CmdCopy_Click()
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Clipboard.SetText Text1.SelText
End Sub

Private Sub CmdPaste_Click()
Text2.Text = Clipboard.GetText()
End Sub

Private Sub CmdUndo_Click()
Text2.Text = “”
Text1.SetFocus
Text1.Text = “Contoh Cut, Copy & Paste”
Clipboard.Clear
End Sub

Private Sub CmdClearClip_Click()
Clipboard.Clear
End Sub

Private Sub Form_Load()
Clipboard.Clear
Text1 = “Contoh Cut, Copy & Paste”
End Sub
[/sourcecode]

Download Contoh Project

Object yand diperlukan :
1 buah form
1 Buah Timer, Name : Timer1, Interval : 250

Masukkan kode dibawah ini pada Form1 Code:
[sourcecode language='vb']
Private Sub Timer1_Timer()
R = 255 * Rnd
g = 255 * Rnd
B = 255 * Rnd
Me.BackColor = RGB(R, g, B)
End Sub
[/sourcecode]

Kemudian jalankan form tersebut dan lihat warna backgroundnya yang kelap-kelip, sehingga aplikasi yang dibangun terlihat menarik.

Download Contoh Project

Object yang diperlukan :
1 Buah Form
1 Buah HScrollBar dengan Name : H

Masukkan kode dibawah ini pada Form Code :
[sourcecode language='vb']
Private Declare Function GetWindowLong Lib “user32″ Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib “user32″ Alias “SetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib “user32″ (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const LWA_ALPHA = &H2

Private Function TranslucentForm(frm As Form, TranslucenceLevel As Byte) As Boolean
SetWindowLong frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
TranslucentForm = Err.LastDllError = 0
End Function

Private Sub Form_Load()
TranslucentForm Me, H.Value

End Sub

Private Sub H_Change()
Dim B As Byte
B = H.Value
TranslucentForm Me, B

Refresh

End Sub
[/sourcecode]

Download Contoh Project

Dalam keadaan Default, form yang dibuat pada VB.6 pertama kali terdapat Caption dengan nama Form1, untuk membuat caption tersebut berjalan tanpa henti, baik itu yang ada di Tittle Form maupun yang berada pada Taksbar windows, masukkan code dibawah ini.

Object yang diperlukan :
1 buah form, dengan Caption sesuai dengan keinginan anda.
1 buah Timer, dengan Name : Timer1

Masukkan code dibawah ini:
[sourcecode language='vb']
Dim Jalan As Integer
Dim Teks As String

Private Sub Form_Load()
Teks = Me.Caption + ” >*< "
End Sub

Private Sub Timer1_Timer()
Me.Caption = Jalan
Teks = Right(Teks, Len(Teks) - 1) & Left(Teks, 1)
Me.Caption = Teks
End Sub
[/sourcecode]

Setelah dimasukkan kode yang diatas, jalankan aplikasi dan lihat perubahannya.

Download Contoh Project