vb picturebox如何显示超过picturebox.width 40倍的图形？

[sxgtxayb]

picturebox如何显示超过picturebox.width 40倍的图形？

[lyserver]

使用滚动条。

[sxgtxayb]

picturebox只能装入picturebox.width 3倍的图形,用滚动条也不行

[贝隆]

http://download.csdn.net/source/2368159

[lyserver]

[Quote=引用 2 楼 sxgtxayb 的回复:]
picturebox只能装入picturebox.width 3倍的图形,用滚动条也不行
[/Quote]
只要有足够的连续内存，就能显示大位图。

[sxgtxayb]

如何给picturebox分配连续内存?

[lyserver]

使用createdc、createcompatiblebitmap创建内存位图，使用bitblt显示位图。

[sxgtxayb]

能否给出例子?

[sxgtxayb]

bitblt显示位图,使用滚动条上下滚动时,图形接逢如何解决

[贝隆]

我提供的例子不就是吗？

[sxgtxayb]

我下载不了

[贝隆]

Option Explicit

Dim K As Double
Dim lngX As Long            'X的值
Dim dblY As Double          'Y的值
Dim L As Long               '绘图区域的宽
Dim H As Long               '绘图区域的高
Dim lngMemoryDC As Long     '内存中绘图的设备场景的句柄
Dim lngBMPHandle As Long    '位图的句柄
Dim lngBrushHandle As Long  '填充刷子的句柄
Dim hRgn As Long            '填充区域的句柄


Private Const PI = 3.1415926        'PI
Private Const DC_L = 500          '内存设备场景对图片设备场景的倍数,注意，这个数据太大会导致函数执行失败
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCDECIMALBIND = 19
Private Const SRCERASE = &H440328


Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, lppt As POINTAPI, ByVal cPoints As Long) As Long
Private Declare Function PolyBezierTo Lib "gdi32.dll" (ByVal hdc As Long, lppt As POINTAPI, ByVal cCount As Long) As Long
Private Declare Function PolyPolygon Lib "gdi32.dll" (ByVal hdc As Long, lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y 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 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc 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 Sub Command1_Click()
    Dim lngP As Long
    If Command1.Caption = "开始" Then
        Timer1.Enabled = True
        Command1.Caption = "停止"
    Else
        Timer1.Enabled = False
        Command1.Caption = "开始"
    End If
End Sub

Private Sub Form_Load()
    Dim intP As Integer
    Dim x As Double
    Dim y As Double
    Dim lngP As Long
On Error GoTo errSub
    L = Picture1.ScaleWidth / 15
    H = Picture1.ScaleHeight / 15
    ReDim A(L)
    K = 4 * PI / L
    dblY = H * 0.5
    lngMemoryDC = CreateCompatibleDC(Picture1.hdc)                  '创建一个与窗体相兼容的设备场景
    lngBMPHandle = CreateCompatibleBitmap(lngMemoryDC, DC_L * L, H) '在内存中创建与窗体同样大小的位图
    SelectObject lngMemoryDC, lngBMPHandle                          '将位图选入刚才创建的设备场景中
    lngBrushHandle = CreateSolidBrush(RGB(255, 255, 255))           '用白色创建一个实色画刷
    hRgn = CreateRectRgn(0, 0, DC_L * L, H)                         '创建一个与窗体同样大小的矩形区域
    lngP = FillRgn(lngMemoryDC, hRgn, lngBrushHandle)               '用创建的画刷对该区域进行填充
    Exit Sub
errSub:
    MsgBox Err.Description
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    DeleteObject hRgn               '删除以前创建的对像用于释放内存
    DeleteObject lngBrushHandle
    DeleteObject lngBMPHandle
    DeleteDC lngMemoryDC
End Sub
Private Sub Timer1_Timer()
    Dim lngP As Long
    Dim lngT As Long
    Dim lngK As Long
    Dim intP As Integer
On Error GoTo errSub
    lngK = GetTickCount
    MoveToEx lngMemoryDC, lngX, dblY, ByVal 0&
    lngX = lngX + 1
    dblY = (0.45 * H * Sin(K * lngX) + 0.5 * H)
    lngP = LineTo(lngMemoryDC, lngX, dblY)
    If lngX <= L Then
        lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY) '将内存位图中的图形拷贝到窗体上显示
    Else
        lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, lngX - L, 0, SRCCOPY) '将内存位图中的图形拷贝到窗体上显示
    End If
    Exit Sub
errSub:
End Sub