Sunday, May 27, 2012

Menyembunyikan Dan Menampilkan Windows Taskbar

Di bawah ini merupakan contoh standar untuk menyembunyikan dan menampilkan windows taskbar.

Option Explicit 
 
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
 
Const SWP_HIDEWINDOW = &H80 
Const SWP_SHOWWINDOW = &H40 
 
Public Sub HideTaskBar() 
    Dim hWnd1 As Long 
    hWnd1 = FindWindow("Shell_traywnd", "") 
    Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) 
End Sub 
 
Public Sub ShowTaskBar() 
    Dim hWnd1 As Long 
    hWnd1 = FindWindow("Shell_traywnd", "") 
    Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) 
End Sub

Contoh penggunaan untuk menyembunyikan windows taskbar

Private Sub Command1_Click() 
    HideTaskBar 
End Sub

Contoh penggunaan untuk menampilkan windows taskbar

Private Sub Command2_Click() 
    ShowTaskBar 
End Sub

Menampilkan Kotak Dialog ShutDown Menggunakan Fungsi API

Di bawah ini merupakan fungsi API untuk menampilkan kotak dialog shutdown. Fungsi yang digunakan adalah SHShutDownDialog yang terdapat pada Shell32.dll.

Option Explicit 
 
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal sParam As Long) As Long

Contoh penggunaan fungsi API di atas:

Private Sub Command1_Click() 
    SHShutDownDialog 0 
End Sub

Menampilkan Kotak Dialog ShutDown Menggunakan Fungsi API

Di bawah ini merupakan fungsi API untuk menampilkan kotak dialog shutdown. Fungsi yang digunakan adalah SHShutDownDialog yang terdapat pada Shell32.dll.

Option Explicit 
 
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal sParam As Long) As Long

Contoh penggunaan fungsi API di atas:

Private Sub Command1_Click() 
    SHShutDownDialog 0 
End Sub

Drag Form Yang Tidak Memiliki ControlBox

Di bawah ini merupakan fungsi standar (menggunakan fungsi API) untuk men-drag form yang tidak memiliki Control Box.

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 
Private Declare Sub ReleaseCapture Lib "User32" () 
 
Const WM_NCLBUTTONDOWN = &HA1 
Const HTCAPTION = 2 
 
Public Sub DragForm(frm As Form) 
    Dim lngReturnValue As Long 
    Call ReleaseCapture 
    lngReturnValue = SendMessage(frm.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) 
End Sub

Contoh penggunaan drag form yang tidak memiliki controlbox

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    DragForm Me 
End Sub

Fungsi Untuk Memeriksa Resolusi Screen

Di bawah ini merupakan fungsi untuk mengetahui resolusi screen. Bagaimana implementasinya dalam Visual Basic 6.0? bisa kita simak kodenya di bawah ini:

Option Explicit 
Public Function ScreenResolution(iWidth, iHeight) As String 
    iWidth = Screen.Width � Screen.TwipsPerPixelX 
iHeight = Screen.Height � Screen.TwipsPerPixelY 
ScreenResolution = "Screen Resolution:" + vbCrLf + vbCrLf + Str$(iWidth) + " x" + Str$(iHeight) 
End Function

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    Dim intWidth As Integer 
    Dim intHeight As Integer 
    MsgBox ScreenResolution(intWidth, intHeight) 
MsgBox intWidth 
MsgBox intHeight 
End Sub

Fungsi Mengubah Object LeftToRigth Menjadi RightToLeft

Di bawah ini merupakan fungsi untuk mengubah objek yang tidak memiliki properties LeftToRight agar seolah-olah memiliki properties tersebut. Melalui akal-akalan fungsi API, hal tersebut mungkin untuk dilakukan.

Option Explicit 
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 'TreeView1 RightToLeft True 
 
Private Const WS_EX_LAYOUTRTL = 4194304 
Private Const GWL_EXSTYLE = -20 
 
Public Sub ctlRightToLeft(ctl As   Control) 
    SetWindowLong ctl.hWnd, GWL_EXSTYLE, WS_EX_LAYOUTRTL 
End Sub

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    ctlRightToLeft TreeView1 
    TreeView1.Appearance = cc3D 
    TreeView1.BorderStyle = ccFixedSingle 
    TreeView1.Refresh 
End Sub

Coba Anda ganti objeknya misalnya menggunakan Progress Bar, kemudian lihat apa yang terjadi?

Mencari Aplikasi Asosiasi Sebuah File

Di bawah ini merupakan fungsi untuk mencari aplikasi yang diasosiasikan terhadap sebuah file. Bingung? misalnya kita double klik file berektensi .ini maka aplikasinya notepad.exe, double klik file berektensi .doc maka aplikasinya Microsoft Word, dst.

Option Explicit 
 
Private Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpdirectory As String, ByVal lpResult As String) As Long 
Private Const MAX_FILENAME_LEN = 256 
 
Public Function FindExecutable(FileName As String) As String 
   Dim iReturn As Integer 
   Dim sResults As String   
 
   sResults = String(MAX_FILENAME_LEN, 32) & Chr$(0) 
 
   iReturn = FindExecutableA(FileName & Chr$(0), vbNullString, sResults) 
 
   If iReturn > 32 Then 
      FindExecutable = Left$(sResults, InStr(sResults, Chr$(0)) - 1) 
   Else 
      FindExecutable = "" 
   End If 
End Function

Contoh penggunaan fungsi untuk mencari assosiasi sebuah file

Private Sub Form_Load() 
    MsgBox FindExecutable("c:\boot.ini") 
End Sub

Apakah Aplikasi Masih Dalam IDE Visual Basic 6.0

Ini merupakan tricky way (cara yang cerdik) untuk mengetahui apakah sebuah aplikasi masih dalam IDE Visual Basic 6.0 ataukah sudah dicompile. Procedurenya sangat sederhana sekali yakni dengan memanfaatkan handle error.

Public Function IsIDE() As Boolean 
On Error GoTo ErrHandler 
    Debug.Print 1 / 0 
ErrHandler: 
    IsIDE = Err 
End Function

Contoh penggunaan kode di atas:

Private Sub Form_Load() 
    If IsIDE Then 
        MsgBox "Jalankan aplikasi ini dari file .EXE", vbInformation, "Message" 
    End If 
End Sub

Download File Menggunakan IE

Di bawah ini merupakan procedure untuk mendownload sebuah file dengan memanfaatkan file bawaan IE (internet explorer) hdocvw.dll. Bagaimana implementasinya dalam Visual Basic 6.0? bisa Anda simak kodenya di bawah ini:

Option Explicit 
 
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long 
 
Public Sub DownloadFile(URL As String) 
   Dim sDownload As String 
   sDownload = StrConv(Text1.Text, vbUnicode) 
   Call DoFileDownload(sDownload) 
End Sub

Contoh penggunaan procedure di atas:

Private Sub Command1_Click()   
    DownloadFile "http://google.co.id" 
End Sub

Memindahkan File Ke Recycle Bin

Di bawah ini merupakan procedure untuk memindahkan/menghapus file ke dalam recycle bin. Bagaimana kodenya dalam Visual Basic 6.0? bisa kita simak di bawah ini:

Option Explicit 
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long 
 
Private Type SHFILEOPSTRUCT 
    hwnd As Long 
    wFunc As Long 
    pFrom As String 
    pTo As String 
    fFlags As Integer 
    fAnyOperationsAborted As Long 
    hNameMappings As Long 
      lpszProgressTitle As Long 
End Type 
 
Private Const FO_DELETE = &H3 
Private Const FOF_ALLOWUNDO = &H40 
Private Const FOF_NOCONFIRMATION = &H10 
Private Const FOF_SILENT = &H4 
 
Public Sub SendFileToRecycleBin(FileName As String, Optional Confirm As Boolean = True, Optional Silent As Boolean = False) 
    Dim FileOp As SHFILEOPSTRUCT 
 
    With FileOp 
        .wFunc = FO_DELETE 
        .pFrom = FileName 
        .fFlags = FOF_ALLOWUNDO 
        If Not Confirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION 
        If Silent Then .fFlags = .fFlags + FOF_SILENT 
    End With 
    SHFileOperation FileOp 
End Sub

Contoh penggunaan procedure di atas

Private Sub Command1_Click() 
    SendFileToRecycleBin "c:\42.tmp", True, False   
End Sub

Menghapus Seluruh File Yang Ada Dalam Recycle Bin

Di bawah ini merupakan fungsi untuk menghapus seluruh file yang terdapat pada recycle bin. Bagaimana implementasinya dalam Visual Basic 6.0? bisa Anda simak kodenya di bawah ini

Option Explicit 
 
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long 
Const SHERB_NOCONFIRMATION = &H1 
Const SHERB_NOPROGRESSUI = &H2 
Const SHERB_NOSOUND = &H4 
 
Public Sub EmptyRecycleBin(frm As Form) 
    Dim RetVal 
    RetVal = SHEmptyRecycleBin(frm.hWnd, "", SHERB_NOPROGRESSUI + SHERB_NOCONFIRMATION) 
End Sub

Contoh pengunaan procedure di atas

Private Sub Command1_Click() 
    EmptyRecycleBin Me 
End Sub

Menghapus Seluruh File Recent Document

Di bawah ini merupakan procedure untuk menghapus seluruh yang terdapat pada recent document. Untuk keperluan ini digunakan satu fungsi API yakni SHAddToRecentDocs yang terdapat pada shell32.dll.

Option Explicit 
 
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As Any) 
 
Sub EmptyRecentDocument() 
   SHAddToRecentDocs 0, CLng(0) 
End Sub

Contoh penggunaan procedure di atas

Private Sub Command1_Click() 
    EmptyRecentDocument 
End Sub

Fungsi Untuk Memeriksa Apakah Recycle Bin Kosong?

Di bawah ini merupakan fungsi untuk memeriksa apakah recycle bin kosong? Bagaimana implementasinya dalam Visual Basic 6.0? bisa Anda simak kodenya dibawah ini:

Option Explicit 
 
Private Type SHQUERYRBINFO 
    cbSize As Long 
    i64SizeLo As Long 
    i64SizeHi As Long 
    i64NumItemsLo As Long 
    i64NumItemsHi As Long 
End Type 
 
Private Declare Function SHQueryRecycleBin Lib "shell32" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHQUERYRBINFO) As Long 
 
Function IsEmptyRecycle() As Boolean 
    Dim RB As SHQUERYRBINFO 
    RB.cbSize = Len(RB) 
    Call SHQueryRecycleBin("C:\", RB) 
    IsEmptyRecycle = (RB.i64NumItemsLo = 0) 
End Function

Contoh penggunaan fungsi di atas

Private Sub Command1_Click() 
    MsgBox IsEmptyRecycle 
End Sub

Membuat Efek Bayangan Pada Objek

Di bawah ini merupakan fungsi untuk membuat efek bayangan pada sebuah objek. Bagaimana implementasi dalam Visual Basic 6.0? bisa Anda simak kodenya di bawah ini:

Option Explicit 
 
Public Function Shadow(frm As Form, ctl As Control, Optional shWidth = 3, Optional Color = vbGrayed) 
    Dim oldWidth As Integer 
    Dim oldScale As Integer 
 
    With frm 
        oldWidth = .DrawWidth 
        oldScale = .ScaleMode 
        .ScaleMode = 3 
          .DrawWidth = 1 
        frm.Line (ctl.Left + shWidth, ctl.Top + shWidth)-Step(ctl.Width - 1, ctl.Height - 1), Color, BF 
        .DrawWidth = oldWidth 
        .ScaleMode = oldScale 
    End With 
 
End Function

Contoh penggunaan fungsi membuat efek bayangan pada objek

Private Sub Command1_Click() 
    Shadow Me, Command1, 2, vbBlack 
End Sub

Anda dapat menggunakannya pada objek secara bulk dengan menggunakan for...each.

Procedure Untuk Menambahkan File Ke Recent Document

Di bawah ini merupakan procedure untuk menambahkan file ke recent document. Untuk keperluan ini digunakan satu fungsi API yakni SHAddToRecentDocs yang terdapat pada shell32.dll.

Option Explicit 
 
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String) 
 
Public Function AddToRecentDocument(FileName As String) 
  Call SHAddToRecentDocs(3, FileName) 
End Function

Cara menggunakan Fungsi Menambahkan Nama File Ke Recent Documents

Private Sub Command1_Click() 
    AddToRecentDocument "C:\boot.ini" 
End Sub

Mencegah Aplikasi Dijalankan Dua Kali

Di bawah ini merupakan fungsi kedua masih mengenai cara mencegah aplikasi dijalankan dua kali. Bagaimana implementasinya dalam Visual Basic 6.0? bisa Anda simak kodenya di bawah ini:

Option Explicit 
 
Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long 
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long 
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long 
 
Public Const GW_HWNDPREV = 3 
 
Sub ActivatePrevInstance() 
 
    Dim AppTitle As String 
    Dim PrevHndl As Long 
    Dim result As Long 
 
    AppTitle = App.Title 
    App.Title = "unwanted instance" 
 
    If PrevHndl = 0 Then 
        PrevHndl = FindWindow("ThunderRT6Main", AppTitle) 
        If PrevHndl <> 0 Then 
            PrevHndl = GetWindow(PrevHndl, GW_HWNDPREV) 
            result = OpenIcon(PrevHndl) 
            result = SetForegroundWindow(PrevHndl) 
            End 
        End If 
    End If 
 
End Sub

Contoh penggunaan:

Private Sub Form_Load() 
    If App.PrevInstance Then ActivatePrevInstance 
End Sub

Class CRC32 Sebuah File - VB6 Code

Di bawah ini merupakan class untuk mengetahui CRC32 dari sebuah file. Untuk keperluan ini copy dan pastekan kode di bawah ini ke dalam class, kemudian ganti nama kelasnya menjadi clsCRC.

Option Explicit 
 
Private crcTable(0 To 255) As Long 'crc32 
 
Private Function CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long 
 
    Dim lCurPos As Long 
    Dim lTemp As Long 
 
    If lLen = 0 Then Exit Function 'In case of empty file 
    lTemp = lcrc Xor &HFFFFFFFF 'lcrc is for current value from partial check on the partial array 
 
    For lCurPos = 0 To lLen 
        lTemp = (((lTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos))) 
    Next lCurPos 
 
    CRC32 = lTemp Xor &HFFFFFFFF 
 
End Function 
 
Private Function BuildTable() As Boolean 
 
    Dim I As Long, x As Long, crc As Long 
    Const Limit = &HEDB88320 'usally its shown backward, cant remember what it was. 
 
    For I = 0 To 255 
        crc = I 
        For x = 0 To 7 
            If crc And 1 Then 
                crc = (((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor Limit 
            Else 
                crc = ((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF 
            End If 
        Next x 
        crcTable(I) = crc 
    Next I 
 
End Function 
 
Private Sub Class_Initialize() 
    BuildTable 
End Sub 
 
Public Function CekCRC32(FileName As String) As String 
 
    Dim lngCrc As Long 
    Dim sCrc As Long 
 
    On Error GoTo ErrHandler 
 
    Open FileName For Binary Access Read As #1 
    ReDim tmp(LOF(1)) As Byte 
    Get #1, , tmp() 
    Close #1 
 
    lngCrc = UBound(tmp) 
    lngCrc = CRC32(tmp, lngCrc) 
    CekCRC32 = Hex(lngCrc) 
 
    Exit Function 
 
    ErrHandler: 
 
    MsgBox Err.Description, vbCritical, "Error" 
 
End Function

Contoh penggunaan Class CRC32

Option Explicit 
 
Private Sub Form_Load() 
    Dim crc As New clsCRC 
    MsgBox crc.CekCRC32("C:\boot.ini") 
End Sub

Mencegah Aplikasi Dijalankan Dua Kali

Di bawah ini merupakan cara termudah untuk mencegah sebuah aplikasi dijalankan dua kali (double instance). Bagaimana implementasinya dalam Visual Basic 6.0? Simaklah kodenya di bawah ini.

Option Explicit  
  
Private Sub ActivatePrevInstance()  
    AppActivate App.Title  
    SendKeys "+", True  
    End  
End Sub

Contoh penggunaan procedure di atas:

Private Sub Form_Load()  
    If App.PrevInstance Then ActivatePrevInstance  
End Sub

Merubah Waktu Double Klik Pada Mouse

Di bawah ini merupakan fungsi untuk merubah waktu double klik pada mouse. Bagaimana implementasinya dalam Visual Basic 6.0? Simaklah kodenya di bawah ini.

Option Explicit 
 
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long 
 
Public Function ChangeDBClkTime(Time As Integer) 
    SetDoubleClickTime (Time) 
End Function

Contoh penggunaan:

Private Sub Command1_Click() 
    Call ChangeDBClkTime(1000) 
End Sub

Memeriksa Apakah Mouse Terinstall Pada Komputer Anda

Di bawah ini merupakan fungsi untuk memeriksa apakah mouse terinstall pada komputer Anda. Bagaimana implementasinya dalam Visual Basic 6.0? simaklah kodenya di bawah ini.

Option Explicit 
 
Private Const SM_CMOUSEBUTTONS = 43 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
 
Public Function IsMousePresent() As Boolean 
    IsMousePresent = (GetSystemMetrics(SM_CMOUSEBUTTONS) > 0) 
End Function

Contoh penggunaan:

Private Sub Command1_Click() 
    MsgBox IsMousePresent 
End Sub

Memindahkan Seluruh File Dalam Satu Directory

Di bawah ini merupakan fungsi untuk memindahkan seluruh file dari satu directory tertentu. Untuk keperluan ini Anda harus mereferensi pada objek Microsoft Scripting Runtime atau scrun.dll.

Option Explicit 
 
Public Function MoveAllFiles() 
    Dim fso As New FileSystemObject 
    Call fso.MoveFolder(Source, Destination) 
    Set fso = Nothing 
End Function

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    Call MoveAllFiles("C:\djview", "D:\djview") 
End Sub

Mengcopy Seluruh File dalam Satu Directory

Di bawah ini merupakan fungsi untuk meng-copy seluruh file dari satu directory tertentu. Untuk keperluan ini Anda harus mereferensi pada objek Microsoft Scripting Runtime atau scrun.dll.

Option Explicit 
 
Public Function CopyAllFiles(Source As String, Destination As String) 
    Dim fso As New FileSystemObject 
    Call fso.CopyFolder(Source, Destination) 
    Set fso = Nothing 
End Function

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    Call CopyAllFiles("C:\djview", "D:\djview") 
End Sub

Memperoleh Jumlah Tombol Yang Terdapat Pada Mouse

Di bawah ini merupakan fungsi untuk mengetahui jumlah tombol yang terdapat pada mouse.

Option Explicit 
 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
Private Const SM_CMOUSEBUTTONS As Long = 43 
 
Public Function ButtonMouse() 
    ButtonMouse = GetSystemMetrics(SM_CMOUSEBUTTONS) 
End Function

Contoh penggunaan:

Private Sub Command1_Click() 
    MsgBox ButtonMouse 
End Sub

VB6 Code - Konversi Warna dari RGB Ke Long

Di bawah ini merupakan fungsi untuk meng-konversi warna dari rgb (red, green, blue) ke Long. Bagaimana implementasinya dalam Visual Basic 6.0? simak kodenya di bawah ini:

Public Function RGBToLong(Red As Integer, Green As Integer, Blue As Integer) 
    RGBToLong = RGB(Red, Green, Blue) 
End Function

Contoh penggunaan fungsi konversi warna dari RGB ke Long

Private Sub Command1_Click() 
    MsgBox RGB(8, 12, 254) 
End Sub

VB6 Code - Konversi Warna dari QBColor ke RGB

Di bawah ini merupakan fungsi untuk meng-konversi warna dari QBColor ke RGB. Bagaimana implementasinya dalam Visual Basic 6.0? simak kodenya di bawah ini:

Public Sub QBColorToRGB(QBColorValue As Integer)      
     QBColorToRGB = LongToRGB(QBColor(QBColorValue))  
End Sub

VB6 Code - Konversi Warna dari RGB ke HEX

Di bawah ini merupakan fungsi untuk meng-konversi warna dari rgb (red, green, blue) ke Hex. Bagaimana implementasinya dalam Visual Basic 6.0? simak kodenya di bawah ini:

Public Function RGBToHex(Red As Integer, Green As Integer, Blue As Integer) 
    RGBToHex = Right(0 & Hex(Red), 2) & Right(0 & Hex(Green), 2) & Right(0 & Hex(Blue), 2) 
End Function

Contoh penggunaan fungsi konversi warna dari RGB ke HEX

Private Sub Command1_Click() 
    MsgBox RGBToHex(0, 0, 12) 
End Sub

VB6 Code - Konversi Warna Long Ke RGB

Di bawah ini merupakan fungsi untuk meng-konversi warna dari long ke rgb (red, green, blue). Bagaimana implementasinya dalam Visual Basic 6.0? simak kodenya di bawah ini:

Public Sub LongToRGB(Color As Long, Red, Green, Blue)  
    Blue = Color \ 65536  
    Green = (Color - Blue * 65536) \ 256  
    Red = Color - (Blue * 65536) - (Green * 256)  
End Sub

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click()   
    Dim red 
    Dim green 
    Dim blue 
    Call LongToRGB(CLng("23489"), red, green, blue) 
    MsgBox red & "," & green & "," & blue 
End Sub

Konversii Angka Dari Hexa ke Decimal dan Sebaliknya

Di bawah ini merupakan fungsi untuk mengkonversi angka dari hexadecimal ke decimal dan sebaliknya.

Option Explicit 
 
Public Function DecToHex(DecNumber) 
    DecToHex = Hex(DecNumber) 
End Function 
 
Public Function HexToDec(HexNumber) 
    HexToDec = Val(&quot;&amp;H&quot; &amp; HexNumber) 
End Function

Contoh penggunaan Konversi angka dari decimal ke hexa

Private Sub Form_Load() 
    MsgBox DecToHex(120000) 
End Sub  Contoh

penggunaan konversi angka dari hexa ke decimal

Private Sub Form_Load() 
    MsgBox HexToDec(120000) 
End Sub

Menyembunyikan dan Menampilkan Pointer Mouse

Di bawah ini merupakan procedure untuk menyembunyikan dan menampilkan pointer mouse. Bagaimana implementasinya dalam Visual Basic 6.0, simaklah kodenya di bawah ini:

Option Explicit 
 
Private Declare Function ShowCursor Lib &amp;amp;amp;quot;user32&amp;amp;amp;quot; ByVal bShow As Long) As Long 
 
Sub ShowMouseCursor(bShow As Boolean) 
    ShowCursor bShow 
End Sub

Dua contoh penggunaan menyembunyikan dan menampilkan pointer mouse

Private Sub Check1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
      ShowMouseCursor Check1.Value = 0) 
End Sub 
 
Private Sub Command1_Click() 
    ShowMouseCursor True 
End Sub

Menampilkan Vertical ScrollBar Pada TextBox Pada Saat Runtime

Di bawah ini merupakan fungsi untuk menampilkan Vertical ScrollBar pada TextBox.

Option Explicit 
 
Private Declare Function ShowScrollBar Lib "user32" ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long 
 
Public Function ShowScroll(obj As Control, bShow As Boolean) 
    ShowScrollBar obj.hwnd, 1, bShow 
    obj.Refresh 
End Function

Contoh penggunaan kode di atas:

Public Sub Command1_Click()   
     ShowScroll Text1, True 
End Sub

Menggerakan Pointer Mouse Pada Koordinat Tertentu

Di bawah ini merupakan fungsi untuk menggerakan pointer mouse pada koordinat tertentu.

Private Declare Function SetCursorPos Lib "User32" ByVal X As Long, ByVal Y As Long) As Long 
'Contoh penggunaan code untuk menggerakan pointer mouse pada koordinat tertentu 
Private Sub Command1_Click() 
    Call SetCursorPos(100, 200) 
End Sub

Menukarkan Tombol Mouse

Di bawah ini merupakan procedure untuk menukarkan tombol mouse, dari kiri ke kanan dan sebaliknya. Bagaimana implementasinya dalam Visual Basic 6.0, simaklah kodenya di bawah ini:

Option Explicit 
 
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long 
 
Public Sub SwapMouse(bSwap As Boolean) 
    SwapMouseButton bSwap 
End Sub

Dua contoh penggunaan menukarkan tombol mouse

Private Sub Check1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    SwapMouse (Check1.Value=0)   
End Sub 
 
Private Sub Command1_Click() 
    SwapMouse True 
End Sub

Menutup Seluruh Aplikasi Yang Sedang Berjalan

Di bawah ini merupakan fungsi untuk menutup seluruh aplikasi yang sedang berjalan. Mengapa seluruh aplikasi yang sedang berjalan tersebut harus ditutup? contoh kecilnya dalam pembuatan billing warnet. Misalnya A (user) log-out, kemudian datang B (user baru) log-in, B tidak akan melihat aplikasi-aplikasi yang masih terbuka (kemungkinan lupa ditutup oleh A), karena seluruh aplikasi yang sedang berjalan telah ditutup secara otomatis dengan fungsi di bawah ini.
Mungkin ada pertanyaan, Apakah ditutup dengan software billing warnetnya juga? ya, boleh jika kita mau, bahkan sekalian di shutdown pula.

Option Explicit 
 
Public Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, _ 
ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long 
Public Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long) 
Public Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long 
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As   String, ByVal lpsz2 As String) As Long 
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
Public Declare Function TerminateProcess& Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) 
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 
   
Public Const SMTO_BLOCK = &H1 
Public Const SMTO_ABORTIFHUNG = &H2 
Public Const SC_CLOSE = &HF060& 
Public Const WM_SYSCOMMAND = &H112 
Public Const WM_NULL = &H0 
Public Const PROCESS_ALL_ACCESS = &H1F0FFF 
 
Public HWND_Taskbar As Long 
Public HWND_Desktop As Long 
Public HWND_ExplorerW As Long 
 
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long 
 
    Dim lThreadID As Long 
    Dim lPid As Long 
    Dim lHp As Long 
 
    If hwnd <> HWND_Taskbar And hwnd <> HWND_Desktop And hwnd <> HWND_ExplorerW Then 
    lThreadID = GetWindowThreadProcessId(hwnd, lPid) 
        If lThreadID <> App.ThreadID Then 
            If IsWindowVisible(hwnd) Then 
                SendMessageTimeout hwnd, WM_SYSCOMMAND, SC_CLOSE, 0, 0, 500, 0 
                If IsWindow(hwnd) Then 
                      lHp = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPid) 
                    TerminateProcess lHp&, 0& 
                    CloseHandle lHp 
                End If 
            End If 
        End If 
    End If 
 
    EnumWindowsProc = 1 
 
End Function 
 
Public Sub CloseAllRuning() 
    HWND_Desktop = FindWindowEx(0&, 0&, "Progman", vbNullString) 
    HWND_Taskbar = FindWindowEx(0&, 0&, "Shell_TrayWnd", vbNullString) 
    EnumWindows AddressOf EnumWindowsProc, 0&   
End Sub

Contoh Penggunaan fungsi untuk menutup seluruh aplikasi

Sub Main() 
      Call CloseAllRuning 
End Sub

Fungsi Untuk Menghancurkan File

Di bawah ini merupakan fungsi untuk menghancurkan file. Maksud dari fungsi ini, agar file yang sudah dihapus/dihancurkan, tidak dapat direcover dengan software-software recovery.
Core function dari fungsi penghancur file ini hanyalah 3 line code, yaitu:

Open Filename For Output As #1 
        Print #1, "Sorry, destroyed....." 
Close #1

Adapun fungsi lengkapnya serta cara penggunaannya:

Option Explicit 
 
Public Function DestroyFile(Filename As String) 
    Open Filename For Output As #1 
        Print #1, "Sorry, destroyed....." 
    Close #1   
End Function

Cara penggunaan Fungsi Untuk Menghancurkan File

Private Sub Command1_Click() 
    Call DestroyFile("C:\hancur.jpg") 
End Sub

Di atas merupakan cara penggunaan yang sederhana, dalam kenyataannya Anda dapat memodifikasi penggunaan, sehingga bisa digunakan untuk bulk files destroyer.

Meng-Capture Screen .bmp atau .jpg Menggunakan ezCapture.dll

Di bawah ini merupakan fungsi untuk meng-capture (mengambil) gambar screen dalam format .bmp atau format .jpg dengan menggunakan ActiveX ezCapture.dll. Untuk keperluan ini tentu saja Anda harus memiliki dll ezCapture.dll kemudian mereferensikan project Anda terhadapnya. Mengenai ezCapture.dll bisa Anda download di sini.
Fungsi untuk meng-Capture screen dalam format .bmp

Option Explicit 
 
Sub CaptureScreenBMP() 
   Dim ezCapture As New CaptureScreen 
   On Error Resume Next 
   With ezCapture 
        .CaptureFullScreen "C:\screen.bmp" 
   End With 
End Sub

Fungsi untuk meng-Capture screen dalam format .jpg

Sub CaptureScreenJPG()   
   Dim ezCapture As New CaptureScreen 
   With ezCapture 
        .CaptureFullScreen "C:\screen.jpg" 
   End With 
End Sub

Contoh penggunaan fungsi capture screen .bmp

Private Sub Command1_Click() 
    CaptureScreenBMP 
End Sub

Contoh penggunaan fungsi capture screen .jpg.
Untuk keperluan ini Anda membutuhkan satu file lagi yakni "ijl11.dll"

Private Sub Command2_Click() 
    CaptureScreenJPG 
End Sub

Fungsi Untuk Menjalankan File .wav Menggunakan Visual Basic 6.0

Di bawah ini merupakan fungsi untuk menjalankan file .wav dengan menggunakan Visual Basic 6.0 disertai dengan beberapa argumen yang dibutuhkan.

Option Explicit 
 
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long 
 
Public Enum SoundOption 
    SND_SYNC = &H0 
    SND_ASYNC = &H1 
    SND_NODEFAULT = &H2 
    SND_LOOP = &H8 
    SND_NOSTOP = &H10   
End Enum 
 
Public Sub PlaySound(Filename As String, Optional OpsiSound As SoundOption = SND_ASYNC Or SND_NODEFAULT) 
    Dim sThewavsound As String, ret As Long 
    sThewavsound = Filename 
    ret = sndPlaySound(sThewavsound, OpsiSound) 
End Sub 
Contoh Penggunaan fungsi menjalankan file .wav menggunakan visual basic 6.0 
Private Sub Command1_Click() 
    PlaySound Text1.Text, SND_ASYNC 
End Sub

Fungsi Untuk Mendapatkan Source HTML dari URL Tertentu

Di bawah ini merupakan fungsi untuk mendapatkan source code HTML dari URL tertentu.

Option Explicit 
 
Function GetSource(ByVal URL As String) As String 
 
    MousePointer = vbHourglass 
 
    Dim Data() As Byte 
    Dim sText As String 
    Dim i As Long 
 
    Data() = Inet1.OpenURL(URL) 
 
    sText = Data() 
    GetSource = sText 
 
    MousePointer = vbDefault 
   
End Function

Cara penggunaan fungsi di atas:

Private Sub Command1_Click() 
    Dim sUrl As String 
    sUrl = Text1.Text 
    Text2.Text = GetSource(sUrl) 
End Sub

Untuk tujuan tertentu, maka dengan sedikit modifikasi tentu saja Anda dapat menyimpannya ke dalam hardisk Anda.

Fungsi Untuk Menghapus Seluruh Komentar Visual Basic 6.0

Di bawah ini merupakan fungsi untuk menghapus seluruh komentar yang terdapat dalam source code Visual Basic 6.0. Kami membuatnya menjadi dua fungsi, fungsi pertama untuk menghapus seluruh komentar sedangkan fungsi yang kedua untuk menghapus seluruh line kosong. Berikut kodenya di bawah ini:
Di bawah ini merupakan fungsi untuk menghapus seluruh komentar yang terdapat dalam Visual Basic 6.0:

Option Explicit 
 
Function DeleteAllComment(sText As String) As String 
     
    Dim str As String 
    Dim vArray As Variant 
    Dim g As String 
    Dim i As Integer 
    Dim x As Integer 
    Dim w As Integer 
    Dim u As String 
    Dim y As Integer 
     
    str =   sText 
    vArray = Split(str, vbCrLf) 
 
    For i = LBound(vArray) To UBound(vArray) 
     
            If Trim(Right(vArray(i), 1)) = "_" Then 
                 
                Do While Trim(Right(vArray(i + w), 1)) = "_" 
                     
                    If w > 0 Then 
                       vArray(i) = vArray(i) & Left(vArray(i + w), Len(vArray(i + w)) - 1) & " " 
                         vArray(i + w) = "'" 
                    Else 
                       vArray(i) = Left(vArray(i), Len(vArray(i)) - 1) 
                    End If 
                     
                    w = w + 1 
                     
                Loop 
                 
                vArray(i) = vArray(i) & Left(vArray(i + w), Len(vArray(i + w))) & " " 
                vArray(i + w) = "'" 
                 
              End If 
          
            w = 0 
          
            y = InStr(1, vArray(i), Chr(34) & "'" & Chr(34)) 
            x = InStr(1, vArray(i), "'") 
             
            If x > 0 Then 
                
               If (y = 0) Then 
                
                   If Right(vArray(i), 1) = "_" Then 
                       Do While Right(vArray(i + w), 1) = "_" 
                           If w > 0 Then vArray(i +   w) = "'" 
                           w = w + 1 
                       Loop 
                       vArray(i + w) = "'" 
                   End If 
                    
                   If Trim(Mid(vArray(i), 1, x)) <> "'" Then 
                        
                       If Right(Mid(vArray(i), 1, x), 1) = "'" Then 
                           g = g & Left(Mid(vArray(i), 1, x), Len(Mid(vArray(i), 1, x)) - 1) & vbCrLf 
                       Else 
                           g = g &   Mid(vArray(i), 1, x) & vbCrLf 
                       End If 
                        
                   End If 
                    
                Else 
                   g = g & vArray(i) & vbCrLf 
                End If 
             Else 
                g = g & vArray(i) & vbCrLf 
            End If 
 
    Next 
     
    DeleteAllComment = g 
     
End Function

Di bawah ini merupakan fungsi untuk menghapus seluruh jajaran kosong (blank line)

Function DeleteBlankLine(sText As String) As String 
 
    Dim str As String   
    Dim vArray As Variant 
    Dim i As Integer 
    Dim g As String 
 
    str = sText 
    vArray = Split(sText, vbCrLf) 
 
    For i = LBound(vArray) To UBound(vArray) 
 
        If Trim(vArray(i)) <> "" Then 
            g = g & vArray(i) & vbCrLf 
        End If 
 
    Next 
 
    DeleteBlankLine = g 
 
End Function

Cara penggunaan:

Option Explicit 
 
Private Sub Command1_Click() 
    Dim str As String 
    str = DeleteAllComment(Text1.Text) 
    Text2.Text = DeleteBlankLine(str) 
End Sub

Fungsi Encode dan Decode Tag HTML

Kode HTML yang dituliskan dalam sebuah tulisan/postingan tentu saja tidak dapat ditulis secara langsung tetapi harus dikonversi terlebih dahulu agar format tulisannya sesuai dengan apa yang diharapkan. Perlu kita ketahui bahwa mesin penerjemah (compiler) akan menganggap tulisannya merupakan kode HTML dan menerjemahkannya, padahal yang kita maksud adalah tulisan, tulisan yang mengandung kode HTML . Dibawah ini merupakan fungsi encode dan decode tag HTML yang bisa Anda gunakan ketika membuat tulisan/postingan yang melibatkan banyak kode/tag HTML.

Option Explicit 
 
Dim EncodeTag() As String 
Dim DecodeTag() As String 
 
Enum eType 
    Decode 
    Encode 
End Enum 
 
Public Function   EncDecTag(strText As String, EncDec As eType) As String 
    Dim i As Integer 
    InitTagArray 
    For i = LBound(EncodeTag) To UBound(EncodeTag) 
        If EncDec = Encode Then 
            strText = Replace(strText, EncodeTag(i), DecodeTag(i), , , vbTextCompare) 
        Else 
            strText = Replace(strText, DecodeTag(i), EncodeTag(i), , , vbTextCompare) 
        End If 
    Next 
    EncDecTag = strText 
End Function 
 
Private Function InitTagArray() 
    Dim EncTag As String 
    Dim DecTag As String 
    EncTag = &quot;&amp;,<,>,&quot; &amp; Chr(34) &amp; &quot;,&plusmn;&quot; 
    DecTag = &quot;&amp;amp;,&amp;lt;,&amp;gt;,&amp;quot;,&amp;plusmn;&quot; 
    EncodeTag = Split(EncTag, &quot;,&quot;) 
    DecodeTag = Split(LCase(DecTag), &quot;,&quot;) 
End Function

Cara Penggunaan Fungsi Encode dan Decode Tag HTML

Private   Sub Command1_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Decode) 
End Sub 
 
Private Sub Command2_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Encode) 
End Sub

Cara Termudah Untuk Mengisi Seluruh Fonts Ke dalam ListBox

Di bawah ini merupakan fungsi untuk mengisi seluruh fonts yang ada dalam komputer Anda ke dalam objek ListBox

Public Function LoadAllFonts(lst As Control) 
    Dim i As Integer 
    For i = 1 To 1000 
        If Screen.Fonts(i) = "" Then Exit For 
        lst.AddItem Screen.Fonts(i) 
    Next i 
End Function

Contoh penggunaan fungsi untuk mengisi seluruh fonts ke dalam ListBox

Private Sub Form_Load() 
    LoadAllFonts List1 
End Sub

Fungsi Compressor CSS Opsi Super Compact | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi super compact. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css compress ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi super compact

Option Explicit 
 
Function CSSCompressSuperCompact(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "")   
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
    Next 
    CSSCompressSuperCompact = sTextCSS 
End Function

Contoh penggunaan css compress opsi super compact

Private Sub   Command1_Click() 
    Text1.Text = CSSCompressSuperCompact(Text1.Text) 
End Sub

Fungsi CSS Decompress Untuk Editing | Visual Basic 6.0

Artikel ini berjudul fungsi css decompress untuk editing. Maksud dari css decompress untuk editing ialah sebuah fungsi (procedure) yang digunakan untuk mengembalikan format css yang telah dicompress. Kita tahu bahwa css yang telah dicompress tentu saja akan menyulitkan pada saat kita ingin mengeditnya kembali. Bagaimana fungsi css decompress ini?

Fungsi css decompress untuk editing

Option Explicit 
 
Public Function CSSDecompress(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = CSSDelSpace(sText) 
    sTextCSS = Replace(sTextCSS, "{", "{" & vbCrLf) 
    sTextCSS = Replace(sTextCSS, "}", "}" & vbCrLf & vbCrLf) 
    sTextCSS = Replace(sTextCSS, ";", ";" & vbCrLf) 
    CSSDecompress = sTextCSS 
End Function 
 
Private Function CSSDelSpace(sText As String) As String 
    Dim sTextCSS As String 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    CSSDelSpace = sTextCSS 
End Function

Contoh penggunaan fungsi css decompress untuk editing

Private Sub Command2_Click() 
    Text1.Text = CSSDecompress(Text1.Text) 
End Sub

Fungsi Untuk Compressor CSS Opsi Normal | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi normal. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css compress ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi normal

Option Explicit 
 
Function CSSCompressNormal(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    sTextCSS = Replace(sTextCSS, "}", "}" & vbCrLf) 
    sTextCSS = Replace(sTextCSS, "*/", "*/" & vbCrLf) 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
      Next 
    CSSCompressNormal = sTextCSS 
End Function

Contoh penggunaan css compress opsi normal

Private Sub Command1_Click() 
    Text1.Text = CSSCompressNormal(Text1.Text) 
End Sub

Fungsi CSS Compressor Opsi Light | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi light. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi light

Option Explicit 
 
Public Function CSSCompressLight(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
    Next 
    CSSCompressLight = sTextCSS 
End Function

Cara penggunaan fungsi css compress opsi light

Private Sub Command1_Click() 
    Text1.Text = CSSCompress(Text1.Text) 
End Sub

Fungsi Untuk Mengganti Extention Sebuah File | Visual Basic 6.0

Mengenai fungsi untuk mengganti extention sebuah file menggunakan kode VB6 - Bagaimanakah cara mengganti sebuah ekstensien pada file tanpa merubah nama file itu sendiri, misalnya file.zip menjadi file.rar atau file.exe.

Public Function ChangeFileExt(ByVal FileName As String, ByVal Extention As String) 
    Dim str() As String, NewFile As String 
    If InStr(1, FileName, ".") Then 
        str = Split(FileName, ".") 
        NewFile = Replace(FileName, str(UBound(str)), Extention) 
        Name FileName As NewFile 
    Else 
        Name FileName As FileName & "." & Extention 
    End If 
End Function

Adapun cara penggunaan fungsi mengganti extension sebuah file adalah sebagai berikut:

Private Sub Form_Load() 
    Call ChangeFileExt("C:\bo.ot.tmp", "exe") 
End Sub

TextBox Hanya Untuk Numeric | Visual Basic 6.0

Artikel ini diberi judul textbox hanya untuk numeric, maksudnya ialah sebuah TextBox hanya dapat diisi dengan angka saja. Kodenya kami buat menjadi sebuah fungsi agar lebih mudah dalam penggunaan. Adapun kode yang dimaksud:

Option Explicit 
 
Private Sub OnlyNumeric(KeyAscii As Integer) 
 
    Select Case KeyAscii 
        Case 48 To 57         ' numeric 
        Case 8                ' backspace 
        Case Else: KeyAscii = 0 
    End Select 
 
End Sub

Cara penggunaan Fungsi TextBox hanya untuk numerik

Private Sub Text1_KeyPress(KeyAscii As Integer) 
    OnlyNumeric KeyAscii 
End Sub

Generator Timestamp ISO 8601 Compliant - VB6 Code

Di bawah ini merupakan fungsi Visual Basic 6.0 untuk melakukan generate timestamp (oauth_timestamp dalam Google atau Twitter) yang dibutuhkan pada saat kita melakukan request terhadap situs affiliate Amazon bersamaan dengan signature yang valid. Fungsi di bawah saya peroleh dari vbhelper. Adapun kode untuk Amazon timestamp tersebut adalah sebagai berikut:

Option Explicit 
 
Private Declare Sub GetSystemTime Lib "kernel32.dll" (lpSystemTime As SYSTEMTIME) 
  
Private Type SYSTEMTIME 
    wYear As Integer 
    wMonth As Integer 
    wDayOfWeek As Integer 
    wDay As Integer 
    wHour As Integer 
    wMinute As Integer 
    wSecond As Integer 
    wMilliseconds As Integer 
End Type 
  
' Return an ISO 8601 compliant timestamp. 
Private Function GetIsoTimestamp() As String 
Dim st As SYSTEMTIME 
  
'  Get the local date and time. 
    GetSystemTime st 
    '  Format the result. 
    GetIsoTimestamp = _ 
        Format$(st.wYear, "0000") & "-" & _ 
        Format$(st.wMonth, "00") & "-" & _ 
        Format$(st.wDay, "00") & "T" & _ 
        Format$(st.wHour, "00") & ":" & _ 
        Format$(st.wMinute, "00") & ":" & _ 
        Format$(st.wSecond, "00") & "Z" 
End Function

Tools Amazon yang dapat membantu Anda dalam hal ini (membuat signature valid untuk request): http://associates-amazon.s3.amazonaws.com/signed-requests/helper/index.html
Keterangan mengenai pembuatan signature: http://docs.amazonwebservices.com/AlexaTopSites/latest/index.html?CalculatingSignatures.html

Mendisablekan Seluruh Objek Yang Terdapat Pada PictureBox

Setelah sebelumnya kita mengetahui cara merubah .Caption dan ukuran Form, maka sekarang kita beralih topik mengenai cara mendisablekan seluruh objek yang terdapat pada PictureBox atau Frame. Jadi judul yang lebih tepat adalah mendisablekan seluruh objek yang terdapat pada PictureBox atau Frame menggunakan kode.

Sebelumnya ada beberapa hal yang harus diketahui, bahwa Form itu merupakan sebuah Container atau bisa disebut juga koleksi (Collection) demikian pula PictureBox dan Frame. Karena mereka (Form, PictureBox, Frame) adalah sebuah kontainer maka mereka dapat menampung objek-objek lain, sebagai contoh: apabila kita membuat sebuah Form dan pada Form tersebut kita tempatkan PictureBox maka bisa dikatakan: Kontainer Form menampung objek PictureBox. Dan apabila kita tempatkan sebuah CommandButton pada PictureBox tersebut, maka bisa dikatakan bahwa kontainer PictureBox menampung sebuah objek CommandButton.

Pada umumnya sebuah kontainer atau koleksi diperlengkapi dengan kode (dulu pada saat pembuatan) agar bisa memanggil objek secara sekaligus menggunakan perulangan For ... Each. Sebagai contoh:

    Dim c As Control 'Deklarasikan bahwa variabel c adalah Control bukan embe atau kucing. 
    For Each c In Me.Controls 
        If TypeOf c Is CommandButton Then 
            c.Enabled = False 'disablekan 
        End If 
    Next

Apabila diterjemahkan maka kira-kira sebagai berikut: Jadikan variabel c sebagai Control bukang string, integer, embe, atau kucing. Untuk setiap c (Control) yang berada pada Container (Me.Controls) [lakukan:] disablekan c (c.Enabled = False).

Dengan memahami yang telah dijelaskan di atas, sekarang bagaimana jika kita ingin mendisablekan seluruh objek yang terdapat pada PictureBox (saja) tanpa mendisablekan objek-objek yang berada di luar PictureBox. Berikur merupakan salah satu contohnya:

Private Sub Command1_Click() 
    Dim c As Control 'deklarasikan bahwa variabel c adalah Contol ehm..ehm.. Control 
    For Each c In Me.Controls 
        If c.Container.Name = "Picture1" Then 
            c.Enabled = False 
        End If 
    Next 
End Sub

Untuk setiap c (control) yang berada pada container [lakukan] jika nama kontainernya adalah Picture1 [pengecualian] maka disablekan c (c.Enabled = False).

Saturday, May 26, 2012

Merubah Caption dan Ukuran Sebuah Form - VB6

Apa yang dimaksud dengan property .Caption? secara definisi yang mudah dipahami, property .Caption pada sebuah Form adalah tulisan yang terdapat pada sisi bagian kiri. Definisi tersebut berlaku bagi Anda orang Amerika, Indonesia dan sebagainya. Sedangkan jika Anda orang Arab atau Mesir maka Caption pada Form adalah tulisan yang berada pada sisi kanan bagian atas. Secara default pada saat kita menambahkan sebuah Form maka pada Form tersebut Captionnya akan bertuliskan Form1, kemudian kita tambah lagi Formnya maka akan bertuliskan Form2 dan seterusnya.

Apa yang dimaksud ukuran dalam sebuah form pada judul di atas? yang dimaksud dengan ukuran pada sebuah form adalah property .Height dan property .Weight. Nah, pada posting kali ini saya akan mendemokan bagaimana cara merubah property .Caption, property .Height, dan property .Weight secara bersamaan menggunakan kode. Adapun kodenya adalah sebagai berikut:

Option Explicit 
   
Private Sub Command1_Click() 
    Form1.Caption = "Test" 'rubah property .Caption menjadi Test asalnya Form1 
    Form1.Width = 2500 'ganti nilai pada property .Width menjadi 2500 
    Form1.Height = 3000 'ganti nilai pada property .Height menjadi 3000 
End Sub

Demikianlah cara merubah property .Caption, property .Height, dan property .Width secara bersamaan menggunakan kode bahasa pemrograman Visual Basic 6.0

Merubah Nilai (Property .Value) CheckBox Menggunakan Kode - VB6

Setelah memposting cara menukar Caption CommandButton, sekarang kita beralih object pada object CheckBox. Perlu diketahui bahwa property .Value yang terdapat pada object CheckBox nilainya bisa kira rubah secara pemrograman (melalui kode). Bagaimanakah cara merubah property .Value pada object CheckBox dari bernilai 0 menjadi bernilai 1 atau dari bernilai 1 menjadi bernilai 0 melalui Code VB6.0.

Berikut merupakan source code untuk merubah property .Value yang terdapat pada CheckBox menggunakan kode bahasa pemrograman Visual Basic 6.0.

Option Explicit 
 
Private Sub Command1_Click() 
    Check1.Value = 1 'menjadi bernilai 1 (tercentang) 
End Sub

Sederhana sekali bukan? nah, demikianlah cara merubah property .Value yang terdapat pada object CheckBox menggunakan kode bahasa pemrograman Visual Basic 6.0. Semoga bermanfaat.

Subscribe to: Posts ( Atom )

Sunday, May 27, 2012

Saturday, May 26, 2012

Perhatian

Page Rank

Online

Statistik Pengunjung

embrio9 - Auto Reply

Blog Archive

Visual Basic 6.0

Arabic

Blogging

Miscellaneous