frmbaseconv.frm

来自「vb精彩编程希望大家有用」· FRM 代码 · 共 564 行 · 第 1/2 页

VERSION 5.00
Begin VB.Form frmbaseconv 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数制转换"
   ClientHeight    =   6120
   ClientLeft      =   2265
   ClientTop       =   1815
   ClientWidth     =   7680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6120
   ScaleWidth      =   7680
   Begin VB.TextBox txtdec2bin2 
      Height          =   375
      Left            =   4680
      TabIndex        =   23
      Top             =   480
      Width           =   2775
   End
   Begin VB.TextBox txtdec2bin 
      Height          =   375
      Left            =   480
      TabIndex        =   22
      Top             =   480
      Width           =   2775
   End
   Begin VB.CommandButton cmddec2bin 
      Caption         =   "-->"
      Height          =   375
      Left            =   3240
      TabIndex        =   21
      Top             =   480
      Width           =   1455
   End
   Begin VB.TextBox txtdec2 
      Height          =   375
      Left            =   4680
      TabIndex        =   18
      Top             =   1560
      Width           =   2775
   End
   Begin VB.TextBox txthexdec 
      Height          =   375
      Left            =   480
      TabIndex        =   17
      Top             =   1560
      Width           =   2775
   End
   Begin VB.CommandButton cmdhexdec 
      Caption         =   "-->"
      Height          =   375
      Left            =   3240
      TabIndex        =   16
      Top             =   1560
      Width           =   1455
   End
   Begin VB.CommandButton cmdDecHex 
      Caption         =   "-->"
      Height          =   375
      Left            =   3240
      TabIndex        =   13
      Top             =   2640
      Width           =   1455
   End
   Begin VB.TextBox txtDecimal 
      Height          =   375
      Left            =   480
      TabIndex        =   12
      Top             =   2640
      Width           =   2775
   End
   Begin VB.TextBox txtdechex 
      Height          =   375
      Left            =   4680
      TabIndex        =   11
      Top             =   2640
      Width           =   2775
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Default         =   -1  'True
      Height          =   375
      Left            =   2520
      TabIndex        =   10
      Top             =   5640
      Width           =   2655
   End
   Begin VB.TextBox txtbinary2 
      Height          =   375
      Left            =   4680
      TabIndex        =   5
      Top             =   3720
      Width           =   2775
   End
   Begin VB.TextBox txthex2 
      Height          =   375
      Left            =   480
      TabIndex        =   4
      Top             =   3720
      Width           =   2775
   End
   Begin VB.CommandButton cmdhex2bin 
      Caption         =   "-->"
      Height          =   375
      Left            =   3240
      TabIndex        =   3
      Top             =   3720
      Width           =   1455
   End
   Begin VB.TextBox txthex 
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Top             =   4800
      Width           =   2775
   End
   Begin VB.TextBox txtbinary 
      Height          =   375
      Left            =   480
      TabIndex        =   1
      Top             =   4800
      Width           =   2775
   End
   Begin VB.CommandButton cmdbin2hex 
      Caption         =   "-->"
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      Top             =   4800
      Width           =   1455
   End
   Begin VB.Label Label9 
      Caption         =   "二进制"
      Height          =   255
      Left            =   4680
      TabIndex        =   25
      Top             =   240
      Width           =   2895
   End
   Begin VB.Label Label8 
      Caption         =   "十进制"
      Height          =   255
      Left            =   480
      TabIndex        =   24
      Top             =   240
      Width           =   2775
   End
   Begin VB.Label Label7 
      Caption         =   "二进制"
      Height          =   255
      Left            =   4680
      TabIndex        =   20
      Top             =   1320
      Width           =   2895
   End
   Begin VB.Label Label6 
      Caption         =   "十六制"
      Height          =   255
      Left            =   480
      TabIndex        =   19
      Top             =   1320
      Width           =   2775
   End
   Begin VB.Label Label5 
      Caption         =   "二进制"
      Height          =   255
      Left            =   480
      TabIndex        =   15
      Top             =   2400
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "十六制"
      Height          =   255
      Left            =   4680
      TabIndex        =   14
      Top             =   2400
      Width           =   2895
   End
   Begin VB.Label Label4 
      Caption         =   "二进制"
      Height          =   255
      Left            =   4680
      TabIndex        =   9
      Top             =   3480
      Width           =   2895
   End
   Begin VB.Label Label3 
      Caption         =   "十六进制"
      Height          =   255
      Left            =   480
      TabIndex        =   8
      Top             =   3480
      Width           =   2775
   End
   Begin VB.Label Label2 
      Caption         =   "十六进制"
      Height          =   255
      Left            =   4680
      TabIndex        =   7
      Top             =   4560
      Width           =   2895
   End
   Begin VB.Label erfgt 
      Caption         =   "二进制"
      Height          =   255
      Left            =   480
      TabIndex        =   6
      Top             =   4560
      Width           =   2775
   End
End
Attribute VB_Name = "frmbaseconv"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdbin2hex_Click()
    txthex.Text = Bin2Hex(txtbinary.Text)
End Sub
Private Sub cmddec2bin_Click()
    If IsNumeric(txtdec2bin.Text) Then
        txtdec2bin2.Text = Dec2Bin(txtdec2bin.Text)
    End If
End Sub
Private Sub cmdDecHex_Click()
    If IsNumeric(txtDecimal.Text) Then
        txtdechex.Text = Hex(CDbl(txtDecimal.Text))
    Else
        MsgBox "不是有效的数。", vbCritical
    End If
End Sub
Private Sub cmdexit_Click()
    Unload Me
End Sub
Private Sub cmdhex2bin_Click()
    txtbinary2.Text = Hex2Bin(txthex2.Text)
End Sub
Private Sub cmdhexdec_Click()
    txtdec2.Text = CStr(Hex2Dec(txthexdec.Text))
End Sub
Function Bin2Dec(InputData As String) As Double
    '二进制转十进制
    Dim DecOut As Double
    Dim I As Integer
    Dim LenBin As Double
    Dim JOne As String
    LenBin = Len(InputData)  '二进制位数长度
    For I = 1 To LenBin
        JOne = Mid(InputData, I, 1)
        If JOne <> "0" And JOne <> "1" Then
            MsgBox "输入的不是二进制数！", vbCritical
            Exit Function
        End If
    Next I
    DecOut = 0
    For I = Len(InputData) To 1 Step -1
        If Mid(InputData, I, 1) = "1" Then
            DecOut = DecOut + 2 ^ (Len(InputData) - I)
        End If
    Next I
    Bin2Dec = DecOut
End Function
Function Dec2Bin(InputData As Double) As String
    '十进制转二进制
    Dim Quot As Double
    Dim Remainder As Double
    Dim BinOut As String
    Dim I As Integer
    Dim NewVal As Double
    Dim TempString As String
    Dim TempVal As Double
    Dim BinTemp As String
    Dim BinTemp1 As String
    Dim PosDot As Integer
    Dim Temp2 As String
    If InStr(1, CStr(InputData), ".") Then
        MsgBox "本程序只能转换整数！", vbCritical
        GoTo eds
    End If
    BinOut = ""