Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Timers stop when Common Dialog box is open 1

Status
Not open for further replies.

SteveGlover

Programmer
Mar 25, 2003
19
GB
I've developed an application that uses a Timer control to send a message to the COM port via MSComm every 5 seconds. All goes well until I use the Common Dialog control to Open or Save a file. While the dialog box is open the timer appears to stop, then starts again once the box has been closed. The same thing happens when a MsgBox is displayed.

Any ideas why this happens, and what are the solutions?

Thanks
 
The Common Dialog and MsgBox are modal forms so the form that displays them stops execution at the point at which they are called, including timers. Try placing the timer on different form than the one dispalying the modal form.

Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
 
'MODULE
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As TCHOOSECOLOR) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type TCHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type


Public Property Get GetColor(Optional AppHwnd As Long = 0, Optional Multiple As Boolean) As Long
Dim Color As TCHOOSECOLOR
Color.flags = 2 'Show full box includes custom
If Multiple = False Then 'If they only want one opened at a time give it an hwnd
Color.hwndOwner = AppHwnd 'when skipped program will keep focus
End If
Color.lStructSize = Len(Color)
Color.lpCustColors = 100
If CHOOSECOLOR(Color) <> 0 Then
GetColor = Color.rgbResult 'Set GetColor to the long value despite it saying rgb
Else
GetColor = vbNullString 'Not 0 because then it would be though black not an error
End If
End Property


Public Function ShowOpen(AppHwnd As Long, Filter As String, Title As String, Optional Multiple As Boolean) As String
On Error GoTo ErrorLoc
Dim OpenF As OPENFILENAME
OpenF.flags = &H4 ' no open as readonly box
If Multiple = True Then
OpenF.hwndOwner = AppHwnd 'set the window handle
End If
OpenF.lpstrFile = String(500, Chr(0))
OpenF.lpstrFileTitle = String(500, Chr(0))
OpenF.lpstrFilter = Filter
OpenF.lpstrTitle = Title
OpenF.lStructSize = Len(OpenF)
OpenF.nMaxFile = 501
OpenF.nMaxFileTitle = 501
If GetOpenFileName(OpenF) Then
ShowOpen = Replace(OpenF.lpstrFile, Chr(0), &quot;&quot;)
Else
ErrorLoc:
ShowOpen = vbNullString 'No file error
End If
End Function


Public Function ShowSave(AppHwnd As Long, Filter As String, Title As String, Optional Multiple As Boolean) As String
On Error GoTo ErrorLoc
Dim SaveF As OPENFILENAME
SaveF.flags = &H2 Or &H4 'Prompt on overwrite, no read only box
If Multiple = False Then
SaveF.hwndOwner = AppHwnd
End If
SaveF.lpstrFile = String(500, Chr(0))
SaveF.lpstrFileTitle = String(500, Chr(0))
SaveF.lpstrFilter = Filter
SaveF.lpstrTitle = Title
SaveF.lStructSize = Len(SaveF)
SaveF.nMaxFile = 501
SaveF.nMaxFileTitle = 501
If GetSaveFileName(SaveF) Then
ShowSave = Replace(SaveF.lpstrFile, Chr(0), &quot;&quot;)
Else
ErrorLoc:
ShowSave = vbNullString 'Error no file
End If
End Function

'FORM
Form1.Caption = ShowOpen(Me.hWnd, &quot;All Files (*.*)&quot; & Chr(0) & &quot;*.*&quot;, &quot;Open Dialog Example&quot;, False)

Form1.Caption = ShowSave(Me.hWnd, &quot;All Files (*.*)&quot; & Chr(0) & &quot;*.*&quot;, &quot;Save Dialog Example&quot;, False)

Form1.BackColor = GetColor(Me.hWnd, False)

You can play around with the hWnd and not only keep a timer running but access the form while the dialog box is open, also eliminating the need to reference the common dialog control ;o)

You could also eliminate the timer using GetTickCount and Sleep API.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top