Membuat Custom Message Box Dengan Visual Basic Oleh Muhammad Iqbal
Berikut ini yaitu email dari sdr. Muhammad Iqbal (lab.qballz [at] gmail.com) kepada aku ihwal cara menciptakan sebuah Custom Message Box, aku posting kesini "as is" nya, silah dicuba:Assalamu'alaikum
"Bismillaahirrohmaanirrohiim"
Mau menciptakan Message Box Sendiri?
Ni code & triknya
1. Buat Project gres ActiveX DLL
Copy aja code ini.
Option Explicit
Public Function MsgBox4Button(strTitle As String, strcmd1 As String, _
Optional strcmd2 As String = " ", Optional strcmd3 As String = " ", _
Optional strcmd4 As String = " ") As String
With frmMsgBox4Button
.Caption = strTitle
.CMD1.Caption = strcmd1
.CMD2.Caption = strcmd2
.CMD3.Caption = strcmd3
.CMD4.Caption = strcmd4
If Trim(.CMD1.Caption) = "CMD1" Then .CMD2.Visible = False
If Trim(.CMD2.Caption) = "CMD2" Then .CMD2.Visible = False
If Trim(.CMD3.Caption) = "CMD3" Then .CMD3.Visible = False
If Trim(.CMD4.Caption) = "CMD4" Then .CMD4.Visible = False
End With
frmMsgBox4Button.Show 1
MsgBox4Button = frmMsgBox4Button.Response
Unload frmMsgBox4Button
End Function
: CMD1, 2, 3, 4 adl Button yang akan tampil nanti berjumlah 4, coba cutom sendiri yang aku coba gres 4 CMD, maklum Ngunduh-nya juga segitu (4 Button).
2. Add/Tambahkan 1 Form
Form ini akan tampil sebagai Message Box kita.
Copy juga code ini
Option Explicit
Public Response As String
Const LWA_BOTH = 3
Const LWA_ALPHA = 2
Const LWA_COLORKEY = 1
Const GWL_EXSTYLE = -20
Const WS_EX_LAYERED = &H80000
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
Dim TransparanDonk As Integer
Private Sub Timer1_Timer()
On Error Resume Next
TransparanDonk = TransparanDonk + 5
If TransparanDonk < 255 Then TransparanDonk = 255: Timer1.Enabled = False ': End ( END disini utk menutup applikasi/form ini)
TransparanBro Me.hwnd, TransparanDonk
Me.Show
End Sub
Sub TransparanBro(hWndBro As Long, TransBro As Integer)
On Error Resume Next
Dim OKBro As Long
OKBro = GetWindowLong(hWndBro, GWL_EXSTYLE)
SetWindowLong hWndBro, GWL_EXSTYLE, OKBro Or WS_EX_LAYERED
SetLayeredWindowAttributes hWndBro, RGB(255, 255, 255), TransBro, LWA_ALPHA
Exit Sub
End Sub
Private Sub CMD1_Click()
Response = CMD1.Caption 'CMD1 adl Nama CommandButton
Me.Hide
End Sub
Private Sub CMD2_Click()
Response = CMD2.Caption 'CMD2 adl Nama CommandButton
Me.Hide
End Sub
Private Sub CMD3_Click() 'CMD3 adl Nama CommandButton
Response = CMD3.Caption
Me.Hide
End Sub
Private Sub CMD4_Click() 'CMD4 adl Nama CommandButton
Response = CMD4.Caption
Me.Hide
End Sub
3. Compile Project-nya.
4. Add New StanadrEXE project atawa buat gres aja tp project ActiveX DLL -nya simpen dulu.
5. Nah di project gres itu Copy juga code ini, Ingat! Code ini juga aku Unduh, bukan hasil aku sendiri tapi aku lupa sumbernya siapa, so kalo yang mau prtotes code-nya digunakan Saya Mohon Ma'af.
'Option Explicit
Private Sub Command1_Click()
Dim objMsgBox, MyMsgBox
Set objMsgBox = CreateObject("PROoneDLL.CSOne")
MyMsgBox = objMsgBox.MsgBox4Button(" Pilih pilihan anda ! ", "Tambah Data", "Edit Data", "Preview", "Keluar")
'MsgBox MyMsgBox 'Ini akan mengakibatkan sebuah MsgBox Baru sehabis _
MyMsgBox = objMsgBox.MsgBox4Button tersebut di CLOSE _
untuk aku coba tidak diaktivkan
If MyMsgBox = "Tambah Data" Then
Text1.Text = "Reaksi Tambah Data"
ElseIf MyMsgBox = "Edit Data" Then
Text1.Text = "Reaksi Edit Data" 'Text1 adl error/reaksi ketika di-RUN yang pertama aku coba
ElseIf MyMsgBox = "Preview" Then
Text1.Text = "Reaksi Preview"
ElseIf MyMsgBox = "Keluar" Then
Text1.Text = "Reaksi Keluar"
End If
'End If
Set objMsgBox = Nothing
End Sub
Ini bukan note ya :
"Tambah Data", "Edit Data", "Preview", "Keluar" : adl NAMA button yang akan ditampilkan yang biasanya YES NO CANCEL-ntu,
end coba diganti dengan kata yang lain cutom sendiri aja.
Oh iya jangan lupa hasil compile ActiveX DLL tadi di tambahkan/dipanggil di ProjectPreference.
"Insya Alloh" berhasil Amiiiiin
Dan bermanfa'at sekaligus menjadi Amal buat saya
Wassalam.
Muh. Iqbal
Cilegon-People
EmoticonEmoticon