frv2.frm

串口通讯。上位机实例.提供了良好的界面。对初学者很有参考性

Attribute VB_Exposed = False
Option Explicit
Dim PicB As Boolean
Const cmdNum As Byte = 3
Dim mWav(cmdNum + 1) As Boolean             '按钮数组有无鼠标移动到的标志
Dim cWav(cmdNum + 1) As Boolean             '按钮数组的按下状态
Dim cmdToolTip(cmdNum) As New ToolTip       '波形按钮标签
Dim PicMove As Boolean                      'pic9 和pic8移动的标志

Private Sub Command1_Click()
Dim Step As Single
Dim OutV As Single
Dim flag As Boolean                             '判断波形是否在工作
Dim i As Byte
Dim TemPath As String
Dim Response As Integer
If Command1.Caption = "工作" Then                     '开始工作,发送命令
    For i = 1 To cmdNum - 1
        flag = cWav(i) Or cWav(i + 1) Or flag
    Next
    If flag Then                                 '有波形在输出
        Response = MsgBox("波形输出正在工作，是否停止？", vbYesNo + vbQuestion + vbDefaultButton1)
        If Response = vbNo Then                 '不停止波形
            SSTab1.Tab = 1
            Exit Sub                            '退出
        Else                                    '停止波形
            cWav(CmdIndex) = False             '参数重置，按钮弹起
            TemPath = "Pic\48WAV" & CmdIndex & ".ico"
            Call Path(TemPath)
            Timer2.Enabled = False
            Timer2.Enabled = False           'timer2停止工作，波形动画停止
            Picture8(0).Visible = False      '图片框不可见
            Picture8(1).Visible = False
            Picture8(0).Left = 0             '初始化图片框参数
            Picture8(1).Left = -Picture8(1).Width
        End If
    End If
    Command1.Caption = "暂停"
    Call SendB(HScroll1.Value)                '发送命令数据 防止误码多发送一次
    Call SendB(HScroll1.Value)                '发送命令数据
    Step = 10 / 255
    OutV = Step * HScroll1.Value - 5 + (HScroll2.Value - 100) * 0.01
    SEG1.Value = Format$(OutV, "0.00")
Else
    SEG1.Value = Format$(Null, "0.00")                 '停止工作
    Command1.Caption = "工作"
    Call SendB(&H80)
End If
End Sub

'Private Sub Command1_Click()                           '+ - 按钮
'If SEG2.Value < 1 Then
'    SEG2.Value = Format$(SEG2.Value + 0.01, "0.00")
'    If SEG1.Value <> Format$(Null, "0.00") Then
'    SEG1.Value = Format$(SEG1.Value + 0.01, "0.00")
'    End If
'Else
'    MsgBox "已经达到上限！"
'End If
'End Sub
'Private Sub Command2_Click()
'If SEG2.Value > -1 Then
'    SEG2.Value = Format$(SEG2.Value - 0.01, "0.00")
'    If SEG1.Value <> Format$(Null, "0.00") Then
'    SEG1.Value = Format$(SEG1.Value - 0.01, "0.00")
'    End If
'Else
'    MsgBox "已经达到下限！"
'End If
'End Sub
Private Sub Command3_Click()
Unload Me
Form1.Show
End Sub
Private Sub Command4_Click()
End
End Sub
Private Sub Command5_Click(Index As Integer)
Dim TemPath As String
Dim i As Byte
If Not cWav(Index) Then             '该键之前未被按下，现在已按下
    If Command1.Caption = "暂停" Then   '若电压输出在工作
        Dim Response As Integer
        Response = MsgBox("电源输出正在工作，是否停止？", vbYesNo + vbQuestion + vbDefaultButton1)
        If Response = vbNo Then          '按下“否”
            SSTab1.Tab = 0               '跳转的电压输出面板
            Exit Sub
        Else                             '按下"是"，电源停止，波形工作：电压输出面板重置
            Command1.Caption = "工作"
            SEG1.Value = Format$(Null, "0.00")                 'seg1不显示
        End If
    End If
    Command5(Index).Picture = Command5(Index).DownPicture
    cmdToolTip(Index).ToolTipText = "工作"
    CmdIndex = Index                    '模块变量
    Call SendW                          '发送指令产生波形
    Timer2.Enabled = True               'timer2开始工作，波形动画开始
    For i = 1 To cmdNum
        If i <> Index Then
            If cWav(i) = True Then      '若已经有其他按钮按下则弹起
                cWav(i) = False
                TemPath = "Pic\48WAV" & i & ".ico"
                Call Path(TemPath)
                Command5(i).Picture = LoadPicture(FullPath)
                cmdToolTip(i).ToolTipText = "停止"
            End If
        End If
    Next
    
Else                             '该键已经按下-弹起
    TemPath = "Pic\48WAV" & Index & ".ico"
    Call Path(TemPath)
    Command5(Index).Picture = LoadPicture(FullPath)
    cmdToolTip(Index).ToolTipText = "停止"
    Call SendB(&H80)               '停止波形的产生
    Timer2.Enabled = False           'timer2停止工作，波形动画停止
    Picture8(0).Visible = False      '图片框不可见
    Picture8(1).Visible = False
    Picture8(0).Left = 0             '初始化图片框参数
    Picture8(1).Left = -Picture8(1).Width
    End If
cWav(Index) = Not cWav(Index)        '状态反置
End Sub
Private Sub Command5_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Byte
Dim TemPath As String
If Not mWav(Index) Then                             '鼠标移动在上面载入蓝色图标
    TemPath = "Pic\48bWAV" & Index & ".ico"
    Call Path(TemPath)
    Command5(Index).Picture = LoadPicture(FullPath)
    mWav(Index) = True
End If
For i = 1 To cmdNum                               '其他按钮若载入蓝色图标则重置
    If i <> Index Then
        If mWav(i) And (Not cWav(i)) Then
            TemPath = "Pic\48WAV" & i & ".ico"
            Call Path(TemPath)
            Command5(i).Picture = LoadPicture(FullPath)
            mWav(i) = False
        End If
    End If
Next
End Sub
Private Sub Command6_Click()
If SEG3.Value < 500 Then
    SEG3.Value = Format$(SEG3.Value + 50, "000")
    Dim i As Byte
    Dim flag As Boolean
        For i = 1 To cmdNum - 1
            flag = cWav(i) Or cWav(i + 1) Or flag
        Next
    If flag Then                     ' 若波形工作 发送数据
        Call SendW                     '发送波形频率命令
    End If
Else
    MsgBox "已经达到上限！"
End If
End Sub
Private Sub Command7_Click()
If SEG3.Value > 50 Then
    SEG3.Value = Format$(SEG3.Value - 50, "000")
    Dim i As Byte
    Dim flag As Boolean
        For i = 1 To cmdNum - 1
            flag = cWav(i) Or cWav(i + 1) Or flag
        Next
    If flag Then                     ' 若波形工作 发送数据
        Call SendW                     '发送波形频率命令
    End If
Else
    MsgBox "已经达到下限！"
    End If
End Sub
Private Sub Form_Load()
'----------------Initialize Parameter-------------------------
With StatusBar1.Panels                            'statusBar setting
    .Item(1).Text = "打开串口：" & OpenPort
    .Item(2).Text = "设置：" & PortSet
  ' .Item(3).Text = "接收数据：" & RecNum
    .Item(5).Text = "Power By Sphinx 08"
End With
SEG1.Value = Format$(Null, "0.00")           '设置SEG1的初始值
SEG2.Value = Format$(0, "0.00")
SEG3.Value = Format$(50, "000")
Dim i As Byte
For i = 1 To cmdNum
    mWav(i) = False
    cWav(i) = False
Next
With Line7                                '设置分割线
    .BorderColor = vbWhite
    .BorderWidth = 3
    .x1 = Line1.x1 + 22
    .x2 = Line1.x2 + 22
    .y1 = Line1.y1
    .y2 = Line1.y2
End With
Line1.ZOrder 0
'---------------------------picbox---------------------------
Picture7.Width = Picture8(0).Width
Picture8(0).Left = 0
Picture8(0).Top = Picture8(1).Top
Picture8(1).Left = -Picture8(1).Width
Timer2.Enabled = False
'---------------------------ToolTip------------------------------
Set cmdToolTip(1).ParentControl = Command5(1)
cmdToolTip(1).ToolTipTitle = "锯齿波"
cmdToolTip(1).ToolTipText = "停止"
cmdToolTip(1).Create
Set cmdToolTip(2).ParentControl = Command5(2)
cmdToolTip(2).ToolTipTitle = "矩形波"
cmdToolTip(2).ToolTipText = "停止"
cmdToolTip(2).Create
Set cmdToolTip(3).ParentControl = Command5(3)
cmdToolTip(3).ToolTipTitle = "三角波"
cmdToolTip(3).ToolTipText = "停止"
cmdToolTip(3).Create


End Sub
Private Sub Form_Unload(Cancel As Integer)                        '输出电压0
SendB (&H80)
SendB (&H80)
Unload Form1                          '卸载主窗口
End Sub
Private Sub HScroll1_Change()
Dim Step As Single
Dim OutV As Single
If Command1.Caption = "暂停" Then                '面板工作时才发送数据
    Call SendB(HScroll1.Value)
    Step = 10 / 255
    OutV = Step * HScroll1.Value - 5 + (HScroll2.Value - 100) * 0.01
    SEG1.Value = Format$(OutV, "0.00")
End If
End Sub

Private Sub HScroll2_Change()
SEG2.Value = Format$((HScroll2.Value - 100) * 0.01, "0.00")
If SEG1.Value <> Format$(Null, "0.00") Then
    Dim Step As Single
    Dim OutV As Single
    Step = 10 / 255
    OutV = Step * HScroll1.Value - 5 + (HScroll2.Value - 100) * 0.01
    SEG1.Value = Format$(OutV, "0.00")
End If
End Sub

Private Sub SSTab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Byte
Dim TemPath As String
For i = 1 To cmdNum                                  '若有按钮载入蓝色图标则重置
    If mWav(i) And (Not cWav(i)) Then
        TemPath = "Pic/48WAV" & i & ".ico"
        Call Path(TemPath)
        Command5(i).Picture = LoadPicture(FullPath)
        mWav(i) = False
    End If
Next
End Sub
Private Sub Timer1_Timer()
If PicB Then
   Call Path("Pic/48wr.ico")
   Image1.Picture = LoadPicture(FullPath)
    'Image1.Picture = LoadPicture(".\Pic\48vr.ico")
    PicB = False
Else
    Call Path("Pic/48wb.ico")
    Image1.Picture = LoadPicture(FullPath)
    'Image1.Picture = LoadPicture(".\Pic\48vb.ico")
    PicB = True
End If
End Sub
Private Sub Timer2_Timer()
Static PreWav As Byte
Dim i As Byte
Dim TemPath As String
Timer2.Interval = 110 - SEG3.Value / 5                   '移动速率
If PreWav <> CmdIndex Then                             '按钮的改变则载入不同的图片
    PreWav = CmdIndex
    TemPath = "Pic\MWAV" & CmdIndex & ".jpg"
    Call Path(TemPath)
    Picture8(0).Picture = LoadPicture(FullPath)
    Picture8(1).Picture = LoadPicture(FullPath)
Else                                                    '按钮不变载入的图片不变
    Picture8(0).Visible = True                          '图片框可见
    Picture8(1).Visible = True
    For i = 0 To 1
    If Picture8(i).Left >= Picture8(i).Width Then       '当图片的left到达容器的末端，图片回到容器的左端
        Picture8(i).Left = -Picture8(i).Width
    End If
    Picture8(i).Left = Picture8(i).Left + 90
    Next
End If
End Sub