www.pudn.com > ProFnt12.rar > Form1.frm, change:2006-11-27,size:4055b

VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Begin VB.Form Form1  
   Caption         =   "ProHzk12" 
   ClientHeight    =   1395 
   ClientLeft      =   1560 
   ClientTop       =   1350 
   ClientWidth     =   2895 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   93 
   ScaleMode       =   3  'Pixel 
   ScaleWidth      =   193 
   Begin VB.CommandButton CmdProHzk  
      Caption         =   "ProHzk12" 
      Height          =   375 
      Left            =   120 
      TabIndex        =   3 
      Top             =   840 
      Width           =   1215 
   End 
   Begin VB.CommandButton CmdQuit  
      Caption         =   "Exit" 
      Height          =   375 
      Left            =   1560 
      TabIndex        =   2 
      Top             =   840 
      Width           =   1215 
   End 
   Begin VB.PictureBox PicBox  
      Appearance      =   0  'Flat 
      BackColor       =   &H80000005& 
      BorderStyle     =   0  'None 
      BeginProperty Font  
         Name            =   "@¹ÙÅÁ" 
         Size            =   9.75 
         Charset         =   129 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H80000008& 
      Height          =   240 
      Left            =   1200 
      ScaleHeight     =   16 
      ScaleMode       =   3  'Pixel 
      ScaleWidth      =   32 
      TabIndex        =   0 
      Top             =   120 
      Width           =   480 
   End 
   Begin MSComctlLib.ProgressBar ProgressBar1  
      Height          =   195 
      Left            =   120 
      TabIndex        =   1 
      Top             =   480 
      Width           =   2655 
      _ExtentX        =   4683 
      _ExtentY        =   344 
      _Version        =   393216 
      Appearance      =   1 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc _ 
As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, _ 
ByVal nCount As Long) As Long 
 
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _ 
ByVal x As Long, ByVal y As Long) As Long 
 
Private Sub CmdProHzk_Click() 
  Dim i As Long, j As Long, k As Integer, ShowText As Long 
  Dim FntMap(0 To 23) As Byte 
 
  Open "HZK12" For Binary As #1 
 
  ProgressBar1.Max = 128 
  ProgressBar1.Min = 0 
  ProgressBar1.Value = 0 
  'For i = 128 To 255 
  For i = 129 To 254 
    'For j = 128 To 255 
    For j = 64 To 254 
      PicBox.Cls 
      ShowText = TextOut(PicBox.hdc, 0, 0, Chr(i * 256 + j), 2) 
      For k = 0 To 22 Step 2 
        FntMap(k) = CByte(GetPixel(PicBox.hdc, 0, k / 2) And 128) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 1, k / 2) And 64) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 2, k / 2) And 32) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 3, k / 2) And 16) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 4, k / 2) And 8) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 5, k / 2) And 4) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 6, k / 2) And 2) 
        FntMap(k) = FntMap(k) + CByte(GetPixel(PicBox.hdc, 7, k / 2) And 1) 
        FntMap(k + 1) = &HF + CByte(GetPixel(PicBox.hdc, 8, k / 2) And 128) 
        FntMap(k + 1) = FntMap(k + 1) + CByte(GetPixel(PicBox.hdc, 9, k / 2) And 64) 
        FntMap(k + 1) = FntMap(k + 1) + CByte(GetPixel(PicBox.hdc, 10, k / 2) And 32) 
        FntMap(k + 1) = FntMap(k + 1) + CByte(GetPixel(PicBox.hdc, 11, k / 2) And 16) 
        Put #1, , Not FntMap(k) 
        Put #1, , Not FntMap(k + 1) 
      Next k 
'      For l = 0 To 1000000: Next 
    Next j 
    ProgressBar1.Value = i - 127 
  Next i 
  Close #1 
End Sub 
 
Private Sub CmdQuit_Click()   'µã»÷¡°Í˳ö¡± 
  Unload Me 
End Sub