Important alert: (current site time 4/24/2014 9:16:24 AM EDT)
 

VB icon

Custom MessageBox And Password InputBox

Email
Submitted on: 12/2/2005 7:19:06 AM
By: Serge Lachapelle  
Level: Intermediate
User Rating: By 5 Users
Compatibility: VB 5.0, VB 6.0
Views: 16890
 
     MessageBox with custom text on buttons, InputBox for password input with *****,

 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
  1. You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.
				
'**************************************
' Name: Custom MessageBox And Password InputBox
' Description:MessageBox with custom text on buttons, 
InputBox for password input with *****, 
' By: Serge Lachapelle
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=63456&lngWId=1'for details.'**************************************

Option Explicit
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal HWND As Long, ByVal lpString As String) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal HWND As Long, ByVal lpClassName As String, ByVal nMaxCount 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, lParam As Any) As Long
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
Private hHook As Long, ButtonText(3) As String, PasswordChar As Byte
Private Function ChangeButtonsText(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 Dim t As Integer, cName As String, Length As Long, Btn(0 To 3) As Long
 If lMsg = HCBT_ACTIVATE Then
Btn(0) = FindWindowEx(wParam, 0, vbNullString, vbNullString)
For t = 1 To 3
 Btn(t) = FindWindowEx(wParam, Btn(t - 1), vbNullString, vbNullString)
 If Btn(t) = 0 Then Exit For
Next t
For t = 0 To 3
 If (Btn(t) <> 0) And (Btn(t) <> wParam) Then
cName = Space(255)
Length = GetClassName(Btn(t), cName, 255)
cName = Left(cName, Length)
If UCase(cName) = "BUTTON" Then
 If ButtonText(t) <> vbNullString Then SetWindowText Btn(t), ButtonText(t)
End If
 End If
Next t
UnhookWindowsHookEx hHook
 End If
 ChangeButtonsText = False
End Function
Private Function SetPasswordChar(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 Const EM_SETPASSWORDCHAR As Long = &HCC
 Dim t As Integer, cName As String, Length As Long, Btn(0 To 3) As Long
 If lMsg = HCBT_ACTIVATE Then
Btn(0) = FindWindowEx(wParam, 0, vbNullString, vbNullString)
For t = 1 To 3
 Btn(t) = FindWindowEx(wParam, Btn(t - 1), vbNullString, vbNullString)
 If Btn(t) = 0 Then Exit For
Next t
For t = 0 To 3
 If (Btn(t) <> 0) And (Btn(t) <> wParam) Then
cName = Space(255)
Length = GetClassName(Btn(t), cName, 255)
cName = Left(cName, Length)
If LCase$(cName) = "edit" Then SendMessage Btn(t), EM_SETPASSWORDCHAR, ByVal PasswordChar, ByVal 0&
 End If
Next t
UnhookWindowsHookEx hHook
 End If
 SetPasswordChar = False
End Function
Public Function CustomMsgBox(ByVal zMessage As String, Optional ByVal zButtons As VbMsgBoxStyle = vbOKOnly, Optional ByVal zTitle As String = vbNullString, Optional ByVal Button1Text As String = vbNullString, Optional ByVal Button2Text As String = vbNullString, Optional ByVal Button3Text As String = vbNullString) As VbMsgBoxResult
 Dim Thread As Long
 ButtonText(0) = Button1Text
 ButtonText(1) = Button2Text
 ButtonText(2) = Button3Text
 Thread = GetCurrentThreadId()
 hHook = SetWindowsHookEx(WH_CBT, AddressOf ChangeButtonsText, ByVal 0&, Thread)
 If zTitle = vbNullString Then
CustomMsgBox = MsgBox(zMessage, zButtons)
 Else
CustomMsgBox = MsgBox(zMessage, zButtons, zTitle)
 End If
End Function
Public Function PasswordBox(ByVal zMessage As String, Optional ByVal zTitle As String = vbNullString, Optional ByVal zPasswordChar As Byte = 42) As String
 Dim Thread As Long
 PasswordChar = zPasswordChar
 Thread = GetCurrentThreadId()
 hHook = SetWindowsHookEx(WH_CBT, AddressOf SetPasswordChar, ByVal 0&, Thread)
 If zTitle = vbNullString Then
PasswordBox = InputBox(zMessage)
 Else
PasswordBox = InputBox(zMessage, zTitle)
 End If
End Function


Other 10 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments

12/2/2005 7:59:17 AMVBtutor

Please post a working sample in zip file
(If this comment was disrespectful, please report it.)

 
12/2/2005 10:04:03 AMSerge Lachapelle

just copy the code in a module and replace msgbox and inputbox functions with CustomMsgBox and PasswordBox

(If this comment was disrespectful, please report it.)

 
12/3/2005 2:46:41 AMTAU

Excellent, but you could have included an example instead of asking the people to copy and paste.
(If this comment was disrespectful, please report it.)

 
12/3/2005 6:19:40 PMRemo Gkardi

Good and clear code, 5 from me, thanks for posting!
(If this comment was disrespectful, please report it.)

 
12/4/2005 7:00:19 AMpietro ing. cecchi

this code is truly excellent...
thank you very much Serge

ce code est vraiment excellent...
merci beaucoup Serge

(If this comment was disrespectful, please report it.)

 
5/17/2007 5:14:28 AMtain

Very excellent, and easy to use. But it more better if can change button's caption text in inputbox too. Thanks
(If this comment was disrespectful, please report it.)

 
7/16/2008 6:13:01 AMLaurent Gaillard

Your code works fine under windows XP. Thank you for it.
UNFORTUNATELY, there is a problem under Windows Vista:
Button1Text is lost, Button2Text goes on first button, Button3Text goes on second button, and third button shows the default text.

To work on vista, I've found that we have to change following code
ButtonText(0) = Button1Text
ButtonText(1) = Button2Text
ButtonText(2) = Button3Text
by this one
ButtonText(1) = Button1Text
ButtonText(2) = Button2Text
ButtonText(3) = Button3Text

Can you please give a better solution, for your code to be compatible with windows XP and windows Vista AT THE SAME TIME?

Please help, THANK YOU IN ADVANCE !
(If this comment was disrespectful, please report it.)

 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.