如何在VB6中用API实现文本转换为位图?

xinlnix 2005-12-10 10:29:08
我的窗体上加入一个名为pbx的picturebox,两个按钮command1,command2
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 Const TRANSPARENT = 1
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) 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 DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat 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 BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long


Private Const DT_BOTTOM = &H8
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_CHARSTREAM = 4 ' Character-stream, PLP
Private Const DT_DISPFILE = 6 ' Display-file
Private Const DT_EXPANDTABS = &H40
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_INTERNAL = &H1000
Private Const DT_LEFT = &H0
Private Const DT_METAFILE = 5 ' Metafile, VDM
Private Const DT_NOCLIP = &H100
Private Const DT_NOPREFIX = &H800
Private Const DT_PLOTTER = 0 ' Vector plotter
Private Const DT_RASCAMERA = 3 ' Raster camera
Private Const DT_RASDISPLAY = 1 ' Raster display
Private Const DT_RASPRINTER = 2 ' Raster printer
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_TABSTOP = &H80
Private Const DT_TOP = &H0
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10


Private Sub Command1_Click()
Dim nResult As Long
Dim szText As String
Dim lpRect As RECT
Dim lpSize As Size
Dim hThisDC As Long

szText = "Hellodflkhqewttttttttt" & Chr(13) & "4wq65756876980436346t1325t"

hThisDC = pbx.hdc
nResult = GetTextExtentPoint32(hThisDC, szText, Len(szText), lpSize)

nResult = SetBkMode(hThisDC, TRANSPARENT)
nReuslt = SetTextColor(hThisDC, &HC00000)

'nResult = TextOut(pbx.hdc, 0, 0, szText, Len(szText))
lpRect.Top = 0
lpRect.Left = 0
lpRect.Bottom = pbx.Width / Screen.TwipsPerPixelX
lpRect.Right = pbx.Height / Screen.TwipsPerPixelY
nResult = DrawText(hThisDC, szText, Len(szText), lpRect, DT_NOCLIP Or DT_WORDBREAK Or DT_LEFT Or DT_TOP)
nResult = BitBlt(pbx.Picture.Handle, 0, 0, pbx.Width, pbx.Height, pbx.hdc, 0, 0, SRCCOPY)

End Sub

Private Sub Command2_Click()
SavePicture pbx.Picture, "D:\Borland\Led\09\my.bmp"
End Sub

Private Sub Form_Load()
pbx.Picture = LoadPicture("D:\Borland\Led\09\AllGrn.bmp")
End Sub

但是无论怎样,也不能将文本转换的位图放入picturebox.picture中,也不能保存。可否给予帮助,谢谢。
...全文
244 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
Summer006 2005-12-10
  • 打赏
  • 举报
回复
print 方法可以简单的做到。
northwolves 2005-12-10
  • 打赏
  • 举报
回复
这么复杂?

下面代码就够了:

Private Sub Command2_Click()
SavePicture pbx.Image, "D:\Borland\Led\09\my.bmp"
End Sub

Private Sub Form_Load()
pbx.AutoRedraw = True
pbx.Picture = LoadPicture("D:\Borland\Led\09\AllGrn.bmp")
pbx.ForeColor = &HC00000
pbx.Print "Hellodflkhqewttttttttt" & Chr(13) & "4wq65756876980436346t1325t"
End Sub
xinlnix 2005-12-10
  • 打赏
  • 举报
回复
?
xinlnix 2005-12-10
  • 打赏
  • 举报
回复
真是茅塞顿开!我太笨了,再问一下,print不能自动换行
如果文本太长超过picturebox的宽度,用哪个函数能自动换行呢?
DRAWTEXT行不?
province_ 2005-12-10
  • 打赏
  • 举报
回复
BITBLT完全多余,DRAWTEXT或TEXTOUT到PBX后只要其AutoRedraw为真就能SAVEPICTURE到BMP文件了。
rainstormmaster 2005-12-10
  • 打赏
  • 举报
回复
错误很多:

在nReuslt = SetTextColor(hThisDC, &HC00000)这句中nReuslt写错了,这是低级错误,改为:
nResult = SetTextColor(hThisDC, &HC00000)

在nResult = BitBlt(pbx.Picture.Handle, 0, 0, pbx.Width, pbx.Height, pbx.hdc, 0, 0, SRCCOPY)这句中没有预先声明SRCCOPY常量,在通用声明部分添加:
Private Const SRCCOPY = &HCC0020
另外:
pbx.Picture.Handle指向的是bitmap,并不是设备场景(DC),很明显BitBlt函数用它作为参数不合适

还有,如果想在程序中使用BitBlt,你的pbx的ScaleMode属性 要设置为3,如果想要保存图片,则pbx的AutoRedraw属性要设置为true

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧