Code:
Option Explicit
'//////////////////////////////////////////////////////
'// The module for displaying text on a Unicode form //
'// Copyright (c) 14.05.2024 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru //
'// 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