Mengubah Format DOS 8.3 menjadi Long Filename

Mengubah format DOS 8.3 menjadi long filename, contohnya: G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE menjadi: G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe. Nah bagaimana kode konversi format DOS 8.3 ini, bisa Anda perhatikan di bawah:

Option Explicit 
 
Private Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long 
 
Public Function GetLongPath(ByVal Filename As String) As String 
    On Error Resume Next 
    Dim length As Long 
    Dim s As String 
    s = String$(MAX_PATH, 0) 
    length = GetLongPathName(Filename, s, Len(s)) 
    If (length And Err = 0) Then GetLongPath = Left$(s, length) 
End Function 

Contoh penggunaan kode di atas:

Private Sub Command1_Click() 
    MsgBox GetLongPath("G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE") 
End Sub 

READ MORE - Mengubah Format DOS 8.3 menjadi Long Filename

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