• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 358
  • Last Modified:

Font inside an array of types

I have a class which looks something like this:

'---class TextPrint.cls---
Option Explicit

Private m_fntPrintFont As New StdFont
Private m_nCurrentX As Integer
Private m_nCurrentY As Integer
Private Type strOutput
     TextOut As String
     fnt As StdFont
     CurrentX As Integer
     CurrentY As Integer
End Type
Dim m_Output() As strOutput

Private Sub Class_Initialize()
    ReDim m_Output(0)
    m_fntPrintFont.Name = "Times New Roman"
    m_fntPrintFont.Size = 10
    m_fntPrintFont.Bold = False
End Sub

Public Property Get Font() As StdFont
    Set Font = m_fntPrintFont
End Property
Public Property Set Font(ByVal Value As StdFont)
    Set m_fntPrintFont = Value
End Property

Public Property Get CurrentX() As Integer
    CurrentX = m_nCurrentX
End Property
Public Property Let CurrentX(Value As Integer)
    m_nCurrentX = Value
End Property

Public Property Get CurrentY() As Integer
    CurrentY = m_nCurrentY
End Property
Public Property Let CurrentY(Value As Integer)
    m_nCurrentY = Value
End Property

Public Sub WriteLine(sText As String)
    Dim i As Integer
    i = UBound(m_Output) + 1
    ReDim Preserve m_Output(i)
    m_Output(i).TextOut = sText
    Set m_Output(i).fnt = m_fntPrintFont
    m_Output(i).CurrentX = m_nCurrentX
    m_Output(i).CurrentY = m_nCurrentY
    m_nCurrentX = 0
    m_nCurrentY = m_nCurrentY + Printer.TextHeight(sText)
End Sub

Public Sub EndDoc()
    Dim i As Integer
    For i = 1 To UBound(m_Output)
        Printer.CurrentX = m_Output(i).CurrentX
        Printer.CurrentY = m_Output(i).CurrentY
        Set Printer.Font = m_Output(i).fnt
        Printer.Print m_Output(i).TextOut
    ReDim m_Output(0)
End Sub
'---End class---

The code which calls the class looks like this:

'---Form Form1.frm---
Private Sub Command2_Click()
    Dim sText As String
    Dim cPrinter As New TextPrint
    Dim fnt As New StdFont

    With fnt
        .Name = "Arial"
        .Size = 36
        .Bold = True
    End With
    Set cPrinter.Font = fnt
    sText = "Test Line 1"
    cPrinter.CurrentX = 0
    cPrinter.CurrentY = 200
    cPrinter.WriteLine sText

    With fnt
        .Name = "Arial"
        .Size = 8
        .Bold = False
    End With
    Set cPrinter.Font = fnt
    sText = "Test Line 2"
    cPrinter.WriteLine sText

End Sub
'---End Form---

The problem is that both lines print in Arial, 8pt, Normal

When whecking the values of m_Output() in the class, I noticed that the first time through, the values for m_Output(1).Font were correct, but as soon as I change the values for fnt in the form, the value for m_Output(1).Font changes to match.  It's as if I'm not actually assigning the font to the property, but only assigning a reference to fnt in the form code.

I have tried declaring the class's Font property as ByVal and ByRef, neither makes any difference.

Although the example above only prints two lines, the actual procedure prints dozens of lines.

I don't want to create a new font variable for every time I need to change the font in the class.

How do a pass a font object to a class, modify the font and then pass it into the class again without affecting the stored original?
1 Solution
When you write:

Set m_Output(i).fnt = m_fntPrintFont

You are only pointing m_Output(i).fnt to m_fntPrintFont     m_Output(i).fnt -> m_fntPrintFont

Which means, when m_fntPrintFont changes, all of the font objects which point to it reflect the changes.

What you can do:

Create another UDT

Private Type FontDescriptor
    Name as string
    Size as long
    Bold as boolean
End Type

'Then modify your UDT

Private Type strOutput
    TextOut as string
    fnt as FontDescriptor

'Then in your code

m_Output(i).fnt.Name = m_fntPrintFont.Name
'repeat for the Size ans Bold properties


Printer.Font.Name = m_Output(i).fnt.Name
'And so on...

Hope it helps!

ClifAuthor Commented:
It's a bit extra typing, but it works.


Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now