VB 5/6-Tipp 0649: DoEvents nachgebaut
von Mathias Grädler
Beschreibung
Diese Tipp zeigt eine Alternative zur Doevents-Funktion. Mittels Peekmessage wird der Nachrichtenpuffer ausgelesen und falls Nachrichten vorliegen wird die Abarbeitung veranlaßt. Aufgrund der notwendigen Verwendung von Sleep ist diese Möglichkeit jedoch erheblich langsamer als das VB-eigene Doevents.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: DispatchMessageA (DispatchMessage), PeekMessageA (PeekMessage), Sleep, TranslateMessage | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command3" ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Schaltfläche "Command4" ' Steuerelement: Bildfeld-Steuerelement "picBorder" ' Steuerelement: Figur-Steuerelement "shpAni" auf picBorder Option Explicit 'Dieser Code ist Verhältnismäßig sinnlos! 'Es geht nur darum, die Anwendung zu belasten Private Sub Form_Load() picBorder.ScaleMode = vbPixels End Sub Private Sub Command4_Click() Unload Me End Sub Private Sub Command1_Click() Dim i As Long Dim j As Long EnableControls False For i = 0 To picBorder.ScaleWidth - shpAni.Width shpAni.Left = i myDoEvents Next i EnableControls True End Sub Private Sub Command2_Click() Dim i As Long Dim j As Long EnableControls False For i = 0 To picBorder.ScaleWidth - shpAni.Width shpAni.Left = i DoEvents Next i EnableControls True End Sub Private Sub Command3_Click() Dim i As Long Dim j As Long EnableControls False For i = 0 To picBorder.ScaleWidth - shpAni.Width shpAni.Left = i Next i EnableControls True End Sub Private Sub EnableControls(DoIt As Boolean) Dim c As Control For Each c In Me If TypeOf c Is CommandButton Then c.Enabled = DoIt Next c End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '--------- Anfang Modul "Module1" alias Module1.bas --------- Option Explicit Private Declare Function PeekMessage Lib "user32.dll" _ Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, _ ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, _ ByVal wRemoveMsg As Long) As Long Private Declare Function TranslateMessage Lib "user32.dll" ( _ lpMsg As MSG) As Long Private Declare Function DispatchMessage Lib "user32.dll" _ Alias "DispatchMessageA" (lpMsg As MSG) As Long Private Declare Sub Sleep Lib "kernel32.dll" _ (ByVal dwMilliseconds As Long) Private Type POINTAPI x As Long y As Long End Type Private Type MSG hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Public Sub myDoEvents() Dim myMSG As MSG If PeekMessage(myMSG, 0, 0, 0, 1) Then Call TranslateMessage(myMSG) Call DispatchMessage(myMSG) Else Call Sleep(1) End If End Sub '---------- Ende Modul "Module1" alias Module1.bas ---------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von _Fire_Dragon_ am 30.03.2005 um 23:34
Naja das hier hab ich zwar (noch) nicht ausprobiert, aber wo anderes gibts das auch schon und ich bin sehr zu frieden das es soetwas gibt
Do
DoEvents
Loop
Wenn Du diesen Code laufen lässt und Dir mal die CPU-Ausnutzung anschaust dann sieht man warum so ein besseres DoEvents benötigt wird.
Achja schau Dir auch mal die CPU-Temperatur an, die bei 2 Rechnern auf ganze 10 C mehr ansteigt, wenn man hohe Auslastungen hat.
Kommentar von 123 am 11.11.2004 um 07:01
Wer braucht denn so was? Oder ist das nur eine Demonstration?