Public Function FirstUCaseWord(ByVal MyString As String) As String
Dim PosSpc As Integer
Mid(MyString, 1, 1) = UCase(Mid(MyString, 1, 1))
PosSpc = InStr(MyString, ” “)
While PosSpc <> 0
Mid(MyString, PosSpc + 1, 1) = UCase(Mid(MyString, PosSpc + 1, 1))
PosSpc = InStr(PosSpc + 1, MyString, ” “)
Wend
FirstUCaseWord = MyString
End Function
Public Function FirstOfMonth(ByVal xDate As Date) As Date
FirstOfMonth = DateSerial(Year(xDate), Month(xDate), 1)
End Function
Public Function EndOfMonth(ByVal xDate As Date) As Date
EndOfMonth = DateSerial(Year(xDate), Month(xDate) + 1, 0)
End Function
Public Function EndOfWeek(ByVal xDate As Date) As Date
EndOfWeek = xDate – Weekday(xDate) + 7
End Function
Mendapatkan Nama user pada Operasi Windows
‘— Letakkan di module
Public Declare Function GetUserNameA Lib “advapi32.dll” _
(ByVal lpBuffer As String, nSize As Long) As Long
‘— Akhir Letakkan di module
Public Function GetUserName() As String
Dim UserName As String * 255
Call GetUserNameA(UserName, 255)
GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) – 1)
End Function
Private Sub Form_Load()
MsgBox GetUserName
End Sub
Mendapatkan Nilai dari Resolusi Windows
Public Function GetWinScrResolution() As String
Dim intWidth As Integer
Dim intHeight As Integer
intWidth = Screen.Width \ Screen.TwipsPerPixelX
intHeight = Screen.Height \ Screen.TwipsPerPixelY
GetWinScrResolution = Str$(intWidth) + ” x” + Str$(intHeight)
End Function
Private Sub Form_Load()
MsgBox GetWinScrResolution
End Sub
Fungsi untuk Mendapatkan Posisi direktory system Windows
‘— Letakkan di module
Declare Function GetSystemDirectory Lib “kernel32” Alias “GetSystemDirectoryA” _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
‘— Akhir Letakkan di module
Public Function GetSysDir() As String
Dim boolRetVal As Boolean, lpBuffer As String, nSize As Long
lpBuffer = Space(255): nSize = 254
boolRetVal = GetSystemDirectory(lpBuffer, nSize)
GetSysDir = StripNullTerminator(lpBuffer)
End Function
Function StripNullTerminator(lpBuffer As String) As String
Dim I As Integer
For I = 1 To 255
If Asc(Mid(lpBuffer, I, 1)) = 0 Then
lpBuffer = Left(lpBuffer, I – 1)
Exit For
End If
Next I
StripNullTerminator = lpBuffer
End Function
Private Sub Form_Load()
MsgBox GetSysDir
End Sub
Fungsi Mendapatkan Nama Komputer
‘— Letakkan di module
Public Declare Function GetComputerName Lib “kernel32” Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long
‘— Akhir Letakkan di module
Public Function GetMyComputerName() As String
Dim Bufstr$, sComputerName$
Bufstr = Space$(50)
If GetComputerName(Bufstr, 50) > 0 Then
sComputerName = Bufstr
sComputerName = RTrim(sComputerName)
sComputerName = StrStripTerminator(sComputerName)
Else
sComputerName = “”
End If
GetMyComputerName = sComputerName
End Function
Function StrStripTerminator(ByVal AString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(AString, Chr$(0))
If intZeroPos > 0 Then
StrStripTerminator = Left$(AString, intZeroPos – 1)
Else
StrStripTerminator = AString
End If
End Function
Private Sub Form_Load()
MsgBox GetMyComputerName
End Sub
Public Function FileDelete(ByVal strFile As String)
If CBool(Len(Dir$(strFile))) Then Call Kill(strFile)
End Function
Menyembunyikan, menampilkan, minimize MDI child forms.
Declare Function ShowWindow% Lib “User” (ByVal hWnd%, ByVal nCmdShow%)
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Global Const SW_SHOWNOACTIVE = 4
Global Const SW_SHOW = 5
Global Const SW_MINIMIZE = 6
Global Const SW_SHOWMINNOACTIVE = 7
Global Const SW_SHOWNA = 8
Global Const SW_RESTORE = 9
‘ Examples:
Dim Re%
‘ Hide the child form
Re% = ShowWindow(frmMDIChild.hWnd, SW_HIDE)
‘ Show the child form
Re% = ShowWindow(frmMDIChild.hWnd, SW_SHOW)
‘ Minimize the child form
Re% = ShowWindow(frmMDIChild.hWnd, SW_MINIMIZE)
Tip Triks dan Source Code Visual Basic 6 