VB6 Code - Membuat Form Yang Berbentuk Elips

Bagaimanakah cara membuat form yang berbentuk elips menggunakan kode Vb6? tentu saja untuk keperluan ini kita harus memanggil beberapa fungsi API. Bagaimana kode lengkap dari VB6 tersebut \? simaklah di bawah ini:

Option Explicit

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Contoh penggunaan fungsi API agar form berbentuk Elips

Private Sub Form_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 299, 200), True
End Sub

Demikian kode VB6 untuk membuat form yang berbentuk lingkaran.

READ MORE - VB6 Code - Membuat Form Yang Berbentuk Elips

VB6 Code - Menampilkan Dialog Properties Sebuah File

Di bawah ini merupakan fungsi VB6 untuk menampilkan kotak dialog properties sebuah file.

Option Explicit

Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

Public Sub ShowProps(FileName As String, OwnerhWnd As Long)

  Dim SEI As SHELLEXECUTEINFO
    Dim lngReturn As Long

  With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS  Or _
            SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hwnd = OwnerhWnd
        .lpVerb = "properties"
        .lpFile = FileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With

  lngReturn = ShellExecuteEX(SEI)

End Sub

Contoh menggunakan dialog properties sebuah file

Option Explicit

Private Sub Command1_Click()
    Call ShowProps("C:\boot.ini", Me.hwnd)
End Sub

READ MORE - VB6 Code - Menampilkan Dialog Properties Sebuah File

VB6 Code - Fungsi API Untuk Browse For Folder

Mengenai fungsi-fungsi API untuk menampilkan dialog browse for folder dengan menggunakan kode-kode VB6:

Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
     lParam As Long
    iImage As Long
End Type

Public Function BrowseForFolder(hwnd As Long, Optional Title As String = "Browse For Folder") As String
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "This Is My Title"
    With tBrowseInfo
        .hWndOwner = Me.hwnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        BrowseForFolder = sBuffer
    End If
End Function

Adapun contoh untuk fungsi API diatas:

Private Sub Command1_Click()
    Text1.Text = BrowseForFolder(Me.hwnd)
End Sub

READ MORE - VB6 Code - Fungsi API Untuk Browse For Folder

VB6 Code - Horizontal Scrollbar Pada Listbox

Di bawah ini merupakan procedure VB6 untuk menambah ScrollBar pada objek ListBox. Seperti yang kita ketahui, ListBox tidak memiliki properties horizontal scroll bar akan tetapi dengan memanggil beberapa fungsi API hal tersebut mungkin untuk dilakukan.

Option Explicit

Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LB_SETHORIZONTALEXTENT = &H194

Public Sub AddHSBToListBox(sText As String, lst As ListBox)
    Static x As Long
    lst.AddItem sText
    If x < TextWidth(sText & "  ") Then
        x = TextWidth(sText & "  ")
    End If
    If ScaleMode = vbTwips Then
        x = x / Screen.TwipsPerPixelX
        SendMessageByNum lst.hwnd, LB_SETHORIZONTALEXTENT, x, 0
    End If
End Sub

Contoh penggunaan menambah horizontal scrollbar pada listbox

Private Sub  Command1_Click()
    Dim sText As String
    sText = ("This is a sample of long text, if the text longer than listbox, it will be create horizontal scrollbar automatically")
    AddHSBToListBox sText, List1
End Sub

READ MORE - VB6 Code - Horizontal Scrollbar Pada Listbox