16-10-2转换.frm

Visual Basic课程举例1 有很好的例题

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "数制转换"
   ClientHeight    =   2655
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9870
   LinkTopic       =   "Form1"
   ScaleHeight     =   2655
   ScaleWidth      =   9870
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "H -> B"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "H -> D"
      Height          =   375
      Left            =   4320
      TabIndex        =   4
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox txtbinary2 
      Height          =   375
      Left            =   5640
      TabIndex        =   3
      Top             =   1680
      Width           =   3735
   End
   Begin VB.TextBox txthex2 
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Top             =   1680
      Width           =   3495
   End
   Begin VB.TextBox txtdec2 
      Height          =   375
      Left            =   5640
      TabIndex        =   1
      Top             =   840
      Width           =   3735
   End
   Begin VB.TextBox txthexdec 
      Height          =   375
      Left            =   720
      TabIndex        =   0
      Top             =   840
      Width           =   3495
   End
   Begin VB.Label Label4 
      Caption         =   "Binary"
      Height          =   255
      Left            =   5640
      TabIndex        =   9
      Top             =   1320
      Width           =   2775
   End
   Begin VB.Label Label3 
      Caption         =   "Hex"
      Height          =   255
      Left            =   720
      TabIndex        =   8
      Top             =   1320
      Width           =   3015
   End
   Begin VB.Label Label2 
      Caption         =   "Decimal"
      Height          =   255
      Left            =   5640
      TabIndex        =   7
      Top             =   480
      Width           =   2655
   End
   Begin VB.Label Label1 
      Caption         =   "Hex"
      Height          =   255
      Left            =   720
      TabIndex        =   6
      Top             =   480
      Width           =   2655
   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 Sub Command1_Click()
    txtdec2.Text = CStr(Hex2Dec(txthexdec.Text)) '调用函数过程Hex2Dec
End Sub

Private Sub Command2_Click()
    txtbinary2.Text = Hex2Bin(txthex2.Text) '调用函数过程Hex2Bin
End Sub
Function Hex2Bin(InputData As String) As String
    Dim i As Integer
    For i = 1 To Len(InputData)
        Hex2Bin = Hex2Bin & ChH2B(Mid(InputData, i, 1))
    Next i
End Function
Function ChH2B(tmp As String) As String
    Dim i As Integer, dec As Integer
    ChH2B = ""
    dec = Val("&h" & tmp)
    For i = 1 To 4
        ChH2B = CStr(dec Mod 2) & ChH2B
        dec = dec \ 2
    Next i

End Function

Private Sub txthex2_LostFocus()
   Dim i As Integer
    txthex2.Text = UCase(txthex2.Text)
    For i = 1 To Len(txthex2.Text)
        '如果输入数据有问题，则清空文本框中数据，并重新获得焦点
        If Not IsNum(Mid(txthex2.Text, i, 1)) Then
            txthex2.Text = ""
            txthex2.SetFocus
            Exit Sub
        End If
    Next i

End Sub

Private Sub txthexdec_LostFocus()
Dim i As Integer
    txthexdec.Text = UCase(txthexdec.Text)
    For i = 1 To Len(txthexdec.Text)
        '如果输入数据有问题，则清空文本框中数据，并重新获得焦点
        If Not IsNum(Mid(txthexdec.Text, i, 1)) Then
            txthexdec.Text = ""
            txthexdec.SetFocus
            Exit Sub
        End If
    Next i

End Sub
Private Function IsNum(tmp As String) As Boolean
'判断每位数据是否是合法的十六进制数据
    If IsNumeric(tmp) Or tmp >= "A" And tmp <= "F" Then
        IsNum = True
    Else
        IsNum = False
    End If
End Function

'将十六进制数转换为十进制数的程序如下:
    


Function Hex2Dec(InputData As String) As Long
'转换十六进制数为十进制数
    Hex2Dec = Val("&h" & InputData)
End Function