The module for displaying text on a Unicode form

[HackerVlad]

Option Explicit
'/////////////////////////////////////////////////////
'// Module for printing unicode-text on a vb6 forms //
'// Copyright (c) 2024-05-14 by HackerVlad          //
'// e-mail: [email protected]                  //
'// Version 2.0                                     //
'/////////////////////////////////////////////////////

Private Declare Function TextOut Lib "gdi32" Alias "TextOutW" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32W" (ByVal hDC As Long, ByVal lpsz As Long, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (arr() As Any) As Long

Private Type POINTAPI
   x As Long
   y As Long
End Type

Dim PlusY() As Long
Dim PlusHwnds() As Long

' Print the text on the form with unicode
Public Function PrintW(PrintText As String, Optional PrintForm As Object) As Boolean
    Dim Frms As Form
    Dim hDC As Long
    Dim hwnd As Long
    Dim pt As POINTAPI
    Dim Redraw As Boolean
    Dim i As Long
    Dim Founded As Boolean
    Dim plus As Long
    
    If PrintForm Is Nothing Then
        For Each Frms In Forms
            hDC = Frms.hDC
            hwnd = Frms.hwnd
            Redraw = Frms.AutoRedraw
            Frms.AutoRedraw = True
            Exit For ' Always choose the first form
        Next
    Else
        hDC = PrintForm.hDC
        hwnd = PrintForm.hwnd
        Redraw = PrintForm.AutoRedraw
        PrintForm.AutoRedraw = True
    End If
    
    GetTextExtentPoint32 hDC, StrPtr(PrintText), Len(PrintText), pt
    
    If SafeArrayGetDim(PlusY) > 0 Then ' If the array is filled
        For i = 0 To UBound(PlusHwnds)
            If PlusHwnds(i) = hwnd Then
                plus = PlusY(i)
                PlusY(i) = PlusY(i) + pt.y
                
                Founded = True
                Exit For
            End If
        Next
        
        If Founded = False Then
            ReDim Preserve PlusHwnds(UBound(PlusHwnds) + 1)
            ReDim Preserve PlusY(UBound(PlusY) + 1)
            
            PlusHwnds(UBound(PlusHwnds)) = hwnd
            PlusY(UBound(PlusY)) = pt.y
        End If
    Else
        ReDim Preserve PlusY(0)
        ReDim Preserve PlusHwnds(0)
        
        PlusY(0) = pt.y
        PlusHwnds(0) = hwnd
    End If
    
    TextOut hDC, 0, plus, StrPtr(PrintText), Len(PrintText)
    
    If PrintForm Is Nothing Then
        If Redraw = True Then Frms.Refresh
        Frms.AutoRedraw = Redraw
    Else
        If Redraw = True Then PrintForm.Refresh
        PrintForm.AutoRedraw = Redraw
    End If
    
    PrintW = True
End Function

' Clear the form
Public Sub ClsW(Optional PrintForm As Object)
    Dim Frms As Form
    Dim hwnd As Long
    Dim i As Long
    
    If PrintForm Is Nothing Then
        For Each Frms In Forms
            Frms.Cls
            hwnd = Frms.hwnd
            Exit For ' Always choose the first form
        Next
    Else
        PrintForm.Cls
        hwnd = PrintForm.hwnd
    End If
    
    If SafeArrayGetDim(PlusHwnds) > 0 Then ' If the array is filled
        For i = 0 To UBound(PlusHwnds)
            If PlusHwnds(i) = hwnd Then
                PlusY(i) = 0
                Exit For
            End If
        Next
    End If
End Sub