Output Text Characters Using Win32 API (Article)

Category:
Screen/Graphics
Type:
Snippets
Difficulty:
Intermediate

Author: David Nishimoto

Version Compatibility: Visual Basic 6

More information:
This article demonstrates how to output a text character using the Win32 api textout.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Overview

Author: David Nishimoto

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.

Download Sample

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