form1.frm

字模点阵浏览器

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "字符点阵浏览器"
   ClientHeight    =   6045
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   10845
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   6045
   ScaleWidth      =   10845
   StartUpPosition =   2  '屏幕中心
   Begin VB.HScrollBar HScroll1 
      Height          =   390
      Left            =   7800
      TabIndex        =   17
      Top             =   3120
      Width           =   2895
   End
   Begin VB.CheckBox Check3 
      Caption         =   "显示""■"""
      Height          =   180
      Left            =   9480
      TabIndex        =   16
      Top             =   5040
      Value           =   1  'Checked
      Width           =   1095
   End
   Begin VB.CommandButton Cmd_File 
      Caption         =   "<<== <--"
      Height          =   495
      Left            =   7800
      TabIndex        =   0
      Top             =   3600
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   11
      Text            =   "Text2"
      Top             =   120
      Width           =   7575
   End
   Begin VB.CheckBox Check2 
      Caption         =   "显示""□"""
      Height          =   180
      Left            =   9480
      TabIndex        =   10
      Top             =   4800
      Value           =   1  'Checked
      Width           =   1095
   End
   Begin VB.CheckBox Check1 
      Caption         =   "反色显示"
      Height          =   180
      Left            =   9480
      TabIndex        =   9
      Top             =   4560
      Width           =   1095
   End
   Begin VB.Frame Frame2 
      BorderStyle     =   0  'None
      Caption         =   "Frame2"
      Height          =   495
      Left            =   9480
      TabIndex        =   15
      Top             =   4080
      Width           =   1215
      Begin VB.OptionButton Option2 
         Caption         =   "低字节在前"
         Height          =   180
         Index           =   1
         Left            =   0
         TabIndex        =   8
         Top             =   240
         Width           =   1215
      End
      Begin VB.OptionButton Option2 
         Caption         =   "高字节在前"
         Height          =   180
         Index           =   0
         Left            =   0
         TabIndex        =   7
         Top             =   0
         Value           =   -1  'True
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1 
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      Height          =   495
      Left            =   9480
      TabIndex        =   14
      Top             =   3600
      Width           =   735
      Begin VB.OptionButton Option1 
         Caption         =   "12x12"
         Height          =   180
         Index           =   1
         Left            =   0
         TabIndex        =   6
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton Option1 
         Caption         =   "16x16"
         Height          =   180
         Index           =   0
         Left            =   0
         TabIndex        =   5
         Top             =   0
         Value           =   -1  'True
         Width           =   855
      End
   End
   Begin VB.CommandButton Cmd_Exit 
      Caption         =   "-->  ==>> "
      Height          =   495
      Left            =   9360
      TabIndex        =   4
      Top             =   5400
      Width           =   1335
   End
   Begin VB.CommandButton Cmd_TXT2ZI 
      Caption         =   " --> 字"
      Height          =   495
      Left            =   7800
      TabIndex        =   1
      Top             =   4200
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      Height          =   5535
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   12
      Text            =   "Form1.frx":030A
      Top             =   360
      Width           =   7575
   End
   Begin VB.CommandButton CMD_TXT2TXT 
      Caption         =   "--> TXT"
      Height          =   495
      Left            =   7800
      TabIndex        =   3
      Top             =   5400
      Width           =   1335
   End
   Begin VB.CommandButton Cmd_TXT2BIN 
      Caption         =   "--> BIN"
      Height          =   495
      Left            =   7800
      TabIndex        =   2
      Top             =   4800
      Width           =   1335
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   7800
      TabIndex        =   13
      Top             =   120
      Width           =   540
   End
   Begin VB.Menu 弹出菜单 
      Caption         =   "弹出菜单"
      Visible         =   0   'False
      Begin VB.Menu 粘贴 
         Caption         =   "粘贴"
      End
      Begin VB.Menu 清除 
         Caption         =   "清除"
      End
   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 Cmd_Exit_Click()
  Unload Me
End Sub

Private Sub Cmd_File_Click()
  Dim FileName As String, vStr As String
  Dim xByte() As Byte, iByte As Byte
  Dim i As Integer, ReadL As Integer
  Dim FileL As Long, Start As Long
  
  FileName = OpenFile()
  If FileName = "" Then Exit Sub
  
  vStr = IIf(Option1(0).Value, 16, 12)
  vStr = "正在读入" & vStr & "*" & vStr & "的字符点阵数据" & "..."
  Text1.Text = vStr
  DoEvents
  
  Open FileName For Binary As #1
  FileL = LOF(1)
  If LCase(Right(FileName, 4)) = ".bin" Then
    ReadL = 188 * IIf(Option1(0).Value, 32, 18)
    GoSub Part
    For i = 1 To ReadL
      Get #1, , iByte
      If EOF(1) Then Exit For
      vStr = vStr & "0x" & Right("0" & Hex(iByte), 2) & ","
    Next i
  ElseIf LCase(Right(FileName, 4)) = ".txt" Then
    ReadL = 188 * IIf(Option1(0).Value, 32, 18) * 5
    GoSub Part
    ReDim xByte(1 To ReadL)
    Get #1, , xByte
    vStr = StrConv(xByte, vbUnicode)
  End If
  
  Close #1
  
  Text1.Text = vStr
  With HScroll1
    .Max = Len(vStr) / (IIf(Option1(0).Value, 32, 18) * 5)
    .Min = 1
    .Value = .Min
  End With
  
  Option1(0).Enabled = False
  Option1(1).Enabled = False
  Exit Sub
  
Part:
  i = IIf((FileL Mod ReadL) > 0, 1, 0)
  i = (FileL \ ReadL) + i
  If i > 0 Then
    vStr = vStr & vbCrLf & "由于文件太大，只能分段读取，" & vbCrLf & vbCrLf & "读入第几段请输入："
    vStr = InputBox(vStr, "分段读取", i)
    If Not IsNumeric(vStr) Then
      Text1.Text = ""
      Exit Sub
    End If
    Start = Val(vStr)
    If Start > 1 Then Start = 1
    Seek #1, (Start - 1) * ReadL + 1
  Else
    Start = 0
  End If
  vStr = ""
  Return
End Sub

Private Sub Cmd_TXT2BIN_Click()
  Dim FileName As String, vStr As String, xStr() As String
  Dim i As Integer, ID As Integer
  
  FileName = SaveFile()
  
  If FileName = "" Then Exit Sub
  
  vStr = Text1.Text
  xStr = Split(vStr, ",")
  ID = FreeFile(0)
  Open FileName For Binary As #ID
  
  For i = 0 To UBound(xStr)
    Put #ID, , CByte(Val(Replace(xStr(i), "0x", "&H")))
  Next i
  
  Close #ID
  
End Sub

Private Sub CMD_TXT2TXT_Click()
  Dim FileName As String, vStr As String, xStr() As String
  Dim i As Integer, ID As Integer
  
  FileName = OpenFile()
  
  If LCase(Right(FileName, 4)) <> ".txt" Then Exit Sub
  
  vStr = Replace(Text1.Text, vbCrLf, "")
  ID = FreeFile(0)
  Open FileName For Binary As #ID
  Put #ID, , vStr
  Close #ID

End Sub

Private Sub Cmd_TXT2ZI_Click()
  Dim ZiMo As String, nStr() As String, xStr() As String, tStr As String
  Dim i As Integer, bit As Integer, TextLen As Integer
  Dim L As Long
  
  TextLen = IIf(Option1(0).Value, 32, 18) * 5
  Text1.SelStart = (Text1.SelStart \ TextLen) * TextLen
  
  If Text1.SelLength <> TextLen Then Text1.SelLength = TextLen
   
  ZiMo = Text1.SelText
  ZiMo = Replace(ZiMo, "0x", "")
  ZiMo = Replace(ZiMo, "0X", "")
  
  xStr = Split(ZiMo, ",")
  
  If Option2(1).Value Then '低字节在前
    For i = 0 To UBound(xStr) - 1 Step 2
      tStr = xStr(i)
      xStr(i) = xStr(i + 1)
      xStr(i + 1) = tStr
    Next i
  End If
  
  If Option1(0).Value Then '16*16
    ReDim nStr(15)
    For i = 0 To UBound(xStr) - 1 Step 2
      L = Val("&H" & xStr(i)) * &H100 + Val("&H" & xStr(i + 1))
      For bit = 0 To 15
        nStr(i \ 2) = IIf(((L Mod 2) = 1) Xor (Check1.Value = vbChecked), "■", "□") & nStr(i \ 2)
        L = L \ 2
      Next bit
    Next i
  ElseIf Option1(1).Value Then '12*12
    ReDim nStr(11)
    For i = 0 To UBound(xStr) - 1 Step 3
      L = Val("&H" & xStr(i)) * &H10 + Val("&H" & xStr(i + 1)) \ &H10
      For bit = 0 To 11
        nStr((i \ 3) * 2) = IIf(((L Mod 2) = 1) Xor (Check1.Value = vbChecked), "■", "□") & nStr((i \ 3) * 2)
        L = L \ 2
      Next bit
      
      L = (Val("&H" & xStr(i + 1)) Mod &H10) * &H100 + Val("&H" & xStr(i + 2))
      For bit = 0 To 11
        nStr((i \ 3) * 2 + 1) = IIf(((L Mod 2) = 1) Xor (Check1.Value = vbChecked), "■", "□") & nStr((i \ 3) * 2 + 1)
        L = L \ 2
      Next bit
        Next i
  End If
  
  tStr = ""
  For i = 0 To UBound(nStr)
    tStr = tStr & nStr(i) & vbCrLf
  Next i
  
  If Check2.Value = vbUnchecked Then tStr = Replace(tStr, "□", "　")
  If Check3.Value = vbUnchecked Then tStr = Replace(tStr, "■", "　")
  Label1.Caption = tStr
  
End Sub

Private Sub Form_Load()
  Dim iStr As String
  
  iStr = String(16, "0")
  iStr = Replace(iStr, "0", "0x00,")
  iStr = iStr & iStr
  Text1.Text = iStr
  iStr = " 00 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 0A | 0B | 0C | 0D | 0E | 0F |"
  Text2.Text = iStr
  Cmd_TXT2ZI_Click
  
End Sub

Private Sub HScroll1_Change()
  Text1.SelStart = (HScroll1.Value - 1) * IIf(Option1(0).Value, 32, 18) * 5
  Me.Caption = App.Title & " ---- " & HScroll1.Value & "/" & HScroll1.Max
  Cmd_TXT2ZI_Click
End Sub

Private Sub Label1_DblClick()
  Option1(0).Enabled = True
  Option1(1).Enabled = True
End Sub


Private Sub Text1_Click()
  Dim No As Integer, Num As Integer
  
  No = Text1.SelStart \ (IIf(Option1(0).Value, 32, 18) * 5) + 1
  Num = Len(Text1.Text) / (IIf(Option1(0).Value, 32, 18) * 5)
  
  Me.Caption = App.Title & IIf(No > Num, "", " ---- " & No & "/" & Num)
  If No >= HScroll1.Min And HScroll1.Max >= No Then HScroll1.Value = No
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbRightButton Then
    Text1.Enabled = False
    粘贴.Enabled = Clipboard.GetFormat(vbCFText)
    清除.Enabled = Len(Text1.Text)
    PopupMenu 弹出菜单
    Text1.Enabled = True
  End If
End Sub

Private Sub 清除_Click()
  Clipboard.Clear
  Clipboard.SetText Text1.Text
  Text1.Text = ""
  Me.Caption = App.Title
End Sub

Private Sub 粘贴_Click()
  Dim iStr As String, tStr As String, xStr() As String
  Dim iByte() As Byte, i As Integer

  iStr = Clipboard.GetText
  If iStr = "" Then Exit Sub
  tStr = Replace(iStr, Space(1), "")
  tStr = Replace(tStr, vbCrLf, "")
  Text1.Text = tStr
  
End Sub