changing font size of prompt message of Inputbox
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 3 of 3

Thread: changing font size of prompt message of Inputbox

  1. #1
    Guest

    changing font size of prompt message of Inputbox

    Hi
    I found the prompt message of inputbox is very small and dull, just like
    the below statement, how can make the prompt message bold and even italic
    or larger ?

    AA = inputbox ("Please Input the Correct Password")


  2. #2
    Join Date
    Sep 1999
    Location
    Red Wing, MN USA
    Posts
    312

    Re: changing font size of prompt message of Inputbox

    Here's some code I've been working on to Modify things like the System Dialogs, this one offers an InputBoxEx function which has additional parameters for BackColor, ForeColor, FontName and FontSize.

    In a Module..

    '****************************************************
    '* InputBoxEx() - Written by Aaron Young, Jan 2000
    '*
    '* MailTo:ajyoung@pressenter.com
    '*
    '* Allows the Back/Fore Color and Font Name/Size of
    '* an InputBox to be Customized.
    '*
    '* >> If you use this code or a modified version <<
    '* >> Please mention me in the Credits. <<
    '*
    option Explicit

    public Type LOGBRUSH
    lbStyle as Long
    lbColor as Long
    lbHatch as Long
    End Type

    public Type CWPSTRUCT
    lParam as Long
    wParam as Long
    message as Long
    hwnd as Long
    End Type

    private Type RECT
    Left as Long
    Top as Long
    Right as Long
    Bottom as Long
    End Type

    public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination as Any, Source as Any, byval Length as Long)
    public 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
    public Declare Function CallNextHookEx Lib "user32" (byval hHook as Long, byval nCode as Long, byval wParam as Long, lParam as Any) as Long
    public Declare Function UnhookWindowsHookEx Lib "user32" (byval hHook as Long) as Long
    public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (byval hwnd as Long, byval nIndex as Long, byval dwNewLong as Long) as Long
    public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (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 GetClassName Lib "user32" Alias "GetClassNameA" (byval hwnd as Long, byval lpClassName as string, byval nMaxCount as Long) as Long
    public Declare Function SetBkColor Lib "gdi32" (byval hdc as Long, byval crColor as Long) as Long
    public Declare Function SetTextColor Lib "gdi32" (byval hdc as Long, byval crColor as Long) as Long
    public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush as LOGBRUSH) as Long
    private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (byval H as Long, byval W as Long, byval E as Long, byval O as Long, byval W as Long, byval I as Long, byval u as Long, byval S as Long, byval C as Long, byval OP as Long, byval CP as Long, byval Q as Long, byval PAF as Long, byval F as string) as Long
    private Declare Function SelectObject Lib "gdi32" (byval hdc as Long, byval hObject as Long) 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 GetWindowRect Lib "user32" (byval hwnd as Long, lpRect as RECT) as Long
    private Declare Function GetSysColor Lib "user32" (byval nIndex as Long) as Long

    private Const COLOR_BTNFACE = 15
    private Const COLOR_BTNTEXT = 18

    private Const WM_GETFONT = &H31

    private Const SWP_FRAMECHANGED = &H20
    private Const SWP_NOSIZE = &H1
    private Const SWP_NOZORDER = &H4

    public Const WH_CALLWNDPROC = 4
    private Const GWL_WNDPROC = (-4)
    private Const WM_CREATE = &H1
    private Const WM_CTLCOLORBTN = &H135
    private Const WM_CTLCOLORDLG = &H136
    private Const WM_CTLCOLORSTATIC = &H138
    private Const WM_DESTROY = &H2
    private Const WM_SHOWWINDOW = &H18

    public lHook as Long
    private lPrevWnd as Long

    private INPUTBOX_BACKCOLOR as Long
    private INPUTBOX_FORECOLOR as Long
    private INPUTBOX_FONT as string
    private INPUTBOX_FONTSIZE as Integer
    private bShowingIB as Boolean
    private bCentVert as Boolean
    private bCentHorz as Boolean

    public Function SubMsgBox(byval hwnd as Long, byval Msg as Long, byval wParam as Long, byval lParam as Long) as Long
    Dim tLB as LOGBRUSH
    Dim lFont as Long
    Dim tRECT as RECT

    Select Case Msg
    Case WM_SHOWWINDOW
    'Reposition Inputbox if Neccessary
    Call GetWindowRect(hwnd, tRECT)
    If bCentHorz then tRECT.Left = ((Screen.Width / Screen.TwipsPerPixelX) - (tRECT.Right - tRECT.Left)) / 2
    If bCentVert then tRECT.Top = ((Screen.Height / Screen.TwipsPerPixelY) - (tRECT.Bottom - tRECT.Top)) / 2
    Call SetWindowPos(hwnd, 0, tRECT.Left, tRECT.Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED)

    Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC, WM_CTLCOLORBTN
    'set the Colors
    Call SetTextColor(wParam, INPUTBOX_FORECOLOR)
    Call SetBkColor(wParam, INPUTBOX_BACKCOLOR)
    If Msg = WM_CTLCOLORSTATIC then
    'set the Font
    lFont = CreateFont(INPUTBOX_FONTSIZE, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, INPUTBOX_FONT)
    Call SelectObject(wParam, lFont)
    End If
    'Create a Solid Brush using that Color
    tLB.lbColor = INPUTBOX_BACKCOLOR
    'Return the Handle to the Brush to Paint the Messagebox
    SubMsgBox = CreateBrushIndirect(tLB)
    Exit Function

    Case WM_DESTROY
    'Remove the Inputbox Subclassing
    Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
    End Select
    SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, byval lParam)
    End Function

    public Function HookWindow(byval nCode as Long, byval wParam as Long, byval lParam as Long) as Long
    Dim tCWP as CWPSTRUCT
    Dim sClass as string
    'This is where you need to Hook the Inputbox
    CopyMemory tCWP, byval lParam, len(tCWP)
    If tCWP.message = WM_CREATE then
    sClass = Space(255)
    sClass = Left(sClass, GetClassName(tCWP.hwnd, byval sClass, 255))
    If sClass = "#32770" then
    If bShowingIB then
    'Subclass the Inputbox as it's created
    lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
    End If
    End If
    End If
    HookWindow = CallNextHookEx(lHook, nCode, wParam, byval lParam)
    End Function

    public Function InputBoxEx(byval Prompt as string, optional byval Title as string, optional byval Default as string, optional byval XPos as Single = -1, optional byval YPos as Single = -1, optional byval HelpFile as string, optional byval Context as Long, optional byval ForeColor as ColorConstants, optional byval BackColor as ColorConstants, optional byval FontName as string, optional byval FontSize as Long) as string
    'set the Defaults
    If len(Title) = 0 then Title = App.Title
    INPUTBOX_FONT = "MS Sans Serif"
    INPUTBOX_FONTSIZE = 8
    INPUTBOX_FORECOLOR = GetSysColor(COLOR_BTNTEXT)
    INPUTBOX_BACKCOLOR = GetSysColor(COLOR_BTNFACE)
    bCentHorz = (XPos = -1)
    bCentVert = (YPos = -1)
    'set the Font and Colors
    If len(FontName) then INPUTBOX_FONT = FontName
    If FontSize > 0 then INPUTBOX_FONTSIZE = FontSize
    If ForeColor > 0 then INPUTBOX_FORECOLOR = ForeColor
    If BackColor > 0 then INPUTBOX_BACKCOLOR = BackColor
    'Show the Modified Inputbox
    bShowingIB = true
    InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    bShowingIB = false
    End Function



    In the Form..

    private Sub Command1_Click()
    on error GoTo CancelError
    With CommonDialog1
    .CancelError = true
    .Flags = cdlCFScreenFonts
    .ShowFont
    'Use Modified InputBox with Selected Font and Size
    Caption = InputBoxEx("This is a Modified Inputbox!!", , , , , , , , , .FontName, .FontSize)
    End With
    CancelError:
    End Sub

    private Sub Form_Load()
    'Monitor All Messages to this Thread.
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
    End Sub

    private Sub Form_Unload(Cancel as Integer)
    'Remove the Hook
    Call UnhookWindowsHookEx(lHook)
    End Sub




    Aaron Young
    Analyst Programmer
    ajyoung@pressenter.com
    aarony@redwingsoftware.com
    Aaron Young
    Senior Programmer Analyst (Red Wing Software)
    Certified AllExperts Expert

  3. #3
    Join Date
    May 1999
    Location
    Oxford UK
    Posts
    1,459

    Re: changing font size of prompt message of Inputbox

    That's excellent - I only had a couple of problems where sometimes the font isn't displayed properly, but I'll look into it (and post to the site if you like).


    Chris Eastwood

    CodeGuru - the website for developers
    http://codeguru.developer.com/vb

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center