Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Convert this code to .NET (Text to Image)

Status
Not open for further replies.

codecref

Programmer
Dec 8, 2003
118
0
0
US
Hi guys
I was converting my project into .net but about this part of code is like that VS 2003 and VS2005 are both unable to convert it.

Code:
Public CurrentSub As Integer
Public SelStream As Integer
Public myFont As New StdFont

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PictDesc, riid As Any, ByVal fOwn As Long, lplpvObj As Any)
Private Declare Sub CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Any)
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type Size
    cx As Long
    cy As Long
End Type
Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
Const PS_SOLID = 0

Function Text2Image(Text, Font As IFont, ByVal BackColor As OLE_COLOR, ByVal FillColor As OLE_COLOR, LineColor As OLE_COLOR, ByVal LineWidth As Long) As StdPicture
    Dim hdc As Long, hBmp As Long, hFont As Long, hBrush As Long, hPen As Long
    Dim hDC0 As Long
    OleTranslateColor BackColor, 0, BackColor
    OleTranslateColor FillColor, 0, FillColor
    OleTranslateColor LineColor, 0, LineColor
    hDC0 = GetDC(0)
    hdc = CreateCompatibleDC(hDC0)
    
    hFont = SelectObject(hdc, Font.hFont)
    
    Dim sz As Size, rc As RECT
    GetTextExtentPoint32 hdc, Text, Len(Text), sz
    sz.cx = 500
    sz.cy = 100
    hBmp = CreateCompatibleBitmap(hDC0, sz.cx, sz.cy)
    hBmp = SelectObject(hdc, hBmp)
    
    ReleaseDC 0, hDC0
    
    rc.Right = sz.cx
    rc.Bottom = sz.cy
    hBrush = CreateSolidBrush(BackColor)
    FillRect hdc, rc, hBrush
    DeleteObject hBrush
    
    hBrush = CreateSolidBrush(FillColor)
    hBrush = SelectObject(hdc, hBrush)
    
    hPen = CreatePen(PS_SOLID, LineWidth, LineColor)
    hPen = SelectObject(hdc, hPen)
    
    BeginPath hdc
    TextOut hdc, 0, 0, Text, Len(Text)
    EndPath hdc
    StrokeAndFillPath hdc
    
    hPen = SelectObject(hdc, hPen)
    DeleteObject hPen

    hBrush = SelectObject(hdc, hBrush)
    DeleteObject hBrush

    hBmp = SelectObject(hdc, hBmp)
    DeleteDC hdc
    
    Dim pd As PictDesc, IPic(15) As Byte
    pd.cbSizeofStruct = Len(pd)
    pd.picType = vbPicTypeBitmap
    pd.hImage = hBmp
    
    CLSIDFromString StrPtr("{00020400-0000-0000-C000-000000000046}"), IPic(0)
    OleCreatePictureIndirect pd, IPic(0), True, Text2Image
End Function

can you give me hand on this? and is there a chance to have antialiasing support and make the BMP file only 4 bit per pixel or 8 bit or even have option to select and at the same time have Auto sizing and Constant size... if you could put some comment in your code then I would learn it and can modify it myself.


and will it automatically support unicode or have to be adjusted?

thanks in advance
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top