vb6+

stm32+TFT+VB上位机

         TabIndex        =   1
         Text            =   "4"
         Top             =   240
         Width           =   1215
      End
      Begin VB.Label Label4 
         BackColor       =   &H00FFFFFF&
         Caption         =   "数据位"
         Height          =   495
         Left            =   120
         TabIndex        =   15
         Top             =   1440
         Width           =   1335
      End
      Begin VB.Label Label3 
         BackColor       =   &H00FFFFFF&
         Caption         =   "波特率"
         Height          =   375
         Left            =   120
         TabIndex        =   14
         Top             =   840
         Width           =   1335
      End
      Begin VB.Label Label2 
         BackColor       =   &H00FFFFFF&
         Caption         =   "端口选择"
         BeginProperty Font 
            Name            =   "幼圆"
            Size            =   15
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Width           =   1335
      End
      Begin VB.Shape Shape1 
         BackColor       =   &H000000FF&
         BorderColor     =   &H0000FF00&
         FillColor       =   &H000000FF&
         FillStyle       =   0  'Solid
         Height          =   615
         Left            =   5640
         Shape           =   3  'Circle
         Top             =   240
         Width           =   495
      End
   End
   Begin VB.Label Label1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   4680
      TabIndex        =   10
      Top             =   7800
      Width           =   3015
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Begin VB.Menu open 
         Caption         =   "打开"
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu EDIT 
      Caption         =   "编辑"
      Begin VB.Menu back 
         Caption         =   "返回"
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
      Begin VB.Menu about 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False




Private Sub cmdManualSend_Click_Click()
 Dim longth As Integer
    ctrMSComm.OutBufferCount = 0 '清空发送缓冲区
    strSendText = frmMain.txtSend.Text
    If OpTxFormalAsii.Value Then
        Output = strSendText
        End If
    If OpTxFormalHex.Value Then
        'add code
        longth = strHexToByteArray(strSendText, bytSendByte())
        If longth > 0 Then
            ctrMSComm.Output = bytSendByte
    End If
    End If
End Sub

Private Sub Command1_Click()
    '显示初始化
    ''Call cmdClear_Click
    
     '初始化串行口
    Dim errorprocess As Integer
If Shape1.FillColor = &HFF00& Then
Shape1.FillColor = &HFF&
ctrMSComm.PortOpen = False

ElseIf Shape1.FillColor = &HFF& Then
ctrMSComm.CommPort = Val(Combo1.Text)
ctrMSComm.Settings = Val(Combo3.Text)
On Error GoTo errrorport
ctrMSComm.PortOpen = True
Shape1.FillColor = &HFF00&
End If
Exit Sub
errrorport:
 errorprocess = MsgBox("端口号无效或者被占用", vbOKCancel, "确认端口")
 
 Select Case errorprocess
 Case 1
 Combo1.SetFocus
  Case 2
  GoTo errrorport
 End Select
End Sub

Private Sub Command3_Click()
Dim number As Integer   '定义要发送的数据
Dim color As Double
Dim rgbx As Integer
Dim rgby As Integer
Dim rr As Integer
Dim gg As Integer
Dim bb As Integer
Dim rrggbb As Long
Dim outputbyte(6) As Byte
If ctrMSComm.PortOpen = True Then
For rgby = 1 To 240 Step 1
For rgbx = 1 To 240 Step 1
color = Picture1.Point(rgbx, rgby)
rr = color And &HFF '分离出红色
gg = (color And &HFF00&) \ 256& '分离出绿色
bb = (color And &HFF0000) \ 65536  '分离出蓝色
rrggbb = (rr / 8 * 2048) + (gg / 4 * 32) + (bb / 8)



ctrMSComm.OutBufferCount = 0 '清空发送缓冲区
outputbyte(0) = CByte(rgbx)
outputbyte(1) = CByte(0)
outputbyte(2) = CByte(rgby)
outputbyte(3) = CByte(0)
outputbyte(4) = CByte(rr)
outputbyte(5) = CByte(gg)
outputbyte(6) = CByte(bb)
ctrMSComm.Output = outputbyte
ProgressBar1.Value = rgbx
ProgressBar2.Value = rgby
Next rgbx
Next rgby
End If

'MSComm1.OutBufferCount = 0 '清空发送缓冲区
'MSComm1.Output = "o" '发送开始信号

'MSComm1.OutBufferCount = 0 '清空发送缓冲区
'MSComm1.Output = Hex(Val(Combo6.Text)) '发送显示字的数量
'MSComm1.Output = Hex(Val(Combo4.Text)) '发送显示模式

End Sub


'**********************************
'字符表示的十六进制数转化为相应的整数
'错误则返回  -1
'**********************************

Function ConvertHexChr(str As String) As Integer
    
    Dim test As Integer
    
    test = Asc(str)
    If test >= Asc("0") And test <= Asc("9") Then
        test = test - Asc("0")
    ElseIf test >= Asc("a") And test <= Asc("f") Then
        test = test - Asc("a") + 10
    ElseIf test >= Asc("A") And test <= Asc("F") Then
        test = test - Asc("A") + 10
    Else
        test = -1                                       '出错信息
    End If
    ConvertHexChr = test
    
End Function

'**********************************
'字符串表示的十六进制数据转化为相应的字节串
'返回转化后的字节数
'**********************************

Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer
    
    Dim HexData As Integer          '十六进制(二进制)数据字节对应值
    Dim hstr As String * 1          '高位字符
    Dim lstr As String * 1          '低位字符
    Dim HighHexData As Integer      '高位数值
    Dim LowHexData As Integer       '低位数值
    Dim HexDataLen As Integer       '字节数
    Dim StringLen As Integer        '字符串长度
    Dim Account As Integer          '计数
        
    strTestn = ""                   '设初值
    HexDataLen = 0
    strHexToByteArray = 0
    
    StringLen = Len(strText)
    Account = StringLen \ 2
    ReDim bytByte(Account)
    
    For n = 1 To StringLen
    
        Do                                              '清除空格
            hstr = Mid(strText, n, 1)
            n = n + 1
            If (n - 1) > StringLen Then
                HexDataLen = HexDataLen - 1
                
                Exit For
            End If
        Loop While hstr = " "
        
        Do
            lstr = Mid(strText, n, 1)
            n = n + 1
            If (n - 1) > StringLen Then
                HexDataLen = HexDataLen - 1
                
                Exit For
            End If
        Loop While lstr = " "
        n = n - 1
        If n > StringLen Then
            HexDataLen = HexDataLen - 1
            Exit For
        End If
        
        HighHexData = ConvertHexChr(hstr)
        LowHexData = ConvertHexChr(lstr)
        
        If HighHexData = -1 Or LowHexData = -1 Then     '遇到非法字符中断转化
            HexDataLen = HexDataLen - 1
            
            Exit For
        Else
            
            HexData = HighHexData * 16 + LowHexData
            bytByte(HexDataLen) = HexData
            HexDataLen = HexDataLen + 1
            
            
        End If
                        
    Next n
    
    If HexDataLen > 0 Then                              '修正最后一次循环改变的数值
        HexDataLen = HexDataLen - 1
        ReDim Preserve bytByte(HexDataLen)
    Else
        ReDim Preserve bytByte(0)
    End If
    
    
    If StringLen = 0 Then                               '如果是空串,则不会进入循环体
        strHexToByteArray = 0
    Else
        strHexToByteArray = HexDataLen + 1
    End If
    
    
End Function






Private Sub ctrMSComm_OnComm()
Dim RecStr As String
Dim bytInput  As Integer
    Dim intInputLen As Integer
    Select Case ctrMSComm.CommEvent
        Case comEvReceive
        If Option3.Value Then
               ctrMSComm.InputMode = comInputModeBinary
                intInputLen = ctrMSComm.InBufferCount
                bytInput = ctrMSComm.Input
                txtReceive.Text = str(Hex(bytInput))
            End If
         If chkAscii.Value Then
         ctrMSComm.InputMode = comInputModeText
         RecStr = ctrMSComm.Input
         txtReceive.Text = RecStr + txtReceive
         End If
         
    End Select
End Sub

'**********************************
Private Sub Form_Load()


ctrMSComm.Settings = "115200,N,8,1"
ctrMSComm.InBufferSize = 1024
ctrMSComm.OutBufferSize = 512
ctrMSComm.InputLen = 0
ctrMSComm.InputMode = 0
ctrMSComm.InBufferCount = 0
ctrMSComm.RThreshold = 1
ctrMSComm.SThreshold = 1
ctrMSComm.InputMode = comInputModeBinary '二进制方式接收
blnReceiveFlag = False
    '接收初始化
    intReceiveLen = 0
    
    '默认发送方式为ASCII
    intOutMode = 0
    intHexWidth = 8
    
    
   
End Sub

Private Sub MSComm1_OnComm()


End Sub



Private Sub Timer1_Timer()
Label1.Caption = Now
End Sub