用VB读取点阵字库

用VB读取点阵字库 Private Sub Combo1_Click() For i = 0 To 575 Shape1(i).Visible = False Next i n = Mid$(Combo1.Text, 3, 2) ^ 2 c = Mid$(Combo1.Text, 3, 2) For i = 0 To n - 1 Shape1(i).Visible = True Next i y = 120 i = 0 For a = 0 To c - 1 x = 240 For b = 0 To c - 1 Shape1(i).Left = x Shape1(i).Top = y i = i + 1 x = x + 120 Next b y = y + 120 Next a End Sub Private Sub Command1_Click() Dim z As Integer Dim x As Integer Dim y As Integer x = Mid$(Combo2.Text, 1, 1) y = Mid$(Combo3.Text, 1, 1) z = Mid$(Combo1.Text, 3, 2) Dim buffer(1000) Text4.Text = " " c = 0 b = 0 Select Case x Case 1 MsgBox "1横排左高位" For n = 0 To z - 1 For i = z - 1 To 0 Step -1 a = a / 2 + 128 * Abs(Shape1((n * z) + i).FillStyle - 1) c = c + 1 If c = 8 Then buffer(b) = a: a = 0: b = b + 1: c = 0 Next i Next n Case 2 MsgBox "2横排右高位" For n = 0 To z - 1 For i = 0 To z - 1 a = a / 2 + 128 * Abs(Shape1((n * z) + i).FillStyle - 1) c = c + 1 If c = 8 Then buffer(b) = a: a = 0: b = b + 1: c = 0 Next i Next n Case 3 MsgBox "3纵排下高位" For n = 0 To z - 1 For i = 0 To z - 1 a = a / 2 + 128 * Abs(Shape1((i * z) + n).FillStyle - 1) c = c + 1 If c = 8 Then buffer(b) = a: a = 0: b = b + 1: c = 0 Next i Next n Case 4 MsgBox "4纵排上高位" For n = 0 To z - 1 For i = z - 1 To 0 Step -1 a = a / 2 + 128 * Abs(Shape1((i * z) + n).FillStyle - 1) c = c + 1 If c = 8 Then buffer(b) = a: a = 0: b = b + 1: c = 0 Next i Next n End Select Select Case y Case 1 MsgBox "C语言格式" Text4.Text = "" Text7.Text = "" c = 0 For i = 0 To z ^ 2 / 8 - 1 If buffer(i) < 16 Then Text7.Text = "0x" & "0" & Hex$(buffer(i)) Else Text7.Text = "0x" & Hex$(buffer(i)) End If c = c + 1 Text4.Text = Text4.Text & Text7.Text & "," If c = z Then Text4.Text = Text4.Text & Chr(13) & Chr(10): c = 0 Next i Case 2 MsgBox "汇编格式" Text4.Text = "db " Text7.Text = "" c = 0 For i = 0 To z ^ 2 / 8 - 1 If buffer(i) < 16 Or buffer(i) > 159 Then Text7.Text = "0" & Hex$(buffer(i)) & "h" Else Text7.Text = Hex$(buffer(i)) & "h" End If c = c + 1 Text4.Text = Text4.Text & Text7.Text & "," If c = z Then Text4.Text = Text4.Text & Chr(13) & Chr(10) & "db ": c = 0 Next i End Select End Sub Private Sub Command2_Click() End End Sub Private Sub Command3_Click() Dim z As Integer Dim x As Integer Dim y As Integer Dim buffer(1000) As Byte Text4.Text = "" x = Mid$(Combo2.Text, 1, 1) y = Mid$(Combo3.Text, 1, 1) z = Mid$(Combo1.Text, 3, 2) If y = 2 Then Text4.Text = "db " c = 0 b = 0 For n = 0 To z - 1 For i = z - 1 To 0 Step -1 a = a / 2 + 128 * Abs(Shape1((i * 24) + n).FillStyle - 1) c = c + 1 If c = 8 Then buffer(b) = a: a = 0: b = b + 1: c = 0 Next i Next n Text4.Text = "" Text7.Text = "" c = 0 For i = 0 To z ^ 2 / 8 - 1 If buffer(i) < 16 Then Text7.Text = "0x" & "0" & Hex$(buffer(i)) Else Text7.Text = "0x" & Hex$(buffer(i)) End If c = c + 1 Text4.Text = Text4.Text & Text7.Text & "," If c = z Then Text4.Text = Text4.Text & Chr(13) & Chr(10): c = 0 Next i End Sub Private Sub Form_Activate() Text2.SetFocus 'Option1(0).SetFocus End Sub Private Sub Form_Load() 'Combo1.AddItem ("宋体12.dot") Combo1.AddItem ("宋体16.dot") Combo1.AddItem ("繁宋16.dot") Combo1.AddItem ("宋体24.dot") Combo1.Text = "宋体24.dot" Text1.Enabled = False Text3.Enabled = False Text5.Text = "" Text6.Text = "" For i = 0 To 575 Shape1(i).Visible = True Shape1(i).FillColor = &HFF00& Shape1(i).Shape = 0 Next i Combo2.AddItem ("1横排左高位") Combo2.AddItem ("2横排右高位") Combo2.AddItem ("3纵排下高位") Combo2.AddItem ("4纵排上高位") Combo2.Text = "1横排左高位" Combo3.AddItem ("1C语言格式") Combo3.AddItem ("2汇编格式") Combo3.Text = "1C语言格式" End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then On Error Resume Next Dim n As Integer For i = 0 To 575 Shape1(i).FillStyle = 1 Next i Text5.Text = "" Text6.Text = "" Text3.Text = "" n = Mid$(Combo1.Text, 3, 2) ^ 2 / 8 If Asc(Text2.Text) < 0 Then Text1.Text = Hex$(Asc(Text2.Text) + 65536) h = ((Int("&h" & Mid(Text1.Text, 1, 2)) - 160)) And 127 l = ((Int("&h" & Mid(Text1.Text, 3, 2)) - 160)) And 127 Else Text1.Text = Hex$(Asc(Text2.Text)) Text3.Text = (Int("&h" & Text1.Text) + 268) h = Mid$(Text3.Text, 1, 1) l = Mid$(Text3.Text, 2, 2) End If Text5.Text = h If Len(Text5.Text) = 1 Then Text5.Text = "0" & Text5.Text Text6.Text = l If Len(Text6.Text) = 1 Then Text6.Text = "0" & Text6.Text Text3.Text = Text5.Text & Text6.Text offset = n * ((h - 1) * 94 + (l - 1)) Dim File_mum As Integer Dim buffer(1000) As Byte File_mum = FreeFile Open App.Path & "\" & Combo1.Text For Binary As #file_mum Get #file_mum, offset + 1, buffer Close #file_mum Dim a As Integer Text5.Text = "" Text6.Text = "" For i = 0 To n - 1 Text5.Text = "" a = buffer(i) For b = 0 To 7 'MsgBox a Text5.Text = (a Mod 2) & Text5.Text a = a \ 2 Next b Text6.Text = Text6.Text & Text5.Text Next i Dim d As Integer d = Mid$(Combo1.Text, 3, 2) ^ 2 For b = 0 To d - 1 Shape1(b).FillStyle = Int(Mid$(Text6.Text, b + 1, 1) - 1) Next b End If End Sub