Attribute VB_Name = "modGradient" Option Explicit '============================================================================================================= ' ' modGradient Module ' ------------------ ' ' Created By : Chris Vidler ' ' Fixed By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : April 01, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : NOTHING ' ' Description : This module was designed to make it easy to visually enhance your project's forms by making ' their titlebars gradient. This module was originally created by Chris Vidler and has been ' modified/fixed since by Kevin Wilson to make it more stable, more flexible, more convenient ' to use, and less error prone at run time. ( See Below ) ' ' NOTE : If you gradiate a form's titlebar and do not call the GradientReleaseForm function in the ' Form_Unload event, you run the risk of crashing your program in debug mode as well as after ' compiled in release mode. ' ' WARNING : This module uses subclassing to draw the gradient titlebar every time the form's titlebar is ' repainted by Windows. By using this module, you'll enhance the look of your forms, but you ' run the risk of crashing Visual Basic in debug mode. To avoid this in debug mode, set the ' variable "boolNoGrad" to TRUE. This will turn off the gradiation and make it safe to debug ' your program in VB's IDE. ' ' Also, whenever you are using any subclassing to do anything, NEVER, NEVER, NEVER click the ' STOP button to halt a debug run of your program in Visual Basic's design environment. Doing ' so will instantly GPF Visual Basic. Some trapping for this has been added to this module, but ' it can't always be trapped. Instead of clicking the STOP button, just unload / close all the ' open Forms. If there's an UnSubclass function, use it in the Form_Unload event. ' ' Known Bugs : 1. If you try to use this module in Windows 98 or Windows 2000 which come with native titlebar ' gradiation, the gradient colors on the titlebars may not be drawn correctly. ' ' 2. Sometimes if the titlebar's caption font is set to BOLD, the titlebar's caption font after ' is has been gradiated is not BOLD. ' ' 3. THE ORIGINAL CODE HAD MANY MORE ( See list of fixed bugs below ) ' '_____________________________________________________________________________________________________________ ' ' ABOUT THIS MODULE : ' =================== ' ' This code was originally part of the Gradient Title Bar Example from the ' Chris Vidler Software Source Code Database ' ' This code can be used in your projects royalty free as long as the following ' lines remain intact: ' Gradient Title Bar Demo - Copyright© 1998 by Chris Vidler Software ' '_____________________________________________________________________________________________________________ ' ' ' The following bugs were fixed by Kevin Wilson on Jan 27, 2000 : ' ============================================================================================================ ' ' 1) Fixed a problem with the code drawing a row of trasparent pixels ' along the bottom of the titlebar on SIZABLE border styles. ' 2) Fixed a problem with drawing the titlebar incorrectly on some ' form border styles ' 3) Fixed a problem with the code trying to draw a form icon on the ' titlebar when it should not (Toolbox boarderstyles) ' 4) Fixed a problem with the code cutting off intentional spaces at ' the beginning of the form's caption ' 5) Added code to make debug run-time crashes much less frequent ' if the user clicks the STOP button in Visual Basic instead of ' closing the form as is normally done and trapped for ' 6) Fixed the problem where all the form's icons had a black back ' ground even if they were transparent. ' 7) Fixed the bug where the Gradient routine wouldn't properly ' gradiate MDI forms ' 8) Fixed the bug where if you set the ControlBox property to FALSE ' it would draw the icon anyways, and the gradient would end too soon ' 9) Fixed the bug where the icon and caption would not be drawn in the ' right locations. This also eliminated the appearance of flicker ' when the titlebar was redrawn. ' 10) Added the ability to easily specify the Gradient colors ' 11) Added the ability to easily adjust the quality of Gradient ' '_____________________________________________________________________________________________________________ ' ' Example Use : ' ============= ' ' Private Sub Form_Load() ' GradientSTART Me, 2, True, GRAD_BEGINCOLOR ' End Sub ' ' Private Sub Form_Unload(Cancel As Integer) ' GradientReleaseForm ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' DefLng makes the default variable type of undefined variables LONG DefLng A-Z '============================================================================================================= ' Types and Enumerations '============================================================================================================= Public Type DRAWTEXTPARAMS cbSize As Long iTabLength As Long iLeftMargin As Long iRightMargin As Long uiLengthDrawn As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName As String * 32 End Type Public Type NONCLIENTMETRICS cbSize As Long iBorderWidth As Long iScrollWidth As Long iScrollHeight As Long iCaptionWidth As Long iCaptionHeight As Long lfCaptionFont As LOGFONT iSMCaptionWidth As Long iSMCaptionHeight As Long lfSMCaptionFont As LOGFONT iMenuWidth As Long iMenuHeight As Long lfMenuFont As LOGFONT lfStatusFont As LOGFONT lfMessageFont As LOGFONT End Type '============================================================================================================= ' Constants '============================================================================================================= ' Windows Messaging Constants Public Const WM_USER = &H400 Public Const WM_NULL = &H0 Public Const WM_CREATE = &H1 Public Const WM_DESTROY = &H2 Public Const WM_MOVE = &H3 Public Const WM_SIZE = &H5 Public Const WM_ACTIVATE = &H6 Public Const WM_SETFOCUS = &H7 Public Const WM_KILLFOCUS = &H8 Public Const WM_ENABLE = &HA Public Const WM_SETREDRAW = &HB Public Const WM_SETTEXT = &HC Public Const WM_GETTEXT = &HD Public Const WM_GETTEXTLENGTH = &HE Public Const WM_PAINT = &HF Public Const WM_CLOSE = &H10 Public Const WM_QUERYENDSESSION = &H11 Public Const WM_QUIT = &H12 Public Const WM_QUERYOPEN = &H13 Public Const WM_ERASEBKGND = &H14 Public Const WM_SYSCOLORCHANGE = &H15 Public Const WM_ENDSESSION = &H16 Public Const WM_SHOWWINDOW = &H18 Public Const WM_WININICHANGE = &H1A Public Const WM_DEVMODECHANGE = &H1B Public Const WM_ACTIVATEAPP = &H1C Public Const WM_FONTCHANGE = &H1D Public Const WM_TIMECHANGE = &H1E Public Const WM_CANCELMODE = &H1F Public Const WM_SETCURSOR = &H20 Public Const WM_MOUSEACTIVATE = &H21 Public Const WM_CHILDACTIVATE = &H22 Public Const WM_QUEUESYNC = &H23 Public Const WM_GETMINMAXINFO = &H24 Public Const WM_PAINTICON = &H26 Public Const WM_ICONERASEBKGND = &H27 Public Const WM_NEXTDLGCTL = &H28 Public Const WM_SPOOLERSTATUS = &H2A Public Const WM_DRAWITEM = &H2B Public Const WM_MEASUREITEM = &H2C Public Const WM_DELETEITEM = &H2D Public Const WM_VKEYTOITEM = &H2E Public Const WM_CHARTOITEM = &H2F Public Const WM_SETFONT = &H30 Public Const WM_GETFONT = &H31 Public Const WM_SETHOTKEY = &H32 Public Const WM_GETHOTKEY = &H33 Public Const WM_QUERYDRAGICON = &H37 Public Const WM_COMPAREITEM = &H39 Public Const WM_COMPACTING = &H41 Public Const WM_OTHERWINDOWCREATED = &H42 Public Const WM_OTHERWINDOWDESTROYED = &H43 Public Const WM_COMMNOTIFY = &H44 Public Const WM_WINDOWPOSCHANGING = &H46 Public Const WM_WINDOWPOSCHANGED = &H47 Public Const WM_POWER = &H48 Public Const WM_COPYDATA = &H4A Public Const WM_CANCELJOURNAL = &H4B Public Const WM_NCCREATE = &H81 Public Const WM_NCDESTROY = &H82 Public Const WM_NCCALCSIZE = &H83 Public Const WM_NCHITTEST = &H84 Public Const WM_NCPAINT = &H85 Public Const WM_NCACTIVATE = &H86 Public Const WM_GETDLGCODE = &H87 Public Const WM_NCMOUSEMOVE = &HA0 Public Const WM_NCLBUTTONDOWN = &HA1 Public Const WM_NCLBUTTONUP = &HA2 Public Const WM_NCLBUTTONDBLCLK = &HA3 Public Const WM_NCRBUTTONDOWN = &HA4 Public Const WM_NCRBUTTONUP = &HA5 Public Const WM_NCRBUTTONDBLCLK = &HA6 Public Const WM_NCMBUTTONDOWN = &HA7 Public Const WM_NCMBUTTONUP = &HA8 Public Const WM_NCMBUTTONDBLCLK = &HA9 Public Const WM_KEYFIRST = &H100 Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const WM_CHAR = &H102 Public Const WM_DEADCHAR = &H103 Public Const WM_SYSKEYDOWN = &H104 Public Const WM_SYSKEYUP = &H105 Public Const WM_SYSCHAR = &H106 Public Const WM_SYSDEADCHAR = &H107 Public Const WM_KEYLAST = &H108 Public Const WM_INITDIALOG = &H110 Public Const WM_COMMAND = &H111 Public Const WM_SYSCOMMAND = &H112 Public Const WM_TIMER = &H113 Public Const WM_HSCROLL = &H114 Public Const WM_VSCROLL = &H115 Public Const WM_INITMENU = &H116 Public Const WM_INITMENUPOPUP = &H117 Public Const WM_MENUSELECT = &H11F Public Const WM_MENUCHAR = &H120 Public Const WM_ENTERIDLE = &H121 Public Const WM_CTLCOLORMSGBOX = &H132 Public Const WM_CTLCOLOREDIT = &H133 Public Const WM_CTLCOLORLISTBOX = &H134 Public Const WM_CTLCOLORBTN = &H135 Public Const WM_CTLCOLORDLG = &H136 Public Const WM_CTLCOLORSCROLLBAR = &H137 Public Const WM_CTLCOLORSTATIC = &H138 Public Const WM_MOUSEFIRST = &H200 Public Const WM_MOUSEMOVE = &H200 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_RBUTTONUP = &H205 Public Const WM_RBUTTONDBLCLK = &H206 Public Const WM_MBUTTONDOWN = &H207 Public Const WM_MBUTTONUP = &H208 Public Const WM_MBUTTONDBLCLK = &H209 Public Const WM_MOUSELAST = &H209 Public Const WM_PARENTNOTIFY = &H210 Public Const WM_ENTERMENULOOP = &H211 Public Const WM_EXITMENULOOP = &H212 Public Const WM_MDICREATE = &H220 Public Const WM_MDIDESTROY = &H221 Public Const WM_MDIACTIVATE = &H222 Public Const WM_MDIRESTORE = &H223 Public Const WM_MDINEXT = &H224 Public Const WM_MDIMAXIMIZE = &H225 Public Const WM_MDIPad = &H226 Public Const WM_MDICASCADE = &H227 Public Const WM_MDIICONARRANGE = &H228 Public Const WM_MDIGETACTIVE = &H229 Public Const WM_MDISETMENU = &H230 Public Const WM_DROPFILES = &H233 Public Const WM_MDIREFRESHMENU = &H234 Public Const WM_CUT = &H300 Public Const WM_COPY = &H301 Public Const WM_PASTE = &H302 Public Const WM_CLEAR = &H303 Public Const WM_UNDO = &H304 Public Const WM_RENDERFORMAT = &H305 Public Const WM_RENDERALLFORMATS = &H306 Public Const WM_DESTROYCLIPBOARD = &H307 Public Const WM_DRAWCLIPBOARD = &H308 Public Const WM_PAINTCLIPBOARD = &H309 Public Const WM_VSCROLLCLIPBOARD = &H30A Public Const WM_SIZECLIPBOARD = &H30B Public Const WM_ASKCBFORMATNAME = &H30C Public Const WM_CHANGECBCHAIN = &H30D Public Const WM_HSCROLLCLIPBOARD = &H30E Public Const WM_QUERYNEWPALETTE = &H30F Public Const WM_PALETTEISCHANGING = &H310 Public Const WM_PALETTECHANGED = &H311 Public Const WM_HOTKEY = &H312 Public Const WM_CVS = "Parts of this code © CVSoftware" Public Const WM_PENWINFIRST = &H380 Public Const WM_PENWINLAST = &H38F ' System Color Constants Public Const COLOR_ACTIVEBORDER = 10 Public Const COLOR_ACTIVECAPTION = 2 Public Const COLOR_ADJ_MAX = 100 Public Const COLOR_ADJ_MIN = -100 'shorts Public Const COLOR_APPWORKSPACE = 12 Public Const COLOR_BACKGROUND = 1 Public Const COLOR_BTNFACE = 15 Public Const COLOR_BTNHIGHLIGHT = 20 Public Const COLOR_BTNSHADOW = 16 Public Const COLOR_BTNTEXT = 18 Public Const COLOR_CAPTIONTEXT = 9 Public Const COLOR_GRAYTEXT = 17 Public Const COLOR_HIGHLIGHT = 13 Public Const COLOR_HIGHLIGHTTEXT = 14 Public Const COLOR_INACTIVEBORDER = 11 Public Const COLOR_INACTIVECAPTION = 3 Public Const COLOR_INACTIVECAPTIONTEXT = 19 Public Const COLOR_MENU = 4 Public Const COLOR_MENUTEXT = 7 Public Const COLOR_SCROLLBAR = 0 Public Const COLOR_WINDOW = 5 Public Const COLOR_WINDOWFRAME = 6 Public Const COLOR_WINDOWTEXT = 8 ' System Message Constants Public Const SM_CMETRICS = 44 Public Const SM_CMOUSEBUTTONS = 43 Public Const SM_CXBORDER = 5 Public Const SM_CXCURSOR = 13 Public Const SM_CXDLGFRAME = 7 Public Const SM_CXDOUBLECLK = 36 Public Const SM_CXFIXEDFRAME = SM_CXDLGFRAME Public Const SM_CXFRAME = 32 Public Const SM_CXFULLSCREEN = 16 Public Const SM_CXHSCROLL = 21 Public Const SM_CXHTHUMB = 10 Public Const SM_CXICON = 11 Public Const SM_CXICONSPACING = 38 Public Const SM_CXMIN = 28 Public Const SM_CXMINTRACK = 34 Public Const SM_CXSCREEN = 0 Public Const SM_CXSMSIZE = 30 Public Const SM_CXSIZEFRAME = SM_CXFRAME Public Const SM_CXVSCROLL = 2 Public Const SM_CYBORDER = 6 Public Const SM_CYCAPTION = 4 Public Const SM_CYCURSOR = 14 Public Const SM_CYDLGFRAME = 8 Public Const SM_CYDOUBLECLK = 37 Public Const SM_CYFIXEDFRAME = SM_CYDLGFRAME Public Const SM_CYFRAME = 33 Public Const SM_CYFULLSCREEN = 17 Public Const SM_CYHSCROLL = 3 Public Const SM_CYICON = 12 Public Const SM_CYICONSPACING = 39 Public Const SM_CYKANJIWINDOW = 18 Public Const SM_CYMENU = 15 Public Const SM_CYMIN = 29 Public Const SM_CYMINTRACK = 35 Public Const SM_CYSCREEN = 1 Public Const SM_CYSMSIZE = 31 Public Const SM_CYSIZEFRAME = SM_CYFRAME Public Const SM_CYVSCROLL = 20 Public Const SM_CYVTHUMB = 9 Public Const SM_DBCSENABLED = 42 Public Const SM_DEBUG = 22 Public Const SM_MENUDROPALIGNMENT = 40 Public Const SM_MOUSEPRESENT = 19 Public Const SM_PENWINDOWS = 41 Public Const SM_RESERVED1 = 24 Public Const SM_RESERVED2 = 25 Public Const SM_RESERVED3 = 26 Public Const SM_RESERVED4 = 27 Public Const SM_SWAPBUTTON = 23 ' Windows Sytle Constants Public Const WS_BORDER = &H800000 Public Const WS_CAPTION = &HC00000 Public Const WS_CHILD = &H40000000 Public Const WS_CHILDWINDOW = (WS_CHILD) Public Const WS_CLIPCHILDREN = &H2000000 Public Const WS_CLIPSIBLINGS = &H4000000 Public Const WS_DISABLED = &H8000000 Public Const WS_DLGFRAME = &H400000 Public Const WS_EX_ACCEPTFILES = &H10& Public Const WS_EX_DLGMODALFRAME = &H1& Public Const WS_EX_NOPARENTNOTIFY = &H4& Public Const WS_EX_TOPMOST = &H8& Public Const WS_EX_TRANSPARENT = &H20& Public Const WS_GROUP = &H20000 Public Const WS_HSCROLL = &H100000 Public Const WS_MINIMIZE = &H20000000 Public Const WS_ICONIC = WS_MINIMIZE Public Const WS_MAXIMIZE = &H1000000 Public Const WS_MAXIMIZEBOX = &H10000 Public Const WS_MINIMIZEBOX = &H20000 Public Const WS_OVERLAPPED = &H0& Public Const WS_SYSMENU = &H80000 Public Const WS_THICKFRAME = &H40000 Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX) Public Const WS_POPUP = &H80000000 Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU) Public Const WS_SIZEBOX = WS_THICKFRAME Public Const WS_PadD = WS_OVERLAPPED Public Const WS_PadDWINDOW = WS_OVERLAPPEDWINDOW Public Const WS_VISIBLE = &H10000000 Public Const WS_VSCROLL = &H200000 Public Const WS_CVS = "Parts of this code © CVSoftware" ' Constants working with the DrawIconEx function Public Const DI_COMPAT = &H4 ' Draws the standard system cursor instead of the image specified. Public Const DI_DEFAULTSIZE = &H8 ' Ignores cxWidth and cyWidth and uses the original icon size Public Const DI_IMAGE = &H2 ' Use the XOR part of the icon in drawing (that is, the icon has no transparent area) Public Const DI_MASK = &H1 ' Use the MASK part of the icon in drawing (used alone, this lets you obtain the icon mask) Public Const DI_NORMAL = &H3 ' Draw the icon normally (combines DI_IMAGE and DI_MASK). ' Constants that work with SystemParametersInfo / SystemParametersInfoByval Public Const SPI_GETNONCLIENTMETRICS = 41 ' Constants that work with the GetWindowLong function Public Const GWL_WNDPROC = (-4) Public Const GWL_STYLE = (-16) ' Constants that work with the DrawText function Public Const DT_SINGLELINE = &H20 Public Const DT_VCENTER = &H4 Public Const DT_END_ELLIPSIS = &H8000& '============================================================================================================= ' DLL Function and Sub Declarations '============================================================================================================= Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function DrawIconEx Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long Public Declare Function drawText Lib "USER32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Public Declare Function ExcludeClipRect Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function FillRect Lib "USER32" (ByVal hDC As Long, lpRect As RECT, ByVal hBRUSH As Long) As Long Public Declare Function GetActiveWindow Lib "USER32" () As Long Public Declare Function GetParent Lib "USER32" (ByVal hWnd As Long) As Long Public Declare Function GetClipRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long) As Long Public Declare Function GetSysColor Lib "USER32" (ByVal nIndex As Long) As Long Public Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long Public Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal LPString As String, ByVal cch As Long) As Long Public Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long Public Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function OffsetClipRgn Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long Public Declare Function OffsetRect Lib "USER32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long Public Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Public Declare Function SelectClipRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long) As Long Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Public Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long Public Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor 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 SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long '============================================================================================================= ' Variables '============================================================================================================= Public GRADhWnd As Long Private GRADIcon As Long Private OldGradProc As Long Private DrawDC As Long Private tmpDC As Long Private hRgn As Long Private tmpGradFont As Long Private CaptionFont As LOGFONT '============================================================================================================= ' Additional Components (not in original code by Chris Vidler) '============================================================================================================= ' Private Const GRAD_SHOWDEBUG As Boolean = False Public Const GRAD_BEGINCOLOR As Long = &H5A5A5A Public boolNoGrad As Boolean Public GRAD_ColorActive As Long Public GRAD_ColorInactive As Long Private GRAD_ColorBegin As Long Private GRAD_ColorIncrement As Integer Private FormControlBox As Boolean Private FormMinButton As Boolean Private FormMaxButton As Boolean Private FormMDI As Boolean Private FormBoarder As FormBorderStyleConstants ' '============================================================================================================= ' Setup gradient titlebar if Gradient is enabled Public Function GradientSTART(Frm As Form, Optional ColorIncrament As Integer = 2, Optional UseCustomColors As Boolean = False, Optional BeginColor As Long = vbBlack, Optional ColorActive As Long = -1, Optional ColorInactive As Long = -1) On Error Resume Next If boolNoGrad = False Then GradientReleaseForm GradientForm Frm, 2, True, BeginColor If FormMDI = False Then Frm.Refresh End If End If End Function ' This is the function that starts gradiating the specified form Private Function GradientFrm(Frm As Form) On Error Resume Next ' Setup the gradiation process GRADhWnd = Frm.hWnd GRADIcon = Frm.Icon OldGradProc = SetWindowLong(Frm.hWnd, GWL_WNDPROC, AddressOf GradientCallback) GradientGetCapsFont ' This makes sure that the Gradient is in place by simulating ' a window repaint, then a left mouse click on the titlebar SendMessage GRADhWnd, WM_NCPAINT, 0, 0 End Function ' This "releases" the form, stopping the gradiation process Public Function GradientReleaseForm() On Error Resume Next If OldGradProc = 0 Or GRADhWnd = 0 Then Exit Function End If SetWindowLong GRADhWnd, GWL_WNDPROC, OldGradProc OldGradProc = 0 GRADhWnd = 0 End Function ' This function processes the different windows messeges sent to the ' specified form and redraws the gradiation as is needed Private Function GradientCallback(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long On Error Resume Next Dim OldBMP As Long Dim NewBMP As Long Dim rcWnd As RECT Dim ColorToUse As Long ' This displays all the windows messages being sent to this function If GRAD_SHOWDEBUG = True Then Debug.Print "wMsg = " & SystemMsgEquals(wMsg) & ", wParam = " & CStr(wParam) & ", lParam = " & CStr(lParam) End If Select Case wMsg ' Form becomes active or inactive... titlebar changes color Case WM_NCACTIVATE, WM_MDIACTIVATE GetWindowRect GRADhWnd, rcWnd GradientCallback = CallWindowProc(OldGradProc, hWnd, wMsg, wParam, lParam) tmpDC = GetWindowDC(GRADhWnd) DrawDC = CreateCompatibleDC(tmpDC) NewBMP = CreateCompatibleBitmap(tmpDC, rcWnd.Right - rcWnd.Left, 50) OldBMP = SelectObject(DrawDC, NewBMP) With rcWnd hRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom) SelectClipRgn tmpDC, hRgn OffsetClipRgn tmpDC, -.Left, -.Top End With If wParam And GetParent(GRADhWnd) = 0 Then DrawGradient GRAD_ColorBegin, GRAD_ColorActive 'GetSysColor(COLOR_ACTIVECAPTION) ElseIf wParam = GRADhWnd And GetParent(GRADhWnd) <> 0 Then DrawGradient GRAD_ColorBegin, GRAD_ColorInactive 'GetSysColor(COLOR_INACTIVECAPTION) ElseIf SendMessage(GetParent(GRADhWnd), WM_MDIGETACTIVE, 0, 0) = GRADhWnd Then DrawGradient GRAD_ColorBegin, GRAD_ColorActive 'GetSysColor(COLOR_ACTIVECAPTION) Else DrawGradient GRAD_ColorBegin, GRAD_ColorInactive 'GetSysColor(COLOR_INACTIVECAPTION) End If 'Cleanup SelectObject DrawDC, OldBMP DeleteObject NewBMP DeleteDC DrawDC OffsetClipRgn tmpDC, rcWnd.Left, rcWnd.Top GetClipRgn tmpDC, hRgn ReleaseDC GRADhWnd, tmpDC DeleteObject hRgn tmpDC = 0 Exit Function ' Form is repainted on the screen... refresh it Case WM_NCPAINT ', WM_PAINT * DON'T PUT WM_PAINT - It loops GetWindowRect GRADhWnd, rcWnd tmpDC = GetWindowDC(GRADhWnd) DrawDC = CreateCompatibleDC(tmpDC) NewBMP = CreateCompatibleBitmap(tmpDC, rcWnd.Right - rcWnd.Left, 50) OldBMP = SelectObject(DrawDC, NewBMP) With rcWnd hRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom) SelectClipRgn tmpDC, hRgn OffsetClipRgn tmpDC, -.Left, -.Top End With If GetActiveWindow() = GRADhWnd Then DrawGradient GRAD_ColorBegin, GRAD_ColorActive 'GetSysColor(COLOR_ACTIVECAPTION) ElseIf SendMessage(GetParent(GRADhWnd), WM_MDIGETACTIVE, 0, 0) = GRADhWnd Then DrawGradient GRAD_ColorBegin, GRAD_ColorActive 'GetSysColor(COLOR_ACTIVECAPTION) Else DrawGradient GRAD_ColorBegin, GRAD_ColorInactive 'GetSysColor(COLOR_INACTIVECAPTION) End If SelectObject DrawDC, OldBMP DeleteObject NewBMP DeleteDC DrawDC OffsetClipRgn tmpDC, rcWnd.Left, rcWnd.Top GetClipRgn tmpDC, hRgn GradientCallback = CallWindowProc(OldGradProc, hWnd, WM_NCPAINT, hRgn, lParam) ReleaseDC GRADhWnd, tmpDC DeleteObject hRgn tmpDC = 0 Exit Function ' Form's size changes ( Width or Height ) Case WM_SIZE If hWnd = GRADhWnd Then SendMessage GRADhWnd, WM_NCPAINT, 0, 0 End If ' This tests to see if the form is being closed and if it is, release ' the Gradient effect to eliminate extra code in the Form_Unload event Case WM_SYSCOMMAND If wParam = 61536 And lParam = 0 Then If OldGradProc = 0 Or GRADhWnd = 0 Then DoEvents Else ' Release the call back GradientCallback = CallWindowProc(OldGradProc, hWnd, wMsg, wParam, lParam) ' Release the form from the Gradient GradientReleaseForm End If DoEvents Exit Function End If ' This tests if the form is being destroyed and releases the Gradient ' effect to prevent VB from crashing in design time when the user ' STOPs the design time debug run. ' * NOTE: For some reason, at design time STOP command, if VB is minimized ' it will still crash... even with this catch in place. Case WM_NCDESTROY ', WM_DESTROY If OldGradProc = 0 Or GRADhWnd = 0 Then DoEvents Else ' Release the call back GradientCallback = CallWindowProc(OldGradProc, hWnd, wMsg, wParam, lParam) ' Release the form from the Gradient GradientReleaseForm End If DoEvents Exit Function End Select GradientCallback = CallWindowProc(OldGradProc, hWnd, wMsg, wParam, lParam) End Function ' This function actually does the gradiation drawing Private Function DrawGradient(ByVal Color1 As Long, ByVal Color2 As Long) As Long On Error Resume Next Dim XBorder As Long ' Window's boarder thikness Dim DestWidth As Long ' Gradient Width Dim DestHeight As Long ' Gradient Height Dim fText As String ' Form's caption Dim MyCounter As Integer ' Iteration Counter Dim StartPnt As Integer ' Where the gradiation starts Dim EndPnt As Integer ' Where the gradiation ends Dim PixelStep As Long ' Number of small rectangles to be drawn to give the Gradient effect Dim WndRect As RECT ' Form's window dimentions (top, bottom, left, right) Dim rct As RECT ' Rectangle area drawn in shades of colors to create the Gradient effect Dim hBr As Long Dim OldFont As Long ' Get the form's size to use in calculations GetWindowRect GRADhWnd, WndRect With WndRect DestWidth = .Right - .Left End With ' This fixex incorrect Gradient drawing and "missing" pixels on the titlebar Select Case FormBoarder Case vbBSNone ' 0 None (no border or border-related elements). Exit Function Case vbFixedSingle ' 1 Fixed Single. Can include Control-menu box, title bar, Maximize button, and Minimize button. Resizable only using Maximize and Minimize buttons. XBorder = GetSystemMetrics(SM_CXDLGFRAME) DestHeight = GetSystemMetrics(SM_CYCAPTION) + 1 If FormControlBox = False Then DestWidth = DestWidth - (XBorder * 2) + 9 Else If FormMinButton = True Or FormMaxButton = True Then DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 3) + 9 Else DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 1) + 9 End If End If Case vbSizable ' 2 (Default) Sizable. Resizable using any of the optional border elements listed for setting 1. XBorder = GetSystemMetrics(SM_CXDLGFRAME) + 1 DestHeight = GetSystemMetrics(SM_CYCAPTION) + 1 If FormControlBox = False Then DestWidth = DestWidth - (XBorder * 2) + 9 Else If FormMinButton = True Or FormMaxButton = True Then DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 3) + 9 Else DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 1) + 9 End If End If Case vbFixedDialog ' 3 Fixed Dialog. Can include Control-menu box and title bar; can't include Maximize or Minimize buttons. Not resizable. XBorder = GetSystemMetrics(SM_CXDLGFRAME) DestHeight = GetSystemMetrics(SM_CYCAPTION) + 1 If FormControlBox = False Then DestWidth = DestWidth - (XBorder * 2) + 9 Else DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 1) + 9 End If Case vbFixedToolWindow ' 4 Fixed ToolWindow. Displays a non-sizable window with a Close button and title bar text in a reduced font size. The form does not appear in the Windows 95 task bar. XBorder = GetSystemMetrics(SM_CXDLGFRAME) DestHeight = GetSystemMetrics(SM_CYCAPTION) - 2 If FormControlBox = False Then DestWidth = DestWidth - (XBorder * 2) + 9 Else DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 1) + 9 End If Case vbSizableToolWindow ' 5 Sizable ToolWindow. Displays a sizable win XBorder = GetSystemMetrics(SM_CXDLGFRAME) + 1 DestHeight = GetSystemMetrics(SM_CYCAPTION) - 2 If FormControlBox = False Then DestWidth = DestWidth - (XBorder * 2) + 9 Else DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 1) + 9 End If End Select ' Get the form's caption fText = Space(255) GetWindowText GRADhWnd, fText, 255 fText = RTrim(fText) ' Get the dimensions of the Gradient area StartPnt = XBorder EndPnt = XBorder + DestWidth - 3 PixelStep = (DestWidth - 8) \ GRAD_ColorIncrement ' Get Gradient colors to draw. The way this is set up, it allows for very ' quick, very rough Gradiention... or very fine, very detailed gradiation. ReDim Colors(PixelStep) As Long GradateColors Colors(), Color1, Color2 With rct ' Get dimentions to use in drawing .Top = XBorder .Left = XBorder .Right = XBorder + (DestWidth \ PixelStep) .Bottom = XBorder + DestHeight - 2 ' Start drawing the gradiation For MyCounter = 0 To PixelStep - 1 hBr = CreateSolidBrush(Colors(MyCounter)) FillRect DrawDC, rct, hBr DeleteObject hBr OffsetRect rct, (DestWidth \ PixelStep), 0 If MyCounter = PixelStep - 2 Then .Right = EndPnt End If Next ' Draw the icon if there is one. Not all border styles support icons Select Case FormBoarder Case vbBSNone, vbFixedToolWindow, vbSizableToolWindow .Left = XBorder + 2 Case Else If GRADIcon <> 0 Then If FormControlBox = False Then .Left = XBorder + 2 Else .Left = XBorder + GetSystemMetrics(SM_CXSMSIZE) + 2 DrawIconEx DrawDC, (XBorder + 2), (XBorder + 1), GRADIcon, (GetSystemMetrics(SM_CXSMSIZE) - 2), (GetSystemMetrics(SM_CYSMSIZE) - 2), ByVal 0&, ByVal 0&, DI_NORMAL End If Else .Left = XBorder + 2 End If End Select ' Draw the caption if there is one If CaptionFont.lfHeight = 0 And tmpGradFont = 0 Then tmpGradFont = SendMessage(GRADhWnd, WM_GETFONT, 0, 0) ElseIf tmpGradFont = 0 Then tmpGradFont = CreateFontIndirect(CaptionFont) End If OldFont = SelectObject(DrawDC, tmpGradFont) SetBkMode DrawDC, 1 SetTextColor DrawDC, RGB(255, 255, 255) .Left = .Left '+ 2 .Right = .Right - 10 drawText DrawDC, fText, Len(fText) - 1, rct, DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_VCENTER SelectObject DrawDC, OldFont DeleteObject tmpGradFont tmpGradFont = 0 .Left = XBorder .Right = .Right + 12 If tmpDC <> 0 Then BitBlt tmpDC, .Left, .Top, .Right - .Left - 10, .Bottom - .Top, DrawDC, .Left, .Top, vbSrcCopy If FormBoarder = vbSizable Or FormBoarder = vbSizableToolWindow Then ExcludeClipRect tmpDC, XBorder, XBorder, .Right - .Left - 8, .Bottom - .Top + 4 Else ExcludeClipRect tmpDC, XBorder, XBorder, .Right - .Left - 8, .Bottom - .Top + 3 End If End If End With End Function ' This function provides all of the different colors to be used ' to create the Gradient effect Private Function GradateColors(Colors() As Long, ByVal Color1 As Long, ByVal Color2 As Long) On Error Resume Next Dim MyCounter As Integer Dim dblR As Double Dim dblG As Double Dim dblB As Double Dim addR As Double Dim addG As Double Dim addB As Double Dim bckR As Double Dim bckG As Double Dim bckB As Double dblR = CDbl(Color1 And &HFF) dblG = CDbl(Color1 And &HFF00&) / 255 dblB = CDbl(Color1 And &HFF0000) / &HFF00& bckR = CDbl(Color2 And &HFF&) bckG = CDbl(Color2 And &HFF00&) / 255 bckB = CDbl(Color2 And &HFF0000) / &HFF00& addR = (bckR - dblR) / UBound(Colors) addG = (bckG - dblG) / UBound(Colors) addB = (bckB - dblB) / UBound(Colors) For MyCounter = 0 To UBound(Colors) dblR = dblR + addR dblG = dblG + addG dblB = dblB + addB If dblR > 255 Then dblR = 255 If dblG > 255 Then dblG = 255 If dblB > 255 Then dblB = 255 If dblR < 0 Then dblR = 0 If dblG < 0 Then dblG = 0 If dblG < 0 Then dblB = 0 Colors(MyCounter) = RGB(dblR, dblG, dblB) Next End Function ' This function is used in processing the caption of the form Private Function GradientGetCapsFont() On Error Resume Next Dim NCM As NONCLIENTMETRICS Dim lfNew As LOGFONT NCM.cbSize = Len(NCM) Call SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, NCM, 0) If NCM.iCaptionHeight = 0 Then CaptionFont.lfHeight = 0 Else CaptionFont = NCM.lfSMCaptionFont End If End Function Public Function GradientRefresh() On Error Resume Next If OldGradProc = 0 Or GRADhWnd = 0 Then Exit Function ElseIf boolNoGrad = True Then Exit Function End If SendMessage GRADhWnd, WM_NCPAINT, 0, 0 End Function Public Function GradientForm(Frm As Form, Optional ColorIncrament As Integer = 2, Optional UseCustomColors As Boolean = False, Optional BeginColor As Long = vbBlack, Optional ColorActive As Long = -1, Optional ColorInactive As Long = -1) On Error Resume Next ' Check if another form is already Gradient, and if so, exit If OldGradProc <> 0 Then Exit Function End If ' Check if form is MDI by calling a property that is only ' found in MDI forms. If an error occurs then it's SDI. Err.Clear Frm.AutoShowChildren = Frm.AutoShowChildren If Err Then Err.Clear If Frm.BorderStyle = vbBSNone Then Exit Function End If FormMDI = False FormBoarder = Frm.BorderStyle FormMaxButton = Frm.MaxButton FormMinButton = Frm.MinButton FormControlBox = Frm.ControlBox Else FormMDI = True FormBoarder = vbSizable FormMaxButton = True FormMinButton = True FormControlBox = True End If ' Set the width of the Gradient lines. ' NOTE: If this number goes above 10, you start seeing some serious ' redraw errors on the system buttons (MIN/MAX) ' NOTE: The lower this number is, the more resources the redraw takes, ' and the longer it takes to resize Gradient forms ' NOTE: The lower this number is, the higher the quality of the Gradient If ColorIncrament < 1 Then GRAD_ColorIncrement = 1 Else GRAD_ColorIncrement = ColorIncrament End If ' Set custom colors If UseCustomColors = True Then GRAD_ColorBegin = BeginColor If ColorActive = -1 Then GRAD_ColorActive = GetSysColor(COLOR_ACTIVECAPTION) Else GRAD_ColorActive = ColorActive End If If ColorInactive = -1 Then GRAD_ColorInactive = GetSysColor(COLOR_INACTIVECAPTION) Else GRAD_ColorInactive = ColorInactive End If Else GRAD_ColorBegin = GRAD_BEGINCOLOR GRAD_ColorActive = GetSysColor(COLOR_ACTIVECAPTION) GRAD_ColorInactive = GetSysColor(COLOR_INACTIVECAPTION) End If GradientFrm Frm End Function ' This function is used to return an understandable translation of the ' windows messages being sent to the form that's being gradiated. This ' is mainly for debugging and fine-tuning purposes. Private Function SystemMsgEquals(wMsg As Long) As String On Error Resume Next Select Case wMsg Case WM_NCHITTEST SystemMsgEquals = "WM_NCHITTEST" Case WM_SETCURSOR SystemMsgEquals = "WM_SETCURSOR" Case WM_NCMOUSEMOVE SystemMsgEquals = "WM_NCMOUSEMOVE" Case WM_USER SystemMsgEquals = "WM_USER" Case WM_NULL SystemMsgEquals = "WM_NULL" Case WM_CREATE SystemMsgEquals = "WM_CREATE" Case WM_DESTROY SystemMsgEquals = "WM_DESTROY" Case WM_MOVE SystemMsgEquals = "WM_MOVE" Case WM_SIZE SystemMsgEquals = "WM_SIZE" Case WM_ACTIVATE SystemMsgEquals = "WM_ACTIVATE" Case WM_SETFOCUS SystemMsgEquals = "WM_SETFOCUS" Case WM_KILLFOCUS SystemMsgEquals = "WM_KILLFOCUS" Case WM_ENABLE SystemMsgEquals = "WM_ENABLE" Case WM_SETREDRAW SystemMsgEquals = "WM_SETREDRAW" Case WM_SETTEXT SystemMsgEquals = "WM_SETTEXT" Case WM_GETTEXT SystemMsgEquals = "WM_GETTEXT" Case WM_GETTEXTLENGTH SystemMsgEquals = "WM_GETTEXTLENGTH" Case WM_PAINT SystemMsgEquals = "WM_PAINT" Case WM_CLOSE SystemMsgEquals = "WM_CLOSE" Case WM_QUERYENDSESSION SystemMsgEquals = "WM_QUERYENDSESSION" Case WM_QUIT SystemMsgEquals = "WM_QUIT" Case WM_QUERYOPEN SystemMsgEquals = "WM_QUERYOPEN" Case WM_ERASEBKGND SystemMsgEquals = "WM_ERASEBKGND" Case WM_SYSCOLORCHANGE SystemMsgEquals = "WM_SYSCOLORCHANGE" Case WM_ENDSESSION SystemMsgEquals = "WM_ENDSESSION" Case WM_SHOWWINDOW SystemMsgEquals = "WM_SHOWWINDOW" Case WM_WININICHANGE SystemMsgEquals = "WM_WININICHANGE" Case WM_DEVMODECHANGE SystemMsgEquals = "WM_DEVMODECHANGE" Case WM_ACTIVATEAPP SystemMsgEquals = "WM_ACTIVATEAPP" Case WM_FONTCHANGE SystemMsgEquals = "WM_FONTCHANGE" Case WM_TIMECHANGE SystemMsgEquals = "WM_TIMECHANGE" Case WM_CANCELMODE SystemMsgEquals = "WM_CANCELMODE" Case WM_MOUSEACTIVATE SystemMsgEquals = "WM_MOUSEACTIVATE" Case WM_CHILDACTIVATE SystemMsgEquals = "WM_CHILDACTIVATE" Case WM_QUEUESYNC SystemMsgEquals = "WM_QUEUESYNC" Case WM_GETMINMAXINFO SystemMsgEquals = "WM_GETMINMAXINFO" Case WM_PAINTICON SystemMsgEquals = "WM_PAINTICON" Case WM_ICONERASEBKGND SystemMsgEquals = "WM_ICONERASEBKGND" Case WM_NEXTDLGCTL SystemMsgEquals = "WM_NEXTDLGCTL" Case WM_SPOOLERSTATUS SystemMsgEquals = "WM_SPOOLERSTATUS" Case WM_DRAWITEM SystemMsgEquals = "WM_DRAWITEM" Case WM_MEASUREITEM SystemMsgEquals = "WM_MEASUREITEM" Case WM_DELETEITEM SystemMsgEquals = "WM_DELETEITEM" Case WM_VKEYTOITEM SystemMsgEquals = "WM_VKEYTOITEM" Case WM_CHARTOITEM SystemMsgEquals = "WM_CHARTOITEM" Case WM_SETFONT SystemMsgEquals = "WM_SETFONT" Case WM_GETFONT SystemMsgEquals = "WM_GETFONT" Case WM_SETHOTKEY SystemMsgEquals = "WM_SETHOTKEY" Case WM_GETHOTKEY SystemMsgEquals = "WM_GETHOTKEY" Case WM_QUERYDRAGICON SystemMsgEquals = "WM_QUERYDRAGICON" Case WM_COMPAREITEM SystemMsgEquals = "WM_COMPAREITEM" Case WM_COMPACTING SystemMsgEquals = "WM_COMPACTING" Case WM_OTHERWINDOWCREATED SystemMsgEquals = "WM_OTHERWINDOWCREATED" Case WM_OTHERWINDOWDESTROYED SystemMsgEquals = "WM_OTHERWINDOWDESTROYED" Case WM_COMMNOTIFY SystemMsgEquals = "WM_COMMNOTIFY" Case WM_WINDOWPOSCHANGING SystemMsgEquals = "WM_WINDOWPOSCHANGING" Case WM_WINDOWPOSCHANGED SystemMsgEquals = "WM_WINDOWPOSCHANGED" Case WM_POWER SystemMsgEquals = "WM_POWER" Case WM_COPYDATA SystemMsgEquals = "WM_COPYDATA" Case WM_CANCELJOURNAL SystemMsgEquals = "WM_CANCELJOURNAL" Case WM_NCCREATE SystemMsgEquals = "WM_NCCREATE" Case WM_NCDESTROY SystemMsgEquals = "WM_NCDESTROY" Case WM_NCCALCSIZE SystemMsgEquals = "WM_NCCALCSIZE" Case WM_NCPAINT SystemMsgEquals = "WM_NCPAINT" Case WM_NCACTIVATE SystemMsgEquals = "WM_NCACTIVATE" Case WM_GETDLGCODE SystemMsgEquals = "WM_GETDLGCODE" Case WM_NCLBUTTONDOWN SystemMsgEquals = "WM_NCLBUTTONDOWN" Case WM_NCLBUTTONUP SystemMsgEquals = "WM_NCLBUTTONUP" Case WM_NCLBUTTONDBLCLK SystemMsgEquals = "WM_NCLBUTTONDBLCLK" Case WM_NCRBUTTONDOWN SystemMsgEquals = "WM_NCRBUTTONDOWN" Case WM_NCRBUTTONUP SystemMsgEquals = "WM_NCRBUTTONUP" Case WM_NCRBUTTONDBLCLK SystemMsgEquals = "WM_NCRBUTTONDBLCLK" Case WM_NCMBUTTONDOWN SystemMsgEquals = "WM_NCMBUTTONDOWN" Case WM_NCMBUTTONUP SystemMsgEquals = "WM_NCMBUTTONUP" Case WM_NCMBUTTONDBLCLK SystemMsgEquals = "WM_NCMBUTTONDBLCLK" Case WM_KEYFIRST SystemMsgEquals = "WM_KEYFIRST" Case WM_KEYDOWN SystemMsgEquals = "WM_KEYDOWN" Case WM_KEYUP SystemMsgEquals = "WM_KEYUP" Case WM_CHAR SystemMsgEquals = "WM_CHAR" Case WM_DEADCHAR SystemMsgEquals = "WM_DEADCHAR" Case WM_SYSKEYDOWN SystemMsgEquals = "WM_SYSKEYDOWN" Case WM_SYSKEYUP SystemMsgEquals = "WM_SYSKEYUP" Case WM_SYSCHAR SystemMsgEquals = "WM_SYSCHAR" Case WM_SYSDEADCHAR SystemMsgEquals = "WM_SYSDEADCHAR" Case WM_KEYLAST SystemMsgEquals = "WM_KEYLAST" Case WM_INITDIALOG SystemMsgEquals = "WM_INITDIALOG" Case WM_COMMAND SystemMsgEquals = "WM_COMMAND" Case WM_SYSCOMMAND SystemMsgEquals = "WM_SYSCOMMAND" Case WM_TIMER SystemMsgEquals = "WM_TIMER" Case WM_HSCROLL SystemMsgEquals = "WM_HSCROLL" Case WM_VSCROLL SystemMsgEquals = "WM_VSCROLL" Case WM_INITMENU SystemMsgEquals = "WM_INITMENU" Case WM_INITMENUPOPUP SystemMsgEquals = "WM_INITMENUPOPUP" Case WM_MENUSELECT SystemMsgEquals = "WM_MENUSELECT" Case WM_MENUCHAR SystemMsgEquals = "WM_MENUCHAR" Case WM_ENTERIDLE SystemMsgEquals = "WM_ENTERIDLE" Case WM_CTLCOLORMSGBOX SystemMsgEquals = "WM_CTLCOLORMSGBOX" Case WM_CTLCOLOREDIT SystemMsgEquals = "WM_CTLCOLOREDIT" Case WM_CTLCOLORLISTBOX SystemMsgEquals = "WM_CTLCOLORLISTBOX" Case WM_CTLCOLORBTN SystemMsgEquals = "WM_CTLCOLORLISTBOX" Case WM_CTLCOLORDLG SystemMsgEquals = "WM_CTLCOLORDLG" Case WM_CTLCOLORSCROLLBAR SystemMsgEquals = "WM_CTLCOLORSCROLLBAR" Case WM_CTLCOLORSTATIC SystemMsgEquals = "WM_CTLCOLORSTATIC" Case WM_MOUSEFIRST SystemMsgEquals = "WM_MOUSEFIRST" Case WM_MOUSEMOVE SystemMsgEquals = "WM_MOUSEMOVE" Case WM_LBUTTONDOWN SystemMsgEquals = "WM_LBUTTONDOWN" Case WM_LBUTTONUP SystemMsgEquals = "WM_LBUTTONUP" Case WM_LBUTTONDBLCLK SystemMsgEquals = "WM_LBUTTONDBLCLK" Case WM_RBUTTONDOWN SystemMsgEquals = "WM_RBUTTONDOWN" Case WM_RBUTTONUP SystemMsgEquals = "WM_RBUTTONUP" Case WM_RBUTTONDBLCLK SystemMsgEquals = "WM_RBUTTONDBLCLK" Case WM_MBUTTONDOWN SystemMsgEquals = "WM_MBUTTONDOWN" Case WM_MBUTTONUP SystemMsgEquals = "WM_MBUTTONUP" Case WM_MBUTTONDBLCLK SystemMsgEquals = "WM_MBUTTONDBLCLK" Case WM_MOUSELAST SystemMsgEquals = "WM_MOUSELAST" Case WM_PARENTNOTIFY SystemMsgEquals = "WM_PARENTNOTIFY" Case WM_ENTERMENULOOP SystemMsgEquals = "WM_ENTERMENULOOP" Case WM_EXITMENULOOP SystemMsgEquals = "WM_EXITMENULOOP" Case WM_MDICREATE SystemMsgEquals = "WM_MDICREATE" Case WM_MDIDESTROY SystemMsgEquals = "WM_MDIDESTROY" Case WM_MDIACTIVATE SystemMsgEquals = "WM_MDIACTIVATE" Case WM_MDIRESTORE SystemMsgEquals = "WM_MDIRESTORE" Case WM_MDINEXT SystemMsgEquals = "WM_MDINEXT" Case WM_MDIMAXIMIZE SystemMsgEquals = "WM_MDIMAXIMIZE" Case WM_MDIPad SystemMsgEquals = "WM_MDIPad" Case WM_MDICASCADE SystemMsgEquals = "WM_MDICASCADE" Case WM_MDIICONARRANGE SystemMsgEquals = "WM_MDIICONARRANGE" Case WM_MDIGETACTIVE SystemMsgEquals = "WM_MDIGETACTIVE" Case WM_MDISETMENU SystemMsgEquals = "WM_MDISETMENU" Case WM_DROPFILES SystemMsgEquals = "WM_DROPFILES" Case WM_MDIREFRESHMENU SystemMsgEquals = "WM_MDIREFRESHMENU" Case WM_CUT SystemMsgEquals = "WM_CUT" Case WM_COPY SystemMsgEquals = "WM_COPY" Case WM_PASTE SystemMsgEquals = "WM_PASTE" Case WM_CLEAR SystemMsgEquals = "WM_CLEAR" Case WM_UNDO SystemMsgEquals = "WM_UNDO" Case WM_RENDERFORMAT SystemMsgEquals = "WM_RENDERFORMAT" Case WM_RENDERALLFORMATS SystemMsgEquals = "WM_RENDERALLFORMATS" Case WM_DESTROYCLIPBOARD SystemMsgEquals = "WM_DESTROYCLIPBOARD" Case WM_DRAWCLIPBOARD SystemMsgEquals = "WM_DRAWCLIPBOARD" Case WM_PAINTCLIPBOARD SystemMsgEquals = "WM_PAINTCLIPBOARD" Case WM_VSCROLLCLIPBOARD SystemMsgEquals = "WM_VSCROLLCLIPBOARD" Case WM_SIZECLIPBOARD SystemMsgEquals = "WM_SIZECLIPBOARD" Case WM_ASKCBFORMATNAME SystemMsgEquals = "WM_ASKCBFORMATNAME" Case WM_CHANGECBCHAIN SystemMsgEquals = "WM_CHANGECBCHAIN" Case WM_HSCROLLCLIPBOARD SystemMsgEquals = "WM_HSCROLLCLIPBOARD" Case WM_QUERYNEWPALETTE SystemMsgEquals = "WM_QUERYNEWPALETTE" Case WM_PALETTEISCHANGING SystemMsgEquals = "WM_PALETTEISCHANGING" Case WM_PALETTECHANGED SystemMsgEquals = "WM_PALETTECHANGED" Case WM_HOTKEY SystemMsgEquals = "WM_HOTKEY" Case Else SystemMsgEquals = CStr(wMsg) End Select End Function