Posted 04 April 2009 - 02:57 AM
firebolt, on 4 Apr, 2009 - 12:53 AM, said:
Posted 04 April 2009 - 09:42 AM
mailderemi, on 27 Jan, 2009 - 09:55 PM, said:
Posted 05 April 2009 - 07:21 AM
firebolt, on 4 Apr, 2009 - 02:00 AM, said:
Posted 05 April 2009 - 09:38 AM
Posted 06 April 2009 - 06:12 AM
Posted 08 May 2009 - 11:43 PM
Posted 09 May 2009 - 03:58 AM
eyes_angel, on 5 Apr, 2009 - 06:21 AM, said:
firebolt, on 4 Apr, 2009 - 02:00 AM, said:
Posted 19 May 2009 - 05:33 PM
eyes_angel, on 5 Apr, 2009 - 06:21 AM, said:
firebolt, on 4 Apr, 2009 - 02:00 AM, said:
Posted 19 May 2009 - 05:58 PM
PsychoCoder, on 5 Apr, 2009 - 08:38 AM, said:
'This code allows font changes and various other format customizations of the standard VB6 MsgBox dialog box. It 'uses CBT hooking to intercept a MsgBox call, then gets a handle to the MsgBox window as well as its various child 'windows (the label containing the message text, any buttons, and an icon if it exists). It then resizes the 'window to accommodate the message text and other windows, and repositions the icon and any command buttons. 'Finally, it positions the msgbox window in the center of the screen. 'General Note: notes are above the line of code to which they apply. Option Explicit ' Window size and position constants Private Const ICON_WIDTH As Integer = 32 Private Const BTN_WIDTH As Integer = 75 Private Const BTN_HEIGHT As Integer = 23 Private Const BTN_SPACER As Integer = 6 ' Space between 2 buttons Private Const STW_OFFSET As Integer = 12 ' Standard window offset, minimum distance one window can be from ' the edge of its container ' SendMessage constants that we will use Private Const WM_SETFONT = &H30 Private Const WM_GETTEXT = &HD ' Necessary constants for hooking Private Const HCBT_CREATEWND = 3 Private Const HCBT_ACTIVATE = 5 Private Const WH_CBT = 5 ' Working variables that require global scope in hooking module Private hHook As Long Private myFont As IFont Private cPrompt As String Private hwndStatic As Long Private ButtonHandles() As Long Private xPixels As Long Private yPixels As Long Private isIcon As Boolean ' The API declarations we need Private Type SIZE cx As Long cy As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 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 'GETTEXT needs a String argument, SETFONT needs an Any argument, hence 2 declarations for SendMessage Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' Wrapper for the normal MsgBox function Public Function myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, ByVal fSize As Integer, ByVal fBold As Boolean, ByVal fItalic As Boolean, ByVal fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional x As Long, Optional y As Long) As Long 'x and y arguments are optional and are in twips. If not specified, msgbox will use default window sizes 'and positions, which work fine if you are using default font sizes. If you aren't they may not. cPrompt = Prompt Set myFont = New StdFont myFont.SIZE = fSize ' We can play around with the font to our heart's content here, all in a VB-friendly way myFont.Bold = fBold myFont.Italic = fItalic myFont.Underline = fULine myFont.Name = fFaceName 'Convert x and y arguments to pixels from twips. (Twips are the same size no matter what the screen 'resolution; pixels aren't.) If Not IsMissing(x) Then xPixels = Int(x / Screen.TwipsPerPixelX) End If If Not IsMissing(y) Then yPixels = Int(y / Screen.TwipsPerPixelY) End If hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0) 'This will call CBTProc, passing the handle of the MsgBox window to the wParam argument. myMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context) End Function Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim i As Integer Dim statX As Integer 'X dimension of static (text) window Dim statY As Integer 'Y dimension of same Dim cLeft As Integer 'Current Left value for current button, used to position buttons along x axis Dim rc As RECT 'Used with GetClientRect If lMsg = HCBT_ACTIVATE Then 'Immediately unhook (we have the handle we're looking for, and don't want to fire any more CBT events) UnhookWindowsHookEx hHook 'Call EnumChildWindowProc once for each window that is contained in the MsgBox EnumChildWindows wParam, AddressOf EnumChildWindowProc, 0 'Reinitialize the static buttoncount variable, see the proc EnumChildWindowProc 0, 1 'Should always be true, but this prevents an abend if for some reason we fail to get the text window If hwndStatic Then 'If the x parameter has been supplied to the main wrapper, then xPixels <> 0 If xPixels Then With Screen 'Center the MsgBox window in the screen SetWindowPos wParam, 0, (.Width / .TwipsPerPixelX - xPixels) / 2, _ (.Height / .TwipsPerPixelY - yPixels) / 2, xPixels, yPixels, 0 End With 'Analogous to the ScaleWidth and ScaleHeight properties. Client rectangle's dimensions are 'returned to the rc type and exclude the dimensions of the title bar and the borders. GetClientRect wParam, rc 'Calculate x and y values for text window. If there's an icon, we need to reduce the size of the 'text window by the width of the icon plus a standard offset value. statX = rc.Right - rc.Left - STW_OFFSET * 2 - ((isIcon And 1) * (ICON_WIDTH + STW_OFFSET)) statY = rc.Bottom - rc.Top - BTN_HEIGHT - STW_OFFSET * 2 'We need to position the text window along the x axis such that it's a standard offset from the left 'border of the msgbox, plus the width of the icon and another standard offset if the icon exists. SetWindowPos hwndStatic, 0, STW_OFFSET + (isIcon And 1) * (ICON_WIDTH + STW_OFFSET), STW_OFFSET, statX, statY, 0 isIcon = 0 'Loop through the button handles, calculating the left border position each time. For i = 0 To UBound(ButtonHandles) 'Current left border is half the container window's width, less the width of half the total 'number of buttons, plus the offset of the current button in the array. cLeft = Int(xPixels / 2 + BTN_WIDTH * (i - (UBound(ButtonHandles) + 1) / 2)) 'Modify the above to add button spacer widths. cLeft = cLeft + BTN_SPACER * (i - (UBound(ButtonHandles) - 1) + (UBound(ButtonHandles) Mod 2) / 2) 'The Y value is 1 standard offset more than the height of the text window. SetWindowPos ButtonHandles(i), 0, cLeft, statY + STW_OFFSET, BTN_WIDTH, BTN_HEIGHT, 0 Next End If SendMessage hwndStatic, WM_SETFONT, myFont.hFont, True End If End If CBTProc = 0 ' allow operation to continue End Function Private Function EnumChildWindowProc(ByVal hChild As Long, ByVal lParam As Long) As Long Static ButtonCount As Integer Dim sLen As Integer Dim wClass As String Dim wText As String Dim rc As RECT If lParam Then ButtonCount = 0 'See the direct call of this proc in CBTProc: resets the ButtonCount variable to 0 Exit Function End If wClass = String(64, 0) 'look up the type of the current window sLen = GetClassName(hChild, wClass, 63) wClass = Left(wClass, sLen) 'We have either one or two static windows: optionally the icon (the first window if it's there) and the 'text window (analogous to a label control). If wClass = "Static" Then 'If we already have the text window's handle, we don't need to do this anymore. If Not hwndStatic Then 'Find out if the current window's text value is the same as the text passed in to the cPrompt 'argument in the main wrapper function. If it is, it's the text window and we store the handle 'value in hwndStatic. If it isn't, then it's an icon and we set the isIcon flag. wText = String(Len(cPrompt) + 1, 0) sLen = SendMessageS(hChild, WM_GETTEXT, 255, wText) wText = Left(wText, sLen) If wText = cPrompt Then hwndStatic = hChild Else isIcon = True End If End If ElseIf wClass = "Button" Then 'Store the button's handle in the ButtonHandles array ReDim Preserve ButtonHandles(ButtonCount) ButtonHandles(ButtonCount) = hChild ButtonCount = ButtonCount + 1 End If EnumChildWindowProc = 1 ' Continue enumeration End Function
firebolt, on 6 Apr, 2009 - 04:58 AM, said:
Posted 26 May 2009 - 08:09 PM
)
Posted 28 May 2009 - 04:46 AM
|
|
New Topic/Question
Reply
MultiQuote
| 