GetShortPathName - Mengubah Filename Menjadi DOS 8.3 Format

Di bawah ini merupakan kode untuk mengubah nama file menjadi format DOS 8.3 - Contoh: G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe menjadi: G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE. Bagaimana kode mengenai cara mengubah filename menjadi DOS 8.3, bisa Anda lihat di bawah:

Option Explicit 
 
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long 
Const MAX_PATH = 260 
 
Public Function GetShortPath(ByVal Filename As String) As String 
    Dim length As Long 
    GetShortPath = Space(1024) 
    length = GetShortPathName(Filename, GetShortPath, Len(GetShortPath)) 
    GetShortPath = Left(GetShortPath, length) 
End Function 

Contoh penggunaan kode di atas:

Private Sub Command1_Click() 
    MsgBox GetShortPath("G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe") 
End Sub 

READ MORE - GetShortPathName - Mengubah Filename Menjadi DOS 8.3 Format

Notify Form Dengan Effect Transparent Hover

Menjelaskan mengenai cara membuat notify form yang menggunakan effect transparent hover - Apa yang dimaksud dengan notify form itu? notify form adalah form yang bertugas memberitahukan sesuatu kepada user, umumnya notify form muncul sebelah kanan bagian bawah. Beberapa software yang menggunakan notify form diantaranya: Mozilla Firefox, Orbit Downloader, IDM, Avira, software-software Anti Virus, dan banyak lagi. Untuk membuat notify form, khususnya yang memiliki effect transparent hover (terinspirasi dari software notepad++ pada dialog findnya), copy dan pastekan kode di bawah ini:

'---------------------------------------------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com 
'coder: Administrator 
'---------------------------------------------------------------------------------------------------------- 
Option Explicit 
 
Dim blnHighlighted As Boolean 
Dim blnMouseDownClick As Boolean 'bug fixed on flickering 
 
Private Type POINTAPI 
    X As Long 
    Y As Long 
End Type 
 
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
Private Declare Sub InitCommonControls Lib "COMCTL32.DLL" () 
 
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal X As Byte, ByVal alpha As Long) As Boolean 
 
Const LWA_BOTH = 3 
Const LWA_ALPHA = 2 
Const LWA_COLORKEY = 1 
Const GWL_EXSTYLE = -20 
Const WS_EX_LAYERED = &H80000 
 
Dim iTransparant As Integer 
Dim blnUp As Boolean 
 
Private Sub Form_Initialize() 
    InitCommonControls 
End Sub 
 
Private Sub MakeTransparan(hWndBro As Long, iTransp As Integer) 
   On Error Resume Next 
   
   Dim ret As Long 
   ret = GetWindowLong(hWndBro, GWL_EXSTYLE) 
   
   SetWindowLong hWndBro, GWL_EXSTYLE, ret Or WS_EX_LAYERED 
   SetLayeredWindowAttributes hWndBro, RGB(255, 255, 0), iTransp, LWA_ALPHA 
   Exit Sub 
 
End Sub 
 
Private Sub cmdOK_Click() 
    'Kode selanjutnya disini .... 
    blnUp = False 
    tmrNotify.Enabled = True 
End Sub 
 
Private Sub cmdCancel_Click() 
    'kode selanjutnya disini .... 
    blnUp = False 
    tmrNotify.Enabled = True 
End Sub 
 
Private Sub Form_Load() 
    MakeTransparan Me.hwnd, 100 
    Top = ((GetSystemMetrics(17) + GetSystemMetrics(4)) * Screen.TwipsPerPixelY) 
    Left = (GetSystemMetrics(16) * Screen.TwipsPerPixelX) - Width 
    blnUp = True 
End Sub 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    blnMouseDownClick = True 
End Sub 
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    If blnHighlighted Then Exit Sub 
    blnHighlighted = True 
    tmrSemiTransparent.Enabled = True 
    MakeTransparan Me.hwnd, 255 
End Sub 
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    blnMouseDownClick = False 
End Sub 
 
Private Sub tmrSemiTransparent_Timer() 
    If blnMouseDownClick Then Exit Sub 
    Dim pt As POINTAPI 
    GetCursorPos pt 
    ScreenToClient hwnd, pt 
    If (pt.X < 0 Or pt.Y < 0) Or _ 
    (pt.X > (Me.ScaleLeft + Me.ScaleWidth) / Screen.TwipsPerPixelX) Or _ 
       (pt.Y > (Me.ScaleTop + Me.ScaleHeight) / Screen.TwipsPerPixelY) Then 
        blnHighlighted = False 
        tmrSemiTransparent.Enabled = False 
        MakeTransparan Me.hwnd, 100 
    End If 
End Sub 
 
Private Sub tmrNotify_Timer() 
    Const s = 100 
    Dim v As Single 
    v = (GetSystemMetrics(17) + GetSystemMetrics(4)) * Screen.TwipsPerPixelY 
    If blnUp = True Then 
        If Top - s <= v - Height Then 
            Top = Top - (Top - (v - Height)) 
            tmrNotify.Enabled = False 
        Else 
            Top = Top - s 
        End If 
    Else 
        Top = Top + s 
        If Top >= v Then End 
    End If 
End Sub

READ MORE - Notify Form Dengan Effect Transparent Hover

Memeriksa Apakah Pointer Mouse Masuk Di atas Sebuah Objek

Menjelaskan mengenai cara untuk memeriksa apakah pointer/cursor mouse berada di atas sebuah objek - Terkadang kita memerlukan sebuah kode untuk memeriksa apakah cursor atau pointer berada di atas sebuah objek, misalnya untuk keperluan hover, dsb. Untuk kasus objek yang memiliki property .hwnd hal tersebut mudah sekali dilakukan yaitu dengan memanggil fungsi API SetCapture dan ReleaseCapture, tapi bagaimana jika objek tersebut tidak memiliki property .hwnd, misalnya objek label atau image?

Di bawah ini merupakan module untuk memeriksa apakah pointer atau cursor berada di atas sebuah objek, untuk mengujinya sediakan 1 Timer dengan property Name = tmrInBox, kemudian 1 PictureBox dengan properpty Name = Picture1 (default).

'simpan kode di bawah pada sebuah module 
Option Explicit 
 
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
 
Private Type POINTAPI 
    x As Long 
    y As Long 
End Type 
 
Public Function InBox(ctl As Control) As Boolean 
    Dim pt As POINTAPI 
    GetCursorPos pt 
    ScreenToClient ctl.Parent.hwnd, pt 
    InBox = Not (pt.x < ctl.Left Or pt.y < ctl.Top Or pt.x > ctl.Left + ctl.Width Or pt.y > ctl.Top + ctl.Height) 
End Function 

'simpan kode di bawah pada form 
Option Explicit 
 
Dim blnFlag As Boolean 
 
Private Sub Form_Load() 
    Form1.ScaleMode = vbPixels 'pixels units 
    tmrInBox.Interval = 10 'or 1 if posible 
End Sub 
 
Private Sub tmrInBox_Timer() 
    If Not InBox(Picture1) Then 
        blnFlag = False 
        tmrInBox.Enabled = False 
        Picture1.BackColor = vbBlack 
    End If 
End Sub 
 
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    If blnFlag Then Exit Sub 
    blnFlag = True 
    tmrInBox.Enabled = True 
    Picture1.BackColor = vbWhite 
End Sub 

READ MORE - Memeriksa Apakah Pointer Mouse Masuk Di atas Sebuah Objek

Mengenai cara menampilkan kotak dialog About

Mengenai cara menampilkan kotak dialog About default windows menggunakan Visual Basic 6 - Apabila kita malas membuat tampilan kotak dialog About, mungkin kode di bawah adalah alternatif yang tepat, selain itu ia memiliki tampilan (GUI) yang menarik, adapun cara menampilkan kotak dialog about default windows adalah sebagai berikut:

'simpan kode di bawah ini pada module 
Option Explicit 
 
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long 
 
Public Sub ShowAboutDialog(hwnd As Long, Caption As String, Txt As String, Icon As Long) 
    Call ShellAbout(hwnd, Caption, Txt, Icon) 
End Sub 

Contoh penggunaan kode untuk menampilkan kotak dialog about:

'simpan kode di bawah ini dalam module 
Option Explicit 
 
Private Sub cmdAbout_Click() 
    ShowAboutDialog Me.hwnd, "About My-Sofware", "Software Versi ke-1", Me.Icon 
End Sub 

READ MORE - Mengenai cara menampilkan kotak dialog About