Results 1 to 6 of 6

Thread: Changing font size of prompt message of Inputbox

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jul 1999
    Posts
    16

    Post

    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 ?

  2. #2
    So Unbanned DiGiTaIErRoR's Avatar
    Join Date
    Apr 1999
    Location
    /dev/null
    Posts
    4,111

    Post

    This is an easy one!
    You can't!
    You're welcome!

    ------------------
    DiGiTaIErRoR

  3. #3
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,175

    Post

    You can fairly easily construct a form that looks like an input box and do what you want with it.

    ------------------
    Marty
    Can you buy an entire chess set in a pawn shop?

  4. #4
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,175

    Post

    Nice job Aaron. I've copied your code into a project in my "I know I'm going to use this some time" VB folder. One caution - don't press the IDE "End" button with the form still running. A loop results that can only be stopped by the task Manager.

    ------------------
    Marty
    Why is it called lipstick if you can still move your lips?

  5. #5
    Guru Aaron Young's Avatar
    Join Date
    Jun 1999
    Location
    Red Wing, MN, USA
    Posts
    2,176

    Post

    Never say Never.. or Can't

    You'd probably find it easier to do as Martin suggested and create your own Form, bt if you want to modify the existing Inputbox..

    Here's some code I've been working on which allows you to customize the Colors and Font of an Inputbox:

    In a Module..
    Code:
    '****************************************************
    '* 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..
    [code]
    Private Sub Command1_Click()
    On Error GoTo CancelError
    With CommonDialog1
    .CancelError = True
    .Flags = cdlCFScreenFonts
    .ShowFont
    'Use Modified I

  6. #6
    Junior Member
    Join Date
    Jan 1999
    Posts
    26

    Post


Posting Permissions

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



Click Here to Expand Forum to Full Width