shujucaiji.rar_ shujucaiji_shujucaiji_多路 温度_曲线_毕业设计

Dim pdata(29) As Variant 'pdata（29）存放每一轮光压数值数组 Dim outbte(0) As Byte Dim w As Integer Dim num As Integer 'num为接收到所有的数据组号 Private Sub Command1_Click() Dim x(1 To 29, 1 To 2) As Variant Dim k As Integer Dim ex As excel.Application '使用excel做一个模版 Dim exwbook As excel.Workbook Dim exsheet As excel.Worksheet For k = 1 To 29 x(k, 1) = k x(k, 2) = pdata(k - 1) Next k If MSComm1.PortOpen = False Then Set ex = CreateObject("Excel.Application") '创建excel对象 Set exwbook = Nothing Set exsheet = Nothing Set exwbook = ex.Workbooks().Add '添加一个工作簿 Set exsheet = exwbook.Worksheets("sheet1") ex.Range("a2:b30").Value = x ex.Range("a1").Value = "光点号" ex.Range("b1").Value = "光压值/V" exwbook.SaveAs "c:\duolu.xls" ex.Quit End If End Sub Private Sub Command2_Click() MSComm1.PortOpen = False End Sub Private Sub Command3_Click() End End Sub Private Sub Command4_Click() MSComm1.PortOpen = True outbte(0) = CByte(1) MSComm1.OutBufferCount = 0 MSComm1.Output = outbte End Sub Private Sub Form_Load() MSComm1.CommPort = 4 'COM1 MSComm1.InputMode = comInputModeBinary '二进制接收模式 MSComm1.RThreshold = 1 '从缓冲区中接受一个字节产生OnComm事件 MSComm1.SThreshold = 0 '不产生发送事件 MSComm1.Settings = "9600,n,8,1" '波特率9600bps，无奇偶校验位，8个数据位，一个停止位 MSComm1.PortOpen = True MSComm1.InputLen = 0 outbte(0) = CByte(1) MSComm1.OutBufferCount = 0 MSComm1.Output = outbte Picture1.Scale (0, 6)-(30, 0) Picture2.Scale (0, 0)-(640, 480) Call tabinit '表格初始化 End Sub Private Sub MSComm1_OnComm() Dim inbyte() As Byte If num >= 20 Then MSFlexGrid1.Clear Picture1.Cls Picture2.Cls Call tabinit num = 0 End If Select Case MSComm1.CommEvent Case comEvReceive inbyte = MSComm1.Input temp = inbyte(0) / 255 * 5 ptemp = Round(temp, 3) '取三位小数 pdata(w) = ptemp MSFlexGrid1.Col = num + 1 MSFlexGrid1.Row = w + 1 MSFlexGrid1.Text = pdata(w) w = w + 1 MSComm1.InBufferCount = 0 '清空接收区 If w = 29 Then w = 0 num = num + 1 Else Exit Sub End If Picture1.Cls '画曲线图 For i = 0 To 27 X1 = i: Y1 = pdata(i) X2 = i + 1: Y2 = pdata(i + 1) Picture1.Line (X1, Y1)-(X2, Y2) Next i j = 0 '画三维色球 Const pi = 3.14159 Picture2.Cls Dim qbcolor As Variant Dim F, N As Integer A0 = 5 A1 = 4.375 A2 = 3.75 A3 = 3.125 A4 = 2.5 A5 = 1.875 A6 = 1.25 A7 = 0.625 A8 = 0 For i = 0 To 28 F = i \ 4 'F为层数 N = i Mod 4 'N为方向区域 Select Case pdata(i) Case A1 To A0 qbcolor = vbWhite Case A2 To A1 qbcolor = vbRed Case A3 To A2 qbcolor = vbGreen Case A4 To A3 qbcolor = vbYellow Case A5 To A4 qbcolor = vbBlue Case A6 To A5 qbcolor = vbMagenta Case A7 To A6 qbcolor = vbCyan Case A8 To A7 qbcolor = vbBlack End Select Select Case F Case 0 q1 = pi / 2: q2 = 1.695 Case 1 q1 = 1.695: q2 = 1.82 Case 2 q1 = 1.82: q2 = 1.954 Case 3 q1 = 1.954: q2 = 2.094 Case 4 q1 = 2.094: q2 = 2.245 Case 5 q1 = 2.245: q2 = 2.418 Case 6 q1 = 2.418: q2 = 2.625 Case 7 q1 = 2.625: q2 = pi End Select r = 200 s = pi / 10 p1 = N / 2 * pi p2 = (N + 1) / 2 * pi If q2 = pi Then 'q2=pi时，对应pdata(28) p1 = 0: p2 = 2 * pi End If For q = q1 To q2 Step 0.05 'p,q为画球角度参数 For p = p1 To p2 Step 0.03 x = r * Sin(q) * Cos(p) y = r * Cos(q) Z = r * Sin(q) * Sin(p) px = x * 0.9 py = y - Z * Sin(s) Picture2.DrawWidth = 4 Picture2.PSet (px + 320, 300 + py), qbcolor Next p Next q Next i outbte(0) = CByte(1) MSComm1.OutBufferCount = 0 MSComm1.Output = outbte MSComm1.OutBufferCount = 0 '清空SBUF，即清k值 End Select End Sub Public Sub tabinit() MSFlexGrid1.Cols = 21 MSFlexGrid1.Rows = 30 MSFlexGrid1.ColWidth(0) = 650 MSFlexGrid1.Col = 0 For i = 1 To 29 MSFlexGrid1.Row = i: MSFlexGrid1.Text = Str$(i) Next i MSFlexGrid1.Row = 0 MSFlexGrid1.Col = 0: MSFlexGrid1.Text = "光点号\光压值\组数" For i = 1 To 20 MSFlexGrid1.Col = i: MSFlexGrid1.Text = " " + Str$(i) Next i MSFlexGrid1.LeftCol = 1 '从第一页开始 End Sub