Imports System Imports System.Drawing Imports System.Windows.Forms Imports System.Runtime.InteropServices PublicClass VistaAPIClass VistaAPI PublicDeclareFunction DwmIsCompositionEnabled()Function DwmIsCompositionEnabled Lib"dwmapi.dll" (ByRef en AsInteger) AsInteger PublicDeclareFunction DwmExtendFrameIntoClientArea()Function DwmExtendFrameIntoClientArea Lib"dwmapi.dll" (ByVal hWnd As IntPtr, ByRef margins As MARGIN_STRUCT) AsInteger '***************************you have to declare it as an unicode function*************************** <DllImport("UxTheme.dll", ExactSpelling:=True, SetLastError:=True, CharSet:=CharSet.Unicode)> _ SharedFunction DrawThemeTextEx()Function DrawThemeTextEx(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId AsInteger, ByVal iStateId AsInteger, ByVal text AsString, ByVal iCharCount AsInteger, ByVal dwFlags AsInteger, ByRef pRect As RECT, ByRef pOptions As S_DTTOPTS) AsInteger End Function '***************************pass BITMAPINFO byref*************************** PublicDeclareFunction CreateDIBSection()Function CreateDIBSection Lib"gdi32.dll" (ByVal hdc As IntPtr, ByRef pbmi As BITMAPINFO, ByVal iUsage As UInt32, ByVal ppvBits AsInteger, ByVal hSection As IntPtr, ByVal dwOffset As UInt32) As IntPtr '*************************************************************************** PublicDeclareFunction BitBlt()Function BitBlt Lib"gdi32.dll" (ByVal hdc As IntPtr, ByVal nXDest AsInteger, ByVal nYDest AsInteger, ByVal nWidth AsInteger, ByVal nHeight AsInteger, ByVal hdcSrc As IntPtr, ByVal nXSrc AsInteger, ByVal nYSrc AsInteger, ByVal dwRop As Int32) AsBoolean PublicDeclareFunction SelectObject()Function SelectObject Lib"gdi32.dll" (ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr PublicDeclareFunction DeleteObject()Function DeleteObject Lib"gdi32.dll" (ByVal hObject As IntPtr) AsBoolean PublicDeclareFunction CreateCompatibleDC()Function CreateCompatibleDC Lib"gdi32.dll" (ByVal hDC As IntPtr) As IntPtr PublicDeclareFunction DeleteDC()Function DeleteDC Lib"gdi32.dll" (ByVal hdc As IntPtr) AsBoolean PublicStructure RECTStructure RECT PublicSub New()SubNew(ByVal tLeft AsInteger, ByVal tTop AsInteger, ByVal tRight AsInteger, ByVal tBottom AsInteger) Left= tLeft Top = tTop Right= tRight Bottom = tBottom End Sub PublicLeftAsInteger Public Top AsInteger PublicRightAsInteger Public Bottom AsInteger End Structure '**************************************************************************************** PublicStructure BITMAPINFOHEADERStructure BITMAPINFOHEADER 'BITMAPINFOHEADER you must declare this Dim biSize AsInteger Dim biWidth AsInteger Dim biHeight AsInteger Dim biPlanes AsShort Dim biBitCount AsShort Dim biCompression AsInteger Dim biSizeImage AsInteger Dim biXPelsPerMeter AsInteger Dim biYPelsPerMeter AsInteger Dim biClrUsed AsInteger Dim biClrImportant AsInteger End Structure PublicStructure RGBQUADStructure RGBQUAD Dim rgbBlue AsByte Dim rgbGreen AsByte Dim rgbRed AsByte Dim rgbReserved AsByte End Structure PublicStructure BITMAPINFOStructure BITMAPINFO Dim bmiHeader As BITMAPINFOHEADER Dim bmiColors As RGBQUAD End Structure '************************************************************************************************ PublicStructure S_DTTOPTSStructure S_DTTOPTS Dim dwSize AsInteger Dim dwFlags AsInteger Dim crText AsInteger Dim crBorder AsInteger Dim crShadow AsInteger Dim iTextShadowType AsInteger Dim ptShadowOffset As POINT Dim iBorderSize AsInteger Dim iFontPropId AsInteger Dim iColorPropId AsInteger Dim iStateId AsInteger Dim fApplyOverlay AsBoolean Dim iGlowSize AsInteger Dim pfnDrawTextCallback AsInteger Dim lParam As IntPtr End Structure PrivateConst DTT_COMPOSITED AsInteger=8192 PrivateConst DTT_GLOWSIZE AsInteger=2048 PrivateConst DTT_TEXTCOLOR AsInteger=1 PublicStructure POINTStructure POINT Dim cx, cy AsInteger Sub New()SubNew(ByVal X AsInteger, ByVal Y AsInteger) cx = X cy = Y End Sub End Structure PublicStructure MARGIN_STRUCTStructure MARGIN_STRUCT Dim cxLeftWidth, cxRightWidth, cyTopHeight, cyBottomHeight AsInteger Sub New()SubNew(ByValLeftAsInteger, ByValRightAsInteger, ByVal Top AsInteger, ByVal Bottom AsInteger) cxLeftWidth =Left cxRightWidth =Right cyTopHeight = Top cyBottomHeight = Bottom End Sub End Structure PublicSharedSub DrawGlowingText()Sub DrawGlowingText(ByVal Graphics As Graphics, ByVal text AsString, ByVal fnt As Font, ByVal bounds As Rectangle, ByVal Clr As Color, ByVal flags As TextFormatFlags) Dim primaryHdc As IntPtr = Graphics.GetHdc Dim bitmapOld As IntPtr = IntPtr.Zero Dim hfontOld As IntPtr = IntPtr.Zero ' '' Create a memory DC so we can work offscreen Dim memoryHdc As IntPtr = CreateCompatibleDC(primaryHdc) '' Create a device-independent bitmap and select it into our DC Dim info As BITMAPINFO =New BITMAPINFO '******************it's the size of BITMAPINFOHEADER, not BITMAPINFO *********************** info.bmiHeader.biSize = Marshal.SizeOf(info.bmiHeader) '******************************************************************************************* '******************* the size of glow is 15px,make it larger******************************** Dim textBounds As RECT =New RECT(0, 0, bounds.Right - bounds.Left +2*15, bounds.Bottom - bounds.Top +2*15) Dim screenBounds As RECT =New RECT(bounds.Left -15, bounds.Top -15, bounds.Right +15, bounds.Bottom +15) '****************************************************************************************** info.bmiHeader.biWidth = bounds.Width +30 info.bmiHeader.biHeight =-bounds.Height -30 info.bmiHeader.biPlanes =1 info.bmiHeader.biBitCount =32 info.bmiHeader.biCompression =0'' BI_RGB Dim dib As IntPtr = CreateDIBSection(primaryHdc, info, 0, 0, IntPtr.Zero, 0) bitmapOld = SelectObject(memoryHdc, dib) ' Create and select font Dim fontHandle As IntPtr = fnt.ToHfont hfontOld = SelectObject(memoryHdc, fontHandle) '' Draw glowing text Dim renderer As System.Windows.Forms.VisualStyles.VisualStyleRenderer =New System.Windows.Forms.VisualStyles.VisualStyleRenderer(System.Windows.Forms.VisualStyles.VisualStyleElement.Window.Caption.Active) Dim dttOpts As S_DTTOPTS =New S_DTTOPTS '********************** GetType is no needed ********************** dttOpts.dwSize = Marshal.SizeOf(dttOpts) '****************************************************************** dttOpts.dwFlags = DTT_COMPOSITED Or DTT_GLOWSIZE Or DTT_TEXTCOLOR dttOpts.crText = ColorTranslator.ToWin32(Clr) dttOpts.iGlowSize =15'' This is about the size Microsoft Word 2007 uses(15) DrawThemeTextEx(renderer.Handle, memoryHdc, 0, 0, text, -1, flags, textBounds, dttOpts) 'DrawThemeTextEx(renderer.Handle, memoryHdc, 0, 0, text, -1, (int)flags, ref textBounds, ref dttOpts); '' Copy to foreground Dim SRCCOPY AsInteger=&HCC0020 ' old C# Value was: 0x00CC0020 BitBlt(primaryHdc, screenBounds.Left, screenBounds.Top, _ screenBounds.Right - screenBounds.Left, screenBounds.Bottom - screenBounds.Top, memoryHdc, 0, 0, SRCCOPY) '' Clean up '*********fist, select this old dibsection and font back and free current dib and font*************** SelectObject(memoryHdc, bitmapOld) SelectObject(memoryHdc, hfontOld) '******************* then delete then******************************** DeleteObject(fontHandle) DeleteObject(dib) DeleteDC(memoryHdc) Graphics.ReleaseHdc(primaryHdc) End Sub End Class