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.
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
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