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

READ MORE - VB6 Facebook: Mengakses Facebook Graph API

VB6 Code - Memperoleh Control Yang Sedang Aktif - Focus

Option Explicit

Private Sub Timer1_Timer()
    Dim cControl As Control
    Set cControl = Me.ActiveControl

    If Not cControl Is Nothing Then
        Caption = cControl.Name
    End If
End Sub

READ MORE - VB6 Code - Memperoleh Control Yang Sedang Aktif - Focus

Membaca dan Menampilkan Karakter Unicode

Option Explicit

Private Sub Command1_Click()
    Dim a(0 To 5) As Byte
    a(0) = &HFF
    a(1) = &HFE
    a(2) = &H39
    a(3) = &H4E
    a(4) = &H44
    a(5) = &H0
    Open "unicode.txt" For Binary As #1
    Put #1, , a
    Close #1
End Sub

Private Sub Command2_Click()
    Dim txtline As String

    Open "unicode.txt" For Binary As #1
        txtline = InputB(2, #1)
        txtline = InputB(4, #1)
    Close #1

    TextBox1.Text = txtline
End Sub

READ MORE - Membaca dan Menampilkan Karakter Unicode

Apakah ScrollBar Visible Pada Sebuah Control?

Option Explicit

Private Const GWL_STYLE = (-16)
Private Const WS_HSCROLL = &H100000
Private Const WS_VSCROLL = &H200000

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub Command1_Click()
    Dim wndStyle As Long
    wndStyle = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
    If (wndStyle And WS_HSCROLL) <> 0 Then
        MsgBox "A horizontal scroll bar is visible."
    Else
        MsgBox "A horizontal scroll bar is NOT visible."
    End If

    If (wndStyle And WS_VSCROLL) <> 0 Then
        MsgBox "A vertical scroll bar is visible."
    Else
        MsgBox "A vertical scroll bar is NOT visible."
    End If
End Sub

Private Sub Command2_Click()
    TreeView1.Move 250, 900, 1000, 1000
End Sub

Private Sub Form_Load()
    Form1.ScaleMode = 1
    Form1.Move 0, 0, 5100, 5040
    Command1.Caption = "Scroll Bar Test"
    Command1.Move 120, 120, 1700, 500
    Command2.Caption = "Size Control"
    Command2.Move 2000, 120, 1700, 500
    TreeView1.Move 250, 900, 3000, 1500
    TreeView1.Nodes.Add , , , "1: Sample Text"
    TreeView1.Nodes.Add , , , "2: Sample Text"
    TreeView1.Nodes.Add , , , "3: Sample Text"
    TreeView1.Nodes.Add , , , "4: Sample Text"
End Sub

READ MORE - Apakah ScrollBar Visible Pada Sebuah Control?

Contoh MRU - Most Recently Used

Option Explicit

Private Const MaxMRU = 4
Private Const NotFound = -1
Private Const NoMRUs = -1

Private MRUCount As Long

Private Sub Form_Load()
    MRUCount = NoMRUs

    GetMRUFileList
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SaveMRUFileList
End Sub

Private Sub mnuMRU_Click(Index As Integer)
    ReorderMRUList mnuMRU(Index).Caption, CLng(Index)
End Sub

Private Sub mnuOpen_Click()
    Me.CommonDialog1.ShowOpen

    AddMRUItem Me.CommonDialog1.FileName
End Sub

Private Sub AddMRUItem(NewItem As String)
    Dim result As Long

    result = CheckForDuplicateMRU(NewItem)

    If result <> NotFound Then
        ReorderMRUList NewItem, result
    Else
        AddMenuElement NewItem
    End If
End Sub

Private Function CheckForDuplicateMRU(ByVal NewItem As String) As Long
    Dim i As Long

    NewItem = UCase$(NewItem)

    For i = 0 To MRUCount
        If UCase$(Me.mnuMRU(i).Caption) = NewItem Then
            CheckForDuplicateMRU = i

            Exit Function
        End If
    Next i

    CheckForDuplicateMRU = -1
End Function

Private Sub mnuQuit_Click()
    Unload Me
End Sub

Private Sub AddMenuElement(NewItem As String)
    Dim i As Long

    If (MRUCount < (MaxMRU - 1)) Or (MaxMRU = -1) Then
        MRUCount = MRUCount + 1

        If MRUCount <> 0 Then
            Load mnuMRU(MRUCount)
        End If

        mnuMRU(MRUCount).Visible = True
    End If

    For i = (MRUCount) To 1 Step -1
        mnuMRU(i).Caption = mnuMRU(i - 1).Caption
    Next i

    mnuMRU(0).Caption = NewItem
End Sub

Private Sub ReorderMRUList(DuplicateMRU As String, DuplicateLocation As Long)
    Dim i As Long

    For i = DuplicateLocation To 1 Step -1
        mnuMRU(i).Caption = mnuMRU(i - 1).Caption
    Next i

    mnuMRU(0).Caption = DuplicateMRU
End Sub

Private Sub GetMRUFileList()
    Dim i As Long
    Dim result As String

    Do
        result = GetSetting(App.Title, "MRUFiles", Trim$(CStr(i)), "")

        If result <> "" Then
            AddMRUItem result
        End If

        i = i + 1
    Loop Until (result = "")
End Sub

Private Sub SaveMRUFileList()
    Dim i As Long

    For i = 0 To MRUCount
        SaveSetting App.Title, "MRUFiles", Trim$(CStr(i)), mnuMRU(i).Caption
    Next i
End Sub

READ MORE - Contoh MRU - Most Recently Used

Cara Membuat Generic Handler Error

Option Explicit

Private Sub Form_Load()
    On Error GoTo FormLoadErr
    Err.Raise 76
    Err.Raise 70
    Exit Sub

FormLoadErr:
    Select Case Err.Number
        Case 76
            MsgBox "Form_Load Error Handler. Form Does Not Exist"
        Case Else
            AppWideErr (Err.Number)
    End Select
End Sub

Private Sub Command1_Click()
    On Error GoTo Cmd1Err
    Err.Raise 53
    Err.Raise 70
    Exit Sub

Cmd1Err:
    Select Case Err.Number
        Case 53
            MsgBox "Command 1 Error Handler"
        Case Else
            AppWideErr (Err.Number)
    End Select
    Resume Next
End Sub

Private Sub Command2_Click()
    Form2.Show
End Sub

Private Sub Command1_Click()
    On Error GoTo ThisSubErr
    Err.Raise 17
    Exit Sub
ThisSubErr:
    AppWideErr (Err.Number)
End Sub

Public Sub AppWideErr(lnErrNumber)
    Select Case lnErrNumber
        Case 70
            MsgBox "Generic Routine.  Access Denied.  See Net Administrator.", , "AppWideErr"
            Exit Sub
        Case Else
            MsgBox "Generic Routine. Unhandled Error: " + Err.Description + " # " & lnErrNumber, , "AppWideErr"
            Exit Sub
    End Select
End Sub

READ MORE - Cara Membuat Generic Handler Error

Membuat Aplikasi Console Dengan Visual Basic 6.0

Option Explicit

Declare Function AllocConsole Lib "kernel32" () As Long
Declare Function FreeConsole Lib "kernel32" () As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long

Public Const STD_OUTPUT_HANDLE = -11&
Dim hConsole As Long

Private Sub Command1_Click()
    Dim Result As Long, sOut As String, cWritten As Long
    sOut = "Hi There" & vbCrLf
    Result = WriteConsole(hConsole, ByVal sOut, Len(sOut), cWritten, ByVal 0&)
    Shell "C:\TEST.BAT"
End Sub

Private Sub Form_Load()
    If AllocConsole() Then
        hConsole = GetStdHandle(STD_OUTPUT_HANDLE)
        If hConsole = 0 Then MsgBox "Couldn"
    Else
        MsgBox "Couldn"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CloseHandle hConsole
    FreeConsole
End Sub

READ MORE - Membuat Aplikasi Console Dengan Visual Basic 6.0

Contoh Menjalankan Procedure Di dalam Script Control

Option Explicit

Private Sub Command1_Click()
    ScriptControl1.Modules.Add Text1.Text
    Form_Activate
End Sub

Private Sub Command2_Click()
    ScriptControl1.Modules(List1).AddCode Text1.Text
    List1_Click
End Sub

Private Sub Command3_Click()
    Dim RetVal As Variant, m As Variant
    Set m = ScriptControl1.Modules(List1.Text)
    With m.Procedures(List2.Text)
        Select Case .NumArgs
            Case 0
                RetVal = m.Run(List2.Text)
            Case 1
                RetVal = m.Run(List2.Text, 5)
            Case 2
                RetVal = m.Run(List2.Text, 4, 23)
            Case Else
                MsgBox "Procedure has too many arguments"
        End Select
        If .HasReturnValue Then
            MsgBox List2.Text & " returned: " & RetVal
        End If
    End With
End Sub

Private Sub Form_Activate()
    Dim m As Variant
    List1.Clear
    With ScriptControl1
        .Language = "VBScript"
        .AllowUI = True
        For Each m In .Modules
            List1.AddItem m.Name
        Next m
    End With
End Sub

Private Sub Form_Load()
    Command1.Caption = "Add Module"
    Command2.Caption = "Add Code"
    Command3.Caption = "Run Procedure"
End Sub

Private Sub List1_Click()
    Dim m As String, p As Variant
    m = List1
    List2.Clear
    If m = "" Then Exit Sub
    For Each p In ScriptControl1.Modules(m).Procedures
        List2.AddItem p.Name
    Next p
End Sub

Private Sub List2_Click()
    Dim m As String, p As String, r As Boolean, a As Long
    m = List1
    p = List2
    With ScriptControl1.Modules(m).Procedures(p)
        r = .HasReturnValue
        a = .NumArgs
    End With
    MsgBox m & "." & p & " has " & IIf(r, "a", "no") & _
    " return value and " & a & " arguments"
End Sub

'Tambahkan module dan prosedur di bawah ini pada script control
Function Calc(X)
    Calc = X * 2
End Function

Function Calc(X, Y)
    Calc = X * Y
End Function

Sub Test()
    MsgBox "The Test Sub in Module Mod2"
End Sub

READ MORE - Contoh Menjalankan Procedure Di dalam Script Control

Spin Artikel Bahasa Indonesia

Apa yang dimaksud artikel spin/spin artikel/article spinner? bisa Anda baca di sini. Dengan kata lain artikel spin adalah mengganti kata dengan menggunakan sinonim dari kata tersebut secara besar-besaran. Tujuannya? Mengecoh mesin pencari agar artikel yang kita duplikatkan (copy paste) berubah menjadi sebuah konten unik menurut pengamatan robot/mesin pencari (bukan menurut pengamatan manusia). Contoh:

Saya akan pergi ke pasar. berubah menjadi
Ana berencana berangkat ke pasar. atau
Ane mau pergi ke pasar. atau
Aku berencana pergi ke pasar. atau
Gue akan berangkat ke pasar. atau
gw mo pergi ke pasar. atau
dan seterusnya. dan seterusnya.

Bukankah seluruh kalimat di atas tersebut unik menurut versi mesin pencari? Nah, bagaimana menurut versi manusia (saya dan Anda)?

Spin artikel bisa dikategorikan sebagai sebuah teknik SEO yang sedikit hitam yang dapat menyebabkan banyaknya duplikasi konten/sampah menurut pengamatan manusia. Tetapi dalam dunia sales online/reseller/affeliate hal ini tidak bisa dihindari. Ya saya ulangi, dalam dunia sales online hal ini tidak bisa dihindari. Satu produk dengan merk yang sama dijual oleh ribuah atau jutaan orang secara online.

Di bawah ini merupakan contoh kode spin artikel bahasa indonesia dengan menggunakan 5 kata dan sinonimnya (seharusnya 5000 kata beserta sinonimnya), yakni saya, pergi, blogger, gmail, akan.

Option Explicit 
 
Private Function ChooseWord(choice As Variant, bWord, Optional bUnik As Boolean) As String 
 
    Dim i As Integer 
    Dim strSpin() As String, strChooseWord As String 
    strSpin = Split(choice, ",") 
    If Not bUnik Then 
        Randomize 
        i = CInt((UBound(strSpin) * Rnd) + 1) 
        strChooseWord = strSpin(i - 1) 
    Else 
        Do 
            Randomize 
            i = CInt((UBound(strSpin) * Rnd) + 1) 
            strChooseWord = strSpin(i - 1) 
        Loop While strChooseWord = bWord 
    End If 
    ChooseWord = strChooseWord 
 
End Function 
 
Private Sub cmdDoSpin_Click() 
    Dim strResult As String 
    Dim strSource As String 
    strResult = txtResult.Text 
    strSource = txtSource.Text 
 
    strResult = LCase(strSource) 
 
    Dim arrWord() As String 
    ReDim arrWord(4) 'gantilah menjadi 40, 400, atau 4000 
    'apabila algoritmanya telah dimodif dan mantap maka 
    'tambahkan sinonim menjadi 40, 400, atau 4000 
    arrWord(0) = "saya, aku, ane, ana" 
    arrWord(1) = "pergi, berangkat" 
    arrWord(2) = " akan, berencana" 
    arrWord(3) = "blogger, blogspot, blog milik google (blogspot)" 
    arrWord(4) = "gmail, gmail.com, google mail, layanan email milik google (gmail)" 
    '-------------------------------------------------------- 
    Dim i As Integer, k As Integer 
 
    For i = LBound(arrWord) To UBound(arrWord) 
        Dim strSpin() As String 
        strSpin = Split(arrWord(i), ",") 
        For k = LBound(strSpin) To UBound(strSpin) 
            If InStr(1, strSource, strSpin(k)) > 0 Then 
                strResult = Replace(strResult, strSpin(k), ChooseWord(arrWord(i), strSpin(k), Check1.Value = 1)) 
                Exit For 
            End If 
        Next 
    Next 
    txtResult.Text = Trim$(strResult) 
End Sub 

Cobalah Anda kembangkan. Semoga kode spin artikel bahasa indonesia di atas bermanfaat. Terima kasih atas kunjungannya.

READ MORE - Spin Artikel Bahasa Indonesia

Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_TERMINATE As Long = &H1

Public Sub terminateApp(ByVal sWindowTitle As String, ByVal fSilent As Boolean)

    
    Dim lHwnd As Long
    Dim lProc As Long
    Dim lProcHnd As Long
    
    On Error GoTo ErrHandler
    
    sWindowTitle = "Inbox - Thunderbird"
    sWindowTitle = "Test"
    
    lHwnd = FindWindow(vbNullString, sWindowTitle)
    If lHwnd = 0 Then
        If fSilent Then
            Exit Sub
        Else
            Err.Raise 1, , "Can"
        End If
    End If

    GetWindowThreadProcessId lHwnd, lProc
    If lProc = 0 Then
        If fSilent Then
            Exit Sub
        Else
            Err.Raise 1, , "Can"
        End If
    End If

    lProcHnd = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, 0, lProc)
    If lProcHnd = 0 Then
        If fSilent Then
            Exit Sub
        Else
            Err.Raise 1, , "Can"
        End If
    End If

    If TerminateProcess(lProcHnd, 0&) <> 0 Then
        If Not fSilent Then
            Err.Raise 1, , "Failed to terminate process"
        End If
    End If

    CloseHandle lProcHnd
    
    Exit Sub

ErrHandler:

    Err.Raise Err.Number, , Err.Description

End Sub

READ MORE - Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Menutup Sebuah Aplikasi Secara Request

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE As Long = &H10

Public Sub closeApp(ByVal sWindowTitle As String, Optional ByVal fSilent As Boolean = False)
    Dim lHwnd As Long
    On Error GoTo ErrHandler

    lHwnd = FindWindow(vbNullString, sWindowTitle)

    If lHwnd = 0 Then
        If Not fSilent Then
            Err.Raise 1, , "Can"
        End If
    Else
        PostMessage lHwnd, WM_CLOSE, 0, 0
    End If

    Exit Sub

ErrHandler:
    Err.Raise Err.Number, , Err.Description
End Sub

READ MORE - Menutup Sebuah Aplikasi Secara Request

Contoh Mengambil Image Dari Resource - VB6 Code

Mengenai cara mengambil gambar dari file resource menggunakan pemrograman Visual Basic 6 - Bagaimana kita dapat menggunakan gambar yang terdapat pada resource file, berikut adalah jawabannya:

Private Sub Form_Paint()
    Me.PaintPicture VB.LoadResPicture(101, vbResBitmap), 0, 0
End Sub

Walaupun hanya satu baris, semoga bermanfaat.

READ MORE - Contoh Mengambil Image Dari Resource - VB6 Code

Google Page Rank Monitor 1.0 - Blogger Tools

Ini merupakan aplikasi untuk melihat Google Page Rank. Sebagian besar source codenya saya ambil dari situs milik Leandro Ascierto, saya hanya sedikit menambahkan kode agar kompatibel dengan firefox.

Fitur-Fitur Google Page Rank Monitor 1.0:

1. Portable
2. Automatic Checker (tanpa membutuhkan verifikasi yang merepotkan)
3. Kecil dan ringan
4. Bekerja dengan baik pada koneksi internet yang lambat
5. dan lain-lain

Kekurangannya:

1. Untuk sementara hanya bekerja pada Firefox.

Cara menggunakan:

1. Buka Firefox
2. Klik install.bat untuk meregistrasikan komponen PageRank.dll
3. Jalankan Google Page Rank Monitor 1.0
4. Selesai.

Download: Google Page Rank Monitor 1.0

Catatan: Pada dasarnya, kita dapat melihat dengan mudah Google Page Rank melalui Google ToolBar. Aplikasi ini hanya sekedar contoh, apabila kita ingin membuat browser sendiri yang dilengkapi dengan Google Page Rank, atau fasilitas-fasilitas yang terdapat pada Google Toolbar dengan cara melakukan Request ke http://toolbar.google.com/.... (query).

READ MORE - Google Page Rank Monitor 1.0 - Blogger Tools

Black Circle PasswordChar Untuk Login Form - Visual Basic 6

Pada saat kita menuliskan password di yahoo, gmail, xp, facebook, dll, kita dapat melihat, bahwa karakter yang digunakan untuk menuliskan password bukanlah karakter asterix (*) melainkan lingkaran kecil berwarna hitam. Nah, bagaimana setting PasswordChar untuk menggantikan karakter asterix (*) tersebut? (ini tentu saja akan membuat form login Anda terlihat lebih baik dan standard).

Option Explicit 
 
Private Sub Form_Load() 
    With Text1 
        .FontName = "Wingdings" 
        .FontSize = 9 
        .PasswordChar = "l" 
    End With 
End Sub 

Catatan: yang harus kita perhatikan adalah, apakah font 'Wingdings' merupakan font bawaan OS (98, 2000, XP, Vista, Windows 7)?, jika bukan maka kita harus mengikutsertakan dalam file setup/installer.

READ MORE - Black Circle PasswordChar Untuk Login Form - Visual Basic 6

Cara Membuat Prosedure Generator Nama Secara Acak (Random)

Fungsi untuk membuat nama secara random (acak) - Di bawah ini merupakan prosedur yang digunakan untuk membuat nama secara acak, fungsi ini memiliki satu parameter untuk mengatur jumlah huruf yang akan digenerate, sedangkan nilai defaultnya adalah 4 huruf. Bagaimana fungsi generator nama secara acak atau random, bisa Anda lihat di bawah ini:

Option Explicit 
 
Private Function NamaAcak(Optional k As Integer = 4) As String 
    Dim s(1) As String, l As String 
    Randomize 
    s(0) = ("aiueo") 
    s(1) = ("bcdfghjklmnpqrstvwxyz") 
    For i = 1 To k 
        l = l & Mid(s(i Mod 2), Int((4 * Rnd) + 1), 1) 
    Next 
    NamaAcak = l 
End Function 

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    MsgBox NamaAcak(10) 'menampilkan nama acak yang memiliki jumlah huruf 10 
    'sedangkan contoh di bawah akan mengenerate 20 nama acak 
    'dengan jumlah huruf 10 karakter 
    Dim i As Integer 
    List1.Clear 
    For i = 1 To 20 
        List1.AddItem NamaAcak(6) 
    Next 
End Sub 

Apakah kegunaan dari generator nama secara acak/random ini? saya juga tidak tahu, mungkin Anda tahu?

READ MORE - Cara Membuat Prosedure Generator Nama Secara Acak (Random)

Memahami Drag and Drop Dalam Visual Basic 6

Posting mengenai contoh operasi Drag and Drop menggunakan OLE pada VB6, Sebelum Anda mencoba kode drag and drop di bawah ini, settinglah property objek Picture1 OLEDropMode = 1 - Manual dan Property AutoSize = True.

Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)  
On Error GoTo ErrHandler  
    Picture1.Picture = LoadPicture(Data.Files(1)) 
   Exit Sub  
ErrHandler:  
    MsgBox "Error gambar tidak bisa diload" 
End Sub 

Untuk melihat cara kerjanya, bukalah Windows Explorer draglah satu file gambar yang terdapat pada Windows Explorer tersebut, selanjutnya drop tepat di atas object PictureBox.

READ MORE - Memahami Drag and Drop Dalam Visual Basic 6

VB Code - Membuat Sound Beep ala Anti Virus AVIRA

Mengenai cara membuat suara beep seperti yang terdapat pada antivirus Avira menggunakan VB6 Code - Pada saat mendeteksi sebuah virus/malware, biasanya anti virus Avira akan mengeluarkan suara yang khas melalui internal speaker. Nah, di bawah ini merupakan cara membuat sound beep ala Avira dengan memanggil fungsi API Beep yang terdapat pada liblary Kernel32. Cobalah untuk mengkalibrasi frekuensi serta durasinya!

Option Explicit 

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long 

Private Sub AvirasBeep() 
    Beep 1500, 100 'frekuensi 1500khz, durasi 100 milidetik 
    Beep 2000, 80 'frekuensi 2000khz, durasi 80 milidetik 
    Beep 3200, 70 'frekuensi 3200khz, durasi 70 milidetik 
End Sub 

Private Sub Command1_Click() 
    AvirasBeep 
End Sub 

READ MORE - VB Code - Membuat Sound Beep ala Anti Virus AVIRA

VB6.0 - Code Generator: Add OCX Add DLL Programmatically

Yang dimaksud kode generator disini adalah sebuah aplikasi yang digunakan untuk membuat sebuah project. Adapun tujuan utamanya ialah untuk menghemat waktu, tenaga, dan biaya sedangkan tujuan lainnya yang tidak kalah penting adalah kecepatan. Kode generator sangat baik sekali digunakan untuk pembuatan aplikasi-aplikasi database, karena aplikasi database hampir memliki kode-kode yang sama (insert-update-delete-dsb) hanya objeknya saja yang berbeda. Maka jika kita ingin membuat belasan aplikasi database dengan objek yang berbeda, pembuatan kode generator dengan rancangan yang baik sungguh sangat layak untuk dipertimbangkan. Sebagai contoh Anda dapat mendownload kode generator yang kurang baik atau tepatnya tidak baik disini. Walaupun kurang baik, tapi coba perhatikan apakah keistimewaanya.

Membuat aplikasi kode generator yang baik, tentunya harus memiliki kemampuan menambahkan sembarang OCX dan referensi DLL yang support VB6.0. Bagaimanakah caranya? Di bawah ini merupakan potongan dari kode generator tersebut, gunanya untuk menambahkan referensi DLL dan OCX.

'------------------------------------------------------------------------------- 
'        http://khoiriyyah.blogspot.com 
'        Administrator 
'------------------------------------------------------------------------------- 
 
Public VBInstance As VBIDE.VBE 
Public Connect As Connect 
 
Option Explicit 
 
Public Function InsertOCX(ProgID As String) As Boolean 
On Error GoTo ErrHandler 
    'Add OCX 
      VBInstance.ActiveVBProject.AddToolboxProgID ProgID 
    InsertOCX = True 
    Exit Function 
ErrHandler: 
    InsertOCX = False 
End Function 
 
Public Function InsertReferences(GUID As String, Mayor As Long, Minor As Long) As Boolean 
On Error GoTo ErrHandler 
    'Add dll references 
    VBInstance.ActiveVBProject.References.AddFromGuid GUID, Mayor, Minor 
    InsertReferences = True 
ErrHandler: 
    InsertReferences = False 
End Function 
 
Private Sub Command1_Click() 
    'Add ListView to VB6 project 
    InsertOCX "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}" 
    'Add TreeView 
    InsertOCX "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}" 
    'Add MSFlexGrid 
    InsertOCX "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}" 
End Sub 
 
Private Sub Command2_Click() 
    'Add scrun.dll Microsoft Scripting Runtime) 
    InsertReferences "{420B2830-E718-11CF-893D-00A0C9054228}", 1#, 0 
    'Add msado15.dll Microsoft ActiveX Data Objects 2.8 Library)   
    InsertReferences "{2A75196C-D9EB-4129-B803-931327F72D5C}", 2, 8 
End Sub 

Adapun cara menggunakan kode di atas telah saya bahas disini dan disini. Semoga bermanfaat.

READ MORE - VB6.0 - Code Generator: Add OCX Add DLL Programmatically

Beberapa masalah penggunaan file manifest dan Penyelesaiannya

Penggunaan file manifest untuk meng- Style XP-kan objek-objek Visual Basic 6.0 ternyata memiliki bebearapa masalah, diantaranya:

1. Hilangnya shortcut mnemonic
2. OptionButton dan CheckBox yang disimpan dalam kontainer Frame berubah berwarna hitam mengakibatkan Caption dari dua objek tersebut tidak dapat terbaca.
3. CommandButton yang property style-nya diset pada mode 1-Graphical tidak mau berubah menjadi Style XP.
4. MSCOMCTL.OCX TreeView, ToolBar, dsb tidak mau berubah menjadi Style XP.

Penyelesaian:

• Masalah ke-1: Simpan kode di bawah ini pada module, selanjutnya panggil pada setiap Event Form Load.
  

  Option Explicit 
   
  Private Const WM_CHANGEUISTATE As Long = &H127 
  Private Const UISF_HIDEFOCUS As Integer = &H1 
  Private Const   UISF_HIDEACCEL As Integer = &H2 
  Private Const UIS_CLEAR As Integer = &H2 
   
  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 
   
  Public Sub ShowMnemonic(frm As Form) 
     Dim uiState As Long 
     uiState = MakeLong(UIS_CLEAR, UISF_HIDEFOCUS Or UISF_HIDEACCEL) 
     SendMessage frm.hwnd, WM_CHANGEUISTATE, uiState, ByVal 0 
  End Sub 
   
  Private Function MakeLong(ByVal wLow As Integer, ByVal wHigh As Integer) As Long 
     MakeLong = wHigh * &H10000 + wLow 
  End Function 

• Masalah ke-2: Jangan tempatkan OptionButton dan CheckBox secara langsung di atas Frame, tetapi simpanlah kedua objek tersebut di atas PictureBox, selanjutnya pindahkan PictureBox ini ke dalam Frame.
• Masalah ke-3: Mengenai permasalah ini Anda dapat mengunjugi situs Edanmo (Eduardo A. Morcillo).
• Masalah ke-4: Sudah diselesaikan disini.

READ MORE - Beberapa masalah penggunaan file manifest dan Penyelesaiannya

Menampilkan Dialog Modal Ala Office - Visual Basic 6.0

Yang dimaksud mirip office disini bukan style-nya, akan tetapi cara menampilkan form dialog secara modal. Sebenarnya apa perbedaan dari aplikasi-aplikasi yang sering kita buat dengan office dalam hal menampilkan dialog secara modal? nah, marilah kita praktekan saja ....

Pertama: buka ms office.
Kedua: buka sembarang form dialog (misalnya form options)
Ketiga: klik office main form (tampilan tempat kita menulis)

Apa yang terjadi? ... tidak ada kedipan sama sekali pada options form, dan sepertinya lebih baik dan lebih tampak profesional (dalam hal menampilkan dialog form).
sekarang coba bandingkan dengan kode di bawah ini:
Buatlah 2 Form, Form1 dan Form2, selanjutnya tempatkan kode di bawah ini pada Form1.

Private Sub Command1_Click() 
    Form2.Show vbModal, Me 
End Sub 

Selanjutnya klik Form1, apa yang terjadi? bandingkan dengan dialog options office yang di atas.
Mengapa dialog office seperti demikian? ada beberapa kemungkinan:

Pertama: dialog-dialog yang terdapat pada office bukanlah ChildForm.
Kedua: office menggunakan form dummy sebagai OwnerForm.

Jika aplikasi-aplikasi yang Anda buat ingin seperti di atas, maka cobalah sampel kode di bawah ini:
Buatlah 3 form, Form1, Form2, Form3

Option Explicit 
 
'Kode ini disimpan pada form1 
Private Sub Command1_Click() 
    'tampilkan form2 dengan menggunakan form dummy yakni Form3 
    'disini form2 tidak akan berkedip walaupun anda klik Form1 
    Form2.Show vbModal, Form3 'OwnerForm 
End Sub 

READ MORE - Menampilkan Dialog Modal Ala Office - Visual Basic 6.0