pic控件里根据数据画实时曲线,需要画坐标网格线。
用line控件无法显示在pic控件上,所以在其load时用line方法画了网格线。
但是到了一定时间,曲线画满屏后,需要左移整个曲线。
问题:现用API:BitBlt将整个图象向左位移一个象素,位移时会将网格线也同时位移。
请问有没有什么好方法,位移曲线而网格线保留?
多谢!!!
用line控件无法显示在pic控件上,所以在其load时用line方法画了网格线。
但是到了一定时间,曲线画满屏后,需要左移整个曲线。
问题:现用API:BitBlt将整个图象向左位移一个象素,位移时会将网格线也同时位移。
请问有没有什么好方法,位移曲线而网格线保留?
多谢!!!
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3750
ClientLeft = 60
ClientTop = 345
ClientWidth = 3000
LinkTopic = "Form1"
ScaleHeight = 3750
ScaleWidth = 3000
StartUpPosition = 3 'Windows Default
Begin VB.Timer t
Left = 105
Top = 3045
End
Begin VB.CommandButton c
Caption = "Command1"
Height = 420
Left = 810
TabIndex = 0
Top = 3240
Width = 1395
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
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 CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor 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 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 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 Ellipse 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 CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) 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 LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Const SRCAND = &H8800C6
Private Const PS_SOLID = 0
Private Const SRCCOPY = &HCC0020
Private Const pi = 3.1415926
Private Const BS_SOLID = 0
Dim g__index As Integer
Dim memdc(0 To 40) As Long
Dim membmp(0 To 40) As Long
Dim oldbmp(0 To 40) As Long
Dim memdcgird As Long
Dim membmpgird As Long
Dim oldbmpgird As Long
Private Sub c_Click()
If LCase(c.Caption) = "start" Then
t.Enabled = True
c.Caption = "stop"
Else
t.Enabled = False
c.Caption = "start"
End If
End SubPrivate Sub Form_Load()
c.Caption = "start"
t.Enabled = False
t.Interval = 50
Dim i As Integer
For i = 0 To 40
memdc(i) = CreateCompatibleDC(Me.hdc)
membmp(i) = CreateCompatibleBitmap(Me.hdc, 200, 200)
oldbmp(i) = SelectObject(memdc(i), membmp(i))
Next i
For i = 0 To 40
draw i, 200, 200
Next i
memdcgird = CreateCompatibleDC(Me.hdc)
membmpgird = CreateCompatibleBitmap(Me.hdc, 200, 200)
oldbmpgird = SelectObject(memdcgird, membmpgird)
Dim hpen As Long
Dim oldpen As Long
Dim hbrush As Long
Dim oldbrush As Long
Dim log As LOGBRUSH
log.lbColor = CLng(RGB(255, 255, 255))
log.lbStyle = BS_SOLID
hbrush = CreateBrushIndirect(log)
oldbrush = SelectObject(memdcgird, hbrush)
Rectangle memdcgird, 0, 0, 200, 200
SelectObject memdcgird, oldbrush
DeleteObject hbrush
hpen = CreatePen(PS_SOLID, 1, CLng(RGB(255, 0, 0)))
oldpen = SelectObject(memdcgird, hpen)
Dim p As POINTAPI
For i = 0 To 200 Step 10
MoveToEx memdcgird, i, 0, p
LineTo memdcgird, i, 200
MoveToEx memdcgird, 0, i, p
LineTo memdcgird, 200, i
Next i
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = 0 To 40
SelectObject memdc(i), oldbmp(i)
DeleteObject membmp(i)
DeleteDC memdc(i)
Next i
SelectObject memdcgird, oldbmpgird
DeleteObject membmpgird
DeleteDC memdcgird
End SubPrivate Sub draw(ByVal angle As Integer, ByVal nw As Long, ByVal nh As Long)
Dim i As Double
Dim j As Double
Dim x As Double
Dim y As Double
Dim rx As Double
Dim ry As Double
Dim r0 As Double
Dim r1 As Double
Dim xx As Long
Dim yy As Long
rx = nw / 2
ry = nh / 2
r0 = 70
r1 = 20
Dim hpen As Long
Dim oldpen As Long
Dim hbrush As Long
Dim oldbrush As Long
Dim log As LOGBRUSH
log.lbColor = CLng(RGB(255, 255, 255))
log.lbStyle = BS_SOLID
hbrush = CreateBrushIndirect(log)
oldbrush = SelectObject(memdc(angle), hbrush)
Rectangle memdc(angle), 0, 0, nw, nh
SelectObject memdc(angle), oldbrush
DeleteObject hbrush
hpen = CreatePen(PS_SOLID, 1, CLng(RGB(Abs(angle - 20) * 12, 0, Abs(angle - 20) * 12)))
oldpen = SelectObject(memdc(angle), hpen)
For i = 0 To 2 * pi Step pi / 4
For j = 0 To 2 * pi Step pi / 10
x = rx + r0 * Cos(i + (angle / 40) * 2 * pi)
y = ry + r0 * Sin(i + (angle / 40) * 2 * pi)
xx = x + r1 * Cos(j)
yy = y + r1 * Sin(j)
Ellipse memdc(angle), xx - 3, yy - 3, xx + 3, yy + 3
Next j
Next i
SelectObject memdc(angle), oldpen
DeleteObject hpen
End SubPrivate Sub t_Timer()
BitBlt Me.hdc, 0, 0, 200, 200, memdc(g__index), 0, 0, SRCCOPY
BitBlt Me.hdc, 0, 0, 200, 200, memdcgird, 0, 0, SRCAND
g__index = g__index + 1
If g__index > 40 Then
g__index = 1
End If
End Sub
需要时,把这个copy回去.要想运行快点,就只复制被网格盖住的几条线