Changing Control Font

[dw85745]

When I obtain the client area using:

Call GetClientRect(ctrl.hWnd, r1)

The control client area expands and shrinks as it should (when the form is Resized) - when NO code is used to set the control Font Size.

HOWEVER if one adds the following code to adjust the Font Size (using the client Height from GetClientRect)

ctrlFontSize = fPixelsToPoints(r1.Bottom - r1.Top) - 5
ctrl.font.SIZE = ctrlFontSize

The Font Size will expand as the control expands - HOWEVER - when the control shrinks, the control continues to expand even though the Client area shrinks.

To complicate matters more, if NO call is made to GetClientRect and just the following code is used to set the FontSize the
control seems to expand and shrink OK.

                           On Error Resume Next
                           ctrl.font.SIZE = y_scale * dtrl.FontSize
                           On Error GoTo 0

Anyone have any idea what is happening and why?

[VBClassicRocks]

What are you trying to achieve?
Bottom - Top gives height. But height has no relationship to font SIZE.
Font size is an arbitray Single value, measured in Points (IIRC 20 Twips per Point)

[dw85745]

What are you trying to achieve?

I'm working on some ideas for resizing fonts.

Bottom - Top gives height. But height has no relationship to font SIZE.
Font size is an arbitray Single value, measured in Points (IIRC 20 Twips per Point)

One of my eariler threads addressed this issue using TEXTMETRIC.
FWIW Height is just a number and can be converted to Font Size.
In the original post -- this thread -- I use:

ctrlFontSize = fPixelsToPoints(r1.Bottom - r1.Top) - 5

to make this conversion. When this number is assigned to the the "ctrl.Font.Size" property, VB will find the closest font size value for the Named font (Tahoma for example).
One can understand this conversion (see what VB does) by stepping though font sizes in very small increments (.01 for example).

/////////////////////////////////////////////////

What really has me CONFUSED, is how a call to GetClientRect, and the subsequent changing of Font Size ,
-- CAUSES - the control to resize incorrectly, while without the Font Size assignnent everything works as designed,
I have noticed that even with the code:

ctrl.font.SIZE = y_scale * dtrl.FontSize

Sometime things go haywire.
So there is something going on with VB when control fonts are changed.

???????????????????????????????????????
BUT -- WHAT and WHY is the question?
??????????????????????????????????????

From my previous efforts it appears control Fonts are assigned and destroyed when the control gains / loses focus.
However, if the control still has focus (e.g. Resize code such as "If TypeOF ctrl Is ........" then one would think
the font could be changed. This is in fact the case with "ctrl.font.SIZE = y_scale * dtrl.FontSize".
Yet, it appears, that a call to another procedure somehow causes a problem -- maybe a pointer is being lost???

[dw85745]

bump

[dw85745]

This little VB example demonstrates the problem.

When the line for font sizing is remmed, pressing Command1 will increase the textbox size.
Converserly, pressing Command2 will decrement the textbox size.

However, when the line for font sizing is Un-Remmed (executed), prressing Command1 will increase the textbox size and font. However if Command2 is pressed the textbox continues to increases borh in size and font Instead of decreasing.

====================================

VERSION 5.00

Begin VB.Form Form1 

Caption = "Form1"

ClientHeight = 3075

ClientLeft = 60

ClientTop = 465

ClientWidth = 4680

LinkTopic = "Form1"

ScaleHeight = 3075

ScaleWidth = 4680

StartUpPosition = 3 'Windows Default

Begin VB.CommandButton Command2 

Caption = "Command2"

Height = 405

Left = 1230

TabIndex = 2

Top = 2565

Width = 2100

End

Begin VB.CommandButton Command1 

Caption = "Command1"

Height = 495

Left = 1245

TabIndex = 1

Top = 1965

Width = 2160

End

Begin VB.TextBox Text1 

BeginProperty Font 

Name = "Tahoma"

Size = 9

Charset = 0

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 405

Left = 1020

TabIndex = 0

Text = "Text1"

Top = 705

Width = 2790

End

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit

Private Increment As Single

Private Decrement As Single

Private Sub Command1_Click()

Dim a As Integer


Increment = Increment + 100


Text1.Height = Text1.Height + Increment


a = ScaleY(Text1.Height, vbTwips, vbPoints)


'<<<< UnRem next line to show problem >>>>>>

' Text1.Font.Size = a


Debug.Print "+"; Text1.Height; Increment; a; Text1.Font.Size

End Sub



Private Sub Command2_Click()

Dim a As Integer


Decrement = Decrement - 100


Text1.Height = Text1.Height + Decrement


a = ScaleY(Text1.Height, vbTwips, vbPoints)

<<<< UnRem next line to show problem >>>>>>
' Text1.Font.Size = a


Debug.Print "-"; Text1.Height; Decrement; a; Text1.Font.Size

End Sub

[dw85745]

This works:

]

[dw85745]

This works:

Place a textbox and two command buttons on a form.

Option Explicit

Private Sub Command1_Click()
'Increase Textbox

   Dim a As Integer
 
 
   Text1.Height = Text1.Height + 100
   
   'Note:  The -100 is quick test solution to account for textbox borders
   a = ScaleY(Text1.Height - 100, vbTwips, vbPoints)
  Text1.Font.Size = a
   
End Sub


Private Sub Command2_Click()
'Decrease Textbox

'CRITICAL >> To decrease size of textbox order must be:
'1)  Make Font Smaller
'2)  Resize textbox
'3)  Set Font to New Font Size


   Dim a As Single
   Dim b As Single

   Text1.Visible = False

   'Change Font to a Smaller Size
   '<<set to some minimum
   Text1.Font.Size = 9        
   
   'Calc the Height for a SmallerTextbox (vbTwips)
   Text1.Height = Text1.Height - 100
    b = Text1.Height
   
   'Set the Height and Size Font to Height if > Zero
   If b  > 0 Then
 
      'Set the Font to the New Size (Font in Points)
      'The -100 is a quick dirty solution to account for Textbox borders
      a = ScaleY(Text1.Height - 100, vbTwips, vbPoints)
       Text1.Font.Size = a
   End If
   
  Text1.Visible = True
  
End Sub