• Thứ Bảy, 20/11/2010 07:56 (GMT+7)

    Mã lệnh VB6 lấy ma trận điểm của ký tự

    Câu hỏi :

    Xin hỏi code Visual Basic 6 lấy ma trận các điểm pixel của một ký tự với một font bất kỳ (kích thước font có thể thay đổi).



    Trả lời :

    Để lấy được ma trận các điểm pixel miêu tả một ký tự của một font bất kỳ, bạn có thể gọi 2 hàm API Windows sau đây:

    - CreateFontIndirect(): hàm này sẽ tạo 1 đối tượng font với tên, co chữ và các thuộc tính theo yêu cầu của bạn.

    - GetGlyphOutline(): hàm này trả về ma trận pixel của ký tự thuộc font chữ xác định.

    Sau đây chúng tôi xin giới thiệu qui trình điển hình để xây dựng ứng dụng VB 6.0 demo việc lấy ma trận pixel biểu diễn ký tự thuộc font chữ do người dùng yêu cầu rồi hiển thị ma trận pixel lên màn hình để người dùng xem:

    1. Chạy VB 6.0, tạo Project ứng dụng dạng "Standard EXE" đơn giản.

    2. Thiết kế Form gồm 3 textbox và 1 button như sau:

    3. Đặt tên cho 3 textbox lần lượt là txtFontName, txtSize, txtCode, tên của button là btnDisplay.

    4. Ấn kép chuột vào button Display để tạo thủ tục xử lý sự kiện Click chuột trên button. Khi cửa sổ soạn mã nguồn cho form hiển thị, hãy viết code VB 6.0 như sau:

    Option Explicit
    'Định nghĩa các kiểu cần dùng
    Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
    End Type

    Private Type FIXED
    fract As Integer
    value As Integer
    End Type

    Private Type POINT
    x As Long
    y As Long
    End Type

    Private Type MAT2
    eM11 As FIXED
    eM12 As FIXED
    eM21 As FIXED
    eM22 As FIXED
    End Type

    Private Type GLYPHMETRICS
    gmBlackBoxX As Long
    gmBlackBoxY As Long
    gmptGlyphOrigin As POINT
    gmCellIncX As Integer
    gmCellIncY As Integer
    End Type

    'Định nghĩa các hằng gợi nhớ cần dùng
    Const GGO_BITMAP = 1
    Const XS = 20
    Const YS = 120

    'Khai báo các hàm API cần dùng
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Private Declare Function GetGlyphOutline Lib "gdi32" Alias "GetGlyphOutlineA" (ByVal hdc As Long, ByVal uChar As Long, ByVal fuFormat As Long, lpgm As GLYPHMETRICS, ByVal cbBuffer As Long, lpBuffer As Any, lpmat2 As MAT2) As Long

    'Định nghĩa các biến cần dùng
    Dim lf As LOGFONT
    Dim buffer(5000) As Byte
    Dim buffersize As Long
    Dim gm As GLYPHMETRICS
    Dim m2 As MAT2

    'thủ tục xử lý Click chuột trên button Display
    Private Sub btnDisplay_Click()
    'Định nghĩa các biến cần dùng
    Dim prevFont As Long, hFont As Long, ret As Long
    Dim rows As Integer, r As Integer
    Dim cols As Integer, c As Integer
    Dim idx As Integer, mask As Integer
    Dim byt As Integer, binr As Integer
    'thiết lập các thuộc tính về font cần dùng
    lf.lfHeight = (CInt(txtSize.Text) * -20) / Screen.TwipsPerPixelY
    lf.lfWidth = 0
    lf.lfEscapement = 0
    lf.lfOrientation = 0
    lf.lfWeight = 300
    lf.lfItalic = False
    lf.lfUnderline = False
    lf.lfStrikeOut = False
    lf.lfFaceName = txtFontName.Text & Chr$(0)
    'tạo font chữ theo yêu cầu
    hFont = CreateFontIndirect(lf)
    If hFont = Null Then Exit Sub
    prevFont = SelectObject(Me.hdc, hFont)
    'thiết lập các ma trận chuyển đổi
    m2.eM11.value = 1: m2.eM11.fract = 0
    m2.eM22.value = 1: m2.eM22.fract = 0
    'tìm kích thước ma trận pixel ký tự
    buffersize = GetGlyphOutline(Me.hdc, CInt(txtCode.Text), GGO_BITMAP, gm, 0, 0, m2)
    If buffersize <= 0 Then Exit Sub
    'đọc ma trận pixel ký tự
    ret = GetGlyphOutline(Me.hdc, CInt(txtCode.Text), GGO_BITMAP, gm, buffersize, buffer(0), m2)
    'xác định số hàng, cột của ma trận
    rows = gm.gmBlackBoxY
    cols = gm.gmBlackBoxX
    'xác định số byte chứa các pixel của 1 cột ma trận
    binr = buffersize \ rows
    'xóa vùng hiển thị ma trận
    Me.ScaleMode = vbPixels
    Me.FillStyle = vbFSSolid
    Me.FillColor = Me.BackColor
    Me.DrawStyle = vbInvisible
    Me.Line (0, YS)-(Me.ScaleWidth, Me.ScaleHeight), , B
    'xác định màu vẽ các pixel
    Me.FillColor = RGB(0, 0, 0)
    'lặp hiển thị từng hàng pixel của ma trận
    For r = 0 To rows - 1
    idx = 1: byt = buffer(r * 4)
    mask = &H80
    'lặp hiển thị từng pixel trong hàng r
    For c = 0 To cols - 1
    If byt And mask Then dispbit r, c
    mask = mask \ 2
    If mask = 0 Then
    byt = buffer(r * binr + idx)
    idx = idx + 1
    mask = &H80
    End If
    Next
    Next
    End Sub

    'thủ tục vẽ 1 pixel được phóng to 8*8
    Private Sub dispbit(r As Integer, c As Integer)
    Dim x As Integer
    Dim y As Integer
    'xác định tọa độ của pixel
    x = XS + c * 8: y = YS + r * 8
    Me.Line (x, y)-(x + 7, y + 7), , B
    End Sub

    5. Chọn menu Run.Start để dịch và chạy thử ứng dụng. Khi form ứng dụng hiển thị, bạn thử nhập tên font, co chữ, mã ký tự cần xem rồi click chuột vào button Display để xem ma trận bitmap của ký tự tương ứng. Bạn thử hiệu chỉnh nội dung các textbox rồi click vào button Display để xem ký tự khác. Lưu ý phải cẩn thận nhập tên font đúng.

    Chuyên mục: Lập trình