You can set the display position and the message box (msgbox) in the font)

Source: Internet
Author: User
Tags drawtext

. Net default msgbox display position can only be in the middle of the screen, the font is,
In many cases, msgbox must be displayed at the specified position, and the msgbox font can be controlled.
I encapsulated a message box that can set the display position and font, which is implemented by using APIs. Its parameters are the same as those of msgbox.
Usage:
Dim PM as new mymsgbox
PM. Location = your location ''sets the location
PM. msgfont = your font ''set the font
PM. Show ("text", "title ")
It can also be placed in the middle of a form: PM. centertoform (your form)

Below is the source code (VB. NET ),
The source code also involves the calling techniques of API functions in VB. NET,
API functions are very convenient to use in VB, but they are not the same in VB. NET,
You must modify the parameter type. Otherwise, a stack asymmetry error occurs,
This type of error often causes a large number of functions that can be conveniently implemented using APIs in VB to be smoothly converted to VB. NET.
(For details about how to modify the parameter type, refer to the call of non-hosted DLL in msdn)

Imports system. Windows. Forms
Imports system. Drawing
Imports system. runtime. interopservices
''' <Summary>
''' Can be set to a message box centered on a form or any position
''' </Summary>
''' <Remarks> </remarks>
Public class mymsgbox

# Region "variable"
''' <Summary>
''' Location type of the message box
''' </Summary>
''' <Remarks> </remarks>
Private Enum mymessageboxpostype
Msgcenterform = 0
Msglocation = 1
End Enum
Private m_centerform as form
Private m_location as point
Private m_font as font
Private m_messageboxtype as mymessageboxpostype
Private m_title as string
Private m_text as string
# End Region

# Region "attributes"
''' <Summary>
''' Text of the message box
''' </Summary>
''' <Value> </value>
''' <Returns> </returns>
''' <Remarks> </remarks>
Property msgfont () as font
Get
Return m_font
End get
Set (byval value as font)
M_font = Value
Settimer (0, 0, 10 &, addressof settingfontproc)
End set
End Property
''' <Summary>
''' Location of the message box
''' </Summary>
''' <Value> </value>
''' <Returns> </returns>
''' <Remarks> </remarks>
Property location () as point
Get
Return m_location
End get
Set (byval value as point)
M_location = Value
Locationmsgbox ()
End set
End Property
# End Region

# Region "API Declaration related to Form Location Settings"
Structure rect
Public left as integer
Public top as integer
Public right as integer
Public bottom as integer
End Structure
Public const gwl_hinstance = (-6)
Public const swp_nosize = & H1
Public const swp_nozorder = & h4
Public const swp_noactivate = & H10
Public const hcbt_activate = 5
Public const wh_cbt = 5
Public hhook as integer
<Dllimport ("user32.dll")> Public shared function unhookwindowshookex (byval hhook as integer) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "getwindowlonga")> Public shared function getwindowlong (byval hwnd as integer, byval nindex as integer) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "setwindowshookexa")> Public overloads shared function setwindowshookex (byval idhook as integer, byval lpfn as counter, byval hmod as integer, byval dwthreadid as integer) as integer
End Function
<Dllimport ("user32.dll")> Public shared function setwindowpos (byval hwnd as integer, byval hwndinsertafter as integer, byval X as integer, byval y as integer, byval CX as integer, byval Cy as integer, byval wflags as integer) as integer
End Function
<Dllimport ("user32.dll")> Public shared function getwindowrect (byval hwnd as integer, byref lprect as rect) as integer
End Function
<Dllimport ("kernel32.dll")> Public shared function getcurrentthreadid () as integer
End Function
# End Region

# Region "message box font setting API Declaration related"
Public const turn_on_updates as long = 0
Public const api_true as long = 1 &
Public const api_false as long = 0 &
Public const wm_setfont as long = & h30 &
Public const wm_settext as long = & HC &
Public const wm_setredraw as long = & HB &
'Draw text flags
Public const dt_wordbreak as long = & H10 &
Public const dt_calcrect as long = & H400 &
Public const dt_editcontrol as long = & h2000 &
Public const dt_end_ellipsis as long = & h8000 &
Public const dt_modifystring as long = & h10000
Public const dt_path_ellipsis as long = & h4000 &
Public const dt_rtlreading as long = & h20000
Public const dt_word_ellipsis as long = & h40000
<Dllimport ("user32.dll")> Public shared function getasktopwindow () as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "find0000wa")> Public shared function findwindow (byval lpclassname as string, byval lpwindowname as string) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "find1_wexa")> Public shared function find1_wex (byval hwndparent as integer, byval encoded as integer, byval pclassname as string, byval lpwindowname as string) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "sendmessagea")> Public shared function sendmessage (byval hwnd as integer, byval wmsg as integer, byval wparam as integer, byref lparam as object) as integer
End Function
<Dllimport ("user32.dll")> Public shared function movewindow (byval hwnd as integer, byval X as integer, byval y as integer, byval nwidth as integer, byval nheight as integer, byval brepaint as integer) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "screentoclient")> Public shared function screentoclientlong (byval hwnd as integer, byref lppoint as integer) as integer
End Function
<Dllimport ("user32.dll")> Public shared function getdc (byval hwnd as integer) as integer
End Function
<Dllimport ("user32.dll")> Public shared function releasedc (byval hwnd as integer, byval HDC as integer) as integer
End Function
<Dllimport ("user32.dll", entrypoint: = "drawtexta")> Public shared function drawtext (byval HDC as integer, byval lpsz as string, byval cchtext as integer, byref lprect as rect, byval dwdtformat as integer) as integer
End Function
<Dllimport ("user32.dll")> Public shared function settimer (byval hwnd as integer, byval nidevent as integer, byval uelapse as integer, byval lptimerfunc as delegatesettingfontproc) as integer
End Function
<Dllimport ("user32.dll")> Public shared function killtimer (byval hwnd as integer, byval nidevent as integer) as integer
End Function
# End Region

# Region "Display message box"
''' <Summary>
''' Display message box
''' </Summary>
''' <Param name = "text"> display text </param>
''' <Param name = "title"> message box title </param>
''' <Param name = "buttons"> button style </param>
''' <Param name = "icon"> icon style </param>
''' <Param name = "defaultbutton"> default button </param>
''' <Param name = "options"> message box options </param>
''' <Param name = "displayhelpbutton"> whether to display the Help button </param>
''' <Returns> message box execution result </returns>
''' <Remarks> </remarks>
Public Function show (byval text as string, optional byval title as string = "", optional byval buttons as messageboxbuttons = 0, optional byval icon as messageboxicon = 0, optional byval defaultbutton as messageboxdefaultbutton = 0, optional byval options as messageboxoptions = 0, optional byval displayhelpbutton as Boolean = false) as dialogresult
M_text = text
M_title = title
Return MessageBox. Show (text, title, buttons, icon, defaultbutton, options, displayhelpbutton)
End Function
# End Region

# Region "set the message box to center or delegate at any location"
''' <Summary>
''' Delegate
''' </Summary>
''' <Param name = "lmsg"> </param>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> </remarks>
Delegate function delegatesettingpositionproc (byval lmsg as integer, byval wparam as integer, byval lparam as integer) as integer
''' <Summary>
'''Callback function, set according to different requirements
''' </Summary>
''' <Param name = "lmsg"> </param>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> </remarks>
Private function settingpositionproc (byval lmsg as integer, byval wparam as integer, byval lparam as integer) as integer
Select case m_messageboxtype
Case mymessageboxpostype. msgcenterform
Centermsgboxproc (lmsg, wparam, lparam)
Case mymessageboxpostype. msglocation
Locationmsgboxproc (lmsg, wparam, lparam)
End select
End Function
# End Region

# Region "setting the message box to any location"
''' <Summary>
''' The location of the message box is set.
''' </Summary>
''' <Remarks> </remarks>
Private sub locationmsgbox ()
M_messageboxtype = mymessageboxpostype. msglocation
Dim hinst as integer
Dim thread as integer
'Set the CBT hook
Hinst = getwindowlong (0, gwl_hinstance)
Thread = getcurrentthreadid ()
Hhook = setwindowshookex (wh_cbt, addressof settingpositionproc, hinst, thread)
End sub
''' <Summary>
'''Callback function to set the position of the form
''' </Summary>
''' <Param name = "lmsg"> </param>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> </remarks>
Function locationmsgboxproc (byval lmsg as integer, byval wparam as integer, byval lparam as integer) as integer
If lmsg = hcbt_activate then
'Set msgbox location
Setwindowpos (wparam, 0, m_location.x, m_location.y, 0, 0, swp_nosize or swp_nozorder or swp_noactivate)
'Release the CBT hook
Unhookwindowshookex (hhook)
End if
End Function
# End Region

# Region "setting message box Center"
''' <Summary>
''' Sets the message box to be displayed to be centered in a form.
''' </Summary>
''' <Param name = "centerform"> This form </param>
''' <Remarks> </remarks>
Public sub centertoform (byval centerform as form)
M_messageboxtype = mymessageboxpostype. msgcenterform
M_centerform = centerform
Dim hinst as integer
Dim thread as integer
'Set the CBT hook
Hinst = getwindowlong (m_centerform.handle, gwl_hinstance)
Thread = getcurrentthreadid ()
Hhook = setwindowshookex (wh_cbt, addressof settingpositionproc, hinst, thread)
End sub
''' <Summary>
'''Callback function, set the form to center
''' </Summary>
''' <Param name = "lmsg"> </param>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> </remarks>
Function centermsgboxproc (byval lmsg as integer, byval wparam as integer, byval lparam as integer) as integer
Dim rectform as rect, rectmsg as rect
Dim X as integer, y as integer
'When lmsg is hcbt_activate, set msgbox to center in the form
If lmsg = hcbt_activate then
''To get the form and msgbox positions, so that you can set the msgbox positions.
Getwindowrect (m_centerform.handle, rectform)
Getwindowrect (wparam, rectmsg)
X = (rectform. Left + (rectform. Right-rectform. Left)/2)-(rectmsg. Right-rectmsg. Left)/2)
Y = (rectform. Top + (rectform. Bottom-rectform. Top)/2)-(rectmsg. Bottom-rectmsg. Top)/2)
'Set msgbox location
Setwindowpos (wparam, 0, x, y, 0, 0, swp_nosize or swp_nozorder or swp_noactivate)
'Release the CBT hook
Unhookwindowshookex (hhook)
End if
End Function
# End Region

# Region "set the message box font"
''' <Summary>
''' Set the font delegate
''' </Summary>
''' <Param name = "hwnd"> </param>
''' <Param name = "umsg"> </param>
''' <Param name = "idevent"> </param>
''' <Param name = "dwtime"> </param>
''' <Remarks> </remarks>
Delegate sub delegatesettingfontproc (byval hwnd as integer, byval umsg as integer, byval idevent as integer, byval dwtime as integer)
''' <Summary>
''' Set the font
''' </Summary>
''' <Param name = "hwnd"> </param>
''' <Param name = "umsg"> </param>
''' <Param name = "idevent"> </param>
''' <Param name = "dwtime"> </param>
''' <Remarks> </remarks>
Public sub settingfontproc (byval hwnd as integer, byval umsg as integer, byval idevent as integer, byval dwtime as integer)
Killtimer (hwnd, idevent)
Dim hmsgbox as integer
''To get the message box handle
Hmsgbox = findwindow ("#32770", m_title)
If hmsgbox then
Dim hstatic as integer, hbutton as integer
Dim ststaticrect, stbuttonrect, stmsgboxrect2 as rect
''To get the handle of static control and button
Hstatic = find1_wex (hmsgbox, api_false, "static", m_text)
Hbutton = find1_wex (hmsgbox, api_false, "button", "OK ")
''Change the font and redefine the display size.
If hstatic then
''To get the range of message boxes, text, and buttons
Getwindowrect (hmsgbox, stmsgboxrect2)
Getwindowrect (hstatic, ststaticrect)
Getwindowrect (hbutton, stbuttonrect)
''Set the message box font
Sendmessage (hstatic, wm_setfont, m_font.tohfont, api_true)
Sendmessage (hbutton, wm_settext, 0 &, "close ")
Dim nrectheight &, nheightdifference &, hstaticdc &
With ststaticrect
'Convert coordinates from the screen to the current form
Screentoclientlong (hmsgbox,. Left)
Screentoclientlong (hmsgbox,. Right)
'Get the height of the current text
Nheightdifference =. Bottom-. Top
'Get the DC of Static Control
Hstaticdc = getdc (hstatic)
Nrectheight = drawtext (hstaticdc, m_text, (-1 &), ststaticrect, dt_calcrect or dt_editcontrol or dt_wordbreak)
''Release DC
Releasedc (hstatic, hstaticdc)
Nheightdifference = nrectheight-nheightdifference
'Resize msgbox
Movewindow (hstatic,. Left,. Top,. Right-. Left, nrectheight, api_true)
End
''Move the button to the corresponding position
With stbuttonrect
Screentoclientlong (hmsgbox,. Left)
Screentoclientlong (hmsgbox,. Right)
Movewindow (hbutton,. Left,. Top + nheightdifference,. Right-. Left,. Bottom-. Top, api_true)
End
With stmsgboxrect2
Movewindow (hmsgbox,. Left,. Top-(nheightdifference \ 2),. Right-. Left, (. Bottom-. Top) + nheightdifference, api_true)
End
End if
End if
'Unlock it
If turn_on_updates then sendmessage (getasktopwindow (), wm_setredraw, api_true, 0 &)
End sub

# End Region

End Class

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.