Attribute VB_Name = "basFormTemplate"
'*******************************************************************************
' Project   : Utilities
'             Copyright © 2000
' Module    : basFormTemplate
' DateTime  : 5/21/2004 08:54
' Author    : Bill Mosca
' Purpose   : Set up Defaults for form controls.
' Note: Form must be open in design view.
' Index     :(Updated on 3/10/2006)
' SetDefaultsTheme - Set values for form & default controls.
' SetDefaultsSys - Set form & default controls to system colors.
' FixAllForms - Run ConvertLabelOnTabPage() for ALL forms in this database.
' ConvertLabelOnTabPage - Change unattached labels on pages of tab control into text boxes.
' ParentIsTabPage - Part of ConvertLabelOnTabPage()
'*******************************************************************************

Option Compare Database
Option Explicit

'Set these colors for database color theme.
Private Enum eFormTmpltColors
    THEME_COLOR = 1462991
    TXTBOX_BACK = 16777215
    FORM_BACK = 16053492
    FORM_HEADER = 1462991
    LBL_BACK = 16053492
    FORE_COLOR = 1462991
    HIGHLITE_FONT = 8454143
    HIGHLITE_BACK = 14933984
    BORDER = 1462991
End Enum

'Available system colors
Private Enum eSysColors
    Scroll_Bar = -2147483648#
    Desktop = -2147483647
    Active_Window_Title_Bar = -2147483646
    Inactive_Window_Title_Bar = -2147483645
    Menu_Bar = -2147483644
    Window = -2147483643
    Window_Frame = -2147483642
    Menu_Text = -2147483641
    Window_Text = -2147483640
    Title_Bar_Text = -2147483639
    Active_Window_Border = 2147483638
    Inactive_Window_Border = -2147483637
    Application_Background = 2147483636
    HIGHLIGHT = -2147483635
    Highlight_Text = -2147483634
    ThreeD_Face = -2147483633
    ThreeD_Shadow = 2147483632
    Dimmed_Text = -2147483631
    Button_Text = -2147483630
    Inactive_Window_Title_Bar_Text = -2147483629
    ThreeD_Highlight = -2147483628
    ThreeD_Dark_Shadow = -2147483627
    ThreeD_Light = -2147483626
    ToolTip_Text = -2147483625
    ToolTip_Background = -2147483624
End Enum

'List of fonts used.
Private Const pstrFont1 = "Tahoma"
Private Const pstrFont2 = "Times New Roman"

Private Enum eFontWt
    THIN = 100
    EXTRA_LIGHT = 200
    LIGHT = 300
    NORMAL = 400
    MEDIUM = 500
    SEMI_BOLD = 600
    EXTRA_BOLD = 800
    HEAVY = 900
End Enum

Public Sub ApplySettings(strForm As String)
    Dim frm As Form

    DoCmd.OpenForm strForm, acDesign

    Set frm = Forms(strForm)
    Call SetDefaultsTheme(frm)
    DoCmd.Close acForm, frm.Name, acSaveYes
    Set frm = Nothing

End Sub

Public Sub SetDefaultsTheme(frm As Form)
'Purpose  : Set values for form & default controls.
'           Form must be open in Design View.
'DateTime : 5/21/2004 10:31
'Author   : Bill Mosca

'    On Error Resume Next

    With frm
        .Section(acDetail).BackColor = eFormTmpltColors.FORM_BACK
        .Section(acHeader).BackColor = eFormTmpltColors.FORM_HEADER
        .Section(acFooter).BackColor = eFormTmpltColors.FORM_BACK
        .ScrollBars = 0        '0=neither;1=Horizontal;2=Vertical;3=Both
        .RecordSelectors = False
        .NavigationButtons = False
        .DividingLines = False
        .AutoResize = True
        .AutoCenter = True
        .AllowDesignChanges = False

    End With

    With frm.DefaultControl(acTextBox)
        .ForeColor = eFormTmpltColors.FORE_COLOR
        .FontName = pstrFont1
        .Height = 0.1979 * 1440
        .FontSize = 10
    End With

    With frm.DefaultControl(acLabel)
        .ForeColor = eFormTmpltColors.FORE_COLOR
        .FontName = pstrFont1
        .Height = 0.1979 * 1440
        .FontSize = 10
        '        .BackStyle = 0  'Transparent
        .BackStyle = 1        'Normal
        .BackColor = eFormTmpltColors.LBL_BACK
        .BorderStyle = 1        'Solid
        .BorderColor = eFormTmpltColors.BORDER
        .BorderWidth = 0
        .TextAlign = 2        '0=General;1=Left;2=Center;3=Right

    End With

    With frm.DefaultControl(acComboBox)
        .ForeColor = eFormTmpltColors.THEME_COLOR
        .FontName = pstrFont1
        .Height = 0.1979 * 1440
        .FontSize = 10
    End With

    With frm.DefaultControl(acListBox)
        .ForeColor = eFormTmpltColors.THEME_COLOR
        .FontName = pstrFont1
        .FontSize = 10
    End With

    With frm.DefaultControl(acOptionGroup)
        .BorderStyle = acEffectEtched        'Etched overrides all other border settings
        .BorderColor = 0
        .BorderWidth = 0
    End With

    With frm.DefaultControl(acCheckBox)
        .BorderStyle = acEffectSunken
        .BorderColor = 0
        .BorderWidth = 0
    End With


End Sub

Public Sub SetDefaultsSys(frm As Form)
'Purpose  : Set form & default controls to system colors.
'           Form must be open in Design View.
'DateTime : 5/21/2004 10:32
'Author   : Bill Mosca

    On Error Resume Next

    With frm
        .Section(0).BackColor = eSysColors.ThreeD_Face        'Detail
        .Section(1).BackColor = eSysColors.ThreeD_Face        'Header
        .Section(2).BackColor = eSysColors.ThreeD_Face        'Footer
        .ScrollBars = 0        '0=neither;1=Horizontal;2=Vertical;3=Both
        .RecordSelectors = False
        .NavigationButtons = False
        .DividingLines = False
        .AutoResize = True
        .AutoCenter = True
        .AllowDesignChanges = False
    End With

    With frm.DefaultControl(acTextBox)
        .ForeColor = eSysColors.Window_Text
    End With

    With frm.DefaultControl(acLabel)
        .ForeColor = eSysColors.Window_Text
        .BackStyle = 0        'Transparent
    End With

    With frm.DefaultControl(acComboBox)
        .ForeColor = eSysColors.Window_Text
    End With

    With frm.DefaultControl(acListBox)
        .ForeColor = eSysColors.Window_Text
    End With

    DoCmd.Save acForm, frm.Name

End Sub

Function FixAllForms()
'Purpose  : Run ConvertLabelOnTabPage() for ALL forms in this database.
'           Warning:   Saves changes without confirmation.
'Author   : Allen Browne (allenbrowne.com)

    Dim accobj As AccessObject
    For Each accobj In CurrentProject.AllForms
        Call ConvertLabelOnTabPage(accobj.Name, True, True)
    Next
End Function

Function ConvertLabelOnTabPage(strFormName As String, _
        Optional bSaveAndClose As Boolean, Optional bHidden As Boolean)
'Purpose  : Change unattached labels on pages of tab control into text boxes.
'           Avoids flicker bug under Windows XP themes.
'Author   : Allen Browne (allenbrowne.com)
    Dim frm As Form
    Dim ctl As Control
    Dim strName As String
    Dim strCaption As String
    Dim bytBackStyle As Byte
    Dim bChanged As Boolean
    Const strcQuote = """"

    'Open the form in design view
    DoCmd.OpenForm strFormName, acDesign, _
            WindowMode:=IIf(bHidden, acHidden, acWindowNormal)
    Set frm = Forms(strFormName)

    'Find the labels whose parent is a tab page.
    For Each ctl In frm.Controls
        If ctl.ControlType = acLabel Then
            If ParentIsTabPage(ctl) Then
                bChanged = True
                strName = ctl.Name        'ctl reference will be lost.
                strCaption = ctl.Caption        'For ControlSource.
                bytBackStyle = ctl.BackStyle        'Access doesn't set this.
Debug.Print strFormName & "." & strName
                'Convert it to a text box.
                ctl.ControlType = acTextBox
                'Set the text box properties.
                With frm.Controls(strName)        'ctl is now undefined.
                    .ControlSource = "=" & strcQuote & _
                            Replace(strCaption, strcQuote, strcQuote & strcQuote) & strcQuote
                    .Enabled = False
                    .Locked = True
                    .BackStyle = bytBackStyle
                End With
            End If
        End If
    Next

    Set ctl = Nothing
    Set frm = Nothing
    If Not bChanged Then
        DoCmd.Close acForm, strFormName, acSaveNo
    ElseIf bSaveAndClose Then
        DoCmd.Close acForm, strFormName, acSaveYes
    End If
End Function

Private Function ParentIsTabPage(ctl As Control) As Boolean
'Purpose  : Part of ConvertLabelOnTabPage()
'Author   : Allen Browne (allenbrowne.com)
    On Error Resume Next
    ParentIsTabPage = (ctl.Parent.ControlType = acPage)
End Function

Public Sub ApplyRptToolbar()
'Purpose  : Sets report's menu to "=-1" and toolbar to "tbrPrintRptSnp".
'           Skips report if settings not "".
'DateTime : 11/26/2007 07:47
'Author   : Bill Mosca
    Dim rpt As Object
    Dim rpt2 As Report

    On Error GoTo err_ApplyRptToolbar

    For Each rpt In CurrentProject.AllReports
        DoCmd.OpenReport rpt.Name, acViewDesign
        Set rpt2 = Reports(rpt.Name)
        With rpt2
            If .MenuBar = "" Then
                'Hide default menu
                .MenuBar = "=-1"
            End If
            If .Toolbar = "" Then
                'Set rpt toolbat
                .Toolbar = "tbrPrintRptSnp"
            End If
            DoCmd.Close acReport, .Name
        End With
        Set rpt2 = Nothing
    Next

exit_ApplyRptToolbar:
    On Error Resume Next
    Exit Sub

err_ApplyRptToolbar:
    Dim strErrMsg As String
    Dim lngIconBtn As Long

    Select Case Err.Number
        Case Else
            strErrMsg = "Module: basForm_Report_OnFly" _
                    & vbNewLine _
                    & "Proc: ApplyRptToolbar" _
                    & vbNewLine & vbNewLine _
                    & Err.Number & ": " & Err.Description
    End Select

    If strErrMsg <> "" Then MsgBox strErrMsg, lngIconBtn, _
            GetSummaryInfo("Title")

    Resume exit_ApplyRptToolbar

End Sub