Monday, December 10, 2012

VB6 Code - Memahami KeyWord ByVal dan ByRef

Di bawah ini merupakan contoh kode sehingga kita bisa memahami KeyWord ByVal dan ByRef. Untuk keperluan ini copy dan pastekan kode di bawah ini:

Option Explicit

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

Coba bedakan dengan yang ini
Fungsinya akan menampilkan error yakni argumen yang tidak sama (cocok/mismatch)

Private Sub Form_Load()
    Dim iNumber As Integer
    iNumber = 1
    MsgBox TampilkanPesan(iNumber)
End Sub

Function TampilkanPesan(Pesan As String) As String
    TampilkanPesan = Pesan
End Function

Untuk mengatasi error di atas maka cocokan saja argumennya yakni
dengan mengubah variable iNumber yang asalnya integer menjadi String

Private Sub Form_Load()
    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

Atau Anda beri statement ByVal pada argumen fungsinya

Private Sub Form_Load()
    '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

Maka kesimpulannya:

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

Untuk Memahami ParamArray dalam Visual Basic 6.0, Coba copy dan pastekan kode di bawah ini:

Option Explicit

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

Bagaimana? Sukses! Selanjutnya hilangkan ParamArray, sehingga kodenya menjadi:

Option Explicit

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

Bagaimana? Error!

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

Untuk memahami Optional pada sebuah argumen, copy dan pastekan kode berikut:

Option Explicit

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

Apa yang terjadi? Error! mengapa? karena argumen yang kedua tidak bersifat optional, sehingga mau tidak mau kita harus mengisinya. Selanjutnya copy dan pastekan kode berikut:

Option Explicit

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

Apa yang terjadi, Sukses! tidak menampilkan pesan error. Selanjutnya copy dan pastekan kode berikut:

Option Explicit

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

Apa yang terjadi, Sukses! tidak menampilkan pesan error!

Maka kesimpulannya:
Sebuah argumen yang disertai Optional memiliki dua pilihan: boleh diisi atau tidak.

VB6 Code - Memahami Recursive Function (Fungsi Recursive)

Di bawah ini merupakan contoh kode sehingga kita dapat memahami fungsi recursive. Apa yang dimaksud dengan fungsi recursive? fungsi recursive adalah fungsi yang memanggil dirinya sendiri. Coba perhatikan contoh kode di bawah ini:

Private Sub Form_Load()
 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

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:

Private Sub Form_Load()
 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

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!

VB6 Code - Fungsi Untuk Menampilkan Dialog Shutdown

Di bawah ini merupakan fungsi VB6 untuk menampilkan dialog shutdown. Karena menggunakan metode Early Binding maka, Untuk keperluan ini Anda harus mereferensi objek "Microsoft Shell Controls And Automation" atau "Shell32.dll" yang biasa terletak pada SystemRoot\System32 (c:\Windows\System32\Shell32.dll).

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

Di bawah ini merupakan fungsi VB6 untuk Me-Restore Seluruh Windows. Karena menggunakan metode Early Binding maka, Untuk keperluan ini Anda harus mereferensi objek "Microsoft Shell Controls And Automation" atau "Shell32.dll" yang biasa terletak pada SystemRoot\System32 (c:\Windows\System32\Shell32.dll).

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

Di bawah ini merupakan fungsi VB6 untuk menampilkan BrowseForFolder. Karena menggunakan metode Early Binding maka, Untuk keperluan ini Anda harus mereferensi objek "Microsoft Shell Controls And Automation" atau "Shell32.dll" yang biasa terletak pada SystemRoot\System32 (c:\Windows\System32\Shell32.dll).

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

Di bawah ini merupakan fungsi VB6 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

Di bawah ini merupakan fungsi VB6 untuk 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

Di bawah ini merupakan fungsi VB6 untuk mendapatkan Aplication Data atau disingkat dengan AppData.

'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

Di bawah ini merupakan fungsi VB6 untuk mendapatkan directory All User Profile (AllUserProfile)

'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

Di bawah ini merupakan Fungsi VB6 untuk mendapatkan directory temporary files tanpa terpengaruh oleh drive tempat Windows berada mis. C:\ D:\ dan seterusnya:

'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

Di bawah ini merupakan Fungsi untuk mendapatkan directory system tanpa terpengaruh oleh drive tempat Windows berada mis. C:\ D:\ dan seterusnya:

'Fungsi untuk mendapatkan directory system
Function GetSystemPath() As String
   GetSystemPath = Environ("WinDir") & "\System32"
End Function

Atau Anda dapat menggunakan fungsi di bawah ini:

'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

Di bawah ini merupakan fungsi VB6 untuk mendapatkan directory windows tanpa terpengaruh oleh drive tempat Windows berada mis. C:\ D:\ dan seterusnya:

'Fungsi untuk mendapatkan directory windows
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

Bagaimana 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.

VB6 Code - Fungsi Untuk Menggenapkan/Membulatkan Bilangan

Dalam membuat sebuah software, seringkali kita membutuhkan fungsi untuk menggenapkan/membulatkan sebuah bilangan (misalnya dalam membuat software biling warnet dan sebagainya). Pertanyaannya, bagaimanakah cara membuat sebuah fungsi dengan algoritma yang baik, kokoh, bisa digunakan dengan segala macam aplikasi, tahan banting, hanya satu jajar kode saja dan tidak menghabiskan energi (karena tidak terlampau banyak mengetik dan berfikir). bahasanya kepanjangan ya, padahal maksudnya dengan kode yang efektif dan efisien).

Fungsi untuk menggenapkan bilangan

Private Function Genapkan(ByVal Number As Double, Optional Range = 10) As double
  Genapkan = (Round((Number / Range) + 0.49)) * Range
End Function

Contoh Fungsi untuk menggenapkan bilangan dalam sebuah aplikasi:

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

Di bawah ini merupakan fungsi VB6 untuk menjadikan kalimat judul (maksudnya kalimat yang setiap katanya diawali dengan huruf besar), baik pada sebuah kata atau kalimat.

Fungsi untuk menjadikan kalimat judul

Function TitleCase(txt) As String
   TitleCase = StrConv(txt, vbProperCase)
End Function

Contoh penggunaan fungsi untuk menjadikan kalimat judul

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

Di bawah ini merupakan fungsi VB6 untuk mengecilkan seluruh huruf, baik pada kata atau kalimat.

Fungsi untuk mengecilkan seluruh huruf:

Function LowerCase(txt As String) As String
     LowerCase = StrConv(txt, vbLowerCase)
End Function

Contoh penggunaan Fungsi untuk mengecilkan seluruh huruf:

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

Di bawah ini merupakan fungsi VB6 untuk membesarkan seluruh huruf (membuat seluruh huruf menjadi kapital), baik pada kata atau kalimat.

'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

Toolbar Resizer 1.0 merupakan sebuah Add-Ins VB6.0 yang berguna untuk merubah ukuran buttons Toolbar yang telah terlanjur diisi gambar (yang berasal dari ImageList)

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.

Seperti yang kita ketahui, objek Toolbar yang buttonnya telah terisi gambar dari ImageList tidak dapat dirubah ukurannya misalnya dari 16 x 16 menjadi 32 x 32, 48 x 48 atau sebaliknya, terkecuali kita hapus terlebih dahulu seluruh gambar yang terdapat pada ImageList tersebut dan meng-unbound property ImageList yang terdapat dalam Toolbar tersebut. Akan tetapi dengan tools kecil yang diberi nama Toolbar Resizer 1.0 kita dapat merubah ukuran gambar sesuai selera tanpa harus mengutak-atik Toolbar dan ImageList-nya.

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)

LockWindowUpdate merupakan sebagian fungsi API yang terdapat dalam dll inti (core) windows "user32". Kegunaannya adalah untuk mengunci program pada saat terjadi proses, yaitu proses yang tidak ingin kita perlihatkan kepada user. Disamping itu software yang sedang memproses akan memiliki kecepatan yang lebih tinggi dibandingkan tanpa menggunakan fungsi API 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

Bagaimanakah cara memindahkan layout keyboard (misalnya dari english ke arabic atau sebaliknya) melalui pengkodean Visual Basic 6.0? Berikut solusinya:

'------------------------------------------------------------------------------- 
'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

Kode di atas tentunya sangat berguna sekali pada membuat aplikasi-aplikasi arabic dengan Visual Basic 6.0, dengan demikian kalimat:

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

Terkadang kita membutuhkan aksi tukar (toggle) property Caption dari sebuah object CommandButton. Misalnya menukar Caption CommandButton dari Start menjadi Stop atau sebaliknya dari Stop menjadi Start. Bagaimana hal tersebut bisa dilakukan melalui pemrograman Visual Basic 6.0?

Berikut ini contoh merubah menukar Caption CommandButton dari Start menjadi Stop dan sebaliknya dari Stop menjadi Start.

Option Explicit 
 
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

Apabila 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.

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

Bagaimanakah cara menampilkan atau memanggil sebuah form dari form yang lain menggunakan kode Visual Basic 6.0? Misalnya kita membuat dua buah form, dan diberi nama Form1 dan Form2. Selanjutnya Form1 ingin menampilkan Form2, maka kodenya adalah sebagai berikut:

Private Sub Command1_Click() 
    Form2.Show 
End Sub

Sederhana bukan? Nah, demikian mengenai cara menampilkan sebuah form dari form yang lain menggunakan VB6 Code. Semoga bermanfaat.

Menghapus Seluruh Isi TextBox Menggunakan For Each - VB6

Terkadang kita membutuhkan cara yang praktis untuk menghapus seluruh TextBox yang terdapat pada Form secara sekaligus. Tanpa harus menghapusnya satu persatu seperti Text1 = "", Text2 = "". Bagaimana jika dalam sebuah Form terdapat banyak object TextBox, misalnya ada 35 TextBox?

Berikut adalah cara menghapus seluruh text yang terdapat pada TextBox menggunakan VB6 code:

Option Explicit 
 
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

Demikianlah cara menghapus seluruh text yang terdapat pada object TextBox secara sekaligus menggunakan perulangan For .. Each.

Menambah dan Menghilangkan Item Pada ListBox - VB6 Code

Object ListBox pada Visual Basic 6.0 dilengkapi dengan beberapa method. Salah satunya adalah method untuk menambah item dan mengurangi item. Untuk menambah item, method yang digunakan adalah AddItem , sedangkan untuk menghilangkan/mengurangi item method yang digunakan adalah RemoveItem.

Berikut merupakan contoh menambah dan mengurangi item yang disertai komentar secukupnya agar mudah dipahami.

Option Explicit 
 
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

Demikian mengenai cara menambah dan mengurangi sebuah item pada object ListBox bahasa pemrograman Visual Basic 6.0.

VB6 Code - Mengurangi dan Menambah Item Pada ComboBox

Mengenai Code VB6 untuk menambah dan mengurangi item yang terdapat pada ComboBox. Code VB6 untuk menambah dan mengurangi item pada ComboBox harmpir sama dengan menambah dan mengurangi/menghilangkan item pada ListBox. Dalam hal ini hanya objectnya saja yang berbeda.

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 Sub

Demikian VB6 Code mengenai cara menambah dan mengurangi item pada object ComboBox. Semoga bermanfaat.

Cara Menampilkan MessageBox Melalui VB6 Code

Ini adalah kode pertama yang ditulis dalam blog ini, mengenai cara menampilkan dialog. Kotak dialog tersebut akan muncul apabila kita menekan tombol cmdShowMessage. Adapun kode untuk menampilkan messagebox melalui VB6 code adalah sebagai berikut:

Private Sub cmdShowMessageBox_Click()
     MsgBox "Hello world", vbInformation, "Sample"
End Sub

Sunday, December 9, 2012

Blogging - Memposting Artikel ke Blogger Menggunakan VB6

Mohon maaf source code ini dijual, agar Anda tidak memiliki kecewaan pada saat membuka posting ini - Ini merupakan aplikasi sederhana yang dibuat dengan Visual Basic 6.0. Aplikasi sangat sederhana ini digunakan untuk mempublish artikel ke blogger.

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

Contoh kode VB6 sederhana untuk dikembangkan mengenai cara menambah objek 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

Meng-capture gambar dari sebuah webcam menggunakan Visual Basic 6.0.

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

Contoh fungsi API untuk mengetahui ukuran layar (screen) yang sebenarnya (dikurangi tinggi taskbar).

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

Contoh fungsi encrypt- decrypt string yang disertai dengan password menggunakan VB6.

'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

Contoh fungsi API untuk memilih (select all/deselect all) item pada 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.

Saturday, December 1, 2012

Software Kamus Besar Bahasa Indonesia - KBBI Offline 1.4

Ini merupakan software yang sangat bermanfaat, digunakan untuk mencari kosakata yang terdapat dalam Kamus Besar Bahasa Indonesia dengan mudah. Pada saat posting ini dibuat software KBBI telah sampai pada versi 1.4. Kamus Besar Bahasa Indonesia versi software ini dibuat oleh Ebta Setiawan pemilik situs: http://ebsoft.web.id. Software Kamus Besar Bahasa Indonesia ini bersifat opensource, dibuat dengan menggunakan bahasa pemrograman delphi.
Adapun fitur-fitur yang terdapat pada KBBI 1.4, diantaranya:

Pencarian kata/kalimat dari arti/definisi
Opsi pengaturan penggunaan auto search (bawaan tidak aktif)
Opsi pengaturan jumlah halaman kata hasil pencarian
Penjelasan tentang arti singkatan (jenis kata, istilah dll)
Icon baru
Tersedia versi installer dan portable
Lisensi menjadi Freeware & Open Source
Perbaikan pencarian kata yg ada tanda - didepannya
Perbaikan penebalan nomor/urutan arti kata
Perbaikan beberapa kata yang belum masuk (bising, durian, uang, sarasehan dan romantisisme)
Perbaikan hasil pencarian lainnya
Fitur pencarian otomatis tidak aktif secara bawaan (penambahan tombol cari)
Perbaikan tampilan font yang mengecil di Windows 8

Untuk download dan lain sebagainya bisa kunjungi link di samping: KBBI Offline 1.4

Keywords: kbbi, offline, 1.4, software, kamus, besar, bahasa, indonesia, v1.5, online, istilah, arab, windows, 7, inggris, download, on, line, pemrograman, (kbbi), versi, kosakata

Friday, November 30, 2012

VB6 Database: Koneksi Access 2007 ke VB6

Koneksi VB6 dengan Access 2007: di bawah ini merupakan contoh kode sederhana untuk mengkoneksiakan Access 2007 dengan VB6, Adapun contoh kode untuk mengkoneksikan VB6 dengan Access 2007 adalah sebagai berikut:

Option Explicit

'-----------------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
'-----------------------------------------------------------------------------------

Dim conn As New ADODB.Connection

Private Sub Command1_Click()
    Static i As Integer
    i = i + 1
    conn.Execute "INSERT INTO tbTest (fdTest)VALUES('Record ke-" & i & "')"
End Sub

Private Sub Form_Load()
    If Not OpenAccess2007 Then
        MsgBox Err.Description
    End If
End Sub

Private Function OpenAccess2007() As Boolean
    On Error GoTo ErrHandler
        conn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & App.Path & "\test.accdb;Persist Security Info=False;"
        OpenAccess2007 = True
        Exit Function
ErrHandler:
End Function

Download: Source Code VB6 - Koneksi Access 2007 ke VB6.

Demikian contoh kode sederhana untuk mengkoneksikan Access 2007 dengan VB6.

Tags: koneksi vb6 dengan access 2007, koneksi access 2007 ke vb6, koneksi vb6 ke access 2007.

Sunday, August 5, 2012

Muslims For Marriage Sites

Muslim Marriage - Qiran.com
Site: www.qiran.com
Muslims For Marriage - Find Your Indonesian Partner Now
Site: www.indonesiancupid.com/
Muslim MuslimMatch.com - 125,000+ Members
Site: www.muslimmatch.com/
USA Matrimonials Muslim
Site: www.simplymarry.com/Matrimonials
Muslim Singles Dating
Site: www.muslimati.com/
Muslim Marriage Online
Site: www.look4marriage.com/
Muslim Wedding
Site: www.valentine.com/
Indian Muslim Girls
Site: www.marryasunni.com/
Muslim_Girls Life as a Muslim Wife
Site: www.eclecticwomen.org/
Muslima
Site: www.muslima.com

Wednesday, July 4, 2012

VB6 Facebook: Mengakses Facebook Graph API

Mengenai teka-teki mengakses Facebook graph API - Agar tidak membosankan kali ini saya ajak Anda untuk bermain teka-teki saja, apakah semuanya setuju? oh, ternyata semuanya setuju. Baiklah teka-teki kali ini mengenai cara mengendalikan Facebook yang kita miliki dari aplikasi VB6 yang kita buat menggunakan Graph API. Di sini hanya diwakili dengan aplikasi facebook uploader sederhana. Untuk membuat aplikasi tersebut tidak sederhana/rumit, baik, user friendy maka kita membutuhkan satu lagi pemahaman mengenai JSON parser.

Tidak seperti Twitter yang menggunakan OAuth 1.0 yang sangat memusingkan kepala pada saat pembuatan digital signature yang valid (seperti yang telah saya posting sebelumnya, maka pada Facebook prosesnya jauh lebih sederhana kita hanya memerlukan access_token jangka panjang itu saja, atau access_token yang digenerate on the fly melalui OAuth 2.0, jadi kita sudah tidak memerlukan lagi password dan email untuk proses otentifikasi dan otorisasi yang tentu saja sangat tidak aman (berpotensi terjadinya pembajakan akun secara besar-besaran) dan ini sudah tidak dianjurkan lagi baik oleh Google, Facebook, Twitter, .dll (termasuk .ocx juga?).

Mengenai cara memperoleh access_token dari Facebook, silakan Anda cari di Google.

Gambar: Upload photo ke Facebook melalui VB6

Demikian teka-teki kali ini mengenai cara mengakses Facebook graph API melalui aplikasi VB6. Baca juga teka-teka sebelumnya:

Mengirim tweet ke twitter melalui aplikasi VB6
Memasukan gambar ke dalam ocx (ocx default VB6 atau third party) melalui VB6 Add-Ins.
Shell Context Menu pada Windows Explorer

Unduh: Aplikasi Facebook Photo Uploder Sederhana

Friday, June 29, 2012

VB6 Source Code: Membuat Frame Dari OptionButton - CheckBox

Mengenai cara membuat Frame dari objek OptionButton atau ChekBox - Dikarenakan objek CheckBox, OptionButton, kemudian CommandButton
berasal dari kelas yang sama yaitu Class Button, maka ketiganya pun dapat kita rubah stylenya menjadi sebuah Frame dengan memanfaatkan konstanta BS_GROUPBOX dan BM_SETSTYLE melalui bantuan fungsi API SendMessage. Keuntungan membuat Frame dari OptionButton, CheckBox atau CommandButton adalah dapat mengikuti Style Windows.
Adapun kode untuk merubah style CheckBox atau OptionButton menjadi Frame sebagai berikut:

'Simpan pada form
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
         
Private Const BM_SETSTYLE As Long = &HF4
Private Const BS_GROUPBOX As Long = &H7&
 
'Contoh penggunaan
Private Sub Form_Load()
    SendMessage Check1.hWnd, BM_SETSTYLE, BS_GROUPBOX, 0
End Sub

Catatan: Jangan lupa untuk merubah property ClipsControl yang terdapat pada Form menjadi False.
Download: Source Code

Tuesday, June 26, 2012

VB6 Animasi: Menggunakan Fungsi API AnimateWindow

VB6 AnimateWindow - Dengan menggunakan fungsi API AnimateWindow, kita dapat membuat efek-efek animasi yang sangat halus. Fungsi API AnimateWindow sendiri tidak bisa digunakan begitu saja, tetapi ia membutuhkan bantuan fungsi API yang lain untuk melakukan SubClassing guna memproses Message WM_PRINT atau WM_PRINTCLIENT agar form yang sedang melakukan animasi terefresh dengan baik, dengan demikian form akan ditampilkan secara sempurna dan terhindar dari warna hitam yang menutupi keseluruhan form tersebut.

Modul AnimateWindow di bawah ini diperoleh dari situs Eduardo A. Morcillo. Nah, pada akhirnya untuk mempermudah penggunaan saya tambahkan beberapa baris Enum Animation, seperti di bawah ini:

Public Enum Animation
'// ACTIVATE
    ACTIVATE_SLIDE_FROM_TOP = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_FROM_BOTTOM = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_FROM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE)
    ACTIVATE_SLIDE_FROM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_TOP_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_TOP_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_CENTER = (AW_ACTIVATE Or AW_SLIDE Or AW_CENTER)
    ACTIVATE_SLIDE_FADE_TRANSITION = (AW_ACTIVATE Or AW_BLEND)
'// DEACTIVATE
    DEACTIVATE_SLIDE_FADE_TRANSITION = (AW_HIDE Or AW_BLEND)
    DEACTIVATE_SLIDE_TO_TOP = (AW_HIDE Or AW_SLIDE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_TO_BOTTOM = (AW_HIDE Or AW_SLIDE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_TO_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE)
    DEACTIVATE_SLIDE_TO_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_TOP_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_TOP_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_CENTER = (AW_HIDE Or AW_SLIDE Or AW_CENTER)
End Enum

Adapun modul lengkapnya adalah sebagai berikut:

Option Explicit

Const GWL_WNDPROC = (-4)

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

Const PROP_PREVPROC = "PrevProc"
Const PROP_FORM = "FormObject"

Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal DestL As Long)

Const WM_PRINTCLIENT = &H318

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long

Enum AnimateWindowFlags
    AW_HOR_POSITIVE = &H1
    AW_HOR_NEGATIVE = &H2
    AW_VER_POSITIVE = &H4
    AW_VER_NEGATIVE = &H8
    AW_CENTER = &H10
    AW_HIDE = &H10000
    AW_ACTIVATE = &H20000
    AW_SLIDE = &H40000
    AW_BLEND = &H80000
End Enum

Private Declare Function apiAnimateWindow Lib "user32" Alias "AnimateWindow" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal Mul As Long, ByVal Nom As Long, ByVal Den As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Enum Animation
'// ACTIVATE
    ACTIVATE_SLIDE_FROM_TOP = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_FROM_BOTTOM = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_FROM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE)
    ACTIVATE_SLIDE_FROM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_TOP_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_TOP_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
    ACTIVATE_SLIDE_EXPAND_FROM_CENTER = (AW_ACTIVATE Or AW_SLIDE Or AW_CENTER)
    ACTIVATE_SLIDE_FADE_TRANSITION = (AW_ACTIVATE Or AW_BLEND)
'// DEACTIVATE
    DEACTIVATE_SLIDE_FADE_TRANSITION = (AW_HIDE Or AW_BLEND)
    DEACTIVATE_SLIDE_TO_TOP = (AW_HIDE Or AW_SLIDE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_TO_BOTTOM = (AW_HIDE Or AW_SLIDE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_TO_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE)
    DEACTIVATE_SLIDE_TO_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_TOP_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_TOP_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
    DEACTIVATE_SLIDE_SHRINK_TO_CENTER = (AW_HIDE Or AW_SLIDE Or AW_CENTER)
End Enum

Function AnimateWindow(ByVal Form As Object, ByVal dwTime As Long, ByVal dwFlags As Animation)
    Dim ctl As Control

    SetProp Form.hWnd, PROP_PREVPROC, GetWindowLong(Form.hWnd, GWL_WNDPROC)
    SetProp Form.hWnd, PROP_FORM, ObjPtr(Form)
    Dim i As Integer
    SetWindowLong Form.hWnd, GWL_WNDPROC, AddressOf AnimateWinProc
    apiAnimateWindow Form.hWnd, dwTime, dwFlags
    SetWindowLong Form.hWnd, GWL_WNDPROC, GetProp(Form.hWnd, PROP_PREVPROC)
    RemoveProp Form.hWnd, PROP_FORM
    RemoveProp Form.hWnd, PROP_PREVPROC
    Form.Refresh
    For Each ctl In Form.Controls
        ctl.Visible = Not ctl.Visible
        ctl.Visible = Not ctl.Visible
    Next
End Function

Private Function AnimateWinProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim lPrevProc As Long
    Dim lForm As Long
    Dim oForm As Form

    lPrevProc = GetProp(hWnd, PROP_PREVPROC)

    lForm = GetProp(hWnd, PROP_FORM)
    MoveMemory oForm, lForm, 4&
    
    Select Case Msg
        Case WM_PRINTCLIENT
            Dim tRect As RECT
            Dim hBr As Long
            GetClientRect hWnd, tRect
            hBr = CreateSolidBrush(OleTranslateColor(oForm.BackColor))
            FillRect wParam, tRect, hBr
            DeleteObject hBr

            If Not oForm.Picture Is Nothing Then
                Dim lScrDC As Long
                Dim lMemDC As Long
                Dim lPrevBMP As Long
                lScrDC = GetDC(0&)
                lMemDC = CreateCompatibleDC(lScrDC)
                ReleaseDC 0, lScrDC
                lPrevBMP = SelectObject(lMemDC, oForm.Picture.Handle)
                BitBlt wParam, 0, 0, HM2Pix(oForm.Picture.Width), HM2Pix(oForm.Picture.Height), lMemDC, 0, 0, vbSrcCopy
                SelectObject lMemDC, lPrevBMP
                DeleteDC lMemDC
            End If
    End Select

    MoveMemory oForm, 0&, 4&
    AnimateWinProc = CallWindowProc(lPrevProc, hWnd, Msg, wParam, lParam)

End Function

Private Function HM2Pix(ByVal Value As Long) As Long
    HM2Pix = MulDiv(Value, 1440, 2540) / Screen.TwipsPerPixelX
End Function

Private Function OleTranslateColor(ByVal Clr As Long) As Long
    apiOleTranslateColor Clr, 0, OleTranslateColor
End Function

Public Function AnimationX(frm As Object, lTime As Long, eMode As Animation)
    AnimateWindow frm, lTime, eMode
End Function

Simpanlah kode diatas pada sebuah module. Adapun contoh penggunaannya adalah sebagai berikut:

Private Sub Form_Load()
    AnimateWindow Me, 300, ACTIVATE_SLIDE_EXPAND_FROM_CENTER
End Sub

Private Sub Form_Unload(Cancel As Integer)
    AnimateWindow Me, 300, DEACTIVATE_SLIDE_SHRINK_TO_CENTER
End Sub

Harap diingat, flags yang diawali dengan ACTIVATE untuk memulai dan flags yang diakhiri dengan DEACTIVATE untuk mengakhiri. Akhirnya saya jadi teringat beberapa software yang menggunakan efek animasi seperti ini, diantaranya adalah Mufid (software kamus) yang menggunakan efek slide kemudian SpeedComander (software utility) yang menggunakan efek center.

Error: File not found: "C:\Windows\system32\ieframe.dll\1"

Mengenai cara mengatasi File not found: "C:\Windows\system32\ieframe.dll\1" secara otomatis dan mudah, anggap saja sebuah trik.

Bekerja dengan objek WebBrowser atau Microsoft Internet Control, terkadang kita sering berhadapan dengan error: File not found: "C:\Windows\system32\ieframe.dll\1" akibat perubahan nilai yang terdapat pada registry. Walaupun error tersebut bukanlah suatu hal yang serius dan sangat mudah diatasi, tetapi bagaimana jika kejadiannya berulang-ulang? sungguh sesuatu hal yang sangat mengesalkan.

Berdasarkan hal yang telah saya sebutkan di atas, akhirnya saya membuat sebuah tools untuk mengatasi hal ini, tools tersebut dapat bekerja dengan otomatis. Tools tersebut dibuat berdasarkan fakta, bahwa Add-Ins lebih dahulu dijalankan oleh VB6 sebelum melakukan Load terhadap seluruh objek. Jadi kata kuncinya adalah merubah registry menggunakan Add-Ins, adapun kodenya saya bagi dua: yang pertama terdapat pada Connect.dsr dan yang kedua terdapat pada module yang saya namakan dengan modRegistry.bas. Adapun penampakan kodenya adalah sebagai berikut:

Connect.dsr

Option Explicit

Public FormDisplayed          As Boolean
Public VBInstance             As VBIDE.VBE
Dim mcbMenuCommandBar         As Office.CommandBarControl
Public WithEvents MenuHandler As CommandBarEvents

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
    On Error GoTo error_handler
    Set VBInstance = Application
    
    Debug.Print VBInstance.FullName
    RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
    If ConnectMode = ext_cm_External Then
        RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
    Else
        Set mcbMenuCommandBar = AddToAddInCommandBar("Handle Internet Error")
        Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
    End If
  
    If ConnectMode = ext_cm_AfterStartup Then
        If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then
             RegWrite "HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32\", "C:\WINDOWS\system32\ieframe.dll"
        End If
    End If
  
    Exit Sub
    
error_handler:
    
    MsgBox Err.Description
    
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
    On Error Resume Next
    mcbMenuCommandBar.Delete
    If FormDisplayed Then
        SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
        FormDisplayed = False
    Else
        SaveSetting App.Title, "Settings", "DisplayOnConnect", "0"
    End If
End Sub

Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
    If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then
    End If
End Sub

Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl
    Dim cbMenuCommandBar As Office.CommandBarControl
    Dim cbMenu As Object
  
    On Error GoTo AddToAddInCommandBarErr
    
    Set cbMenu = VBInstance.CommandBars("Add-Ins")
    If cbMenu Is Nothing Then
        Exit Function
    End If
    
    Set cbMenuCommandBar = cbMenu.Controls.Add(1)
    cbMenuCommandBar.Caption = sCaption
    
    Set AddToAddInCommandBar = cbMenuCommandBar
    
    Exit Function
    
AddToAddInCommandBarErr:

End Function

modRegistry.bas:

Option Explicit
 
Dim oWSHShell As WshShell
 
"untuk menulisi registry
Public Function RegWrite(sKey As String, sFilepath As String) As Boolean
On Error GoTo Err
    Set oWSHShell = New WshShell
        oWSHShell.RegWrite sKey, sFilepath
    Set oWSHShell = Nothing
    RegWrite = True
    Exit Function
Err:
    RegWrite = False
End Function
 
"untuk menghapus key dari registry
Public Function RegDelete(sKey As String) As Boolean
On Error GoTo Err
    Set oWSHShell = New WshShell
        oWSHShell.RegDelete sKey
    Set oWSHShell = Nothing
    RegDelete = True
    Exit Function
Err:
    RegDelete = False
End Function
 
"untuk membaca key dari registry
Public Function RegRead(strKey)
    On Error Resume Next
    Set oWSHShell = New WshShell
        RegRead = oWSHShell.RegRead(strKey)
    Set oWSHShell = Nothing
End Function

Langkah-langkah pembuatan:

Buat project Add-Ins.
Ganti seluruh kode yang terdapat pada Connect.dsr dengan kode di atas.
Tambahkan satu Module dan beri nama dengan module modRegistry
Simpan Project dan lakukan Compile
Lakukan register dll apabila project yang Anda buat belum terigistrasi pada registry

Sekarang Anda tidak akan pernah diganggu lagi dengan error: File not found: "C:\Windows\system32\ieframe.dll\1" selamanya. Terakhir, mari kita ucapkan bersama, selamat tinggal error: File not found: "C:\Windows\system32\ieframe.dll\1"

Monday, June 25, 2012

VB6 Animasi: Animasi Melayang Ala Google Talk

Mengenai animasi melayang pada saat tampil dan sembunyi di systray ala Google Talk menggunakan VB6.

Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function SetRect Lib "User32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DrawAnimatedRects Lib "User32" (ByVal hwnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Sub ShowMinimzeToSysTray(ByVal hwnd As Long)
    Dim rSource As RECT, rDest As RECT
    GetWindowRect hwnd, rSource
    GetWindowRect FindWindowEx(FindWindow("Shell_TrayWnd", vbNullString), 0, "TrayNotifyWnd", vbNullString), rDest
    Call DrawAnimatedRects(hwnd, IDANI_CLOSE Or IDANI_CAPTION, rSource, rDest)
End Sub

Public Sub ShowRestoreFromSysTray(ByVal hwnd As Long)
    Dim rSource As RECT, rDest As RECT
    GetWindowRect FindWindowEx(FindWindow("Shell_TrayWnd", vbNullString), 0, "TrayNotifyWnd", vbNullString), rSource
    GetWindowRect hwnd, rDest
    Call DrawAnimatedRects(hwnd, IDANI_OPEN Or IDANI_CAPTION, rSource, rDest)
End Sub

Private Sub Command2_Click()
    ShowMinimzeToSysTray hwnd
End Sub

Private Sub Command1_Click()
    ShowRestoreFromSysTray Me.hwnd
End Sub

Kode di atas, akan menjadi tidak bermanfaat apabila aplikasi tidak menggunakan/memanfaatkan systray icon untuk menampilkan dan menyembunyikan aplikasi.

theBatch Add-Ins, Mengatasi Beberapa Masalah Manifest Resour

Ini merupakan aplikasi VB6 Add-Ins, saya namakan dengan theBatch, karena ia dapat menyelesaikan masalah form yang disebabkan manifest resource secara bersamaan/sekaligus berapapun banyaknya form tersebut. Modul utamanya milik Eduardo A. Morcillo and Vlad Vissoultchev (pembuat Hook Menu).

Beberapa masalah manifest tersebut, diantaranya:

Flickering pada frame
Hilangnya mnemonic (shorcut underline), ini sangat mengganggu dalam aplikasi database.
CommandButton yang ditempatkan pada frame akan memiliki border hitam disekelilingnya
CommandButton dengan property Style = 1 - Graphical, tidak bisa ditheme XP
OptionButton yang dtempatkan pada frame akan memiliki background hitam

Download: theBatch dan Sample UI.

Download Software Speech/Voice Recognition

Ini merupakan software pembelajaran untuk melatih mengucapkan frase-frase pendek dalam percakapan. Adapun yang menjadi lawan bicaranya adalah sebuah komputer.

Cara menggunakan:

Isi terlebih dahulu database percakapan yang terdapat pada C:\Program Files\Speech\dbase.mdb. Isi dari percakapan tersebut disesuaikan dengan kebutuhan Anda atau anak didik Anda.
Siapkan mikrofon berkualitas baik
Atur volume
Bacalah frase-frase pendek yang telah Anda isi ke dalam database yang terdapat pada sisi kiri. Selanjutnya komputer akan menjawabnya.

Keunggulan dari software ini adalah sangat sederhana, sehingga sangat mudah untuk digunakan. Disamping itu ukurannya sangat kecil, sekitar 400kb lebih. Nah, selamat berlatih dan bercakap-cakap dengan komputer dan Insya Allah dikembangkan jika ada waktu.

Download: Speech 1.5

Software - Simple SQL Query Tester 2.0 Open Source

Ini merupakan software sederhana untuk menguji connection string beberapa database serta menguji sql query meliputi INSERT, UPDATE, SELECT, DELETE selanjutnya melalui software ini, Anda dapat merubahnya menjadi Visual Basic String dan mengcopy paste pada project yang sedang Anda buat.Selain yang telah dijelaskan, Anda pun dapat mempelajari pembuatan script installer untuk pembuatan file setup, dan beberapa code VB6 yang kebanyakan telah dituliskan pada postingan secara terpisah.

Catatan:

Compile terlebih dahulu menjadi file .exe, karena ada sedikit perbedaan antara design time dan runtime.
Apabila Anda berkeinginan membuat file setup, download terlebih dahulu innosetup installer kemudian klik kanan pada file Application.iss >> compile. maka pada folder output Anda akan mendapati file Query Tester.EXE yang merupakan file setup.

Download: Query Tester (Source Code)
Download: Query Tester (Setup)

Update: My Source Online 2.0 - Online MySQL Database

Rupanya pada versi yang sebelumnya terjadi beberapa kegagalan, diantaranya:

Gagal dalam mengecek koneksi internet, modul yang digunakan adalah -[memeriksa keberadaan koneksi internet]- sehingga selalu terkadang menampilkan pesan error "Mohon maaf, tidak ada koneksi internet".
Gagal dalam meregistrasikan COMDLG32.OCX (CommonDialog ActiveX), kemungkinan masalah versi.

Kedua masalah tersebut telah saya perbaiki, pertama dengan mengganti modul check koneksi internet masalah kedua diatasi dengan cara mengganti COMDLG32.OCX dengan class yang diembed langsung pada aplikasi.

Catatan: karena aplikasi ini tidak dilengkapi dengan file-file runtime (hanya dua ActiveX yang disertakan vbSendMail dan CMAX20.OCX [Syntax Hightlighter]), maka sebaiknya Anda lengkapi dulu runtimenya dan beberapa file untuk mengakses database MySQL, atau Anda rujuk pada link di bawah ini:

Aplikasi Minimarket (menggunakan database MySQL, lengkap beserta file-file runtime yang dibutuhkan)
MySQL ODBC 3.51 Driver

Nah, setelah menjalankan dua file di atas, seharusnya Anda sudah dapat mengakses database MySQL secara online menggunakan VB6.

Aplikasi iImsyakiyah Dari http://www.diajar.com

Aplikasi iImsyakiyah ini dibuat oleh saudara Agung Novian pemiliki situs http://www.diajar.com. Aplikasi ini digunakan untuk memberitahukan jadwal sholat lima waktu.

Keterangan mengenai Aplikasi iImsyakiyah:

Dibuat menggunakan bahasa pemrograman Visual Basic 6.
Portable, artinya tidak memerlukan penginstallan.
GUI yang menarik dan serasi.
Dilengkapi dengan tray icon.
Alarm untuk memberitahukan waktu imsyak, dan adzan untuk memberitahukan waktu shalat (bisa dirubah settingannya).
Dilengkapi fasilitas shutdown dan hibernate
Walaupun aplikasi hanya mencantumkan tiga daerah (Jakarta, Bandung, dan Cirebon) tetapi Anda dapat dengan mudah menambahkan nama daerah, dengan terlebih dahulu menyesuaikan settingannya, seperti tampak pada gambar di bawah ini:

Bagi Anda yang berminat memiliki aplikasinya, Anda dapat mengunjungi tautan di samping http://www.diajar.com/#/aplikasi-iimsakiyahv1-1. Kritik dan saran mengenai aplikasi ini bisa Anda kirimkan ke alamat email disamping:
pujanggabageur[at]yahoo.com (ganti [at] dengan @)

Terima kasih semoga bermanfaat.

Wednesday, June 20, 2012

Cara Yang Cerdik Untuk Mentrap On Error Resume Next - VB6

Mengenai cara men-trap (menjebak) objek error yang berada di bawah bari On Error Resume Next - Bagaimana kita dapat melakukan sebuah pengecualian dalam baris yang berada di bawah On Error Resume Next, di bawah adalah contoh kode VB6 beserta penjelasannya:

Option Explicit

Private Sub Command1_Click()
    'Baris pertama kita memasang On Error Resume Next, maksudnya
    'kita memberitahukan pada compiler VB6 untuk melangkahi baris error
    'dan mengeksekusi baris berikutnya tanpa harus menampilkan pesan error
    On Error Resume Next
    
    'Selanjutnya kita mamasang satu variable i (catatan: variable satu huruf
    'seperti i, b, j dan selanjutnya, hanya bisa digunakan pada sebuah jangkah (scope)
    'yang sempit, dan jangan pernah menggunakannya pada scope yang luas seperti
    'Public i as Integer dan variable i berada pada module, Global l as long, dst
    Dim i As Integer
    
    'Dengan adanya On Error Resume Next di atas, maka kode di bawah ini akan
    'diabaikan/dilangkahi oleh compiler VB6. Selanjutnya pesan error tidak akan
    'ditampilkan
    i = "Hai, ini pasti error"
    
    'Walaupun kita telah memasang baris On Error Resume Next, bukan berarti
    'Bukan berarti Error Object tidak, Error Object tetap bekerja sebagaimana
    'biasanya
    If Err Then 'Apabila Error = True a.k.a Err.Number > 0 maka ...
        'Kode trap ...
        MsgBox Err.Description
        'Kode trap ...
    End If
    
    'Baris di bawah akan meng-Clear error
    On Error GoTo 0
    
    'Sekarang lihat hasilnya
    MsgBox Err.Description
End Sub

Kode utuh tanpa keterangan (comment) adalah sebagai berikut:

Option Explicit

Private Sub Command1_Click()
    On Error Resume Next
    Dim i As Integer
    i = "Hai, ini pasti error"
    If Err Then
        MsgBox Err.Description
    End If
    On Error GoTo 0
    MsgBox Err.Description
End Sub

Sunday, June 17, 2012

Contoh Menambahkan Attribut Pada Tag HTML - VB Code

Private Function AddPreWithClassName()
     Dim d As New MSHTML.HTMLDocument
     Dim l As HTMLMetaElement
     Dim x As HTMLHtmlElement
     
     d.body.innerHTML = txtPost.Text
    
     For Each l In d.All
         If l.tagName = "PRE" Then
             l.className = "code" '
         End If
     Next
     txtPost.Text = d.body.innerHTML
End Function

Subscribe to: Comments ( Atom )

Monday, December 10, 2012

Sunday, December 9, 2012

Thursday, December 6, 2012

Wednesday, December 5, 2012

Saturday, December 1, 2012

Friday, November 30, 2012

Sunday, August 5, 2012

Wednesday, July 4, 2012

Friday, June 29, 2012

Tuesday, June 26, 2012

Monday, June 25, 2012

Wednesday, June 20, 2012

Sunday, June 17, 2012

Perhatian

Page Rank

Online

Statistik Pengunjung

embrio9 - Auto Reply

Blog Archive

Visual Basic 6.0

Arabic

Blogging

Miscellaneous