Friday, June 8, 2012

VB6 Code - Disable Button X atau Tombol Close Pada MDI

Kode untuk mendisable button x atau tombol close pada MDI form - Di bawah ini merupakan cara menghilangkan button 'x' atau tombol close pada MDI Form.
'simpan kode di bawah pada module 
Option Explicit

Private Declare Function DeleteMenu Lib "user32" ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function
GetSystemMenu Lib "user32" ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Const MF_BYPOSITION = &H400&

Dim hMenu As Long

Public Sub RemoveMenus(frm As Form, Optional brestore As Boolean, Optional bmove As Boolean, Optional bsize As Boolean, Optional bminimize As Boolean, Optional bmaximize As Boolean, Optional bseperator As Boolean, Optional bclose As Boolean)
hMenu = GetSystemMenu(frm.hwnd, False)
If
bclose Then DeleteMenu hMenu, 6, MF_BYPOSITION
If
bseperator Then DeleteMenu hMenu, 5, MF_BYPOSITION
If
bmaximize Then DeleteMenu hMenu, 4, MF_BYPOSITION
If
bminimize Then DeleteMenu hMenu, 3, MF_BYPOSITION
If
bsize Then DeleteMenu hMenu, 2, MF_BYPOSITION
If
bmove Then DeleteMenu hMenu, 1, MF_BYPOSITION
If
brestore Then DeleteMenu hMenu, 0, MF_BYPOSITION
End Sub
Contoh penggunaan kode di atas:
'simpan kode di bawah pada MDI Form.  
Option Explicit

Private Sub MDIForm_Load()
'nilai true untuk remove, sesuaikan kodenya!
RemoveMenus Me, , , , , , True, True
End Sub
READ MORE - VB6 Code - Disable Button X atau Tombol Close Pada MDI

VB6 Code - Cara Menampilkan ToolTipText Pada ListBox

Mengenai cara menampilkan ToolTipText pada saat pointer mouse bergerak di atas ListItem ListBox menggunakan VB6 Code. Adapun cara menampilkan ToolTipText pada ListBox adalah sebagai berikut:

Option Explicit 

Private Type
POINTAPI
x As Long
Y As Long
End Type

Private Declare Function
ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function
LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long
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
WithEvents lst As ListBox
Private Const LB_SETHORIZONTALEXTENT = &H194

Public Property Let
List(New_List As ListBox)
Set lst = New_List
End Property

Private Sub
lst_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' lst.ListIndex = ItemUnderMouse(lst.hwnd, X, Y)
Dim l As Long
Dim a As Long
a =
lst.Parent.TextWidth(lst.List(ItemUnderMouse(lst.hwnd, x, Y))) / Screen.TwipsPerPixelX
l = lst.Parent.TextWidth("AAAAAAAAAAAAAAAAAAAAAAA") / Screen.TwipsPerPixelX
If a > l Then
If
lst.ToolTipText <> lst.List(ItemUnderMouse(lst.hwnd, x, Y)) Then
lst.ToolTipText = lst.List(ItemUnderMouse(lst.hwnd, x, Y))
End If
Else
lst.ToolTipText = ""
End If
End Sub

' Return the index of the item under the mouse.
Public Function ItemUnderMouse(ByVal list_hWnd As Long, ByVal x As Single, ByVal Y As Single)
Dim pt As POINTAPI
pt.x = x \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
ClientToScreen list_hWnd, pt
ItemUnderMouse = LBItemFromPt(list_hWnd, pt.x, pt.Y, False)
End Function
READ MORE - VB6 Code - Cara Menampilkan ToolTipText Pada ListBox

VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

Mengenai cara mengisi ListBox atau ComboBox dengan seluruh isi file menggunakan VB6 Code. Adapun cara mengisi ListBox atau ComboBox dengan isi seluruh file adalah sebagai berikut: 
Public Sub LoadFileToComboOrList(FileName As String, obj As Object) 
Dim s As String
Dim
InFile As Integer ' Descriptor for file.
InFile = FreeFile
Open
FileName For Input As InFile
While Not EOF(InFile)
Line Input #InFile, s
obj.AddItem s
Wend
Close
InFile
End Sub
READ MORE - VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

VB6 Code - Fungsi Untuk Baca Tulis File .INI

Mengenai fungsi untuk baca tulis file .INI menggunakan VB6 Code - Adapun prosedure VB6 untuk baca tulis file .INI adalah sebagai berikut:
Option Explicit 

Private Declare Function
WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function
GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function
WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function
GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Function
ReadIni(ByVal strSection As String, ByVal strKey As String, ByVal strDefault As String, ByVal strFileName As String) As String
Dim
intRes As Integer, strRet As String
strRet = Space$(32400)
intRes = GetPrivateProfileString(strSection, strKey, strDefault, strRet, Len(strRet), strFileName)
ReadIni = Left$(strRet, intRes)
End Function

Public Sub
WriteIni(ByVal strSection As String, ByVal strKey As String, ByVal strSetting As Variant, ByVal strFileName As String)
WritePrivateProfileString strSection, strKey, CStr(strSetting), strFileName
End Sub

Public Function
ReadWinIni(strSection As String, strKey As String) As String
Dim
Result As String * 128
Dim Temp As Integer
Temp = GetProfileString(strSection, strKey, "", Result, Len(Result))
ReadWinIni = Left$(Result, Temp)
End Function

Public Sub
WriteWinIni(strSection As String, strKey As String, strSetting As String)
WriteProfileString strSection, strKey, strSetting
End Sub
Contoh penggunaan kode di atas:
Private Sub Command1_Click() 
If Combo1.ListIndex < 0 Then
MsgBox "You must select the combo first!"
Exit Sub
End If
WriteIni "EXE", "EXE", Combo1.ListIndex, App.Path & "\windows.ini"
MsgBox "Run Again and look the change!"
Unload Me
End Sub

Private Sub
Form_Load()
Me.WindowState = ReadIni("EXE", "EXE", 0, App.Path & "\windows.ini")
With Combo1
.AddItem "Normal"
.AddItem "Minimized"
.AddItem "Maximized"
End With
End Sub
READ MORE - VB6 Code - Fungsi Untuk Baca Tulis File .INI