GFMsgBox/GFMsgBoxfrm.frm

VERSION 5.00
Begin VB.Form GFMsgBoxfrm
   BorderStyle     =   3 'Fester Dialog
   Caption         =   "[...]"
   ClientHeight    =   3210
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4650
   Icon            =   "GFMsgBoxfrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0 'False
   MinButton       =   0 'False
   ScaleHeight     =   3210
   ScaleWidth      =   4650
   ShowInTaskbar   =   0 'False
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.TextBox MsgBoxText
      Height          =   285
      Left            =   1740
      MaxLength       =   1024
      TabIndex        =   3
      Top             =   900
      Width           =   2175
   End
   Begin VB.PictureBox MsgBoxTextWidthPicture
      Enabled         =   0 'False
      Height          =   315
      Left            =   4380
      ScaleHeight     =   255
      ScaleWidth      =   135
      TabIndex        =   2
      Top             =   60
      Visible         =   0 'False
      Width           =   195
   End
   Begin VB.CommandButton MsgBoxCommand
      Caption         =   "MsgBoxCommand"
      Height          =   435
      Index           =   0
      Left            =   60
      TabIndex        =   0
      Top             =   840
      Visible         =   0 'False
      Width           =   1515
   End
   Begin VB.Image MsgBoxInformationImage
      Height          =   480
      Left            =   180
      Picture         =   "GFMsgBoxfrm.frx":000C
      Top             =   180
      Width           =   480
   End
   Begin VB.Image MsgBoxCriticalImage
      Height          =   480
      Left            =   180
      Picture         =   "GFMsgBoxfrm.frx":044E
      Top             =   180
      Width           =   480
   End
   Begin VB.Image MsgBoxExclamationImage
      Height          =   480
      Left            =   180
      Picture         =   "GFMsgBoxfrm.frx":0890
      Top             =   180
      Width           =   480
   End
   Begin VB.Image MsgBoxQuestionImage
      Height          =   480
      Left            =   180
      Picture         =   "GFMsgBoxfrm.frx":0CD2
      Top             =   180
      Width           =   480
   End
   Begin VB.Label MsgBoxLabel
      BackStyle       =   0 'Transparent
      Caption         =   "MsgBoxLabel"
      Height          =   195
      Left            =   960
      TabIndex        =   1
      Top             =   300
      UseMnemonic     =   0 'False
      Width           =   1395
   End
End
Attribute VB_Name = "GFMsgBoxfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2004 by Louis.
'
'This form can serve as:
'‑a GFMsgBox
'‑a GFInputBox
'‑a GFStatisticsBox
'
'The GFMsgBox can also be used as GFInputBox by displaying
'a text control where the user can enter data.
'The appearance of a GFInputBox can be set like that of a GFMsgBox
'(using icons, custom buttons, etc. is possible).
'The GFInputBox optionally supports using a fixed password char.
'
'The actual interface code between GFMsgBox code and the target application
'is located in GFMsgBoxmod, but the target project can also directly use the
'functions of this form if necessary (lower level).
'
#Const GFSkinEngineAvailableFlag = False 'disable if GFSkinEngine code is not available or not to be used (disabled in downloadable version)
'
'GFMsgBox_Show
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'GFSetWindowOnTop
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
'GFSetWindowOnTop
Const HWND_TOPMOST = ‑1
Const HWND_NOTOPMOST = ‑2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
'GFMsgBoxMode constants
Private Const GFMSGBOXMODE_MSGBOX As Integer = 1
Private Const GFMSGBOXMODE_INPUTBOX As Integer = 2
'GFMsgBoxFontStruct ‑ used to retain special control's font even when reloading this form
Private Type GFMsgBoxFontStruct
    FontSavedFlag As Boolean 'used to verify font has been saved before restoring
    LabelFontName As String
    LabelFontSize As Single
    LabelFontBoldFlag As Boolean
    LabelFontItalicFlag As Boolean
    LabelFontUnderlineFlag As Boolean
    LabelFontStrikeThroughFlag As Boolean
    TextFontName As String
    TextFontSize As Single
    TextFontBoldFlag As Boolean
    TextFontItalicFlag As Boolean
    TextFontUnderlineFlag As Boolean
    TextFontStrikeThroughFlag As Boolean
    CommandFontName As String
    CommandFontSize As Single
    CommandFontBoldFlag As Boolean
    CommandFontItalicFlag As Boolean
    CommandFontUnderlineFlag As Boolean
    CommandFontStrikeThroughFlag As Boolean
End Type
Dim GFMsgBoxFontStructVar As GFMsgBoxFontStruct
'GFMsgBox_RequestMsg
Dim MsgBoxInputText As String 'text that was entered
Dim MsgBoxCommandIndex As Integer 'command that was pressed
Dim GFMsgBoxSkinningEnabledFlag As Boolean 'if palette number is valid
Dim GFMsgBoxPaletteNumber As Integer 'number of external palette reserved for GFMsgBoxfrm (set if skinning was enabled only)
'other
Dim GFMsgBoxMode As Integer
Dim ContinueFlag As Boolean 'set to True if any button is pressed

Private Sub Form_Load()
    'on error resume next
    Call DefineStatus
    Call MsgBoxFont_Restore 'see also Form_Unload()
End Sub

Private Sub DefineStatus()
    'on error resume next
    MsgBoxLabel.UseMnemonic = False
End Sub

'************************************INTERFACE SUBS*************************************

Public Sub GFMsgBox_EnableSkinning(ByVal PaletteNumber As Integer) 'use only when GFSkinEngine available
    'on error resume next 'pass number of external palette reserved for GFMsgBoxfrm
    '
    'NOTE: skinning a GFMsgBox does not work correctly, so don't do it.
    'As GFMsgBoxfrm is shown in vbModal state many errors occur when
    'the user tries to change the appearance of the window.
    '
    GFMsgBoxSkinningEnabledFlag = True
    GFMsgBoxPaletteNumber = PaletteNumber
End Sub

'***FONT (GENERAL)***

Public Sub GFMsgBox_SetFont(ByVal FontName As String, ByVal FontSize As Long, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean)
    'on error resume next 'can be optionally be used by GFSkinEngine
    '
    'NOTE: this sub is implemented as 'representative' of the VB control .Font property.
    'The target project can also manually call one of the following subs to
    'set the GFMsgBox font more detailed (one font setting for every control class).
    '
    Call GFMsgBox_SetLabelFont(FontName, FontSize, FontBoldFlag, FontItalicFlag, FontUnderlineFlag, FontStrikeThroughFlag)
    Call GFMsgBox_SetTextBoxFont(FontName, FontSize, FontBoldFlag, FontItalicFlag, FontUnderlineFlag, FontStrikeThroughFlag)
    Call GFMsgBox_SetCommandFont(FontName, FontSize, FontBoldFlag, FontItalicFlag, FontUnderlineFlag, FontStrikeThroughFlag)
    '
End Sub

'***END OF FONT (GENERAL)***
'***LABEL FONT***

Public Sub GFMsgBox_SetLabelFont(ByVal FontName As String, ByVal FontSize As Long, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean)
    'on error resume next
    MsgBoxLabel.Font.Name = FontName
    MsgBoxLabel.Font.Size = FontSize
    MsgBoxLabel.Font.Bold = FontBoldFlag
    MsgBoxLabel.Font.Italic = FontItalicFlag
    MsgBoxLabel.Font.Underline = FontUnderlineFlag
    MsgBoxLabel.Font.StrikeThrough = FontStrikeThroughFlag
End Sub

Public Sub GFMsgBox_GetLabelFont(ByRef FontName As String, ByRef FontSize As Long, ByRef FontBoldFlag As Boolean, ByRef FontItalicFlag As Boolean, ByRef FontUnderlineFlag As Boolean, ByRef FontStrikeThroughFlag As Boolean)
    'on error resume next
    FontName = MsgBoxLabel.Font.Name
    FontSize = MsgBoxLabel.Font.Size
    FontBoldFlag = MsgBoxLabel.Font.Bold
    FontItalicFlag = MsgBoxLabel.Font.Italic
    FontUnderlineFlag = MsgBoxLabel.Font.Underline
    FontStrikeThroughFlag = MsgBoxLabel.Font.StrikeThrough
End Sub

'***END OF LABEL FONT***
'***TEXT BOX FONT***

Public Sub GFMsgBox_SetTextBoxFont(ByVal FontName As String, ByVal FontSize As Long, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean)
    'on error resume next
    MsgBoxText.Font.Name = FontName
    MsgBoxText.Font.Size = FontSize
    MsgBoxText.Font.Bold = FontBoldFlag
    MsgBoxText.Font.Italic = FontItalicFlag
    MsgBoxText.Font.Underline = FontUnderlineFlag
    MsgBoxText.Font.StrikeThrough = FontStrikeThroughFlag
End Sub

Public Sub GFMsgBox_GetTextBoxFont(ByRef FontName As String, ByRef FontSize As Long, ByRef FontBoldFlag As Boolean, ByRef FontItalicFlag As Boolean, ByRef FontUnderlineFlag As Boolean, ByRef FontStrikeThroughFlag As Boolean)
    'on error resume next
    FontName = MsgBoxText.Font.Name
    FontSize = MsgBoxText.Font.Size
    FontBoldFlag = MsgBoxText.Font.Bold
    FontItalicFlag = MsgBoxText.Font.Italic
    FontUnderlineFlag = MsgBoxText.Font.Underline
    FontStrikeThroughFlag = MsgBoxText.Font.StrikeThrough
End Sub

'***END OF TEXT BOX FONT***
'***COMMAND FONT***

Public Sub GFMsgBox_SetCommandFont(ByVal FontName As String, ByVal FontSize As Long, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean)
    'on error resume next
    'NOTE: new command instances will have this font setting, too.
    MsgBoxCommand(0).Font.Name = FontName
    MsgBoxCommand(0).Font.Size = FontSize
    MsgBoxCommand(0).Font.Bold = FontBoldFlag
    MsgBoxCommand(0).Font.Italic = FontItalicFlag
    MsgBoxCommand(0).Font.Underline = FontUnderlineFlag
    MsgBoxCommand(0).Font.StrikeThrough = FontStrikeThroughFlag
End Sub

Public Sub GFMsgBox_GetCommandFont(ByRef FontName As String, ByRef FontSize As Long, ByRef FontBoldFlag As Boolean, ByRef FontItalicFlag As Boolean, ByRef FontUnderlineFlag As Boolean, ByRef FontStrikeThroughFlag As Boolean)
    'on error resume next
    'NOTE: new command instances will have this font setting, too.
    FontName = MsgBoxCommand(0).Font.Name
    FontSize = MsgBoxCommand(0).Font.Size
    FontBoldFlag = MsgBoxCommand(0).Font.Bold
    FontItalicFlag = MsgBoxCommand(0).Font.Italic
    FontUnderlineFlag = MsgBoxCommand(0).Font.Underline
    FontStrikeThroughFlag = MsgBoxCommand(0).Font.StrikeThrough
End Sub

'***END OF COMMAND FONT***
'***COLOR***

Public Sub GFMsgBox_SetForeColor(ByVal ForeColor As Long)
    'on error resume next 'can be optionally be used by GFSkinEngine; Windows‑colors allowed
    MsgBoxLabel.ForeColor = ForeColor
    'MsgBoxCommand(0).ForeColor = ForeColor 'not possible
    GFMsgBoxfrm.ForeColor = ForeColor
End Sub

Public Sub GFMsgBox_SetBackColor(ByVal BackColor As Long)
    'on error resume next 'can be optionally be used by GFSkinEngine; Windows‑colors allowed
    MsgBoxLabel.BackColor = BackColor
    'MsgBoxCommand(0).BackColor = BackColor 'not possible
    GFMsgBoxfrm.BackColor = BackColor
End Sub

'***END OF COLOR***

Public Sub GFMsgBox_PrepareMsg(ByVal Prompt As String, ByVal Buttons As VbMsgBoxStyle, ByVal Title As String, ByVal CustomButtonNumber As Integer, ByRef CustomButtonCaptionArray() As String)
    'on error resume next 'call before displaying GFMsgBoxfrm
    GFMsgBoxMode = GFMSGBOXMODE_MSGBOX
    MsgBoxCommandIndex = 0 'reset
    Call GFMsgBox_PrepareMsgSub(Prompt, Buttons, Title, CustomButtonNumber, CustomButtonCaptionArray(), False, "", False)
End Sub

Public Sub GFInputBox_PrepareMsg(ByVal Prompt As String, ByVal Buttons As VbMsgBoxStyle, ByVal Title As String, ByVal CustomButtonNumber As Integer, ByRef CustomButtonCaptionArray() As String, ByVal InputTextDefault As String, Optional ByVal InputTextPasswordCharEnabledFlag As Boolean = False)
    'on error resume next 'call before displaying GFMsgBoxfrm
    GFMsgBoxMode = GFMSGBOXMODE_INPUTBOX
    MsgBoxCommandIndex = 0 'reset
    Call GFMsgBox_PrepareMsgSub(Prompt, Buttons, Title, CustomButtonNumber, CustomButtonCaptionArray(), True, InputTextDefault, InputTextPasswordCharEnabledFlag)
End Sub

Public Sub GFMsgBox_OnTop()
    'on error resume next 'call before displaying GFMsgBoxfrm
    Call GFSetWindowOnTop(Me) 'works also if not enabled/visible
End Sub

Public Sub GFMsgBox_Show()
    'on error resume next
    'reset
    ContinueFlag = False
    'begin
    Me.Enabled = True
    Me.Visible = True
    Me.Refresh
    Select Case GFMsgBoxMode 'perform special actions
    Case GFMSGBOXMODE_INPUTBOX
        MsgBoxText.SetFocus
    End Select
    Do
        Call Sleep(10) 'minimize CPU usage in loop
        DoEvents 'after sleep to avoid window trash when closing form
    Loop Until ContinueFlag = True
    Me.Visible = False
    Me.Enabled = False
    Me.Refresh
End Sub

Public Sub GFMsgBox_FromTop()
    'on error resume next 'call after hiding GFMsgBoxfrm
    Call GFRemoveWindowFromTop(Me)
End Sub

Public Function GFMsgBox_RequestMsg() As Integer
    'on error resume next
    '
    'NOTE: call this sub after hiding GFMsgBoxfrm to retrieve
    'the index of the command the user pressed.
    '
    GFMsgBox_RequestMsg = MsgBoxCommandIndex
    '
    #If GFSkinEngineAvailableFlag = True Then
        If GFMsgBoxSkinningEnabledFlag = True Then
            Call SE_UnloadPalette(GFMsgBoxPaletteNumber)
        End If
    #End If
End Function

Public Function GFMsgBox_RequestInputText() As String
    'on error resume next
    '
    'NOTE: call this sub after hiding GFMsgBoxfrm to retrieve
    'the text the user has entered.
    '
    GFMsgBox_RequestInputText = MsgBoxInputText
    '
    #If GFSkinEngineAvailableFlag = True Then
        If GFMsgBoxSkinningEnabledFlag = True Then
            Call SE_UnloadPalette(GFMsgBoxPaletteNumber)
        End If
    #End If
End Function

'*********************************END OF INTERFACE SUBS*********************************
'************************************CONTROL EVENTS*************************************

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'on error resume next
    #If GFSkinEngineAvailableFlag = True Then
        If Button = vbRightButton Then
            Call SE_OpenFormMenu("GFMsgBoxfrm", GFMsgBoxfrm)
        End If
    #End If
End Sub

Private Sub MsgBoxText_Change()
    'on error resume next
    MsgBoxInputText = MsgBoxText.TEXT
End Sub

Private Sub MsgBoxCommand_Click(Index As Integer)
    'on error resume next
    MsgBoxCommandIndex = Index '1 based
    ContinueFlag = True 'close box if any command is pressed
End Sub

'*********************************END OF CONTROL EVENTS*********************************
'*****************************************OTHER*****************************************

Private Sub GFMsgBox_PrepareMsgSub(ByVal Prompt As String, ByVal Buttons As VbMsgBoxStyle, ByVal Title As String, ByVal CustomButtonNumber As Integer, ByRef CustomButtonCaptionArray() As String, ByVal InputTextUsedFlag As Boolean, ByVal InputText As String, ByVal InputTextPasswordCharEnabledFlag As Boolean)
    'on error resume next
    Dim MsgBoxCommandWidthTotal As Long
    'begin
    Call GFMsgBox_PrepareMsgSub_EnableSkinning
    Call GFMsgBox_PrepareMsgSub_DisplayLabel(Prompt, InputTextUsedFlag)
    Call GFMsgBox_PrepareMsgSub_DisplayImages(Buttons)
    Call GFMsgBox_PrepareMsgSub_DisplayInputText(InputText, InputTextUsedFlag, InputTextPasswordCharEnabledFlag, MsgBoxLabel)
    Call GFMsgBox_PrepareMsgSub_DisplayCommands(CustomButtonNumber, CustomButtonCaptionArray(), InputTextUsedFlag, MsgBoxCommandWidthTotal, MsgBoxLabel)
    Call GFMsgBox_PrepareMsgSub_MoveForm(Title, MsgBoxCommandWidthTotal, MsgBoxLabel, MsgBoxCommand)
    Call GFMsgBox_PrepareMsgSub_MoveCommands(CustomButtonNumber, CustomButtonCaptionArray(), MsgBoxCommandWidthTotal, MsgBoxLabel, MsgBoxCommand)
End Sub

Private Sub GFMsgBox_PrepareMsgSub_EnableSkinning()
    'on error resume next
    #If GFSkinEngineAvailableFlag = True Then
        '
        'NOTE: the GFMsgBox project can be compiled without the presence
        'of the Skin Engine code.
        '
        If GFMsgBoxSkinningEnabledFlag = True Then
            Call SE_LoadPalette(GFMsgBoxPaletteNumber, True)
        End If
    #End If
End Sub

Private Sub GFMsgBox_PrepareMsgSub_DisplayLabel(ByVal Prompt As String, ByVal InputTextUsedFlag As Boolean)
    'on error resume next
    Dim LineWidthMax As Long 'format: twips
    Dim LineNumber As Integer
    Dim LineArray() As String
    Dim Temp As Long
    Dim Tempstr$
    'preset
    Set MsgBoxTextWidthPicture.Font = MsgBoxLabel.Font 'important: use 'Set' or only one font name will be transferred
    LineWidthMax = (Screen.Width ‑ 110 * Screen.TwipsPerPixelX)
    Call GFGetLineArrayThroughLineWidth(Prompt, LineWidthMax ‑ 750, 750, " ", LineArray(), LineNumber, MsgBoxTextWidthPicture)
    MsgBoxLabel.Width = MsgBoxTextWidthPicture.TextWidth(Prompt) 'returns length of longest line
    'begin
    If InputTextUsedFlag = True Then
        If MsgBoxLabel.Width < 175 * Screen.TwipsPerPixelX Then MsgBoxLabel.Width = 175 * Screen.TwipsPerPixelX 'minimum to make stuff look good (text box will have that width)
    End If
    If 0 = 0 Then
        If MsgBoxLabel.Width > (Screen.Width ‑ 100 * Screen.TwipsPerPixelX) Then MsgBoxLabel.Width = LineWidthMax
    End If
    For Temp = 1 To LineNumber
        If Not (Temp = LineNumber) Then
            Tempstr$ = Tempstr$ + LineArray(Temp) + Chr$(13) + Chr$(10)
        Else
            Tempstr$ = Tempstr$ + LineArray(Temp)
        End If
    Next Temp
    MsgBoxLabel.Caption = Tempstr$
    MsgBoxLabel.Height = LineNumber * MsgBoxTextWidthPicture.TextHeight(Chr$(32))
End Sub

Private Sub GFMsgBox_PrepareMsgSub_DisplayImages(ByVal Buttons As Integer)
    'on error resume next
    If (Buttons And vbQuestion) = vbQuestion Then
        MsgBoxQuestionImage.Visible = True
    Else
        MsgBoxQuestionImage.Visible = False
    End If
    If (Buttons And vbExclamation) = vbExclamation Then
        MsgBoxExclamationImage.Visible = True
    Else
        MsgBoxExclamationImage.Visible = False
    End If
    If (Buttons And vbCritical) = vbCritical Then
        MsgBoxCriticalImage.Visible = True
    Else
        MsgBoxCriticalImage.Visible = False
    End If
    If (Buttons And vbInformation) = vbInformation Then
        MsgBoxInformationImage.Visible = True
    Else
        MsgBoxInformationImage.Visible = False
    End If
End Sub

Private Sub GFMsgBox_PrepareMsgSub_DisplayInputText(ByVal InputText As String, ByVal InputTextUsedFlag As Boolean, ByVal InputTextPasswordCharEnabledFlag As Boolean, ByRef MsgBoxLabel As Label)
    'on error resume next
    Set MsgBoxTextWidthPicture.Font = MsgBoxText.Font
    If InputTextUsedFlag = True Then
        MsgBoxText.TEXT = InputText
        MsgBoxText.Width = MsgBoxLabel.Width
        MsgBoxText.Left = MsgBoxLabel.Left
        MsgBoxText.Top = MsgBoxLabel.Top + MsgBoxLabel.Height + 20 * Screen.TwipsPerPixelY
        If InputTextPasswordCharEnabledFlag = False Then
            MsgBoxText.PasswordChar = ""
        Else
            MsgBoxText.PasswordChar = "?" 'looks better than '*'
        End If
        MsgBoxText.Enabled = True
        MsgBoxText.Visible = True
        MsgBoxText.SelStart = 0
        MsgBoxText.SelLength = Len(MsgBoxText.TEXT)
    Else
        MsgBoxText.Visible = False
    End If
End Sub

Private Sub GFMsgBox_PrepareMsgSub_DisplayCommands(ByVal CustomButtonNumber As Integer, ByRef CustomButtonCaptionArray() As String, ByVal InputTextUsedFlag As Boolean, ByRef MsgBoxCommandWidthTotal As Long, ByRef MsgBoxLabel As Label)
    'on error resume next
    Dim Temp As Long
    'reset
    For Temp = 1 To MsgBoxCommand.UBound
        Unload MsgBoxCommand(Temp)
    Next Temp
    'begin
    For Temp = 1 To CustomButtonNumber
        Load MsgBoxCommand(Temp) 'MsgBoxCommand(0) will not be displayed
        Set MsgBoxTextWidthPicture.Font = MsgBoxCommand(Temp).Font
        MsgBoxCommand(Temp).Width = MsgBoxTextWidthPicture.TextWidth(CustomButtonCaptionArray(Temp)) + 32 * Screen.TwipsPerPixelX
        If InputTextUsedFlag = False Then
            MsgBoxCommand(Temp).Top = MsgBoxLabel.Top + MsgBoxLabel.Height + 20 * Screen.TwipsPerPixelX
            MsgBoxCommand(Temp).Default = False
            MsgBoxCommand(Temp).Cancel = False
        Else
            MsgBoxCommand(Temp).Top = MsgBoxLabel.Top + MsgBoxLabel.Height + MsgBoxText.Height + 40 * Screen.TwipsPerPixelX
            Select Case Temp
            Case 1 'the first command has Default = true set by default
                MsgBoxCommand(Temp).Default = True
                MsgBoxCommand(Temp).Cancel = False
            Case 2 'the second command has Cancel = True set by default
                MsgBoxCommand(Temp).Default = False
                MsgBoxCommand(Temp).Cancel = True
            Case Else
                MsgBoxCommand(Temp).Default = False
                MsgBoxCommand(Temp).Cancel = False
            End Select
        End If
        MsgBoxCommand(Temp).Caption = CustomButtonCaptionArray(Temp)
        MsgBoxCommandWidthTotal = MsgBoxCommandWidthTotal + _
            MsgBoxCommand(Temp).Width + 20 * Screen.TwipsPerPixelX
    Next Temp
End Sub

Private Sub GFMsgBox_PrepareMsgSub_MoveForm(ByVal Title As String, ByVal MsgBoxCommandWidthTotal As Long, ByRef MsgBoxLabel As Label, ByRef MsgBoxCommand As Object)
    'on error resume next
    'begin; size for
    GFMsgBoxfrm.Width = MAX( _
        MsgBoxLabel.Left + MsgBoxLabel.Width + 35 * Screen.TwipsPerPixelX, _
        MsgBoxCommandWidthTotal + 20 * Screen.TwipsPerPixelX)
    GFMsgBoxfrm.Height = MsgBoxCommand(1).Top + MsgBoxCommand(1).Height + 50 * Screen.TwipsPerPixelY 'there is always at least one button
    If Not (Len(Title) = 0) Then
        GFMsgBoxfrm.Caption = Title
    Else
        GFMsgBoxfrm.Caption = App.Title
    End If
    'center form
    GFMsgBoxfrm.Left = Screen.Width / 2 ‑ GFMsgBoxfrm.Width / 2
    GFMsgBoxfrm.Top = Screen.Height / 2 ‑ GFMsgBoxfrm.Height / 2
End Sub

Private Sub GFMsgBox_PrepareMsgSub_MoveCommands(ByVal CustomButtonNumber As Integer, ByRef CostomButtonCaptionArray() As String, ByRef MsgBoxCommandWidthTotal As Long, ByRef MsgBoxLabel As Label, ByRef MsgBoxCommand As Object)
    'on error resume next
    Dim MsgBoxCommandRowLeft As Long
    Dim Temp As Long
    'preset
    MsgBoxCommandRowLeft = (GFMsgBoxfrm.ScaleWidth / 2) ‑ (MsgBoxCommandWidthTotal / 2)
    MsgBoxCommandRowLeft = MsgBoxCommandRowLeft + 10 * Screen.TwipsPerPixelX 'add half of the space between the command buttons to center them correctly
    'reset
    MsgBoxCommandWidthTotal = 0 'reset
    'begin
    For Temp = 1 To CustomButtonNumber
        MsgBoxCommand(Temp).Left = MsgBoxCommandRowLeft + MsgBoxCommandWidthTotal
        MsgBoxCommandWidthTotal = MsgBoxCommandWidthTotal + _
            MsgBoxCommand(Temp).Width + 20 * Screen.TwipsPerPixelX
        MsgBoxCommand(Temp).Visible = True
    Next Temp
End Sub

Private Sub MsgBoxFont_Save()
    'on error resume next
    '
    'NOTE: because of Show vbModal the control's font is reset when
    'the GFMsgBoxfrm is closed as it must be unloaded.
    'Through the MsgBoxFont subs the current control's font is retained.
    '
    GFMsgBoxFontStructVar.LabelFontName = MsgBoxLabel.Font.Name
    GFMsgBoxFontStructVar.LabelFontSize = MsgBoxLabel.Font.Size
    GFMsgBoxFontStructVar.LabelFontBoldFlag = MsgBoxLabel.Font.Bold
    GFMsgBoxFontStructVar.LabelFontItalicFlag = MsgBoxLabel.Font.Italic
    GFMsgBoxFontStructVar.LabelFontUnderlineFlag = MsgBoxLabel.Font.Underline
    GFMsgBoxFontStructVar.LabelFontStrikeThroughFlag = MsgBoxLabel.Font.StrikeThrough
    GFMsgBoxFontStructVar.TextFontName = MsgBoxText.Font.Name
    GFMsgBoxFontStructVar.TextFontSize = MsgBoxText.Font.Size
    GFMsgBoxFontStructVar.TextFontBoldFlag = MsgBoxText.Font.Bold
    GFMsgBoxFontStructVar.TextFontItalicFlag = MsgBoxText.Font.Italic
    GFMsgBoxFontStructVar.TextFontUnderlineFlag = MsgBoxText.Font.Underline
    GFMsgBoxFontStructVar.TextFontStrikeThroughFlag = MsgBoxText.Font.StrikeThrough
    GFMsgBoxFontStructVar.CommandFontName = MsgBoxCommand(0).Font.Name
    GFMsgBoxFontStructVar.CommandFontSize = MsgBoxCommand(0).Font.Size
    GFMsgBoxFontStructVar.CommandFontBoldFlag = MsgBoxCommand(0).Font.Bold
    GFMsgBoxFontStructVar.CommandFontItalicFlag = MsgBoxCommand(0).Font.Italic
    GFMsgBoxFontStructVar.CommandFontUnderlineFlag = MsgBoxCommand(0).Font.Underline
    GFMsgBoxFontStructVar.CommandFontStrikeThroughFlag = MsgBoxCommand(0).Font.StrikeThrough
    '
    GFMsgBoxFontStructVar.FontSavedFlag = True
    '
End Sub

Private Sub MsgBoxFont_Restore()
    'on error resume next
    '
    'NOTE: because of Show vbModal the control's font is reset when
    'the GFMsgBoxfrm is closed as it must be unloaded.
    'By the MsgBoxFont subs the current control's font is determined.
    '
    'begin
    If GFMsgBoxFontStructVar.FontSavedFlag = True Then 'verify
        Call GFMsgBox_SetLabelFont( _
            GFMsgBoxFontStructVar.LabelFontName, _
            GFMsgBoxFontStructVar.LabelFontSize, _
            GFMsgBoxFontStructVar.LabelFontBoldFlag, _
            GFMsgBoxFontStructVar.LabelFontItalicFlag, _
            GFMsgBoxFontStructVar.LabelFontUnderlineFlag, _
            GFMsgBoxFontStructVar.LabelFontStrikeThroughFlag)
        Call GFMsgBox_SetTextBoxFont( _
            GFMsgBoxFontStructVar.TextFontName, _
            GFMsgBoxFontStructVar.TextFontSize, _
            GFMsgBoxFontStructVar.TextFontBoldFlag, _
            GFMsgBoxFontStructVar.TextFontItalicFlag, _
            GFMsgBoxFontStructVar.TextFontUnderlineFlag, _
            GFMsgBoxFontStructVar.TextFontStrikeThroughFlag)
        Call GFMsgBox_SetCommandFont( _
            GFMsgBoxFontStructVar.CommandFontName, _
            GFMsgBoxFontStructVar.CommandFontSize, _
            GFMsgBoxFontStructVar.CommandFontBoldFlag, _
            GFMsgBoxFontStructVar.CommandFontItalicFlag, _
            GFMsgBoxFontStructVar.CommandFontUnderlineFlag, _
            GFMsgBoxFontStructVar.CommandFontStrikeThroughFlag)
    End If
End Sub

'*************************************END OF OTHER**************************************
'***********************************GENERAL FUNCTIONS***********************************

Public Function GFSetWindowOnTop(ByVal WindowOrFormName As Form) As Long
    'On Error Resume Next
    GFSetWindowOnTop = SetWindowPos(WindowOrFormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
    WindowOrFormName.Refresh
End Function

Public Function GFRemoveWindowFromTop(ByVal WindowOrFormName As Form) As Long
    'On Error Resume Next
    GFRemoveWindowFromTop = SetWindowPos(WindowOrFormName.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
    WindowOrFormName.Refresh
End Function

Private Function GFGetLineArrayThroughLineWidth(ByVal InputString As String, ByVal LineWidthMax As Long, ByVal LineWidthOverflowMax As Long, ByVal LineBorderChar As String, ByRef LineArray() As String, ByRef LineNumber As Integer, ByRef LineWidthPicture As PictureBox) As Boolean
    'on error resume next 'format: twips; use as general function to create a text block with defined width; function returns True for success or False for error
    Dim Temp As Long
    'preset
    LineNumber = 0
    ReDim LineArray(1 To 1) As String
    'verify
    If Not (Len(LineBorderChar) = 1) Then
        GoTo Error:
    End If
    If InputString = "" Then
        GFGetLineArrayThroughLineWidth = True 'ok
        Exit Function
    End If
    'begin
    Temp = 0 'reset
    Do
        Temp = Temp + 1
        If Mid$(InputString, Temp, 2) = Chr$(13) + Chr$(10) Then
            If Not (LineNumber = 32766) Then 'verify
                LineNumber = LineNumber + 1
            Else
                GoTo Error:
            End If
            ReDim Preserve LineArray(1 To LineNumber) As String
            LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
            InputString = Right$(InputString, Len(InputString) ‑ Temp ‑ 1)
            Temp = 0 'reset
        Else
            If Mid$(InputString, Temp, 1) = LineBorderChar Then
                Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
                Case Is < LineWidthMax
                    'do nothing
                Case Is >= LineWidthMax
                    If Not (LineNumber = 32766) Then 'verify
                        LineNumber = LineNumber + 1
                    Else
                        GoTo Error:
                    End If
                    ReDim Preserve LineArray(1 To LineNumber) As String
                    LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
                    InputString = Right$(InputString, Len(InputString) ‑ Temp + 0)
                    Temp = 0 'reset
                End Select
            Else
                Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
                Case Is < LineWidthMax
                    'do nothing
                Case Is >= (LineWidthMax + LineWidthOverflowMax)
                    If Not (LineNumber = 32766) Then 'verify
                        LineNumber = LineNumber + 1
                    Else
                        GoTo Error:
                    End If
                    ReDim Preserve LineArray(1 To LineNumber) As String
                    LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
                    InputString = Right$(InputString, Len(InputString) ‑ Temp + 1)
                    Temp = 0 'reset
                End Select
            End If
        End If
        If Temp = Len(InputString) Then
            If Not (LineNumber = 32766) Then 'verify
                    LineNumber = LineNumber + 1
                Else
                    GoTo Error:
                End If
            ReDim Preserve LineArray(1 To LineNumber) As String
            LineArray(LineNumber) = InputString
            Exit Do
        End If
    Loop
    GFGetLineArrayThroughLineWidth = True 'ok
    Exit Function
Error:
    MsgBox "internal error in GFGetLineArrayThroughLineWidth() !", vbOKOnly + vbExclamation
    GFGetLineArrayThroughLineWidth = False 'error
    Exit Function
End Function

Private Function MAX(ByVal Value1 As Long, ByVal Value2 As Long) As Long
    'on error resume next
    If Value1 > Value2 Then
        MAX = Value1
    Else
        MAX = Value2
    End If
End Function

Private Sub Form_Unload(Cancel As Integer)
    'on error resume next
    Select Case GFMsgBoxMode
    Case GFMSGBOXMODE_MSGBOX
        If MsgBoxCommandIndex = 0 Then 'X button was pressed
            Cancel = True
            Exit Sub
        End If
    Case GFMSGBOXMODE_INPUTBOX
        If MsgBoxCommandIndex = 0 Then 'X button was pressed
            Call MsgBoxCommand_Click(2) '2nd command is always the 'Cancel' command
            'Cancel = True 'no (recursive call)
            'Exit Sub 'no (recursive call)
        End If
    End Select
    Call MsgBoxFont_Save 'also see Form_Load
    Exit Sub
End Sub


[END OF FILE]