Private Declare Function SetWindowTheme Lib "uxtheme.dll" (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
Private Sub Form_Load()
Call SetWindowTheme(ListView1.hwnd, StrPtr("explorer"), 0)
Call SetWindowTheme(TreeView1.hwnd, StrPtr("explorer"), 0)
End Sub
Keterengan:
Microsoft Windows Common Controls 5.0
API-ucListView 1.0
API-ucTreeView 1.3
Ketentuan:
Manifest
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type BUTTON_IMAGELIST
himl As Long
rc As RECT
uAlign As Long
End Type
Private Declare Function ImageList_Create Lib "comctl32.dll" (ByVal cx As Long, ByVal cy As Long, ByVal Flags As Long, ByVal cInitial As Long, ByVal cGrow As Long) As Long
Private Declare Function ImageList_AddIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function PrivateExtractIconsW Lib "user32.dll" (ByVal lpIconPath As Long, ByVal Iconindex As Long, ByVal cxIcon As Long, ByVal cyIcon As Long, ByVal phIcon As Long, ByVal piIconId As Long, ByVal nIcons As Long, ByVal lFlags As Long) As Long
Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Enum Align
IconLeft = 0
IconRight = 1
IconTop = 2
IconBottom = 3
IconCenter = 4
End Enum
Private Sub CommandButtonIcon1(sLibName As String, objCommandButton As CommandButton, lSize As Long, lIndex As Long, IconAlign As Align, Optional lLeftMargin As Long = 0, Optional lTopMargin As Long = 0, Optional lRightMargin As Long = 0, Optional lBottomMargin As Long = 0)
Const ILC_MASK As Long = &H1
Const ILC_COLOR32 As Long = &H20
Const LR_DEFAULTCOLOR As Long = &H0
Const LR_DEFAULTSIZE As Long = &H40
Const BCM_SETIMAGELIST As Long = &H1602&
Dim hImage As Long
Dim hIcon As Long
Dim BI As BUTTON_IMAGELIST
hImage = ImageList_Create(lSize, lSize, ILC_COLOR32 Or ILC_MASK, 1, 1)
Call PrivateExtractIconsW(StrPtr(sLibName), lIndex, lSize, lSize, VarPtr(hIcon), VarPtr(0), 1, LR_DEFAULTCOLOR Or LR_DEFAULTSIZE)
Call ImageList_AddIcon(hImage, hIcon)
Call DestroyIcon(hIcon)
With BI
.rc.Left = lLeftMargin
.rc.Top = lTopMargin
.rc.Right = lRightMargin
.rc.Bottom = lBottomMargin
.himl = hImage
.uAlign = IconAlign
End With
Call SendMessage(objCommandButton.hwnd, BCM_SETIMAGELIST, 4, BI)
End Sub
Private Sub CommandButtonIcon2(objCommandButton As CommandButton, lSize As Long, sIconResName As String, IconAlign As Align, Optional lLeftMargin As Long = 0, Optional lTopMargin As Long = 0, Optional lRightMargin As Long = 0, Optional lBottomMargin As Long = 0)
Const IMAGE_ICON = 1
Const LR_LOADFROMFILE As Long = &H10
Const LR_LOADMAP3DCOLORS As Long = &H1000
Const LR_SHARED As Long = &H8000&
Const ILC_MASK As Long = &H1
Const ILC_COLOR32 As Long = &H20
Const BCM_SETIMAGELIST As Long = &H1602&
Dim hImage As Long
Dim hIcon As Long
Dim BI As BUTTON_IMAGELIST
hImage = ImageList_Create(lSize, lSize, ILC_COLOR32 Or ILC_MASK, 1, 1)
hIcon = LoadImage(App.hInstance, sIconResName, IMAGE_ICON, lSize, lSize, IIf(True, LR_SHARED Or LR_LOADMAP3DCOLORS, LR_LOADFROMFILE))
Call ImageList_AddIcon(hImage, hIcon)
DestroyIcon hIcon
With BI
.rc.Left = lLeftMargin
.rc.Top = lTopMargin
.rc.Right = lRightMargin
.rc.Bottom = lBottomMargin
.himl = hImage
.uAlign = IconAlign
End With
Call SendMessage(objCommandButton.hwnd, BCM_SETIMAGELIST, 4, BI)
End Sub
Download Sample:
CommandButtonIcon.rar Update 24 Maret 2011
Private Sub cmdSend_Click()
With wskUDP
.Protocol = sckUDPProtocol
.RemoteHost = “255.255.255.255″
.RemotePort = 4000
End With
DataToSend = “FFFFFFFFFFFF”
For i = 1 To 16
DataToSend = DataToSend & txtMACAddress.Text
Next i
DataToSend = (HEX2ASCII(DataToSend))
wskUDP.SendData DataToSend
wskUDP.Close
End Sub
Private Sub Form_Load()
txtMACAddress.Text = “001195613823″
End Sub
Function HEX2ASCII(ByVal sHEX As String) As String
For j = 1 To Len(sHEX)
HEX2ASCII = HEX2ASCII & Chr(Val(“&h” & Mid(sHEX, j, 2)))
j = j + 1
Next j
End Function
Keterangan :
txtMACAddress =TextBox
wskUDP = WinSock
cmdSend = CommandButton
“001195613823″=Merupakan nilai dari MAC Address
Syarat:
1. LAN
2. pada BIOS komputer mendukung Wake On Lan
3. Komputer belum pernah terputus pada jaringan listrik (komputer yang akan dinyalakan)
Option Explicit
Private Declare Function CryptAcquireContext Lib "ADVAPI32.DLL" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "ADVAPI32.DLL" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "ADVAPI32.DLL" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "ADVAPI32.DLL" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "ADVAPI32.DLL" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "ADVAPI32.DLL" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Private Const CALG_MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
Private Const CALG_MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
Private Const CALG_MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
Private Const CALG_SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
Private Function CreateHash(ByVal Str As String, ByVal ConstVal As Long) As String
Dim hCtx As Long
Dim hHash As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abData() As Byte
lRes = CryptAcquireContext(hCtx, vbNullString, "Microsoft Enhanced Cryptographic Provider v1.0", PROV_RSA_FULL, &HF0000000)
If lRes <> 0 Then
lRes = CryptCreateHash(hCtx, ConstVal, 0, 0, hHash)
If lRes <> 0 Then
lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
If lRes <> 0 Then
lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
If lRes <> 0 Then
ReDim abData(0 To lLen - 1)
lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
If lRes <> 0 Then
For lIdx = 0 To UBound(abData)
CreateHash = CreateHash & Right$("0" & Hex$(abData(lIdx)), 2)
Next
End If
End If
End If
CryptDestroyHash hHash
End If
End If
CryptReleaseContext hCtx, 0
End Function
Contoh :
HashMD2 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD2))
HashMD4 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD4))
HashMD5 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD5))
HashSHA1 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_SHA1))
