G
Glint
Hi Guys,
I am really inspired by the idea of creating custom dialog boxes. So I came
accross this code through this forum, and I am in love with it.
Unfortunately, I have problems adapting it to my needs. This is the code
which creates a box that displays for as many seconds as it is set with a
timer, and it works great:
Public Sub msgForm(ByVal Message As String, _
Optional ByVal title As Variant, _
Optional ByVal duration As Single, _
Optional strFontName As String, _
Optional intFontSize As Integer)
Dim f As Form
Dim lbl As Label, cmdYes As CommandButton, cmdNo As CommandButton
Dim dblWidth As Double
Dim myName As String
Dim savedForm As Boolean
' used for error handling
'
savedForm = False
' turn off screen repainting so that we don't see the
' form being created
'
On Error GoTo ErrorHandler
Application.Echo False
' make a simple blank form
'
Set f = CreateForm
myName = f.Name
f.RecordSelectors = False
f.NavigationButtons = False
f.DividingLines = False
f.ScrollBars = 0 ' none
f.PopUp = True
f.BorderStyle = acDialog
f.Modal = True
f.ControlBox = False
f.AutoResize = True
f.AutoCenter = True
' set the title
'
If IsMissing(title) Then
f.Caption = "ECKANKAR AREA ADMIN"
Else
f.Caption = title
End If
' add a label for the message
'
Set lbl = CreateControl(f.Name, acLabel)
lbl.Caption = Message
lbl.BackColor = 0 ' transparent
lbl.ForeColor = 0
lbl.Left = 100
lbl.Top = 100
lbl.FontName = "Arial"
lbl.FontSize = 14
'If strFontName <> "" Then lbl.FontName = strFontName '...rejecting
parameters
'If intFontSize > 0 Then lbl.FontSize = intFontSize '...rejecting
parameters
lbl.SizeToFit
dblWidth = lbl.Width + 600
f.Width = dblWidth + 200
f.Section(acDetail).Height = lbl.Height + 600
Set cmdYes = CreateControl(f.Name, acCommandButton)
cmdYes.Caption = "Yes"
cmdYes.ForeColor = -2147483630
cmdYes.Top = lbl.Height + 100
cmdYes.Left = 200
cmdYes.ForeColor = vbBlue
cmdYes.FontSize = 12
cmdYes.FontBold = True
cmdYes.SizeToFit
' cmdYes.OnClick = cmdYesClick
' display the form (first close and save it so that when
' it is reopened it will auto-centre itself)
'
DoCmd.Close acForm, myName, acSaveYes
savedForm = True
DoCmd.OpenForm myName
DoCmd.MoveSize , , dblWidth
DoCmd.RepaintObject acForm, myName
' turn screen repainting back on again
'
Application.Echo True
' display form for specifed number of seconds
'
If duration <= 0 Then duration = 10
Dim startTime As Single
startTime = Timer
While Timer < startTime + duration
Wend
' close and delete the form
'
DoCmd.Close acForm, myName, acSaveNo
DoCmd.DeleteObject acForm, myName
Exit Sub
ErrorHandler:
Application.Echo True
Dim i As Integer
For Each f In Forms
If f.Name = myName Then
DoCmd.Close acForm, myName, acSaveNo
Exit For
End If
Next f
If savedForm Then
DoCmd.DeleteObject acForm, myName
End If
End Sub
I HAVE PROBLEMS IN 3 AREAS.
1. The first problem is that when I call the procedure like this (for a
situation where my message is defined by strMsg):
msgForm(strMsg, "PUT TITLE",10,"ARIAL",12)
I get error message "Expected:=". In fact the only way to make it work is
limit my parameters to the message only. Infact, this is the reason I placed
an actual title, fontname and fontsize directly into the code, thereby
reducing its functionality. How do I do this properly so that I can call the
procedure with different parameters whenever I want?
2. The second problem is that I do not know how to make the form stay until
the user clicks it off, like a normal dialog box. When I remove the timer
portion of the code, the form just blinks for a microsecond and it is gone.
3. The third problem is related to the second above: I need to put code on
the OnClick event of the buttons that will be on the form. How do I achieve
this?
I am really inspired by the idea of creating custom dialog boxes. So I came
accross this code through this forum, and I am in love with it.
Unfortunately, I have problems adapting it to my needs. This is the code
which creates a box that displays for as many seconds as it is set with a
timer, and it works great:
Public Sub msgForm(ByVal Message As String, _
Optional ByVal title As Variant, _
Optional ByVal duration As Single, _
Optional strFontName As String, _
Optional intFontSize As Integer)
Dim f As Form
Dim lbl As Label, cmdYes As CommandButton, cmdNo As CommandButton
Dim dblWidth As Double
Dim myName As String
Dim savedForm As Boolean
' used for error handling
'
savedForm = False
' turn off screen repainting so that we don't see the
' form being created
'
On Error GoTo ErrorHandler
Application.Echo False
' make a simple blank form
'
Set f = CreateForm
myName = f.Name
f.RecordSelectors = False
f.NavigationButtons = False
f.DividingLines = False
f.ScrollBars = 0 ' none
f.PopUp = True
f.BorderStyle = acDialog
f.Modal = True
f.ControlBox = False
f.AutoResize = True
f.AutoCenter = True
' set the title
'
If IsMissing(title) Then
f.Caption = "ECKANKAR AREA ADMIN"
Else
f.Caption = title
End If
' add a label for the message
'
Set lbl = CreateControl(f.Name, acLabel)
lbl.Caption = Message
lbl.BackColor = 0 ' transparent
lbl.ForeColor = 0
lbl.Left = 100
lbl.Top = 100
lbl.FontName = "Arial"
lbl.FontSize = 14
'If strFontName <> "" Then lbl.FontName = strFontName '...rejecting
parameters
'If intFontSize > 0 Then lbl.FontSize = intFontSize '...rejecting
parameters
lbl.SizeToFit
dblWidth = lbl.Width + 600
f.Width = dblWidth + 200
f.Section(acDetail).Height = lbl.Height + 600
Set cmdYes = CreateControl(f.Name, acCommandButton)
cmdYes.Caption = "Yes"
cmdYes.ForeColor = -2147483630
cmdYes.Top = lbl.Height + 100
cmdYes.Left = 200
cmdYes.ForeColor = vbBlue
cmdYes.FontSize = 12
cmdYes.FontBold = True
cmdYes.SizeToFit
' cmdYes.OnClick = cmdYesClick
' display the form (first close and save it so that when
' it is reopened it will auto-centre itself)
'
DoCmd.Close acForm, myName, acSaveYes
savedForm = True
DoCmd.OpenForm myName
DoCmd.MoveSize , , dblWidth
DoCmd.RepaintObject acForm, myName
' turn screen repainting back on again
'
Application.Echo True
' display form for specifed number of seconds
'
If duration <= 0 Then duration = 10
Dim startTime As Single
startTime = Timer
While Timer < startTime + duration
Wend
' close and delete the form
'
DoCmd.Close acForm, myName, acSaveNo
DoCmd.DeleteObject acForm, myName
Exit Sub
ErrorHandler:
Application.Echo True
Dim i As Integer
For Each f In Forms
If f.Name = myName Then
DoCmd.Close acForm, myName, acSaveNo
Exit For
End If
Next f
If savedForm Then
DoCmd.DeleteObject acForm, myName
End If
End Sub
I HAVE PROBLEMS IN 3 AREAS.
1. The first problem is that when I call the procedure like this (for a
situation where my message is defined by strMsg):
msgForm(strMsg, "PUT TITLE",10,"ARIAL",12)
I get error message "Expected:=". In fact the only way to make it work is
limit my parameters to the message only. Infact, this is the reason I placed
an actual title, fontname and fontsize directly into the code, thereby
reducing its functionality. How do I do this properly so that I can call the
procedure with different parameters whenever I want?
2. The second problem is that I do not know how to make the form stay until
the user clicks it off, like a normal dialog box. When I remove the timer
portion of the code, the form just blinks for a microsecond and it is gone.
3. The third problem is related to the second above: I need to put code on
the OnClick event of the buttons that will be on the form. How do I achieve
this?