回 帖 发 新 帖 刷新版面

主题:VB能否绘制大图形?

我在用VB绘图时在PictureBox上用Pset(x,y),Color描绘点,我的图片大小为1400*1400像素,但速度很慢,我用另一种方法绘制是在内存dc绘图,然后拷贝到PictureBox上显示,速度很快,但是内存绘图的图形大小是在屏幕可见范围内,能不能用什么方法绘制超过屏幕可见范围的图片?谢谢

回复列表 (共12个回复)

沙发

创建一个大的内存位图,然后选入内存DC中,在需要的位置绘图后用BITBLT拷贝到前台显示

板凳

王老师,你说的方法你自己试过吗?我的图片大小为1400*1400像素,我用内存dc绘图,然后用BITBLT拷贝到PictureBox上显示,但是内存绘图的图形大小是在屏幕可见范围内(如1024*768),那么用什么方法绘制超过屏幕可见范围的图片?如果你实现了你说的方法,能不能给我程序拜读一下?谢谢

3 楼


王老师,你说的方法你自己试过吗?我的图片大小为1400*1400像素,我用内存dc绘图,然后用BITBLT拷贝到PictureBox上显示,但是内存绘图的图形大小是在屏幕可见范围内(如1024*768),那么用什么方法绘制超过屏幕可见范围的图片?如果你实现了你说的方法,能不能给我程序拜读一下?谢谢

4 楼

PictureBox的Pset(x,y)是最慢的方法

5 楼

你贴你创建内存DC的代码出来。

6 楼

rem VB通用声明部分
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 LineTo Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Dim newX1 As Single, newx2 As Single, newy1 As Single, newy2 As Single
Dim hBitmap As Long
Dim hDCMem 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 CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function Rectangle Lib "GDI32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Long

Private Declare Function MoveToEx Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) 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 Declare Function CreateRectRgn Lib "GDI32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRgn Lib "GDI32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "GDI32" (ByVal crColor 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 SetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Sub Command2_Click()  
rem 开始画图,Picture1是Picturebox控件
  Dim i, j
  Dim timedi
   timedi = Now
      dc = CreateCompatibleDC(Picture1.hDC)         '创建一个与窗体相兼容的设备场景
      hBmp = CreateCompatibleBitmap(dc, Picture1.ScaleWidth, Picture1.ScaleHeight)       '在内存中创建与窗体同样大小的位图
      SelectObject dc, hBmp        '将位图选入刚才创建的设备场景中

  For i = 0 To Picture1.Width / 15
     For j = 0 To Picture1.Height / 15
        SetPixel hDC, i, j, RGB(Rnd * 255, Rnd * 255, Rnd * 255)    'RGB(255, 255, 0)
       'Picture1.ScalePSet (i, j), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
     Next
  Next
  Picture1.Cls
    BitBlt Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, hDC, 0, 0, vbSrcCopy      '将内存位图中的图形拷贝到窗体上显示
   MsgBox DateDiff("s", timedi, Now)
     DeleteObject hBmp
     DeleteDC dc
end sub

Private Sub Form_Load()
   Picture1.Width = 21000
   Picture1.Height = 21000
   Picture1.ScaleWidth = 2004
   Picture1.ScaleHeight = 2004

End Sub

7 楼

我写过一个这方面的ActiveX Dll好像在这里发布过

8 楼

[quote]hBmp = CreateCompatibleBitmap(dc, Picture1.ScaleWidth, Picture1.ScaleHeight)[/quote]
你自己创建了一幅100*100的位图,你怎么可以推出“不能创建200*200的位图了呢”?

9 楼

去这个地址下载
http://bbs.pfan.cn/post-270066.html

10 楼

[quote]去这个地址下载
http://bbs.pfan.cn/post-270066.html[/quote]
请教你的这个控件具有什么功能?如何使用?谢谢

我来回复

您尚未登录,请登录后再回复。点此登录或注册