Re: set fontsize with variable

OK, this is a lot of code.
It is an ActiveX dll to make a custom MsgBox.
I have altered to single and it seems better as I can run it a few times but it still
keeps breaking down with the same error.


In a class module:
------------------------

Option Explicit

Public Function MsgBoxDLL(Optional strPrompt As String, _
Optional strTitle As String, _
Optional strButton1 As String = "OK", _
Optional strButton2 As String, _
Optional strButton3 As String, _
Optional strButton4 As String, _
Optional btDefault As Byte = 1, _
Optional lFormColour As Long = -1, _
Optional lLabelColour As Long = -1, _
Optional lButtonColour As Long = -1, _
Optional lLabelFontColour As Long = -1, _
Optional lMaxLen As Long = 125, _
Optional bPromptBorder As Boolean = False, _
Optional bIndentAfterBreak As Boolean = False, _
Optional bOnlyIndentWithNumericFirstChar As Boolean = True, _
Optional strIndent As String, _
Optional bStartLineWithSpacer As Boolean = False, _
Optional strSpacer As String, _
Optional siPromptButtonFontSize As Single = 8, _
Optional bShowIcon As Boolean = True) As String

Dim frm As FMsgBox
Set frm = New FMsgBox

If bStartLineWithSpacer Then
lMaxLen = lMaxLen - Len(strSpacer)
End If

If Len(strPrompt) > lMaxLen Then
strPrompt = BreakText(strPrompt, _
lMaxLen, bIndentAfterBreak, _
bOnlyIndentWithNumericFirstChar, _
strIndent)
End If

If bStartLineWithSpacer Then
strPrompt = AddLineSpacer(strPrompt, strSpacer)
End If

'so setting the form colour only will
'give the label and buttons the same colour
'------------------------------------------
If lFormColour > -1 Then
If lLabelColour = -1 Then
lLabelColour = lFormColour
End If
If lButtonColour = -1 Then
lButtonColour = lFormColour
End If
End If

'to avoid a non-contrasting label font colour
'--------------------------------------------
If lLabelColour > -1 Then
If lLabelFontColour = -1 Then
lLabelFontColour = GetContrastingFontx(lLabelColour)
End If
End If

'to move buttons to the left
'---------------------------
If Len(strButton2) = 0 Then
If Len(strButton3) > 0 Then
strButton2 = strButton3
strButton3 = ""
Else
If Len(strButton4) > 0 Then
strButton2 = strButton4
strButton4 = ""
End If
End If
End If

If Len(strButton3) = 0 Then
If Len(strButton4) > 0 Then
strButton3 = strButton4
strButton4 = ""
End If
End If

With frm
.Prompt = strPrompt
.Title = strTitle
.DefaultButton = btDefault
.FormColour = lFormColour
.LabelColour = lLabelColour
.ButtonColour = lButtonColour
.LabelFontColour = lLabelFontColour
.MaxLenPrompt = lMaxLen
.Button1 = strButton1
.Button2 = strButton2
.Button3 = strButton3
.Button4 = strButton4
.PromptBorder = bPromptBorder
.PromptButtonFontSize = siPromptButtonFontSize
.ShowIcon = bShowIcon
.Show vbModal
MsgBoxDLL = .ReturnValue
End With

Unload frm
Set frm = Nothing

End Function


In a Form:
-----------------

Option Explicit
Private m_Prompt As String
Private m_Title As String
Private m_Button1 As String
Private m_Button2 As String
Private m_Button3 As String
Private m_Button4 As String
Private m_Default As Byte
Private m_ColourForm As Long
Private m_ColourLabel As Long
Private m_ColourButton As Long
Private m_ColourLabelFont As Long
Private m_MaxLen As Long
Private m_PromptBorder As Boolean
Private m_PromptButtonFontSize As Single
Private m_ShowIcon As Boolean
Private lFormWidth As Long
Private btButtonCount As Byte
Private s_RetVal As String

Public Property Let Prompt(ByVal SomeText As String)
m_Prompt = SomeText
End Property

Public Property Let Title(ByVal SomeText As String)
m_Title = SomeText
End Property

Public Property Let Button1(ByVal SomeText As String)
m_Button1 = SomeText
End Property

Public Property Let Button2(ByVal SomeText As String)
m_Button2 = SomeText
End Property

Public Property Let Button3(ByVal SomeText As String)
m_Button3 = SomeText
End Property

Public Property Let Button4(ByVal SomeText As String)
m_Button4 = SomeText
End Property

Public Property Let DefaultButton(ByVal btValue As Byte)
m_Default = btValue
End Property

Public Property Let FormColour(ByVal lValue As Long)
m_ColourForm = lValue
End Property

Public Property Let LabelColour(ByVal lValue As Long)
m_ColourLabel = lValue
End Property

Public Property Let ButtonColour(ByVal lValue As Long)
m_ColourButton = lValue
End Property

Public Property Let LabelFontColour(ByVal lValue As Long)
m_ColourLabelFont = lValue
End Property

Public Property Let MaxLenPrompt(ByVal lValue As Long)
m_MaxLen = lValue
End Property

Public Property Let PromptBorder(ByVal bValue As Boolean)
m_PromptBorder = bValue
End Property

Public Property Let PromptButtonFontSize(ByVal siValue As Single)
m_PromptButtonFontSize = siValue
End Property

Public Property Let ShowIcon(ByVal bValue As Boolean)
m_ShowIcon = bValue
End Property

Public Property Get ReturnValue() As String
ReturnValue = s_RetVal
End Property

Private Sub cmdButton1_Click()
s_RetVal = cmdButton1.Caption
Me.Hide
End Sub

Private Sub cmdButton2_Click()
s_RetVal = cmdButton2.Caption
Me.Hide
End Sub

Private Sub cmdButton3_Click()
s_RetVal = cmdButton3.Caption
Me.Hide
End Sub

Private Sub cmdButton4_Click()
s_RetVal = cmdButton4.Caption
Me.Hide
End Sub

Private Sub Form_Load()

If m_ShowIcon Then
BorderStyle = 3
Else
BorderStyle = 4
End If
Caption = m_Title
If m_PromptBorder Then
txtPrompt.BorderStyle = 1
Else
txtPrompt.BorderStyle = 0
End If
FontBold = True
txtPrompt.FontSize = m_PromptButtonFontSize
txtPrompt.Text = m_Prompt
cmdButton1.Caption = m_Button1
cmdButton1.FontSize = m_PromptButtonFontSize
lFormWidth = 1600
btButtonCount = 1

If m_ColourForm > -1 Then
BackColor = m_ColourForm Or &H2000000
End If

If m_ColourLabel > -1 Then
txtPrompt.BackColor = m_ColourLabel Or &H2000000
Else
'this is needed for if no colour is specified at all
txtPrompt.BackColor = BackColor
End If

If m_ColourLabelFont > -1 Then
txtPrompt.ForeColor = m_ColourLabelFont
End If

If m_ColourButton > -1 Then
cmdButton1.BackColor = m_ColourButton Or &H2000000
End If

If Len(m_Button2) > 0 Then
btButtonCount = 2
lFormWidth = 2900
cmdButton2.FontSize = m_PromptButtonFontSize
cmdButton2.Caption = m_Button2
If m_ColourButton > -1 Then
cmdButton2.BackColor = m_ColourButton Or &H2000000
End If
cmdButton2.Visible = True
End If

If Len(m_Button3) > 0 Then
btButtonCount = 3
lFormWidth = 4200
cmdButton3.FontSize = m_PromptButtonFontSize
cmdButton3.Caption = m_Button3
If m_ColourButton > -1 Then
cmdButton3.BackColor = m_ColourButton Or &H2000000
End If
cmdButton3.Visible = True
End If

If Len(m_Button4) > 0 Then
btButtonCount = 4
lFormWidth = 5500
cmdButton4.FontSize = m_PromptButtonFontSize
cmdButton4.Caption = m_Button4
If m_ColourButton > -1 Then
cmdButton4.BackColor = m_ColourButton Or &H2000000
End If
cmdButton4.Visible = True
End If

End Sub

Private Sub Form_Activate()

Dim lExtraHeight As Long
Dim lExtraWidth As Long
Dim lWidth As Long
Dim lMidForm As Long
Dim lCaptionWidth As Long
Dim lPromptWidth As Long
Dim lPromptHeight As Long
Dim lFormHeight As Long
Dim lIconsCorrection As Long
Dim lPromptWidthCorrection As Long
Dim dTitleWidthCorrection As Double
Dim btTabWidthInSpaces As Byte
Dim lPromptHeightCorrection As Long
Dim strTemp As String

strTemp = txtPrompt.Text

dTitleWidthCorrection = 1.25

If m_PromptBorder Then
lPromptHeightCorrection = 72
lPromptWidthCorrection = 270
Else
lPromptHeightCorrection = 0
lPromptWidthCorrection = 150
End If

FontBold = True
FontSize = m_PromptButtonFontSize
lExtraHeight = Height - ScaleHeight
lExtraWidth = Width - ScaleWidth
lIconsCorrection = lExtraHeight * 2
lCaptionWidth = TextWidth(Caption) * dTitleWidthCorrection + lIconsCorrection
FontBold = False
FontSize = m_PromptButtonFontSize
btTabWidthInSpaces = TextWidth(vbTab) \ TextWidth(Chr(32))
'without this replace the width of tabs is under-calculated
'----------------------------------------------------------
lPromptWidth = TextWidth(Replace(strTemp, _
vbTab, _
String(btTabWidthInSpaces, Chr(32)), _
1, -1, _
vbBinaryCompare)) + lPromptWidthCorrection
lPromptHeight = TextHeight(strTemp) + lPromptHeightCorrection
FontBold = True
FontSize = m_PromptButtonFontSize
lFormHeight = lPromptHeight + 325 + 375 + lExtraHeight
lFormWidth = lFormWidth + lExtraWidth

'correct form for prompt width, lFormWidth was set by buttons
'------------------------------------------------------------
If lPromptWidth + 400 > lFormWidth Then
lFormWidth = lPromptWidth + 400
End If

'correct form for title caption width
'------------------------------------
If lCaptionWidth > lFormWidth Then
lFormWidth = lCaptionWidth
End If

Height = lFormHeight
Width = lFormWidth
txtPrompt.Height = lPromptHeight
txtPrompt.Width = (lFormWidth - 400) - lExtraWidth

cmdButton1.Top = lPromptHeight + 225
cmdButton2.Top = lPromptHeight + 225
cmdButton3.Top = lPromptHeight + 225
cmdButton4.Top = lPromptHeight + 225

lMidForm = (lFormWidth - lExtraWidth) \ 2

Select Case btButtonCount
Case 1
cmdButton1.Left = lMidForm - 600
Case 2
cmdButton1.Left = lMidForm - 1250
cmdButton2.Left = lMidForm + 50
Case 3
cmdButton1.Left = lMidForm - 1900
cmdButton2.Left = lMidForm - 600
cmdButton3.Left = lMidForm + 700
Case 4
cmdButton1.Left = lMidForm - 2550
cmdButton2.Left = lMidForm - 1250
cmdButton3.Left = lMidForm + 50
cmdButton4.Left = lMidForm + 1350
End Select

Select Case m_Default
Case 1
cmdButton1.SetFocus
Case 2
cmdButton2.SetFocus
Case 3
cmdButton3.SetFocus
Case 4
cmdButton4.SetFocus
End Select

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
s_RetVal = ""
Me.Hide
End If
End Sub


Calling this from VBA:
--------------------------------
Option Explicit

Sub RefDLL()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile "C:\RBSSynergyReporting\Program\CustomMsgBox.dll"
End Sub

Sub RemoveRef()

Dim R As Object

For Each R In ThisWorkbook.VBProject.References
If R.Name = "CustomMsgBox" Then
ThisWorkbook.VBProject.References.Remove R
Exit For
End If
Next

ThisWorkbook.Save

RefDLL

End Sub


Sub test()

Dim sRetVal As String

MsgBoxDLL , , , , , , , , , , , , , , , , , , 10

MsgBoxDLL , , , , , , , , , , , , , , , , , , 10

'Exit Sub

MsgBox "", vbYesNo, String(80, "-") & "1" & String(80, "-")
MsgBoxDLL "", String(80, "-") & "1" & String(80, "-"), "aa", "aa"
MsgBoxDLL "", String(80, "-") & "1" & String(80, "-"), "aa", "aa", , , , , , , , , True

'Exit Sub

MsgBox "this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. "

MsgBoxDLL "this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. " & _
"this is a very long bit of text with no linebreaks. ", , , , , , , , , , , 135, True

'Exit Sub

MsgBox "testing" & vbTab & "tab" & vbCrLf & _
"testing" & " " & "not"

MsgBoxDLL "testing" & vbTab & "tab" & vbCrLf & _
"testing" & " " & "not", , , , , , , , , , , , True


'Exit Sub

MsgBoxDLL "testing tabs" & vbTab & "test" & vbCrLf, _
"tabsss", , , , , , , 255, , , , True

MsgBoxDLL "testing tabs" & String(6, " ") & "test" & vbCrLf, _
"spaces", , , , , , , 255, , , , True

MsgBox "very wide text end of it."
MsgBoxDLL "very wide text end of it.", , , , , , , , , , , , True

'Exit Sub

MsgBox "Your version:" & vbTab & 12.98 & _
vbCrLf & _
"Web version:" & vbTab & 13.03 & _
vbCrLf & vbCrLf & _
"Do you want to download the new version?" & vbCrLf, _
vbYesNo + vbDefaultButton1, _
"checking add-in version"

MsgBoxDLL "Your version:" & Chr(9) & 12.98 & _
vbCrLf & _
"Web version:" & Chr(9) & 13.03 & _
vbCrLf & vbCrLf & _
"Do you want to download the new version?" & vbCrLf, _
"checking add-in version", _
"Yes", "No", , , 1, _
15001309, , , , , True

'Exit Sub


'Exit Sub

MsgBoxDLL "Sub RefDLL()" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"\VB98\CustomMSB\MyDLL.dll" & vbCrLf & _
"End Sub", _
" test ", , , , _
"Cancel", 1, RGB(200, 200, 200), , , , , True


MsgBoxDLL "test", " test ", , , , , , 255, , , , , True

MsgBoxDLL "all done now ", _
" 12345 ", , , , , , RGB(0, 0, 255), RGB(0, 0, 255), , , , True


MsgBoxDLL "pick one of the 4 options", "4 options", "option 1", "option 2", "option 3", "option 4", 2, 255, , , , , True

MsgBoxDLL "Your version:" & vbTab & "13.03" & _
vbCrLf & _
"Web version:" & vbTab & "13.02" & _
vbCrLf & vbCrLf & _
"Do you want to download the new version?", _
"checking add-in version", _
"Yes", "No", , , 1, _
15001309, 15001309, 15001309, , , True

MsgBoxDLL "test ", "title", "OK", "NO", "YES", , 2, , , , , , True

MsgBoxDLL "Simplest MsgBox", "", , , , , , , , , , , True

MsgBoxDLL "no icon", "no icon", , , , , , , , , , , True, False

End Sub


RBS






"Mike Williams" <Mike@xxxxxxxxxxxxxxxxx> wrote in message news:OUMgbzlMGHA.1312@xxxxxxxxxxxxxxxxxxxxxxx
"RB Smissaert" <bartsmissaert@xxxxxxxxxxxxxxxx> wrote in message news:ezAc1nlMGHA.2012@xxxxxxxxxxxxxxxxxxxxxxx

Trying to set the FontSize of a TextBox and CommandButton
via a variable. I understand the datatype for this is currency, but
whatever datatype I choose I get: Runtime error 380: Invalid
property value. How do I do this:

Personally I would use a Single to hold the size of a font, but an Integer (as you are using) will also work, except that you won't know the exact font size you have achieved (which may or may not be important to you). You usually only get an error 380 if you try to set the size to zero (which means 0.5 or less if you are using an Integer variable) or to a negative value. Post the full code you are using.

Mike



.

Loading