VB-Homepage Tipp 093
variable Intervale - nach Dauer der Aktion
Ich hoffe, der Titel sagt in etwa aus, was hier als Tipp weiter gegeben werde soll.
Vielleicht veranschaulicht ein Beispiel das am Besten.
Viele werden sicher Paintshop Pro kennen, wenn Sie dort zum Beispiel die Pinselstärke vergrößern wollen, gehen Sie auf ein Auswahlmenü, wo Sie die dargestellte Zahl der Pinselgröße über einen Button verändern können. Dabei wird Ihnen auffallen, daß sich die Geschwindigkeit des Zahlenwechsels erhöht, wenn Sie länger auf den Auswahlbutton drücken.

Und genau dies soll hier genauer betrachtet werden.
Es gibt für diese Funktionalität, zwei Timer die genau die selbe Funktion ausführen. ( Im Beispiel ebenfalls das hoch oder runterzählen einer Anzeige).
Nun ist es lediglich wichtig, die Zeit zu ermitteln, wie lange der Button gedrückt wird, um nach einer gewissen Zeit den langsamen Timer gegen den schnellen zu wecheln und beim Beenden der Aktion die Timer wieder zu reseten.

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

interval.frm
VERSION 2.00
Begin Form Form1
Caption = "VB-Homepage Tipp"
ClientHeight = 1185
ClientLeft = 1170
ClientTop = 1545
ClientWidth = 5970
Height = 1590
Left = 1110
LinkTopic = "Form1"
ScaleHeight = 1185
ScaleWidth = 5970
Top = 1200
Width = 6090
Begin CommandButton Command2
Caption = "<"
Height = 285
Left = 120
TabIndex = 1
Top = 360
Width = 255
End
Begin CommandButton Command1
Caption = ">"
Height = 285
Left = 840
TabIndex = 0
Top = 360
Width = 255
End
Begin Timer tmrAccel
Enabled = 0 'False
Interval = 2000
Left = 2400
Top = 0
End
Begin Timer tmrNormal
Enabled = 0 'False
Interval = 250
Left = 1920
Top = 0
End
Begin Label Label2
Caption = "Veränderbare Intervallanzeige, je nachdem wie lange der Button angeklickt bleibt."
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 = 840
Width = 5895
End
Begin Label Label1
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Caption = "0"
Height = 285
Left = 360
TabIndex = 2
Top = 360
Width = 495
End
End
Option Explicit
Dim iSpinDir As Integer
Sub Command1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Defininiert, wieviel Stellen mit einmal addiert werden sollen
iSpinDir = 1
If Not tmrNormal.Enabled Then
SpinEditBoxValue
tmrNormal.Enabled = True
End If
If Not tmrAccel.Enabled Then
tmrAccel.Enabled = True
End If
End Sub
Sub Command1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Zurücksetzen der Timerwerte
ResetTimers
End Sub
Sub Command2_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
iSpinDir = -1
If Not tmrNormal.Enabled Then
SpinEditBoxValue
tmrNormal.Enabled = True
End If
If Not tmrAccel.Enabled Then
tmrAccel.Enabled = True
End If
End Sub
Sub Command2_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Zurücksetzen der Timerwerte
ResetTimers
End Sub
Sub Form_DblClick ()
Cls
End Sub
Sub ResetTimers ()
'Zurücksetzen der Timerwerte, immer bei Mouseup Ereignis
tmrNormal.Enabled = False
tmrAccel.Enabled = False
tmrNormal.Interval = 250
tmrAccel.Interval = 2000
End Sub
Sub SpinEditBoxValue ()
'definiert, das minimalwert 0 ist
If iSpinDir > 0 Then
If iSpinDir + Val(Label1.Caption) > 1000 Then
iSpinDir = 0
End If
Else
If iSpinDir + Val(Label1.Caption) < 0 Then
iSpinDir = 0
End If
End If
If iSpinDir <> 0 Then
Label1.Caption = Format$(Str$(Val(Label1.Caption) + iSpinDir))
DoEvents
End If
End Sub
Sub tmrAccel_Timer ()
tmrNormal.Interval = 1
End Sub
Sub tmrNormal_timer ()
SpinEditBoxValue
End Sub

Um den Code zu nutzen, erstellen Sie sich mit einem Editor (ZBsp. Notepad) Dateien, die Sie wie beschrieben benennen und den jeweiligen Code hinein kopieren.
Rufen Sie dann die *.mak Datei aus dem Dateimanager auf oder starten Ihr VB-Programm und öffnen das Projekt.
Tipp-Download
Quelle :
Zurück zur Übersichtsseite