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

昨天我在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特有):

 

Public   Declare   Function DrawThemeTextEx Lib "UxTheme.dll" (ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As IntegerByVal iStateId As IntegerByVal text As StringByVal iCharCount As IntegerByVal dwFlags As IntegerByRef 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 IntegerByVal iStateId As IntegerByVal text As StringByVal iCharCount As IntegerByVal dwFlags As IntegerByRef 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 IntegerAs 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 IntegerByVal iStateId As IntegerByVal text As StringByVal iCharCount As IntegerByVal dwFlags As IntegerByRef 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 IntegerByVal hSection As IntPtr, ByVal dwOffset As UInt32) As IntPtr
    
'***************************************************************************



    
Public Declare Function BitBlt Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal nXDest As IntegerByVal nYDest As IntegerByVal nWidth As IntegerByVal nHeight As IntegerByVal hdcSrc As IntPtr, ByVal nXSrc As IntegerByVal nYSrc As IntegerByVal 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 IntegerByVal tTop As IntegerByVal tRight As IntegerByVal 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 IntegerByVal 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 IntegerByVal Right As IntegerByVal Top As IntegerByVal 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 StringByVal 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(00, 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, 00, 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, 
00, 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, 00, 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
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值