| 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 | |
| |
zurück