PathCompactPathEx - Untuk Menyingkat Nama Path - VB6

Dalam membuat sebuah program, terkadang kita membutuhkan nama path yang disingkat, adapun tujuannya, agar nama yang berada paling akhir dapat kita baca. Lagipula jika path tidak disingkat, mungkin kita akan menemukan MRU (Most Recently Used) seperti pada gambar di bawah ini: (sebenarnya tidak se-ekstrim itu, hanya saja saya membuatnya menjadi panjang)

Untuk menyingkat nama path, kita membuhtuhkan fungsi API PathCompactPathEx. Berikut merupakan contoh kode untuk menyingkat nama path:

Option Explicit 
 
Private Declare Function PathCompactPathEx Lib "shlwapi.dll" Alias "PathCompactPathExA" ByVal pszOut As String, ByVal pszSrc As String, ByVal cchMax As Long, ByVal dwFlags As Long) As Long 
 
'simpan dalam modul 
Public Function ShortFilePath(FilePath As String, Optional MaxLen As Long = 40) As String 
    Dim ShortPath As String 
    On Error Resume Next 
    ShortPath = String(255, 0) 
    PathCompactPathEx ShortPath, FilePath, MaxLen, 0 
    ShortFilePath = ShortPath 
End Function 

Contoh penggunaan prosedur di atas:

Private Sub Form_Load() 
    Text1.Text = ShortFilePath("F:\Project\Outlook Bar control + Photoshop Color Picker v1.3.2\3. Samples\Images") 
    'akan menghasilkan "F:\Project\Outlook Bar   con...\Images" 
End Sub 

READ MORE - PathCompactPathEx - Untuk Menyingkat Nama Path - VB6

Fungsi Terbilang Bagaimanakah Membuatnya - Database VB6

Posting yang menjelaskan tentang cara membuat fungsi terbilang - Fungsi terbilang adalah sebuah fungsi yang dapat mengkonversi angka ke dalam kalimat. Sebuah fungsi yang cukup penting, terutama pada saat kita bekerja dengan database. Bagaimanakah cara membuat fungsi terbilang ini:

Option Explicit 
 
Public Function Terbilang(x As Double, Optional w = "terlalu besar") As String 
     
    Dim t As Double, s As String, b As String, i As Integer, d As Boolean, letak()
    letak = Array("", "ribu ", "juta ", "milyar ", "trilyun ") 
     
    If (x = 0) Then
        Terbilang = "nol"
        Exit Function 
    End If
     
    If (x < 2000) Then d = True
     
    If (x >= 1E+15) Then
        Terbilang = w
        Exit Function
    End If
     
    For i = 4 To 1 Step -1
        t = Int(x / (10 ^ (3 * i))) 
        If (t > 0) Then 
            b = ratusan(t, d)
            s = s & b & letak(i) 
        End If 
        x = x - t * (10 ^ (3 *   i))
    Next 
     
    s = s & ratusan(x, False)
    Terbilang = s 
     
End Function 
     
Private Function ratusan(ByVal y As Double, ByVal f As Boolean) As String 
    Dim t As Double, b As String, g As String, j As Integer, a(), p()
    a = Array("", "se", "dua ", "tiga ", "empat ", "lima ", "enam ", "tujuh ", "delapan ", "sembilan ") 
    p = Array("", "puluh ", "ratus ") 
     
    For j = 2 To 1 Step -1
        t = Int(y / (10   ^ j)) 
        If (t > 0) Then 
            g = a(t)
            If (j = 1 And t = 1) Then 
                y = y - t * 10 ^ j
                If (y >= 1) Then
                    p(j) = "belas "
                Else 
                    a(y) = "se"
                End If 
                b = b & a(y) & p(j)
                ratusan = b 
                Exit Function
            Else
                b = b & g & p(j)
            End If 
        End If
        y = y - t * 10 ^ j
    Next
     
    If (f = False) Then a(1) = "satu "
     
    b = b & a(y)
    ratusan = b 
     
End Function 

Contoh penggunaan fungsi di atas:

Option Explicit 
 
Private Sub cmdTerbilang_Click() 
    txtTerbilang.Text = UCase(Terbilang(Val(txtAngka.Text))) 
End Sub 

READ MORE - Fungsi Terbilang Bagaimanakah Membuatnya - Database VB6

BCM_SETIMAGELIST CommandButton Standar Tampil Indah Menawan

CommandButton Standar dengan Icon 32-bit. Melanjutkan project mengenai tampilan yang telah saya tulis, sekarang kita akan bereksperimen dengan konstanta API BCM_SETIMAGELIST (konstanta yang diperkenalkan Microsoft sekitar tahun 2004). Apakah kegunaan dari BCM_SETIMAGELIST ini? kegunaannya ialah untuk meng-assign serangkaian icon (tepatnya 5 atau 6 icon) ke dalam CommandButton. Adapun kelima icon tersebut secara berurutan: NORMAL, HOT, PRESSED, DISABLED, DEFAULTED. Icon-icon tersebut harus diurutkan seperti demikian, agar menghasilkan effect yang baik. Perhatikan gambar di bawah:

Karena icon yang digunakan disini memiliki color depth 32 bit, maka penggunaan ImageList standar yang terdapat pada file MSCOMCTL.OCX akan menuai masalah, oleh karenanya kita ganti dengan ImageList yang dibuat oleh vbaccelelator. Alternatif lainnya adalah membuat sendiri ImageList melalui Fungsi API.

Option Explicit 
 
Public Declare Sub   InitCommonControls Lib "comctl32" ) 'For XP style 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
 
Private   Const GWL_STYLE As Long = -16& 
Private Const BM_SETIMAGE As Long = &HF7& 
Private Const BCM_SETIMAGELIST = &H1602& 
 
Private Type RECT 
   Left As Long 
   Top As Long 
   Right As Long 
   Bottom As Long 
End Type 
 
Private Type BUTTON_IMAGELIST 
   hIml As Long 
   rc As RECT 
   uAlign As Long 
End Type 
 
Public Sub SetButtonXPIcon(btn As CommandButton, il As vbalImageList, Optional align As Long = 4, _ 
           Optional leftMargin As Long, Optional topMargin As Long, _ 
           Optional rightMargin As Long, Optional bottomMargin As Long) 
    
    Dim bi As BUTTON_IMAGELIST 
    Dim sPic As StdPicture 
    Dim hicon As Long 
     
    With bi 
        .uAlign = align 
        .rc.Left = leftMargin 
        .rc.Top = topMargin 
        .rc.Right = rightMargin 
        .rc.Bottom = bottomMargin 
        .hIml = il.hIml 
    End With 
    
    SendMessage btn.hwnd, BCM_SETIMAGELIST, 0, bi 
    
End Sub 

READ MORE - BCM_SETIMAGELIST CommandButton Standar Tampil Indah Menawan

TextBox Auto Complete Dan Pencarian Cepat Pada ListBox

Apabila Anda pernah menggunakan Tools API-Guide salah satu produk AllApi.net, maka kita akan melihat salah satu TextBox (untuk pencarian fungsi API) yang dilengkapi dengan fasilitas Auto Complete. Auto Complete ini sangat tepat bagi Anda yang sedang mengembangkan aplikasi kamus, database (unbound-control), maupun aplikasi-aplikasi yang menuntut pencarian cepat. Agar lebih jelas, apa yang dimaksud dengan AutoComplete itu perhatikan gambar di bawah ini:

'simpan kode di bawah ini pada modul 
Option Explicit 
 
Public Function TextBoxAutoComplete(Key As Integer, txt As TextBox, lst As ListBox) 
    'fitur auto complete 
    If Key = vbKeyBack Then Exit Function 
    If Key =   vbKeyDelete Then Exit Function 
    
    Dim start As Integer 
     
    If InStr(1, lst.Text, txt.Text) > 0 Then 
        start = txt.SelStart 
        txt.Text = lst.Text 
        If Key = 13 Then 'enter 
            txt.SelStart = Len(txt.Text) 
            Exit Function 
        End If 
        txt.SelStart = start 
        txt.SelLength = Len(lst.Text) 
    End If 
End Function 

Contoh penggunaan fungsi di atas:

'simpan kode di bawah ini pada form 
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) 
    Call TextBoxAutoComplete(KeyCode, Text1, List1) 
End Sub 

READ MORE - TextBox Auto Complete Dan Pencarian Cepat Pada ListBox