Endlos laufender Formular-Titel per API

Endlos laufender Formular-Titel per API: KillTimer, SetTimer
Prozedur im Klassenmodul
Make a class to represent the caption. When a timer fires, call the class objects to redisplay their text rotated.
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Dim index As Long
Dim m_fObject As Object
Dim m_msg As String
Dim m_Maxlen As Long
Public Sub initialise(f As Object, msg As String, MaxLen As Long)
Set m_fObject = f
m_msg = msg
If MaxLen > Len(msg) Then MaxLen = Len(msg) Rudimentary validation.
If MaxLen < 0 Then MaxLen = 0
m_Maxlen = MaxLen
End Sub
Sub rotate()
On Error GoTo err_handler
Dim str As String
Dim partMsg As String
If index = Len(m_msg) Then Counter for 1 to len(msg).
index = 1
Else
index = index + 1
End If
partMsg = Mid$(m_msg, index, m_Maxlen)
If Len(partMsg) < m_Maxlen Then We have come to end of message and return less letters.
str = Mid$(m_msg, 1, m_Maxlen - Len(partMsg)) Str is the added, wrapped part from the start of the
Else message.
If Len(str) Then Initialise wrapped part.
str = ""
End If
End If
m_fObject.Caption = partMsg & str Only work on caption (label/form).
Exit Sub
err_handler:
If Err.Number = 438 Then
m_fObject.Text = partMsg & str
Else
MsgBox Err.Description & ": " & Err.Number
End If
End Sub
Prozedur im Formular
Const msg = "1234567890"
Dim rc As cRotateCaption
Dim rc2 As cRotateCaption
Dim rc3 As cRotateCaption
Dim rc4 As cRotateCaption
Dim rcCol As Collection
Private Sub Form_Load()
Dim v As Variant Iterator.
Set rcCol = New Collection
Set rc = New cRotateCaption
Set rc2 = New cRotateCaption
Set rc3 = New cRotateCaption
Set rc4 = New cRotateCaption
Timer1.Interval = 50
rc.initialise Form1, ",,.-~^'*~-.,,.-~^'*~-.,,.-~^'*~-.,", 30 Object to display in "message"; number of letters.
rc2.initialise Label1, "This is a rotating label caption. ", 10
rc3.initialise Label2, "This is a String. ", 10
rc4.initialise Text1, "This is text in a text box. ", 10
rcCol.Add rc
rcCol.Add rc2
rcCol.Add rc3
rcCol.Add rc4
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim v As Variant
For Each v In rcCol Clean up.
Set v = Nothing
Next
Set rc = Nothing
Set rc2 = Nothing
Set rc3 = Nothing
End Sub
Private Sub Timer1_Timer()
Dim v As Variant
For Each v In rcCol
v.rotate
Next
rc.rotate
rc2.rotate
rc3.rotate
End Sub
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt