hextext.ctl

磁条读写机

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.UserControl HexText 
   ClientHeight    =   3015
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4290
   ScaleHeight     =   3015
   ScaleWidth      =   4290
   Begin RichTextLib.RichTextBox txtBuf 
      Height          =   2115
      Left            =   420
      TabIndex        =   0
      Top             =   360
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   3731
      _Version        =   393217
      BackColor       =   16777215
      HideSelection   =   0   'False
      ScrollBars      =   2
      DisableNoScroll =   -1  'True
      MaxLength       =   768
      TextRTF         =   $"HexText.ctx":0000
   End
End
Attribute VB_Name = "HexText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'事件声明:
Event Change() 'MappingInfo=txtBuf,txtBuf,-1,Change
Attribute Change.VB_Description = "当控件内容改变时发生。"

Private m_bufsize As Long
Private m_mutative As Boolean

Private Sub txtBuf_KeyDown(KeyAscii As Integer, Shift As Integer)
If KeyAscii = vbKeyUp Or KeyAscii = vbKeyDown Or KeyAscii = vbKeyRight Or KeyAscii = vbKeyLeft Or KeyAscii = vbKeyEnd Or KeyAscii = vbKeyHome Or KeyAscii = vbKeyPageDown Or KeyAscii = vbKeyPageUp Then
    Exit Sub
End If
If KeyAscii = vbKeyBack Then
    KeyAscii = 0
    If txtBuf.SelStart <> 0 Then
        If txtBuf.SelStart Mod 3 = 0 Then
            txtBuf.SelStart = txtBuf.SelStart - 2
            txtBuf.SelLength = 1
            txtBuf.SelText = "F"
            txtBuf.SelStart = txtBuf.SelStart - 1
        Else
            txtBuf.SelStart = txtBuf.SelStart - 1
            txtBuf.SelLength = 1
            txtBuf.SelText = "F"
            txtBuf.SelStart = txtBuf.SelStart - 1
        End If
    End If
ElseIf (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) _
    Or (KeyAscii >= Asc("A") And KeyAscii <= Asc("F")) _
    Or (KeyAscii >= Asc("a") And KeyAscii <= Asc("f")) Then

    '大小写转换
    If KeyAscii >= Asc("a") And KeyAscii <= Asc("f") Then
        KeyAscii = KeyAscii + Asc("A") - Asc("a")
    End If
    
    If txtBuf.SelStart + 1 < m_bufsize * 3 Then
        If txtBuf.SelStart Mod 3 = 2 Then
            txtBuf.SelStart = txtBuf.SelStart + 1
            txtBuf.SelLength = 1
                        txtBuf.SelColor = &HFF0000
            txtBuf.SelText = Chr$(KeyAscii)
        ElseIf txtBuf.SelStart Mod 3 = 1 Then
            txtBuf.SelLength = 1
                        txtBuf.SelColor = &HFF0000
            txtBuf.SelText = Chr$(KeyAscii)
                        
            txtBuf.SelStart = txtBuf.SelStart + 1
        ElseIf txtBuf.SelStart Mod 3 = 0 Then
            txtBuf.SelLength = 1
                        txtBuf.SelColor = &HFF0000
            txtBuf.SelText = Chr$(KeyAscii)
        End If


    End If

End If

KeyAscii = 0
txtBuf.SelLength = 0
End Sub

Private Sub UserControl_InitProperties()
txtBuf.Left = UserControl.ScaleLeft
txtBuf.Top = UserControl.ScaleTop

txtBuf.Width = UserControl.ScaleWidth
txtBuf.Height = UserControl.ScaleHeight

m_mutative = False
m_bufsize = 0
txtBuf.Text = ""

End Sub

Private Sub UserControl_Resize()
txtBuf.Left = UserControl.ScaleLeft
txtBuf.Top = UserControl.ScaleTop
txtBuf.Width = UserControl.ScaleWidth
txtBuf.Height = UserControl.ScaleHeight
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtBuf,txtBuf,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "返回/设置控件中包含的文本。"
    Text = txtBuf.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    txtBuf.Text() = New_Text
    PropertyChanged "Text"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtBuf,txtBuf,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "返回一个 Font 对象。"
Attribute Font.VB_UserMemId = -512
    Set Font = txtBuf.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set txtBuf.Font = New_Font
    PropertyChanged "Font"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtBuf,txtBuf,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值，决定一个对象是否响应用户生成事件。"
    Enabled = txtBuf.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    txtBuf.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

Private Sub txtBuf_Change()
    RaiseEvent Change
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_bufsize = PropBag.ReadProperty("BufferSize", 0)
    txtBuf.Text = ""
    Dim i As Long
    For i = 0 To m_bufsize - 1
        txtBuf.SelText = "FF "
    Next
    Set txtBuf.Font = PropBag.ReadProperty("Font", Ambient.Font)
    txtBuf.Enabled = PropBag.ReadProperty("Enabled", True)
    m_mutative = PropBag.ReadProperty("Mutative", False)
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BufferSize", m_bufsize, 0)
    Call PropBag.WriteProperty("Font", txtBuf.Font, Ambient.Font)
    Call PropBag.WriteProperty("Enabled", txtBuf.Enabled, True)
    Call PropBag.WriteProperty("Mutative", m_mutative, False)
End Sub


Public Property Get BufferSize() As Long
Attribute BufferSize.VB_ProcData.VB_Invoke_Property = ";外观"
    BufferSize = m_bufsize
End Property

Public Property Let BufferSize(ByVal vNewValue As Long)
    Dim i As Long
    Dim tpStr As String
    If m_bufsize > vNewValue Then
        txtBuf.SelStart = vNewValue * 3
        txtBuf.SelLength = (m_bufsize - vNewValue) * 3
        txtBuf.SelText = ""
    ElseIf m_bufsize < vNewValue Then
        tpStr = ""
        For i = 0 To vNewValue - m_bufsize - 1
            tpStr = tpStr + "FF "
        Next
        txtBuf.SelStart = m_bufsize * 3
        txtBuf.SelLength = 0
        txtBuf.SelText = tpStr
        txtBuf.Refresh
    End If

    m_bufsize = vNewValue
End Property


Public Sub SelSetColor(ByVal colorVal As Long)
    txtBuf.SelColor = colorVal
End Sub

Public Property Get Mutative() As Boolean
Attribute Mutative.VB_ProcData.VB_Invoke_Property = ";行为"
    Mutative = m_mutative
End Property

Public Property Let Mutative(ByVal vNewValue As Boolean)
    m_mutative = vNewValue
End Property