home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / The_messag2066355182007.psc / Module1.bas < prev    next >
BASIC Source File  |  2007-05-19  |  11KB  |  247 lines
  1. Attribute VB_Name = "Module1"
  2.   Option Explicit
  3.   ' demo project showing how to use the API to manipulate a messagebox
  4.   ' by Bryan Stafford of New Vision Software« - newvision@imt.net
  5.   ' this demo is released into the public domain "as is" without
  6.   ' warranty or guaranty of any kind.  In other words, use at
  7.   ' your own risk.
  8.   
  9.  Public Const MSG_TITLE = "Question"
  10.   
  11.   ' the max length of a path for the system (usually 260 or there abouts)
  12.   ' this is used to size the buffer string for retrieving the class name of the active window below
  13.   Public Const MAX_PATH As Long = 260&
  14.  
  15.   Public Const API_TRUE As Long = 1&
  16.   Public Const API_FALSE As Long = 0&
  17.   
  18.   ' font *borrowed* from the form used to replace MessageBox font
  19.   Public g_hBoldFont As Long
  20.   
  21.   Public Const MSGBOXTEXT As String = "Have you ever seen a standard message box with a different font than all the others on the system?"
  22.   Public Const WM_SETFONT As Long = &H30
  23.  
  24.   ' made up constants for setting our timer
  25.   Public Const NV_CLOSEMSGBOX As Long = &H5000&
  26.   Public Const NV_MOVEMSGBOX As Long = &H5001&
  27.   Public Const NV_MSGBOXCHNGFONT As Long = &H5002&
  28.  
  29.   ' MessageBox() Flags
  30.   Public Const MB_ICONQUESTION As Long = &H20&
  31.   Public Const MB_TASKMODAL As Long = &H2000&
  32.  
  33.   ' SetWindowPos Flags
  34.   Public Const SWP_NOSIZE As Long = &H1&
  35.   Public Const SWP_NOZORDER As Long = &H4&
  36.   Public Const HWND_TOP As Long = 0&
  37.  
  38.   Type RECT
  39.     Left As Long
  40.     Top As Long
  41.     Right As Long
  42.     Bottom As Long
  43.   End Type
  44.  
  45.   ' API declares
  46.   Public Declare Function LockWindowUpdate& Lib "user32" (ByVal hwndLock&)
  47.   
  48.   Public Declare Function GetActiveWindow& Lib "user32" ()
  49.   
  50.   Public Declare Function GetDesktopWindow& Lib "user32" ()
  51.   
  52.   Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, _
  53.                                                                         ByVal lpWindowName$)
  54.  
  55.   Public Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent&, _
  56.                               ByVal hWndChildAfter&, ByVal lpClassName$, ByVal lpWindowName$)
  57.  
  58.   Public Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal _
  59.                                                         wMsg&, ByVal wParam&, lParam As Any)
  60.  
  61.   Public Declare Function MoveWindow& Lib "user32" (ByVal hWnd&, ByVal x&, ByVal y&, _
  62.                                               ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&)
  63.  
  64.   Public Declare Function ScreenToClientLong& Lib "user32" Alias "ScreenToClient" (ByVal hWnd&, _
  65.                                                                                     lpPoint&)
  66.   
  67.   Public Declare Function GetDC& Lib "user32" (ByVal hWnd&)
  68.   Public Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hDC&)
  69.  
  70.   ' drawtext flags
  71.   Public Const DT_WORDBREAK As Long = &H10&
  72.   Public Const DT_CALCRECT As Long = &H400&
  73.   Public Const DT_EDITCONTROL As Long = &H2000&
  74.   Public Const DT_END_ELLIPSIS As Long = &H8000&
  75.   Public Const DT_MODIFYSTRING As Long = &H10000
  76.   Public Const DT_PATH_ELLIPSIS As Long = &H4000&
  77.   Public Const DT_RTLREADING As Long = &H20000
  78.   Public Const DT_WORD_ELLIPSIS As Long = &H40000
  79.   
  80.   Public Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC&, ByVal lpsz$, _
  81.                                           ByVal cchText&, lpRect As RECT, ByVal dwDTFormat&)
  82.   
  83.   Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hWnd&)
  84.   
  85.   Public Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hWnd&, _
  86.                                                         ByVal lpClassName$, ByVal nMaxCount&)
  87.  
  88.   Public Declare Function GetWindowRect& Lib "user32" (ByVal hWnd&, lpRect As RECT)
  89.   
  90.   Public Declare Function SetWindowPos& Lib "user32" (ByVal hWnd&, ByVal hWndInsertAfter&, _
  91.                                       ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
  92.                                       
  93.   Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" (ByVal hWnd&, _
  94.                                                 ByVal lpText$, ByVal lpCaption$, ByVal wType&)
  95.  
  96.   Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, ByVal uElapse&, _
  97.                                                                             ByVal lpTimerFunc&)
  98.   
  99.   Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)
  100.  
  101. Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
  102.   ' this is a callback function.  This means that windows "calls back" to this function
  103.   ' when it's time for the timer event to fire
  104.   
  105.   ' first thing we do is kill the timer so that no other timer events will fire
  106.   KillTimer hWnd, idEvent
  107.   
  108.   ' select the type of manipulation that we want to perform
  109.   Select Case idEvent
  110.     Case NV_CLOSEMSGBOX '<-- we want to close this messagebox after 4 seconds
  111.       Dim hMessageBox&
  112.       
  113.       ' find the messagebox window
  114.       hMessageBox = FindWindow("#32770", MSG_TITLE)
  115.       
  116.       ' if we found it make sure it has the keyboard focus and then send it an enter to dismiss it
  117.       If hMessageBox Then
  118.         Call SetForegroundWindow(hMessageBox)
  119.         SendKeys "{enter}"
  120.       End If
  121.       
  122.     Case NV_MOVEMSGBOX '<-- we want to move this messagebox
  123.       Dim hMsgBox&, xPoint&, yPoint&
  124.       Dim stMsgBoxRect As RECT, stParentRect As RECT
  125.       
  126.       ' find the messagebox window
  127.       hMsgBox = FindWindow("#32770", "Position A Message Box")
  128.     
  129.       ' if we found it then move it
  130.       If hMsgBox Then
  131.         ' get the rect for the parent window and the messagebox
  132.         Call GetWindowRect(hMsgBox, stMsgBoxRect)
  133.         Call GetWindowRect(hWnd, stParentRect)
  134.         
  135.         ' calculate the position for putting the messagebox in the middle of the form
  136.         xPoint = stParentRect.Left + (((stParentRect.Right - stParentRect.Left) \ 2) - _
  137.                                               ((stMsgBoxRect.Right - stMsgBoxRect.Left) \ 2))
  138.         yPoint = stParentRect.Top + (((stParentRect.Bottom - stParentRect.Top) \ 2) - _
  139.                                               ((stMsgBoxRect.Bottom - stMsgBoxRect.Top) \ 2))
  140.         
  141.         ' make sure the messagebox will not be off the screen.
  142.         If xPoint < 0 Then xPoint = 0
  143.         If yPoint < 0 Then yPoint = 0
  144.         If (xPoint + (stMsgBoxRect.Right - stMsgBoxRect.Left)) > _
  145.                                           (Screen.Width \ Screen.TwipsPerPixelX) Then
  146.           xPoint = (Screen.Width \ Screen.TwipsPerPixelX) - (stMsgBoxRect.Right - stMsgBoxRect.Left)
  147.         End If
  148.         If (yPoint + (stMsgBoxRect.Bottom - stMsgBoxRect.Top)) > _
  149.                                           (Screen.Height \ Screen.TwipsPerPixelY) Then
  150.           yPoint = (Screen.Height \ Screen.TwipsPerPixelY) - (stMsgBoxRect.Bottom - stMsgBoxRect.Top)
  151.         End If
  152.         
  153.         
  154.         ' move the messagebox
  155.         Call SetWindowPos(hMsgBox, HWND_TOP, xPoint, yPoint, _
  156.                                         API_FALSE, API_FALSE, SWP_NOZORDER Or SWP_NOSIZE)
  157.       End If
  158.       
  159.       ' unlock the desktop
  160.       Call LockWindowUpdate(API_FALSE)
  161.       
  162.       
  163.     Case NV_MSGBOXCHNGFONT '<-- we want to change the font for this messagebox
  164.       '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  165.       ' NOTE: Changing the font of a message box is not recomemded!!
  166.       '       This portion of the demo is just provided to show some of the possibilities
  167.       '       for manipulating other windows using the Windows API.
  168.       '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  169.       
  170.       ' find the messagebox window
  171.       hMsgBox = FindWindow("#32770", "Change The Message Box Font")
  172.     
  173.       ' if we found it then find the static control that holds the text...
  174.       If hMsgBox Then
  175.         Dim hStatic&, hButton&, stMsgBoxRect2 As RECT
  176.         Dim stStaticRect As RECT, stButtonRect As RECT
  177.         
  178.         ' find the static control that holds the message text
  179.         hStatic = FindWindowEx(hMsgBox, API_FALSE, "Static", MSGBOXTEXT)
  180.         hButton = FindWindowEx(hMsgBox, API_FALSE, "Button", "OK")
  181.         
  182.         ' if we found it, change the text and resize the static control so it will be displayed
  183.         If hStatic Then
  184.           ' get the rects of the message box and the static control before we change the font
  185.           Call GetWindowRect(hMsgBox, stMsgBoxRect2)
  186.           Call GetWindowRect(hStatic, stStaticRect)
  187.           Call GetWindowRect(hButton, stButtonRect)
  188.           
  189.           ' set the font we borrowed from the form into the static control
  190.           Call SendMessage(hStatic, WM_SETFONT, g_hBoldFont, ByVal API_TRUE)
  191.           
  192.           With stStaticRect
  193.             ' convert the rect from screen coordinates to client coordinates
  194.             Call ScreenToClientLong(hMsgBox, .Left)
  195.             Call ScreenToClientLong(hMsgBox, .Right)
  196.             
  197.             Dim nRectHeight&, nHeightDifference&, hStaticDC&
  198.             
  199.             ' get the current height of the static control
  200.             nHeightDifference = .Bottom - .Top
  201.             
  202.             ' get the device context of the static control to pass to DrawText
  203.             hStaticDC = GetDC(hStatic)
  204.             
  205.             ' use DrawText to calculate the new height of the static control
  206.             nRectHeight = DrawText(hStaticDC, MSGBOXTEXT, (-1&), stStaticRect, _
  207.                                               DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK)
  208.             
  209.             ' release the DC
  210.             Call ReleaseDC(hStatic, hStaticDC)
  211.             
  212.             ' calculate the difference in height
  213.             nHeightDifference = nRectHeight - nHeightDifference
  214.             
  215.             ' resize the static control so that the new larger bold text will fit in the messagebox
  216.             Call MoveWindow(hStatic, .Left, .Top, .Right - .Left, nRectHeight, API_TRUE)
  217.           End With
  218.             
  219.           ' move the button to the new position
  220.           With stButtonRect
  221.             ' convert the rect from screen coordinates to client coordinates
  222.             Call ScreenToClientLong(hMsgBox, .Left)
  223.             Call ScreenToClientLong(hMsgBox, .Right)
  224.             
  225.              ' move the button
  226.             Call MoveWindow(hButton, .Left, .Top + nHeightDifference, .Right - .Left, .Bottom - .Top, API_TRUE)
  227.           End With
  228.           
  229.           With stMsgBoxRect2
  230.             ' resize and reposition the messagebox
  231.             Call MoveWindow(hMsgBox, .Left, .Top - (nHeightDifference \ 2), .Right - .Left, (.Bottom - .Top) + nHeightDifference, API_TRUE)
  232.           
  233.             ' NOTE: if your message is very long, you may need to add code to make sure the messagebox
  234.             ' will not run off the screen....
  235.           End With
  236.         End If
  237.       End If
  238.       
  239.       ' unlock the desktop
  240.       Call LockWindowUpdate(API_FALSE)
  241.   
  242.   End Select
  243.   
  244. End Sub
  245.  
  246.  
  247.