QBColor Function

Returns a Long representing the RGB color code corresponding to the specified color number.

Syntax

QBColor(color)

Parameters

• color - Required. Integer in the range 0-15 that represents a color value from the QBasic/DOS era color palette.

Return Value

Returns a Long representing the RGB color code that corresponds to the specified QBasic color number. The returned value can be used with Visual Basic's color properties.

Remarks

The QBColor function provides backward compatibility with QBasic and QuickBASIC programs by converting the 16-color palette used in DOS applications to RGB values usable in Windows applications. The color argument must be an integer from 0 to 15. Each number corresponds to a specific color from the classic DOS/QBasic palette:

Important Notes: - Colors 0-7 are the standard intensity colors - Colors 8-15 are the high intensity (bright) versions - The RGB values use BGR byte order when stored as Long values - Values outside 0-15 will cause an "Invalid procedure call or argument" error

Typical Uses

1. Legacy Code Migration: Converting QBasic/DOS applications to VB6/Windows
2. Console-Style Interfaces: Creating retro-style applications with classic color schemes
3. Educational Programs: Teaching programming with familiar DOS color palette
4. Text Display: Coloring text output in legacy-compatible ways
5. Form Backgrounds: Setting form or control colors using QBasic conventions
6. Chart/Graph Colors: Using classic palette for data visualization
7. Terminal Emulation: Emulating DOS/console applications
8. Game Development: Retro game development with classic color palette

Basic Examples

Example 1: Setting Form Background

' Set form background to bright blue (QBasic color 9)
Form1.BackColor = QBColor(9)

Example 2: Setting Text Color

' Set label text to bright yellow (QBasic color 14)
Label1.ForeColor = QBColor(14)

Example 3: Cycling Through Colors

' Cycle through all 16 QBasic colors
Dim i As Integer
For i = 0 To 15
    Picture1.Line (i * 20, 0)-(i * 20 + 19, 100), QBColor(i), BF
Next i

Example 4: Conditional Coloring

' Color-code values: green for positive, red for negative
If value >= 0 Then
    Label1.ForeColor = QBColor(10)  ' Light Green
Else
    Label1.ForeColor = QBColor(12)  ' Light Red
End If

Common Patterns

Pattern 1: ColorByNumber

Function ColorByNumber(colorNum As Integer) As Long
    ' Safely convert color number with bounds checking
    If colorNum < 0 Then colorNum = 0
    If colorNum > 15 Then colorNum = 15
    ColorByNumber = QBColor(colorNum)
End Function

Pattern 2: GetColorName

Function GetColorName(colorNum As Integer) As String
    ' Return descriptive name for QBasic color number
    Select Case colorNum
        Case 0: GetColorName = "Black"
        Case 1: GetColorName = "Blue"
        Case 2: GetColorName = "Green"
        Case 3: GetColorName = "Cyan"
        Case 4: GetColorName = "Red"
        Case 5: GetColorName = "Magenta"
        Case 6: GetColorName = "Yellow"
        Case 7: GetColorName = "White"
        Case 8: GetColorName = "Gray"
        Case 9: GetColorName = "Light Blue"
        Case 10: GetColorName = "Light Green"
        Case 11: GetColorName = "Light Cyan"
        Case 12: GetColorName = "Light Red"
        Case 13: GetColorName = "Light Magenta"
        Case 14: GetColorName = "Light Yellow"
        Case 15: GetColorName = "Bright White"
        Case Else: GetColorName = "Unknown"
    End Select
End Function

Pattern 3: ColorPalettePicker

Sub ShowColorPalette()
    Dim i As Integer
    Dim x As Integer, y As Integer
    ' Display all 16 colors in a 4x4 grid
    For i = 0 To 15
        x = (i Mod 4) * 60
        y = (i \ 4) * 40
        Picture1.Line (x, y)-(x + 55, y + 35), QBColor(i), BF
        Picture1.ForeColor = QBColor(15 - i)  ' Contrast color
        Picture1.CurrentX = x + 5
        Picture1.CurrentY = y + 10
        Picture1.Print i
    Next i
End Sub

Pattern 4: ApplyColorScheme

Sub ApplyColorScheme(bgColor As Integer, fgColor As Integer, _
                     Optional ctrl As Control = Nothing)
    ' Apply QBasic color scheme to control or form
    If ctrl Is Nothing Then
        Me.BackColor = QBColor(bgColor)
        Me.ForeColor = QBColor(fgColor)
    Else
        ctrl.BackColor = QBColor(bgColor)
        ctrl.ForeColor = QBColor(fgColor)
    End If
End Sub

Pattern 5: ValidateColorNumber

Function ValidateColorNumber(colorNum As Integer) As Boolean
    ' Check if color number is in valid range
    ValidateColorNumber = (colorNum >= 0 And colorNum <= 15)
End Function

Pattern 6: GetComplementaryColor

Function GetComplementaryColor(colorNum As Integer) As Long
    ' Get a contrasting color for readability
    If colorNum >= 0 And colorNum <= 7 Then
        ' Dark colors: use white/bright white
        GetComplementaryColor = QBColor(15)
    Else
        ' Light colors: use black
        GetComplementaryColor = QBColor(0)
    End If
End Function

Pattern 7: ColorizeText

Sub ColorizeText(textBox As TextBox, colorCode As Integer)
    ' Apply color with error handling
    On Error Resume Next
    textBox.ForeColor = QBColor(colorCode)
    If Err.Number <> 0 Then
        textBox.ForeColor = vbBlack  ' Default to black on error
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Pattern 8: CreateColorGradient

Sub CreateColorGradient(pic As PictureBox, startColor As Integer, _
                       endColor As Integer, steps As Integer)
    ' Create gradient using QBasic colors
    Dim i As Integer
    Dim stepHeight As Single
    stepHeight = pic.ScaleHeight / steps
    For i = 0 To steps - 1
        Dim blendColor As Integer
        blendColor = startColor + ((endColor - startColor) * i \ steps)
        If blendColor < 0 Then blendColor = 0
        If blendColor > 15 Then blendColor = 15
        pic.Line (0, i * stepHeight)-(pic.ScaleWidth, (i + 1) * stepHeight), _
                 QBColor(blendColor), BF
    Next i
End Sub

Pattern 9: HighlightControl

Sub HighlightControl(ctrl As Control, highlight As Boolean)
    ' Toggle control highlighting using QBasic colors
    If highlight Then
        ctrl.BackColor = QBColor(14)  ' Light Yellow
        ctrl.ForeColor = QBColor(0)   ' Black
    Else
        ctrl.BackColor = QBColor(15)  ' White
        ctrl.ForeColor = QBColor(0)   ' Black
    End If
End Sub

Pattern 10: ColorCodeStatus

Function GetStatusColor(status As String) As Long
    ' Return color based on status string
    Select Case UCase(status)
        Case "ERROR", "CRITICAL"
            GetStatusColor = QBColor(12)  ' Light Red
        Case "WARNING"
            GetStatusColor = QBColor(14)  ' Light Yellow
        Case "SUCCESS", "OK"
            GetStatusColor = QBColor(10)  ' Light Green
        Case "INFO"
            GetStatusColor = QBColor(9)   ' Light Blue
        Case Else
            GetStatusColor = QBColor(7)   ' White
    End Select
End Function

Advanced Usage

Example 1: Console-Style Output Window

' Create a DOS-style console window with classic colors
Class ConsoleWindow
    Private m_textBox As TextBox
    Private m_currentColor As Integer
    Private m_bgColor As Integer
    Public Sub Initialize(textBox As TextBox)
        Set m_textBox = textBox
        m_currentColor = 7   ' White
        m_bgColor = 0        ' Black
        ' Setup for console appearance
        With m_textBox
            .BackColor = QBColor(m_bgColor)
            .ForeColor = QBColor(m_currentColor)
            .Font.Name = "Courier New"
            .Font.Size = 10
            .MultiLine = True
            .ScrollBars = vbVertical
        End With
    End Sub
    Public Sub SetColor(colorNum As Integer)
        If colorNum >= 0 And colorNum <= 15 Then
            m_currentColor = colorNum
        End If
    End Sub
    Public Sub SetBackColor(colorNum As Integer)
        If colorNum >= 0 And colorNum <= 15 Then
            m_bgColor = colorNum
            m_textBox.BackColor = QBColor(m_bgColor)
        End If
    End Sub
    Public Sub Print(text As String)
        ' Note: VB6 doesn't support rich text easily in TextBox
        ' This is simplified - use RichTextBox for multi-color text
        m_textBox.ForeColor = QBColor(m_currentColor)
        m_textBox.Text = m_textBox.Text & text & vbCrLf
        m_textBox.SelStart = Len(m_textBox.Text)
    End Sub
    Public Sub PrintColored(text As String, colorNum As Integer)
        Dim oldColor As Integer
        oldColor = m_currentColor
        SetColor colorNum
        Print text
        SetColor oldColor
    End Sub
    Public Sub Clear()
        m_textBox.Text = ""
    End Sub
    Public Sub ShowColorTest()
        Dim i As Integer
        Clear
        For i = 0 To 15
            PrintColored "Color " & i & ": " & GetColorName(i), i
        Next i
    End Sub
    Private Function GetColorName(colorNum As Integer) As String
        Select Case colorNum
            Case 0: GetColorName = "Black"
            Case 1: GetColorName = "Blue"
            Case 2: GetColorName = "Green"
            Case 3: GetColorName = "Cyan"
            Case 4: GetColorName = "Red"
            Case 5: GetColorName = "Magenta"
            Case 6: GetColorName = "Yellow"
            Case 7: GetColorName = "White"
            Case 8: GetColorName = "Gray"
            Case 9: GetColorName = "Light Blue"
            Case 10: GetColorName = "Light Green"
            Case 11: GetColorName = "Light Cyan"
            Case 12: GetColorName = "Light Red"
            Case 13: GetColorName = "Light Magenta"
            Case 14: GetColorName = "Light Yellow"
            Case 15: GetColorName = "Bright White"
            Case Else: GetColorName = "Unknown"
        End Select
    End Function
End Class

Example 2: Color Palette Manager

' Manage and display QBasic color palette
Module ColorPaletteManager
    Private Type ColorInfo
        Number As Integer
        Name As String
        RGBValue As Long
        HexValue As String
    End Type
    Private m_palette(0 To 15) As ColorInfo
    Private m_initialized As Boolean
    Public Sub InitializePalette()
        Dim i As Integer
        For i = 0 To 15
            m_palette(i).Number = i
            m_palette(i).Name = GetColorName(i)
            m_palette(i).RGBValue = QBColor(i)
            m_palette(i).HexValue = "&H" & Right("000000" & Hex(QBColor(i)), 6)
        Next i
        m_initialized = True
    End Sub
    Public Function GetColorInfo(colorNum As Integer) As String
        If Not m_initialized Then InitializePalette
        If colorNum < 0 Or colorNum > 15 Then
            GetColorInfo = "Invalid color number"
            Exit Function
        End If
        With m_palette(colorNum)
            GetColorInfo = "Color " & .Number & ": " & .Name & _
                          " (RGB: " & .RGBValue & ", Hex: " & .HexValue & ")"
        End With
    End Function
    Public Function FindColorByName(colorName As String) As Integer
        Dim i As Integer
        If Not m_initialized Then InitializePalette
        For i = 0 To 15
            If UCase(m_palette(i).Name) = UCase(colorName) Then
                FindColorByName = i
                Exit Function
            End If
        Next i
        FindColorByName = -1  ' Not found
    End Function
    Public Sub DisplayPalette(pic As PictureBox)
        Dim i As Integer
        Dim x As Single, y As Single
        Dim boxSize As Single
        If Not m_initialized Then InitializePalette
        pic.Cls
        boxSize = pic.ScaleWidth / 4
        For i = 0 To 15
            x = (i Mod 4) * boxSize
            y = (i \ 4) * boxSize
            ' Draw color box
            pic.Line (x, y)-(x + boxSize - 5, y + boxSize - 5), _
                     QBColor(i), BF
            ' Draw color number
            pic.ForeColor = GetComplementaryColor(i)
            pic.CurrentX = x + 5
            pic.CurrentY = y + 5
            pic.Print Format(i, "00")
        Next i
    End Sub
    Public Function ExportPaletteToHTML() As String
        Dim html As String
        Dim i As Integer
        If Not m_initialized Then InitializePalette
        html = "<table border='1'>" & vbCrLf
        html = html & "<tr><th>Number</th><th>Name</th><th>Hex</th><th>Preview</th></tr>" & vbCrLf
        For i = 0 To 15
            html = html & "<tr>"
            html = html & "<td>" & i & "</td>"
            html = html & "<td>" & m_palette(i).Name & "</td>"
            html = html & "<td>" & m_palette(i).HexValue & "</td>"
            html = html & "<td style='background-color:" & m_palette(i).HexValue & ";'>&nbsp;&nbsp;&nbsp;</td>"
            html = html & "</tr>" & vbCrLf
        Next i
        html = html & "</table>"
        ExportPaletteToHTML = html
    End Function
    Private Function GetColorName(colorNum As Integer) As String
        ' Implementation same as previous examples
        Select Case colorNum
            Case 0: GetColorName = "Black"
            Case 1: GetColorName = "Blue"
            Case 2: GetColorName = "Green"
            Case 3: GetColorName = "Cyan"
            Case 4: GetColorName = "Red"
            Case 5: GetColorName = "Magenta"
            Case 6: GetColorName = "Yellow"
            Case 7: GetColorName = "White"
            Case 8: GetColorName = "Gray"
            Case 9: GetColorName = "Light Blue"
            Case 10: GetColorName = "Light Green"
            Case 11: GetColorName = "Light Cyan"
            Case 12: GetColorName = "Light Red"
            Case 13: GetColorName = "Light Magenta"
            Case 14: GetColorName = "Light Yellow"
            Case 15: GetColorName = "Bright White"
        End Select
    End Function
    Private Function GetComplementaryColor(colorNum As Integer) As Long
        If colorNum >= 0 And colorNum <= 7 Then
            GetComplementaryColor = QBColor(15)
        Else
            GetComplementaryColor = QBColor(0)
        End If
    End Function
End Module

Example 3: Retro Game Color Manager

' Manage colors for retro-style games
Class GameColorManager
    Private m_playerColor As Integer
    Private m_enemyColor As Integer
    Private m_backgroundColors() As Integer
    Private m_levelColors As Collection
    Public Sub Initialize()
        Set m_levelColors = New Collection
        ReDim m_backgroundColors(0 To 3)
        ' Default colors
        m_playerColor = 14       ' Light Yellow
        m_enemyColor = 12        ' Light Red
        m_backgroundColors(0) = 0  ' Black
        m_backgroundColors(1) = 1  ' Blue
        m_backgroundColors(2) = 2  ' Green
        m_backgroundColors(3) = 5  ' Magenta
    End Sub
    Public Function GetPlayerColor() As Long
        GetPlayerColor = QBColor(m_playerColor)
    End Function
    Public Function GetEnemyColor() As Long
        GetEnemyColor = QBColor(m_enemyColor)
    End Function
    Public Function GetBackgroundColor(level As Integer) As Long
        Dim colorIndex As Integer
        colorIndex = level Mod (UBound(m_backgroundColors) + 1)
        GetBackgroundColor = QBColor(m_backgroundColors(colorIndex))
    End Function
    Public Sub SetLevelColorScheme(level As Integer, bgColor As Integer, _
                                  playerColor As Integer, enemyColor As Integer)
        Dim scheme As String
        scheme = bgColor & "," & playerColor & "," & enemyColor
        ' Store in collection using level as key
        On Error Resume Next
        m_levelColors.Remove CStr(level)
        On Error GoTo 0
        m_levelColors.Add scheme, CStr(level)
    End Sub
    Public Sub ApplyLevelColors(level As Integer, gameForm As Form)
        Dim scheme As String
        Dim colors() As String
        On Error Resume Next
        scheme = m_levelColors(CStr(level))
        On Error GoTo 0
        If scheme <> "" Then
            colors = Split(scheme, ",")
            If UBound(colors) = 2 Then
                gameForm.BackColor = QBColor(CInt(colors(0)))
                m_playerColor = CInt(colors(1))
                m_enemyColor = CInt(colors(2))
            End If
        Else
            ' Use default colors
            gameForm.BackColor = GetBackgroundColor(level)
        End If
    End Sub
    Public Function CreateColorCycle(startColor As Integer, endColor As Integer) As Long()
        ' Create array of colors for animation
        Dim colors() As Long
        Dim i As Integer
        Dim count As Integer
        count = Abs(endColor - startColor) + 1
        ReDim colors(0 To count - 1)
        For i = 0 To count - 1
            If startColor <= endColor Then
                colors(i) = QBColor(startColor + i)
            Else
                colors(i) = QBColor(startColor - i)
            End If
        Next i
        CreateColorCycle = colors
    End Function
End Class

Example 4: Syntax Highlighter

' Simple syntax highlighter using QBasic colors
Class SyntaxHighlighter
    Private m_keywordColor As Integer
    Private m_stringColor As Integer
    Private m_commentColor As Integer
    Private m_numberColor As Integer
    Private m_normalColor As Integer
    Public Sub Initialize()
        m_keywordColor = 9    ' Light Blue
        m_stringColor = 12    ' Light Red
        m_commentColor = 2    ' Green
        m_numberColor = 14    ' Light Yellow
        m_normalColor = 15    ' Bright White
    End Sub
    Public Function GetKeywordColor() As Long
        GetKeywordColor = QBColor(m_keywordColor)
    End Function
    Public Function GetStringColor() As Long
        GetStringColor = QBColor(m_stringColor)
    End Function
    Public Function GetCommentColor() As Long
        GetCommentColor = QBColor(m_commentColor)
    End Function
    Public Function GetNumberColor() As Long
        GetNumberColor = QBColor(m_numberColor)
    End Function
    Public Function GetNormalColor() As Long
        GetNormalColor = QBColor(m_normalColor)
    End Function
    Public Sub SetColorScheme(scheme As String)
        ' Apply predefined color schemes
        Select Case UCase(scheme)
            Case "CLASSIC"
                m_keywordColor = 9
                m_stringColor = 12
                m_commentColor = 2
                m_numberColor = 14
                m_normalColor = 15
            Case "PASTEL"
                m_keywordColor = 11
                m_stringColor = 13
                m_commentColor = 10
                m_numberColor = 14
                m_normalColor = 7
            Case "CONTRAST"
                m_keywordColor = 14
                m_stringColor = 12
                m_commentColor = 10
                m_numberColor = 11
                m_normalColor = 15
        End Select
    End Sub
    Public Function GetColorForType(tokenType As String) As Long
        Select Case UCase(tokenType)
            Case "KEYWORD"
                GetColorForType = GetKeywordColor()
            Case "STRING"
                GetColorForType = GetStringColor()
            Case "COMMENT"
                GetColorForType = GetCommentColor()
            Case "NUMBER"
                GetColorForType = GetNumberColor()
            Case Else
                GetColorForType = GetNormalColor()
        End Select
    End Function
End Class

Error Handling

The QBColor function can raise errors in the following situations: - Invalid Procedure Call or Argument (Error 5): When: - The color argument is less than 0 or greater than 15 - The argument is not a valid integer - Type Mismatch (Error 13): When the argument cannot be converted to an integer Always validate the color number before calling QBColor:

Function SafeQBColor(colorNum As Integer) As Long
    On Error Resume Next
    SafeQBColor = QBColor(colorNum)
    If Err.Number <> 0 Then
        SafeQBColor = QBColor(7)  ' Default to white
        Err.Clear
    End If
    On Error GoTo 0
End Function

Performance Considerations

• The QBColor function is very fast - it's essentially a lookup table
• No performance penalty for repeated calls
• Can be called thousands of times without noticeable impact
• Consider caching if using the same color multiple times in tight loops

Best Practices

1. Validate Input: Always check that color numbers are in range 0-15
2. Use Constants: Define named constants for frequently used colors
3. Document Color Choices: Comment why specific colors were chosen
4. Test Accessibility: Consider color-blind users when choosing colors
5. Provide Contrast: Ensure text is readable against background
6. Use Complementary Colors: Pair dark backgrounds with light foregrounds
7. Consider Modern Alternatives: For new code, consider RGB() function
8. Legacy Compatibility: Use QBColor when porting QBasic/DOS code
9. Error Handling: Wrap QBColor calls in error handlers for robustness
10. Color Naming: Use GetColorName pattern for better code readability

Comparison with Related Functions

Platform and Version Notes

• Available in VB6 and all versions of VBA
• Behavior is consistent across all Windows platforms
• Returns BGR byte order (Blue-Green-Red) as is standard for Windows
• Color values are identical to QBasic and QuickBASIC
• Not available in VB.NET (use System.Drawing.Color instead)

Limitations

• Limited to 16 predefined colors only
• Cannot create custom colors (use RGB function instead)
• Color numbers must be exactly 0-15 (no wrapping or modulo)
• Colors may not display identically on all monitors
• High-intensity colors (8-15) may appear less distinct on some displays
• Not suitable for professional graphics requiring precise color control

Related Functions

• RGB: Creates custom RGB color values
• Hex: Converts numbers to hexadecimal strings
• LoadPicture: Loads images with full color support
• Color constants: vbBlack, vbRed, vbGreen, vbBlue, etc.