窗口.frm

51单片机控制LED点阵式汉显系统制作资料

            End
         End
      End
      Begin VB.Frame frmSeq 
         Caption         =   "取模顺序"
         Height          =   3135
         Left            =   8700
         TabIndex        =   5
         Top             =   90
         Width           =   1185
         Begin VB.PictureBox picMask 
            BorderStyle     =   0  'None
            Height          =   2805
            Index           =   4
            Left            =   240
            ScaleHeight     =   2805
            ScaleMode       =   0  'User
            ScaleWidth      =   735
            TabIndex        =   31
            Top             =   240
            Width           =   735
            Begin VB.OptionButton optMode 
               Caption         =   "竖排分离"
               ForeColor       =   &H00FF00FF&
               Height          =   495
               Index           =   5
               Left            =   0
               TabIndex        =   43
               Top             =   2280
               Width           =   735
            End
            Begin VB.OptionButton optMode 
               Caption         =   "竖排"
               ForeColor       =   &H00FF00FF&
               Height          =   375
               Index           =   4
               Left            =   0
               TabIndex        =   42
               Top             =   1920
               Width           =   495
            End
            Begin VB.OptionButton optMode 
               Caption         =   "CA DB"
               ForeColor       =   &H000040C0&
               Height          =   495
               Index           =   3
               Left            =   0
               TabIndex        =   35
               Top             =   1440
               Width           =   615
            End
            Begin VB.OptionButton optMode 
               Caption         =   "AC BD"
               ForeColor       =   &H000040C0&
               Height          =   375
               Index           =   2
               Left            =   0
               TabIndex        =   34
               Top             =   1080
               Width           =   615
            End
            Begin VB.OptionButton optMode 
               Caption         =   "BA DC"
               ForeColor       =   &H000040C0&
               Height          =   375
               Index           =   1
               Left            =   0
               TabIndex        =   33
               Top             =   600
               Width           =   615
            End
            Begin VB.OptionButton optMode 
               Caption         =   "AB CD"
               ForeColor       =   &H000040C0&
               Height          =   375
               Index           =   0
               Left            =   0
               TabIndex        =   32
               Top             =   120
               Value           =   -1  'True
               Width           =   615
            End
         End
         Begin VB.Label lblNotify 
            Caption         =   "A  |  B  |  C  |  D "
            ForeColor       =   &H000000C0&
            Height          =   1335
            Left            =   0
            TabIndex        =   4
            Top             =   240
            Width           =   195
         End
      End
      Begin VB.CommandButton cmdRotateLeft 
         Caption         =   "左旋90度(&L)"
         Height          =   375
         Left            =   8640
         TabIndex        =   3
         Top             =   3960
         Width           =   1215
      End
      Begin VB.CommandButton cmdRotateRight 
         Caption         =   "右旋90度(&R)"
         Height          =   375
         Left            =   8640
         TabIndex        =   2
         Top             =   4320
         Width           =   1215
      End
      Begin VB.Frame frmMode 
         Caption         =   "Mode"
         Height          =   855
         Left            =   7380
         TabIndex        =   1
         Top             =   2550
         Width           =   975
         Begin VB.PictureBox picMask 
            BorderStyle     =   0  'None
            Height          =   675
            Index           =   3
            Left            =   60
            ScaleHeight     =   675
            ScaleWidth      =   885
            TabIndex        =   28
            Top             =   150
            Width           =   885
            Begin VB.OptionButton optASM_C51 
               Caption         =   " C51"
               Height          =   255
               Index           =   1
               Left            =   90
               TabIndex        =   30
               Top             =   390
               Width           =   735
            End
            Begin VB.OptionButton optASM_C51 
               Caption         =   " ASM"
               Height          =   255
               Index           =   0
               Left            =   90
               TabIndex        =   29
               Top             =   90
               Value           =   -1  'True
               Width           =   735
            End
         End
      End
      Begin VB.Label Label2 
         Caption         =   "zcllom 2006.8.8"
         ForeColor       =   &H80000001&
         Height          =   255
         Left            =   8520
         TabIndex        =   44
         Top             =   6000
         Width           =   1455
      End
      Begin VB.Image ImageLeft 
         Height          =   420
         Left            =   6120
         Picture         =   "窗口.frx":0000
         Top             =   3960
         Width           =   405
      End
      Begin VB.Image ImageUp 
         Height          =   405
         Left            =   6480
         Picture         =   "窗口.frx":0972
         Top             =   3600
         Width           =   420
      End
      Begin VB.Image ImageDown 
         Height          =   405
         Left            =   6480
         Picture         =   "窗口.frx":1290
         Top             =   4320
         Width           =   420
      End
      Begin VB.Image ImageRight 
         Height          =   420
         Left            =   6840
         Picture         =   "窗口.frx":1BAE
         Top             =   3960
         Width           =   405
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'取字模的源码
'关键词： 字模

'转载请保留作者版权信息,谢谢.

'author:xsoft
'date:2005/10/16
'just a try
'several problems waiting for processing.
Option Explicit

Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long

Private Const OUT_DEFAULT_PRECIS = 0
Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const GB2312_CHARSET = 5
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const FF_DONTCARE = 0    '  Don't care or don't know.
Private Const SW_SHOWNORMAL = 1

'the attribute "Shape" for each shape  点形状属性
Private Const INIT_SHAPE = vbShapeCircle    'vbShapeSquare 默认初始化点为 圆点
'the color used for initializing all shapes 点颜色总共4种
Private Const INIT_COLOR = 4
'width Y height of the picturebox which will paint the char by "Print" method 画布Y轴的高度范围
Private Const ROW = 32
Private Const COL = ROW
'the size of the result array 最终阵列尺寸
Private Const row_1 = 15
Private Const col_1 = row_1
'location for print method
Private Const CUR_X = 0
Private Const CUR_Y = 0
'the space between two shapes,in pixel
Private Const DISTANCE = 0
'在图片框中有 (ROW/16)*(COL/16) 个点代表一个输出点
'此常数表示图片框的一定范围内多少个点为黑时,此输出点该为高亮.
Private Const VALID_POINT_NUM = 1  '有效点数量

'enum result mode 列举
Private Enum RESULT_MODE
    MODE_ASM = 1
    MODE_C51 = 2
End Enum


Private ZiFuNo1(row_1) As String
Private ZiFuNo2(row_1) As String


'sequence number of color in use
Private m_nColor As Long
'width & height of each shape 宽 和 高
Private W As Long, H As Long
'six pairs of colors    6对颜色
Private color(1 To 6, 1 To 2) As String
'either the point should be HighLight or no 每个点要么高亮要么黑
Private m_bHighLight(row_1, col_1) As Boolean
'current font for PictureBox and the old font saved
Private curFont As Long, oldFont As Long
'for GetDC & ReleaseDC
Private curDC As Long
'mode for get result,1 for ASM and 2 for C51
Private mode As RESULT_MODE

Private Sub DrawPic(ByVal pic As PictureBox, ByVal strText As String)

    If Len(strText) = 0 Then Exit Sub

    pic.Cls
    pic.CurrentY = CUR_Y
    pic.CurrentX = CUR_X
    pic.Print Left(strText, 1)
    
    If Asc(strText) >= 0 Then
        Call CalcPointEn(pic)
    Else
        Call CalcPointCn(strText)
    End If
    
    Call DrawShape
End Sub

'calculate which points should be HighLight for English.
Private Sub CalcPointEn(pic As PictureBox)
    Dim i As Long
    Dim j As Long
    
    Dim num As Long, r As Long, c As Long
    
    For i = 0 To pic.ScaleHeight - 1 Step ROW / (row_1 + 1)
    
        For j = 0 To pic.ScaleWidth - 1 Step COL / (col_1 + 1)
        
            num = 0
            
            For r = 0 To ROW / (row_1 + 1) - 1
            
                For c = 0 To COL / (col_1 + 1) - 1
                
                    If picOutput.Point(i + r, j + c) = vbBlack Then num = num + 1
                    
                Next
                
            Next
            
            'if have more than VALID_POINT_NUM black point,the point should be HighLight
            If num > VALID_POINT_NUM Then
            
                m_bHighLight((j + 1) \ 2, (i + 1) \ 2) = True
                
            Else
                
                m_bHighLight((j + 1) \ 2, (i + 1) \ 2) = False
            
            End If
            
        Next
        
    Next
    
End Sub

'calculate which points should be HighLight, for Chinese.
Private Sub CalcPointCn(ByVal strText As String)
On Error Resume Next

    If Len(strText) = 0 Then Exit Sub
    If Asc(strText) >= 0 Then Exit Sub
    
    strText = Left(strText, 1)
    
    Dim hzkPath As String
    hzkPath = App.Path & IIf(Len(App.Path) = 3, "", "\") & "HZK16.dat"
    
    If Dir(hzkPath) = "" Then
        MsgBox "未能找到汉字库，请检查后重试！", vbCritical Or vbOKOnly
        Exit Sub
    End If
    
    Dim i As Long, l_QuHao As Long, l_WeiHao As Long
    i = Asc(strText) + 65536
    '第一个字节减去 0xA0,然后再减1,减1是因为字库计数从零开始.位号相同
    l_QuHao = i \ 256 - 160 - 1
    l_WeiHao = i Mod 256 - 160 - 1
    
    '接收用于表示一个汉字的32个字节
    Dim byt(1 To 32) As Byte
    
On Error GoTo ErrHandle

    Open hzkPath For Binary As #1
        Get #1, (94 * l_QuHao + l_WeiHao) * 32 + 1, byt
    Close #1
    
    Dim j As Long
    
    For i = 1 To 32 Step 2
        
        For j = 7 To 0 Step -1
        
            If byt(i) And 2 ^ j Then
                
                m_bHighLight(i \ 2, 7 - j) = True
            
            Else
                
                m_bHighLight(i \ 2, 7 - j) = False
            
            End If
            
        Next
        
        For j = 7 To 0 Step -1
        
            If byt(i + 1) And 2 ^ j Then
                
                m_bHighLight(i \ 2, 15 - j) = True
            
            Else
            
                m_bHighLight(i \ 2, 15 - j) = False
            
            End If