关于vb.net里面api UnicodeANSI调用一个问题解答

技术2022-05-11 89

昨天我在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.netEvery thing seems to work but the text is drawn using japaneese signs, Not normal letters :0Can anyone tell me whats wrong?

翻译成中文的大意是：我把GlassText.cs中的DrawGlowingText 函数从C#翻译成了vb.net，但是画出的文本却全是日文（其实是乱码），这是为什么？

下面接着就贴着长长的代码了，大家有兴趣可以去一看。

我把他的代码复制下来，一到vista里面调试，发觉是乱码。于是感觉是他的函数调用方式出了问题，一看，果然。他的DrawThemeTextEx函数声明的时候用的是vb6时代的api声明方式（该函数vista特有）：

Public Declare Function DrawThemeTextEx Lib "UxTheme.dll" (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

然而，.net对于这种声明默认被声明的函数为Ansi调用，于是string参数被强制作为Ansi字符串读取。而我们知道，.net里面所有的string默认都是unicode。更不幸的是，DrawThemeTextEx本身就是一个Unicode函数。于是这种种错误加在一起，便造成了乱码。那怎么解决呢？方法很简单：使用.net标准的P/Invoke声明，显式声明该函数为Unicode调用：

< DllImport( " UxTheme.dll " , ExactSpelling: = True , SetLastError: = True , CharSet: = CharSet.Unicode) > _ Shared 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 Imports System.Drawing Imports System.Windows.Forms Imports System.Runtime.InteropServices Public Class VistaAPI Public Declare Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef en As Integer) As Integer Public Declare 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(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 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 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 Lib "gdi32.dll" (ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Boolean Public Structure RECT Public 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 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 RGBQUAD Dim rgbBlue As Byte Dim rgbGreen As Byte Dim rgbRed As Byte Dim rgbReserved As Byte End Structure Public Structure BITMAPINFO Dim bmiHeader As BITMAPINFOHEADER Dim bmiColors As RGBQUAD End Structure '************************************************************************************************ Public Structure 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 POINT Dim cx, cy As Integer Sub New(ByVal X As Integer, ByVal Y As Integer) cx = X cy = Y End Sub End Structure Public Structure MARGIN_STRUCT Dim cxLeftWidth, cxRightWidth, cyTopHeight, cyBottomHeight As Integer 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(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 SubEnd Class

专利

最新回复(0)