请教如何形成实时曲线并打印？

[happydoublefish]

我想在picture控件里显示实时曲线（显示一些模拟量与时间的关系），并使得坐标轴以及其上的坐标显示可以与曲线一起打印出来。请问该怎么实现啊？谢谢！

[射天狼]

Printer.PaintPicture picture1.Picture, 0, 0

[happydoublefish]

那样的话，怎么把坐标写在坐标轴上啊？

[felix]

printer.print i
printer.line (x1,y1)-(x2,y2)

[myguilotus]

Dim total As Integer '接收数据个数
Dim j As Integer
Dim buffer As Variant
''''''''''''''
Dim s As Long
Dim L As Long
Dim t As Integer
Dim y1, y As Long
''''''''''''''


Private Sub Command1_Click() '关闭
Command2_Click
End
End Sub

Private Sub Command2_Click() '断开
If MSComm1.PortOpen Then
MSComm1.PortOpen = False ' 关闭串行口
Command2.Enabled = False ' 断开按钮无效
End If
End Sub

Private Sub Command3_Click() ' 连接
With MSComm1
.CommPort = 1 ' 使用串行口1
'波特率2400/4800，无校验位，8个数据位
.Settings = Combo1.Text + "n,8,1"
.InputLen = 0
.InBufferSize = 100 '置MSComm1接收缓冲区为100字节
.InputMode = comInputModeBinary '二进制
.RThreshold = 1 '设置接收一个字节产生OnComm事件
.InBufferCount = 0 '清除接收缓冲区
If .PortOpen = False Then '判断通信口是否打开
.PortOpen = True '打开通信口
If Err Then '错误处理
MsgBox "串口通信无效"
Exit Sub
End If
End If
End With

Command2.Enabled = True '断开

Picture1.Cls '请空Picturebox
j = 0
End Sub
'Private Sub Command4_Click() '打印
'Printer.PaintPicture Picture1.Image, 0, 0
'Printer.EndDoc
'End Sub

Private Sub Command5_Click() '保存曲线图
Dim fname As String
fname = App.Path + "\" + CStr(Date) + "QXT.bmp"
SavePicture CaptureWindow(Picture1.hWnd, False, 0, 0, _
Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), _
Picture1.ScaleY(Picture1.Height, vbTwips, vbPixels)) _
, fname
MsgBox ("实时曲线图已经成功保存在" + fname + "中!")
End Sub

Private Sub Form_Load()
'' Picture1.AutoRedraw = False
'' Picture1.ScaleMode = 3
L = -1
s = 256
t = -1
End Sub

Public Sub MSComm1_OnComm()
Dim i As Integer
Dim k As Integer

Select Case MSComm1.CommEvent
Case comEvReceive ' 收到 RThreshold=1 of chars.
i = MSComm1.InBufferCount
buffer = MSComm1.Input
' ShowData Text1, (StrConv(buffer, vbUnicode)), buffer, i

ShowData Text1, buffer, i
' showPic Picture1, Shape1, buffer, k
showSSPic Picture1, buffer, i

Case comEventOverrun: MsgBox ("数据丢失.")
Case comEventRxOver: MsgBox ("接收缓冲区溢出。")
Case comEventRxParity: MsgBox ("Parity 错误。")
Case comEventTxFull: MsgBox ("传输缓冲区已满。")
Case comEventBreak: MsgBox ("接收到一个中断信号。")
End Select
End Sub
'显示实时图像
Private Static Sub showSSPic(Pic As Control, buffer As Variant, tlen As Integer)
Dim w As Long, h As Long, data As Long
Dim showmode As Long, ii As Long, i As Integer

h = Pic.Height
w = Pic.Width
showmode = &HCC0020 'ROP模式（复制）
'' Pic.BackColor = vbblank

For t = 0 To tlen - 1
y1 = CLng(buffer(t)) / 256 * h
ii = BitBlt(Pic.hDC, 0, 0, w - 1, h, Pic.hDC, 1, 0, showmode) '整个曲线右移一个像素点
' Pic.Line (w - 1, y)-(w, y1), RGB(255, 0, 0)
Pic.Line (w - 1, y)-(w, y1), RGB(255, 0, 0)

Debug.Print "y= " & y & "*** y1= " & y1 & "*** w=" & w&; "*** h=" & h & "******buffer(t)= " & buffer(t)
y = y1
Next t
End Sub
Private Static Sub showPic(Pic As Control, sha As Control, buffer As Variant, tlen As Integer)
Dim x0, y0, h, w
Dim y1, y2 As Long
x0 = sha.Left
y0 = sha.Top + sha.Height
h = sha.Height / 4
w = sha.Width / 600

j = j + 1
If j > 600 Then
j = 0
Pic.Cls
End If

y2 = buffer(tlen) / 64 * h
Pic.Line (x0 + j * w, y0 - y1)-(x0 + (j + 1) * w, y0 - y2), RGB(255, 0, 0)
Label3.Caption = "X1:" + CStr(Int((x0 + j * w) / 10))
Label4.Caption = "Y1:" + CStr(Int(y1 / 10))
Label5.Caption = "X2:" + CStr(Int(((x0 + j + 1) * w) / 10))
Label6.Caption = "Y2:" + CStr(Int(y2 / 10))

y1 = y2

End Sub



'Private Static Sub ShowData(Term As Control, data As String, buffer As Variant, datalenth As Integer)
Private Static Sub ShowData(Term As Control, buffer As Variant, datalenth As Integer)
Const MAXTERMSIZE = 320000
Dim TermSize, i As Long
Dim strtemp, s2 As String
Dim s1 As Byte
Dim n3, n1, n2, StrLen As Integer

For n3 = 0 To datalenth - 1
' DoEvents
s1 = buffer(n3)
s2 = Hex(s1)
s2 = "0" & s2
s2 = Right(s2, 2)
Term.SelText = s2 & " "
Term.SelStart = Term.SelStart + 3
Next n3

End Sub