Можно, сказать, последним штрихом к созданию красивого интерфейса становится замена в программе стандартных серых, унылых всплывающих сообщений - MsgBox'ов. Всем бы хотелось раскрасить их в тоновый цвет собственных форм, изменить шрифт, использовать цветные кнопочки, собственные красивые стильные значки для обозначений типов событий, в общем, всем бы хотелось переделать MsgBox по своему вкусу.
Скажу сразу - здесь не рассматривается возможность переделки стандартного MsgBox, я объясню создание собственного MsgBox на основе формы Access. А раз это форма Access - значит, с ней можно делать все что угодно.
Итак, начнем:
Создадим модуль кода mdlMsgBox и вставим в него следующий код:
(конечно, код довольно длинноват, но видели бы Вы оригинал ! ;)
Option Compare Database
Option Explicit
Private mvarResult As Variant ' возвращаемый результат
Private strPrompt As String ' само сообщение
Private lngIconStyle As Long ' стиль иконки
Private strTitle As String ' заголовок
Private intNumberOfButtons As Integer 'количество кнопок в сообщении
Private intDefaultButton As Integer ' номер кнопки по умолчанию
Private strCustomButton1 As String ' для переноса подписи первой кнопки
Private strCustomButton2 As String ' для переноса подписи второй кнопки
Function MBox(ByVal Prompt As String, _
Optional Style As Long, _
Optional Title As String) As Variant
' функция получает параметры обязательный "Сообщение", _
необязательный стиль сообщения, _
необязательный заголовок сообщения
ResetVars ' обязательно сбросим все предыдущие значения переменных
strPrompt = Prompt ' присваиваем переменной строку сообщения
' допускается три вида значков Восклицание, Критический, Информация
' проведем анализ переменной Style и присвоим переменной lngIconStyle значение
If (Style And vbExclamation) = vbExclamation Then
lngIconStyle = vbExclamation
ElseIf (Style And vbCritical) = vbCritical Then
lngIconStyle = vbCritical
ElseIf (Style And vbInformation) = vbInformation Then
lngIconStyle = vbInformation
End If
' особенно хочу обратить внимание на предыдущий абзац кода -
' превосходная идея побитового сравнения двух чисел для выделения нужного !
strTitle = Title ' присваиваем переменной строку заголовка
' используем константы VB MsgBox и согласно им именуем кнопки
' обратите внимание - я использую только 2 кнопки - на практике мне больше не требовалось...
If (Style And vbRetryCancel) = vbRetryCancel Then
strCustomButton1 = "&Повторить"
strCustomButton2 = "&Отменить"
intNumberOfButtons = 2
ElseIf (Style And vbOKCancel) = vbOKCancel Then
strCustomButton1 = "&OK"
strCustomButton2 = "&Отменить"
intNumberOfButtons = 2
ElseIf (Style And vbYesNo) = vbYesNo Then
strCustomButton1 = "&Да"
strCustomButton2 = "&Нет"
intNumberOfButtons = 2
Else ' если вообще никаких констант не задано, тогда просто кнопка ОК
strCustomButton1 = "&OK"
intNumberOfButtons = 1
End If
' анализируем кнопку по умолчанию - вторая или первая ?
If (Style And vbDefaultButton2) = vbDefaultButton2 Then
intDefaultButton = 2
Else
intDefaultButton = 1
End If
' ну и открываем саму форму frmMsgBox - имитатор стандартного MsgBox
DoCmd.OpenForm "frmMsgBox", , , , , acDialog, "MBox" ' открываем форму в режиме диалога
' пока вызываемое диалоговое окно не закроется, дальнейший код не будет выполняться.
' Ждем-ссс выбора пользователя.....
' теперь анализируем возвращенный результат
If IsEmpty(mvarResult) Or IsNull(mvarResult) Then
MBox = 1 ' если ничего нет (хм...), тогда присваиваем функции 1
Else
MBox = mvarResult ' ну тогда функции присваиваем уже возвращенный через Property Let MBoxResult результат
End If
End Function
' а здесь начинаем перечислять процедуры свойств, которая использует наше диалоговое окно
Public Property Get MBoxNumberOfButtons() As Integer
MBoxNumberOfButtons = intNumberOfButtons ' передадим количество кнопок
End Property
Public Property Get MBoxDefaultButton() As Integer
MBoxDefaultButton = intDefaultButton ' передадим кнопку по умолчанию
End Property
Public Property Get MBoxCustomButton1() As String
MBoxCustomButton1 = strCustomButton1 ' передадим подпись первой кнопки
End Property
Public Property Get MBoxCustomButton2() As String
MBoxCustomButton2 = strCustomButton2 ' передадим подпись второй кнопки
End Property
Public Property Get MBoxPrompt() As String
MBoxPrompt = strPrompt ' передадим строку самого сообщения
End Property
Public Property Get MBoxTitle() As String
MBoxTitle = strTitle ' передадим строку заголовка
End Property
Public Property Get MBoxIconStyle() As Long
MBoxIconStyle = lngIconStyle ' передадим стиль иконки
End Property
Public Property Let MBoxResult(varResult As Variant)
' а вот тут-то не передадим, а получим свойство и его обработаем
On Error GoTo 0
If IsObject(varResult) Then
mvarResult = 1 ' по умолчанию присваиваем ОК
ElseIf IsNull(varResult) Then
mvarResult = 1 ' также присвоим ОК
ElseIf IsNumeric(varResult) Then ' ага - здесь числовой код выбранного результата!
mvarResult = CLng(varResult)
End If
End Property
Private Sub ResetVars()
' сбрасываем - переинициализируем все используемые переменные
mvarResult = Empty
strPrompt = vbNullString
strTitle = vbNullString
intDefaultButton = 0
End Sub
Так-с, с модулем разобрались, теперь непосредственно создаем форму frmMsgBox. Я пошел опять же по пути упрощения кода ;) и усиления визуальной сигнализации ;) оригинала.
Размер формы примерно 12х4 см. Это позволяет комфортно размещать текстовый блок высотой 5 строк шрифтом 10 пунктов и кнопки выбора внизу без визуальной тесноты. Справа я положил друг на друга три Рисунка с довольно большими стильными рисунками: Информация, Восклицание, Критический. Тон формы соответствует общей тональности форм приложения. По форме также растянул прямоугольник с бордюром в 2 пункта, который (бордюр) раскрашивается в зависимости от тональности вопроса. Внизу расположил две прозрачные! кнопки и две надписи, которые по размеру точно соответствую кнопкам. Эти надписи также окрашиваются в тон вопроса и будут эмулировать кнопки выбора, а также получение "фокуса". Прозрачные кнопки обязательно нужны (одними надписями не обойтись) и расположены в слое выше, чем надписи - прямо над надписями, т.е. перехватывают все нажатия кнопок на них (Формат -> На передний план). Еще отключите контекстное меню для формы. Остальное объясню по ходу кода формы frmMsgBox:
Option Compare Database
Option Explicit
Private mvarReturn As Variant ' возвращаемое числовое значение
Private mintButtonClicked As Integer ' на какой кнопке кликнули
Private Sub cmdButton1_Click()
' присваиваем переменной номер кнопки и закрываем форму
mintButtonClicked = 1
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub cmdButton2_Click()
mintButtonClicked = 2
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
' Перечисленные ниже четыре процедуры - чистейшие визуальные прибамбасы для выделения
' получения фокуса "кнопок" при нажатии Tab или проведении мышкой, но как красиво! ;)
Private Sub cmdButton1_GotFocus()
Me.lblFakeButton1.FontBold = True
Me.lblFakeButton2.FontBold = False
Me.lblFakeButton1.SpecialEffect = 3 ' плоский
Me.lblFakeButton2.SpecialEffect = 0 ' вдавленный
mintButtonClicked = 1
End Sub
Private Sub cmdButton2_GotFocus()
Me.lblFakeButton1.FontBold = False
Me.lblFakeButton2.FontBold = True
Me.lblFakeButton1.SpecialEffect = 0
Me.lblFakeButton2.SpecialEffect = 3
mintButtonClicked = 2
End Sub
Private Sub cmdButton1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.lblFakeButton1.FontBold = True
Me.lblFakeButton2.FontBold = False
Me.lblFakeButton1.SpecialEffect = 3
Me.lblFakeButton2.SpecialEffect = 0
mintButtonClicked = 1
End Sub
Private Sub cmdButton2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.lblFakeButton1.FontBold = False
Me.lblFakeButton2.FontBold = True
Me.lblFakeButton1.SpecialEffect = 0
Me.lblFakeButton2.SpecialEffect = 3
mintButtonClicked = 2
End Sub
' установим свойство Перехват нажатия клавиш у формы = Да
' для того, чтобы отрабатывал [Enter]
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
DoCmd.Close acForm, Me.Name, acSaveNo
End If
End Sub
Private Sub Form_Close()
On Error Resume Next
Select Case StrConv(Mid$(Me("cmdButton" & mintButtonClicked).Caption, 2), vbLowerCase) 'здесь необходимо срезать первый символ '&' (используется для быстрого выбора)
' проведем анализ подписи и возвратим результат (Public Property Let MBoxResult)
Case "да"
MBoxResult = vbYes
Case "нет"
MBoxResult = vbNo
Case "ok"
MBoxResult = vbOK
Case "отменить"
MBoxResult = vbCancel
Case "повторить"
MBoxResult = vbRetry
End Select
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim intCount As Integer, intNumberOfButtons As Integer
Dim intDefaultButton As Integer
Dim lngFormWidth As Long, lngHalfButton As Long
If Not (StrComp(Me.OpenArgs & vbNullString, "MBox", vbBinaryCompare) = 0) Then
' проведем анализ переданных аргументов, если нет то вообще ничего не откроем ;)
Cancel = True
Exit Sub
End If
'Получим параметры свойств из mdlMsgBox модуля
Me.txtMessage.Value = MBoxPrompt
' укажем подходящую иконку сообщения - изначально рисунки не отображаются
Select Case MBoxIconStyle
Case vbCritical
Me.picCritical.Visible = True
Me.recBorder.BorderColor = RGB(230, 70, 30) ' тут, конечно, используйте свои
Me.lblFakeButton1.BackColor = RGB(230, 70, 30) ' цвета, выдержанные в
Me.lblFakeButton2.BackColor = RGB(230, 70, 30) ' общей тематике программы
Case vbExclamation
Me.picExclamation.Visible = True
Me.recBorder.BorderColor = RGB(230, 190, 20)
Me.lblFakeButton1.BackColor = RGB(230, 190, 20)
Me.lblFakeButton2.BackColor = RGB(230, 190, 20)
Case vbInformation
Me.picInformation.Visible = True
Me.recBorder.BorderColor = RGB(150, 200, 50)
Me.lblFakeButton1.BackColor = RGB(150, 200, 50)
Me.lblFakeButton2.BackColor = RGB(150, 200, 50)
End Select
' если передан заголовок, тогда получаем и указываем его в строке заголовка
If Len(MBoxTitle) > 0 Then Me.Caption = MBoxTitle
' необходимо распределить кнопки горизонтально - одна посередине или две рядом
lngFormWidth = Me.Width
lngHalfButton = Me.cmdButton1.Width * 0.5 ' все кнопки одинаковые по ширине
Select Case MBoxNumberOfButtons ' в зависимости от количества кнопок
Case 2
Me.cmdButton1.Left = lngFormWidth * 0.25 - lngHalfButton
Me.cmdButton2.Left = lngFormWidth * 0.75 - lngHalfButton
Me.lblFakeButton1.Left = lngFormWidth * 0.25 - lngHalfButton
Me.lblFakeButton2.Left = lngFormWidth * 0.75 - lngHalfButton
' подпишем обе кнопки - тут лучше значение получить в переменную и ею манипулировать
Me.cmdButton1.Caption = MBoxCustomButton1
Me.lblFakeButton1.Caption = MBoxCustomButton1
Me.cmdButton2.Caption = MBoxCustomButton2
Me.lblFakeButton2.Caption = MBoxCustomButton2
Me.cmdButton1.Visible = True
Me.cmdButton2.Visible = True
Me.lblFakeButton1.Visible = True
Me.lblFakeButton2.Visible = True
Case Else
Me.cmdButton1.Left = lngFormWidth * 0.5 - lngHalfButton
Me.lblFakeButton1.Left = lngFormWidth * 0.5 - lngHalfButton
' подпишем кнопку
Me.cmdButton1.Caption = MBoxCustomButton1
Me.lblFakeButton1.Caption = MBoxCustomButton1
Me.cmdButton1.Visible = True
Me.lblFakeButton1.Visible = True
End Select
' установим кнопку по умолчанию
intDefaultButton = MBoxDefaultButton
If intDefaultButton > 0 And (intDefaultButton <= MBoxNumberOfButtons) Then
Me("cmdButton" & intDefaultButton).Default = True
Me("cmdButton" & intDefaultButton).SetFocus
' хоть кнопка и прозрачная, но фокус все-таки поддерживает ;)
Else
Me.cmdButton1.Default = True
End If
End Sub
Ну вот практически все. Можно удалить кнопку закрытия и кнопку оконного меню нашей формы - лично я все это отключил - у меня в диалоговое окно формы имеет лишь сиротливую полоску заголовка без единой кнопки. Также можно задать подпись заголовка формы в конструкторе, например "Моя программа" - она будет отображаться, если строка заголовка не будет передана при вызове функции.
Ах, да, как же использовать эту функцию ? совсем забыл ;). Вызов данной функции ничем не отличается от вызова стандартной функции MsgBox, с тем лишь отличием, что вызывать нужно MBox. Помните только, что используются всего две кнопки! и избегайте вызова с тремя кнопками (если хотите можете доработать код для трех кнопок ;), но лично мне на практике варианты выбора с тремя кнопками не были нужны ни разу.
Например, так (и такой текст (Tahoma 10 пт) отлично смотрится в самодельном MBox'е):
If MBox("Перед началом архивации проверьте, " & _
"чтобы база была закрыта на всех остальных компьютерах в сети." & vbCrLf & _
"Иначе при попытке архивации возникнет ошибка." & vbCrLf & vbCrLf & _
"Начинаем архивацию ?", vbExclamation + vbYesNo + vbDefaultButton2, _
"Архивация данных") = vbYes Then
...................
End If
или так:
MBox "Архивацию данных необходимо запускать только на компьютере, " & _
"на котором сама база и находится.", vbInformation, _
"Архивация данных"
Красивых Вам MBox'ов !