This code sample demonstrates how to output a text character using the Win32 api textout. The process includes two parts starting first with a two dimensional character array called aScreenChars mapping to a column and row on the display and a two dimensional attributes string array containing a concatenation of attributes commands per string. The attributes string is parsed and the attributes applied before the character is rasterized.

Each textout character is rasterized using the text_opaque turned on. The form font properties are initialized or de-initialized in a functional called setattributes. Some of the font attributes include underline, bold, background color, and text color.

The screeninitialize method extracts the character width and height used during text rasterization.

The form paint events calls the displaytext method which can render out a single character or all characters in the ascreenChars array.

API Module

Option Explicit
Public 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
Public Declare Function SetTextColor Lib "gdi32" 
(ByVal hDC As Long, ByVal crColor _
  As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" 
(ByVal hDC As Long, ByVal crColor As _
 Long) As Long
Public Declare Function SetBkMode Lib "gdi32" 
(ByVal hDC As Long, ByVal nBkMode As Long) As Long

Public Const TEXT_TRANSPARENT = 1
Public Const TEXT_OPAQUE = 2

Public Const conScreenHeight = 24
Public Const conScreenWidth = 80

Public aScreenChars(conScreenWidth + 1, conScreenHeight + 1) As String
Public aAttributes(conScreenWidth + 1, conScreenHeight + 1) As String

Public Const constATTR_NORMAL = "0"

frmMain (variables)

Option Explicit

Const constOne = 1
Const constAll = 2

Dim iCharWidth, iCharHeight As Integer
Dim iCursorRow, iCursorColumn As Integer
Dim iTermBKColor, iTermTextColor As Long

frmMain (functions)

Public Sub ScreenInitialize()
    Dim RC
   
    With Me
        .FontUnderline = False
        .FontItalic = False
        .FontBold = False
        .Font.Name = "Fixedsys"
        .ScaleMode = 3
        If iCharWidth = 0 Then
           iCharWidth = .TextWidth("M")
        End If
        If iCharHeight = 0 Then
            iCharHeight = .TextHeight("M") + 2
        End If
    End With
    
    'Setup the User Scale of the display
    With Me
        .ScaleMode = 0
        .ScaleWidth = conScreenWidth
        .ScaleHeight = conScreenHeight
    End With
    
    Me.Scale (0, 0)-(conScreenWidth - 1, conScreenHeight - 1)
    
    RC = SetBkMode(hDC, TEXT_OPAQUE)
    
    iTermTextColor = QBColor(15)
    iTermBKColor = QBColor(0)
        
End Sub

Public Sub DisplayText(iType As Integer)
    Dim i
    Dim j
    Dim sBuffer
    Dim iAttrChangeOffset As Integer
    Dim sAttributeCmds As String
    Dim iNewAttribute As Integer
    Dim sOldAttributeCmds As String
    Dim iRow As Integer
    Dim iColumn As Integer
    
    
    If iType = constAll Then
        For i = 0 To conScreenHeight
            sBuffer = ""
            For j = 0 To conScreenWidth
                sBuffer = aScreenChars(j, i)
                sAttributeCmds = aAttributes(j, i)
                If sAttributeCmds <> sOldAttributeCmds Then
                    Do
                        iNewAttribute = Val(EscapeParseArg(sAttributeCmds))
                        SetAttribute (iNewAttribute)
                     Loop While sAttributeCmds <> ""
                End If
                TextOut hDC, j * iCharWidth, i * iCharHeight, sBuffer, Len(sBuffer)
                sOldAttributeCmds = sAttributeCmds
            Next
        Next
    ElseIf iType = constOne Then
    
        i = iCursorRow
        j = iCursorColumn - 1
        
        sBuffer = aScreenChars(j, i)
        sAttributeCmds = aAttributes(j, i)
        Do
            iNewAttribute = Val(EscapeParseArg(sAttributeCmds))
            SetAttribute (iNewAttribute)
         Loop While sAttributeCmds <> ""
         TextOut hDC, j * iCharWidth, i * iCharHeight, sBuffer, Len(sBuffer)
    End If

End Sub

Private Function EscapeParseArg(s As String) As String
    Dim i As Integer
    i = InStr(s, ";")
    
    If i = 0 Then
        EscapeParseArg = s
        s = ""
    Else
        EscapeParseArg = Left(s, i - 1)
        s = Mid(s, i + 1)
    End If
    
End Function

Public Sub SetAttribute(ch As Integer)
    Dim RC As Long
    
    Select Case ch
        Case 0  'Normal
            With Me
                .FontUnderline = False
                .FontItalic = False
                .FontBold = False
                .Font.Name = "Fixedsys"
            End With
            'RC = SetBkColor(hDC, iTermBKColor)
           'RC = SetTextColor(hDC, iTermTextColor)
        Case 1 'Bold
            With Me
                .FontBold = True
            End With
            RC = SetTextColor(hDC, QBColor(9))
        Case 5 'Blinking
            With Me
                .FontItalic = True
            End With
            RC = SetTextColor(hDC, QBColor(3))
        Case 4 'Underscore
            With Me
                .FontUnderline = True
            End With
        Case 7 'Reverse Video
            iTermTextColor = iTermBKColor
            iTermBKColor = iTermTextColor
        Case 8 'Cancel
            iTermTextColor = iTermBKColor
            iTermBKColor = iTermTextColor
        Case 30 'Black Foreground
            iTermTextColor = QBColor(0)
        Case 31 'Red Foreground
            iTermTextColor = QBColor(4)
        Case 32 'Green Foreground
            iTermTextColor = QBColor(2)
        Case 33 'Yellow Foreground
            iTermTextColor = QBColor(14)
        Case 34 'Blue Foreground
            iTermTextColor = QBColor(1)
        Case 35 'Magenta Foreground
            iTermTextColor = QBColor(5)
        Case 36 'Cyan Foreground
            iTermTextColor = QBColor(3)
        Case 37 'White Foreground
            iTermTextColor = QBColor(15)
        Case 40 'Black Background
            iTermBKColor = QBColor(0)
        Case 41 'Red Background
            iTermBKColor = QBColor(4)
        Case 42 'Green Background
            iTermBKColor = QBColor(2)
        Case 43 'Yellow Background
            iTermBKColor = QBColor(14)
        Case 44 'Blue Background
            iTermBKColor = QBColor(1)
        Case 45 'Magenta Background
             iTermBKColor = QBColor(5)
        Case 46 'Cyan Background
             iTermBKColor = QBColor(3)
        Case 47 'White Background
            iTermBKColor = QBColor(15)
    End Select
  
    With Me
        .ForeColor = iTermTextColor
        .BackColor = iTermBKColor
        RC = SetBkColor(hDC, .BackColor)
        RC = SetTextColor(hDC, .ForeColor)
    End With
    
End Sub

Private Sub Form_Load()
    ScreenInitialize
    
    aScreenChars(20, 5) = "H"
    aAttributes(20, 5) = "0;1;32"
    aScreenChars(21, 5) = "E"
    aAttributes(21, 5) = "0"
    aScreenChars(22, 5) = "L"
    aAttributes(22, 5) = "0"
    aScreenChars(23, 5) = "L"
    aAttributes(23, 5) = "0"
    aScreenChars(24, 5) = "O"
    aAttributes(24, 5) = "0;1;33"
    
End Sub

Private Sub Form_Paint()
    DisplayText constAll
End Sub