Battery Checker Menggunakan VB.6.0

Salam…
Belajar,, Sekarang kita belajar membuat Aplikasi Battery Checker dengan pemrograman Visual Basic 6.0..minta maaf sebelumnya ya aplikasi ini hanya bisa jalan di OS Windows… aplikasi ini udah saya buat satu tahun yang lalu, tp baru saya ingat kalau ada teman temanku yang membutuhkannya dan mungkin juga anda membutuhkanya, dan juga saya berpikir bahwa ilmu itu harus memang di bagikan.

Sebenarnya aplikasi ini bukan ideku, idenya saya dapat dari teman karena katanya dia sering kelupaan untuk cabut cas baterry leptopnya kalau udah penuh. memang sih.. di setiap OS udah ngikut aplikasi Baterry Cheker tersebut tp kadang-kadang kita kurang tahu atapun tidak lihat kalau batterynya udah penuh mungkin dikarenakan kita terlalu asik bermain leptop.. batteray leptop bila penuh kemudian kita tidak mencabutnya bisa juga meyebabkan batteray kita menjadi rusak..

Cara menjalankan aplikasi ini tinggal di klik dobel aja aplikasinya.
Cara kerjanya yaitu bila batteray leptop anda sudah penuh maka secara otomatis aplikasi ini akan muncul di tengah layar dan tidak bisa anda tutup kecuali anda sudah mencabut cas batterynya
Pasti udah ga sabaran ya.. langsung aja saya jelaskan: yang perlu di ketahui ada beberapan tahapan yang anda harus tahu sebelum membuatnya

1. Tahu dan paham tentang bahasa pemrograman visual basic 6.0
2. Mengerti tentang registry di OS windows

Lanjut..
Buat satu Proyek baru di VB kemudian tambahkan tiga module…
Di modul pertama isikan kode programnya seperti ini: maksud dari kode program di bawah ini adalah untuk membuat aplikasi menjadi try icon atau berada di di taskbar sebelah kanan

Public Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function Shell_NotifyIconA Lib "shell32.dll" (ByVal Message As Long, Data As NotifyIconData) As Long

Public Type NotifyIconData
Size As Long
Handle As Long
ID As Long
Flags As Long
CallBackMessage As Long
Icon As Long
Tip As String * 64
End Type

Public Const AddIcon = &H0
Public Const ModifyIcon = &H1
Public Const DeleteIcon = &H2

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202

Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205

Public Const MessageFlag = &H1
Public Const IconFlag = &H2
Public Const TipFlag = &H4

Public formloaded As Boolean
Public mRtn As Boolean
Public oldproc As Long
Public Data As NotifyIconData
Public Function proc&(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
If Msg = 1400 And lParam = 517 And formloaded Then frmbatteray.PopupMenu frmbatteray.mnu

' Sintax ini untuk try icon
proc = CallWindowProcA(oldproc, hWnd, Msg, wParam, lParam)

End Function

Lanjut dengan mengisi kode program di module yang kedua : di module ini kita akan membuat aplikasi
bisa di jalankan pada startup dengan cara deklarasikan registry yang di perlukan

Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0&
Private Const REG_DWORD = 4
Private Const REG_SZ = 1

'----------------------------------------------------------------------------------------
' Syntax : AddToStartUp App.EXEName, App.Path & "\" & App.EXEName, True
'----------------------------------------------------------------------------------------
' mItemKey : buat sebuah function
' mPath : perhatikan pathx akan di eksekusi pada saat di jalankan
' mState : berikan nilaix menjadi.. True = [Enabled, loads on startup}
'----------------------------------------------------------------------------------------

Public Function AddToStartUp(mItemKey As String, mPath As String, ByVal mState As Boolean) As Boolean
Dim keyhand As Long
Dim Rtn As Long
Const StrPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"

On Error GoTo Handle
Rtn = RegCreateKey(HKEY_LOCAL_MACHINE, StrPath, keyhand)
If mState Then
Rtn = RegSetValueEx(keyhand, mItemKey, 0, REG_SZ, ByVal mPath, Len(mPath))
Else
Rtn = RegDeleteValue(keyhand, mItemKey)
End If
Rtn = RegCloseKey(keyhand)

AddToStartUp = True

Exit Function
Handle:
AddToStartUp = False
End Function

Untuk module yang ketiga kita akan membuat agar aplikasi menjadi TOP MOST atau selalu berada di atas, berikut kode progamnya :

Public Declare Function GetSystemPowerStatus Lib "kernel32" (lpSystemPowerStatus As SYSTEM_POWER_STATUS) As Long
Public Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE


Public Type SYSTEM_POWER_STATUS
ACLineStatus As Byte
BatteryFlag As Byte
BatteryLifePercent As Byte
Reserved1 As Byte
BatteryLifeTime As Long
BatteryFullLifeTime As Long
End Type

Public kSysPwr As SYSTEM_POWER_STATUS

' sintax ini agar supaya form selalu di atas

Public Sub MakeTopMost(lngHwnd As Long)
SetWindowPos lngHwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Nah langkah selanjutnya kita mendesain form, tambahkan 2 Command Butt

on, timer, dan 5 label sehingga membentuk tampilan form seperti ini :

Dan ketikkan kode seperti ini ya..
Option Explicit

Private Sub Check1_Click()
'bila kontrolCheckBox di pilih maka buat sebuah dword di registry
'dan bila tidak maka hapus dari registry
If Check1.Value = Checked Then
mRtn = AddToStartUp(App.EXEName, App.Path & "\" & App.EXEName, True)
'Check1.Value = Gray
ElseIf Check1.Value = Unchecked Then
mRtn = AddToStartUp(App.EXEName, App.Path & "\" & App.EXEName, False)
Else
MsgBox "Anda Tidak Memilih Apapun", vbCritical, "Informasi"
End If
End Sub
Private Sub Command1_Click()
'panggil GetSystemPowerStatus(kSysPwr)
Screen.MousePointer = vbHourglass
Call GetSystemPowerStatus(kSysPwr)
Screen.MousePointer = vbNormal
Label23.Caption = Format$(kSysPwr.BatteryLifePercent / 100, "Percent")
If (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus = 1) Then
MsgBox "Opps,, di Cabut Dulu Casnya Ya...", vbInformation + vbSystemModal, "Informasi"
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Exit Sub

ElseIf (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus = 0) Then

Me.Hide
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True

ElseIf (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus <> 1) Then
MsgBox "Opps,, di Cabut Dulu Casnya Ya...", vbInformation + vbSystemModal, "Informasi"
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Else

Me.Hide
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True

End If

End Sub

Private Sub Form_Load()
'panggil semua method yang bertipe public yang ada di modul tadi
MakeTopMost Me.hWnd
AddIconToTray
'mRtn = AddToStartUp(App.EXEName, App.Path & "\" & App.EXEName, True)
Check1.Value = Gray
Timer1.Enabled = False
End Sub

Private Sub Form_Paint()
formloaded = True
End Sub

Private Sub Form_Terminate()
DeleteIconFromTray
End Sub

Private Sub AddIconToTray()
Data.Size = Len(Data)
Data.Handle = hWnd
Data.ID = vbNull
Call GetSystemPowerStatus(kSysPwr)
Data.Flags = IconFlag Or TipFlag Or MessageFlag
Data.CallBackMessage = WM_MOUSEMOVE
Data.CallBackMessage = 1400
Data.Icon = Icon
Data.Tip = "Aplikasi Batteray " & (kSysPwr.BatteryLifePercent) & "%" & vbNullChar
Call Shell_NotifyIconA(AddIcon, Data)
'Shell_NotifyIconA NIM_ADD, nid
oldproc = SetWindowLongA(Me.hWnd, -4, AddressOf proc)
End Sub
Private Sub DeleteIconFromTray()
Call Shell_NotifyIconA(DeleteIcon, Data)
End Sub

Private Sub hid_Click()
Me.Hide
Timer1.Enabled = True
End Sub

Private Sub sho_Click()
frmbatteray.Show
'Timer1.Enabled = False
End Sub
Private Sub clo_Click()
Unload frmbatteray

End Sub

Private Sub Timer1_Timer()
' masukan ke timer agar supaya selalu di d cek kondisi bateray sekarang
Screen.MousePointer = vbHourglass
Call GetSystemPowerStatus(kSysPwr)
Screen.MousePointer = vbNormal


Label23.Caption = Format$(kSysPwr.BatteryLifePercent / 100, "Percent")
If (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus = 1) Then
' MsgBox "Opps,, di Cabut Dulu Casnya Ya...", vbInformation + vbSystemModal, "Informasi"
frmbatteray.Show
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Exit Sub

ElseIf (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus = 0) Then

Me.Hide
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True

ElseIf (kSysPwr.BatteryLifePercent >= 87) And (kSysPwr.ACLineStatus <> 1) Then
frmbatteray.Show
' MsgBox "Opps,, di Cabut Dulu Casnya Ya...", vbInformation + vbSystemModal, "Informasi"
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Else
Me.Hide
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
End If
End Sub

buat juga satu menu seperti tampilan ini :












Selamat belajar.. oh… ya nih.. saya kasih aplikasinya download aja di sini Battery LeptopQ

Read more »

Posted in: VB6.0