昨天我在codeproject的一篇文章(http://www.codeproject.com/vista/textonglass.asp) 收到一个回复(http://www.codeproject.com/vista/textonglass.asp?select=1914299&forumid=336550&df=100&msg=1914299),他遇到的问题如下:
I've converted the DrawGlowingText function from the c# version that was in "GlassText.cs" to Vb.net
Every thing seems to work but the text is drawn using japaneese signs, Not normal letters :0
Can anyone tell me whats wrong?
翻译成中文的大意是:我把GlassText.cs中的DrawGlowingText 函数从C#翻译成了vb.net,但是画出的文本却全是日文(其实是乱码),这是为什么?
下面接着就贴着长长的代码了,大家有兴趣可以去一看。
我把他的代码复制下来,一到vista里面调试,发觉是乱码。于是感觉是他的函数调用方式出了问题,一看,果然。他的DrawThemeTextEx函数声明的时候用的是vb6时代的api声明方式(该函数vista特有):
然而,.net对于这种声明默认被声明的函数为Ansi调用,于是string参数被强制作为Ansi字符串读取。而我们知道,.net里面所有的string默认都是unicode。更不幸的是,DrawThemeTextEx本身就是一个Unicode函数。于是这种种错误加在一起,便造成了乱码。那怎么解决呢?方法很简单:使用.net标准的P/Invoke声明,显式声明该函数为Unicode调用:
Shared Function DrawThemeTextEx() Function DrawThemeTextEx(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, ByVal dwFlags As Integer, ByRef pRect As RECT, ByRef pOptions As S_DTTOPTS) As Integer
End Function
最后整个vb类代码如下,这个代码的作用是在vista的玻璃区域画出像vista窗体标题栏那样效果的文字,工作函数是DrawGlowingText,是一个静态函数,可以直接调用:
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Public Class VistaAPI Class VistaAPI
Public Declare Function DwmIsCompositionEnabled()Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef en As Integer) As Integer
Public Declare Function DwmExtendFrameIntoClientArea()Function DwmExtendFrameIntoClientArea Lib "dwmapi.dll" (ByVal hWnd As IntPtr, ByRef margins As MARGIN_STRUCT) As Integer
'***************************you have to declare it as an unicode function***************************
<DllImport("UxTheme.dll", ExactSpelling:=True, SetLastError:=True, CharSet:=CharSet.Unicode)> _
Shared Function DrawThemeTextEx()Function DrawThemeTextEx(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, ByVal dwFlags As Integer, ByRef pRect As RECT, ByRef pOptions As S_DTTOPTS) As Integer
End Function
'***************************pass BITMAPINFO byref***************************
Public Declare Function CreateDIBSection()Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As IntPtr, ByRef pbmi As BITMAPINFO, ByVal iUsage As UInt32, ByVal ppvBits As Integer, ByVal hSection As IntPtr, ByVal dwOffset As UInt32) As IntPtr
'***************************************************************************
Public Declare Function BitBlt()Function BitBlt Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean
Public Declare Function SelectObject()Function SelectObject Lib "gdi32.dll" (ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
Public Declare Function DeleteObject()Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean
Public Declare Function CreateCompatibleDC()Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr
Public Declare Function DeleteDC()Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Boolean
Public Structure RECTStructure RECT
Public Sub New()Sub New(ByVal tLeft As Integer, ByVal tTop As Integer, ByVal tRight As Integer, ByVal tBottom As Integer)
Left = tLeft
Top = tTop
Right = tRight
Bottom = tBottom
End Sub
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
'****************************************************************************************
Public Structure BITMAPINFOHEADERStructure BITMAPINFOHEADER 'BITMAPINFOHEADER you must declare this
Dim biSize As Integer
Dim biWidth As Integer
Dim biHeight As Integer
Dim biPlanes As Short
Dim biBitCount As Short
Dim biCompression As Integer
Dim biSizeImage As Integer
Dim biXPelsPerMeter As Integer
Dim biYPelsPerMeter As Integer
Dim biClrUsed As Integer
Dim biClrImportant As Integer
End Structure
Public Structure RGBQUADStructure RGBQUAD
Dim rgbBlue As Byte
Dim rgbGreen As Byte
Dim rgbRed As Byte
Dim rgbReserved As Byte
End Structure
Public Structure BITMAPINFOStructure BITMAPINFO
Dim bmiHeader As BITMAPINFOHEADER
Dim bmiColors As RGBQUAD
End Structure
'************************************************************************************************
Public Structure S_DTTOPTSStructure S_DTTOPTS
Dim dwSize As Integer
Dim dwFlags As Integer
Dim crText As Integer
Dim crBorder As Integer
Dim crShadow As Integer
Dim iTextShadowType As Integer
Dim ptShadowOffset As POINT
Dim iBorderSize As Integer
Dim iFontPropId As Integer
Dim iColorPropId As Integer
Dim iStateId As Integer
Dim fApplyOverlay As Boolean
Dim iGlowSize As Integer
Dim pfnDrawTextCallback As Integer
Dim lParam As IntPtr
End Structure
Private Const DTT_COMPOSITED As Integer = 8192
Private Const DTT_GLOWSIZE As Integer = 2048
Private Const DTT_TEXTCOLOR As Integer = 1
Public Structure POINTStructure POINT
Dim cx, cy As Integer
Sub New()Sub New(ByVal X As Integer, ByVal Y As Integer)
cx = X
cy = Y
End Sub
End Structure
Public Structure MARGIN_STRUCTStructure MARGIN_STRUCT
Dim cxLeftWidth, cxRightWidth, cyTopHeight, cyBottomHeight As Integer
Sub New()Sub New(ByVal Left As Integer, ByVal Right As Integer, ByVal Top As Integer, ByVal Bottom As Integer)
cxLeftWidth = Left
cxRightWidth = Right
cyTopHeight = Top
cyBottomHeight = Bottom
End Sub
End Structure
Public Shared Sub DrawGlowingText()Sub DrawGlowingText(ByVal Graphics As Graphics, ByVal text As String, 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 As Integer = &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