VB-Homepage Tipp 082
Do While Schleife mit TimeOut und Ereignisabfrage
Wann immer Sie eine Aktion auslösen, von der Sie wissen oder annehmen müssen, das diese nicht gleich beim ersten Versuch klappt, könnten Sie diesen Tipp gebrauchen.
Hier haben Sie die Möglichkeit, eine Schleife eine vordefinierte Zeit laufen zu lassen und gleichzeitig kann ihre Aktion immer wieder ausgelößt werden. Dies geschieht solange, bis entweder das Ereignis eintritt, oder die vordefinierte Zeit abgelaufen ist.

timeout.mak
TIMEOUT.FRM
ProjWinSize=152,402,248,215
ProjWinShow=2
IconForm="Form1"
Title="TIMEOUT"
ExeName="TIMEOUT.EXE"

timeout.frm
VERSION 2.00
Begin Form Form1
BorderStyle = 3 'Fixed Double
Caption = "Schleife die vordefinierte Zeit prüft, ob ein Ereignis eintritt"
ClientHeight = 1905
ClientLeft = 1410
ClientTop = 4005
ClientWidth = 6120
ClipControls = 0 'False
ControlBox = 0 'False
Height = 2310
Left = 1350
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1905
ScaleWidth = 6120
Top = 3660
Width = 6240
Begin CommandButton Command2
Caption = "Ende"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 5520
TabIndex = 8
Top = 1680
Width = 495
End
Begin TextBox Text1
Height = 285
Left = 2880
TabIndex = 5
Text = "658"
Top = 480
Width = 855
End
Begin CommandButton Command1
Caption = "START"
Height = 375
Left = 4320
TabIndex = 0
Top = 960
Width = 1575
End
Begin Label Label6
Caption = "< 5000"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 3780
TabIndex = 7
Top = 600
Width = 855
End
Begin Label Label5
Alignment = 1 'Right Justify
Caption = "Geben Sie hier die Zahl an :"
Height = 255
Left = 120
TabIndex = 6
Top = 480
Width = 2655
End
Begin Label Label4
Caption = "Do While Schleife mit Timeout und Ausgang, wenn Ereignis eintritt."
Height = 255
Left = 120
TabIndex = 4
Top = 120
Width = 5775
End
Begin Label Label3
Caption = "Zufallsgenerator hat 15s Zeit um vordefinierte Zahl zu ermitteln."
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 120
TabIndex = 3
Top = 1560
Width = 4575
End
Begin Label Label2
BorderStyle = 1 'Fixed Single
Height = 255
Left = 2880
TabIndex = 2
Top = 960
Width = 855
End
Begin Label Label1
Alignment = 1 'Right Justify
Caption = "vergangene Zeit in Sekunden :"
Height = 255
Left = 120
TabIndex = 1
Top = 960
Width = 2655
End
End
Sub Command1_Click ()
Dim Start As Variant
Dim Ereignis As String
Dim Sekunden As Integer, Zeit As Integer

'Wie lange soll die Schleife laufen (in Sekunden)
Zeit = 15

'Startzeit
Start = Now

Do While Not Ereignis = "ok"

'Übergibt an andere Prozeduren
DoEvents
Sekunden = DateDiff("s", Now, Start)

'Abfrage ob Zeit schon abgelaufen
If Abs(Sekunden) > Zeit Then
'Zeit abgelaufen
Label2.Caption = "beendet"
Exit Do

Else
'Zeit noch nicht abgelaufen
Label2.Caption = Abs(Sekunden)

'zum Test Zufallszahlermittlung um evtl. das Ereignis ausgelößt
Randomize
zufall = Int(5000 * Rnd + 1)

If Trim(zufall) = Trim(Val(Text1.Text)) Then Ereignis = "ok"

End If

Loop

'wurde Ereignis ausgelößt
If Ereignis = "ok" Then
MsgBox "Die Zahl " + Trim(Val(Text1.Text)) + " wurde nach " + Str(Abs(Sekunden)) + " Sekunden ermittelt"

Else
MsgBox "Die Zahl " + Trim(Val(Text1.Text)) + " wurde nicht ermittelt"

End If

End Sub

Sub Command2_Click ()
Unload form1
Set form1 = Nothing
End
End Sub

Um den Code zu verwenden legen Sie, zum Beispiel mit Notepad, eine Datei an, in den Sie den Code kopieren und speichern die Datei unter dem vorgegebenen Namen ab. Starten Sie nun die *.mak Datei und es öffnet sich Ihr Visual Basic Programm, in dem Sie nun das Projekt zum Test verfügbar haben.
Tipp-Download
Quelle :
Zurück zur Übersichtsseite