如何做出跑馬燈效果的 TextBox

如何做出跑馬燈效果的 TextBox


老怪試作：

VERSION 5.00
Begin VB.Form Form1
Caption = "Marquee"
ClientHeight = 3960
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3960
ScaleWidth = 4680
StartUpPosition = 3 '系統預設值
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "跑馬燈結束"
Height = 495
Left = 2640
TabIndex = 5
Top = 3360
Width = 1215
End
Begin VB.Timer Timer1
Left = 2160
Top = 3480
End
Begin VB.CommandButton Command1
Caption = "跑馬燈開始"
Height = 495
Left = 840
TabIndex = 2
Top = 3360
Width = 1215
End
Begin VB.TextBox Text2
Height = 1215
Left = 840
MultiLine = -1 'True
ScrollBars = 2 '垂直捲軸
TabIndex = 1
Top = 1920
Width = 3135
End
Begin VB.TextBox Text1
BackColor = &H80000018&
Height = 375
Left = 1200
TabIndex = 0
Top = 360
Width = 2895
End
Begin VB.Label Label4
Alignment = 2 '靠中對齊
Caption = "請輸入跑馬燈文字"
Height = 375
Left = 1320
TabIndex = 4
Top = 1200
Width = 2295
End
Begin VB.Label Label2
Caption = "Text 跑馬燈"
Height = 375
Left = 120
TabIndex = 3
Top = 360
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'宣告要在 Text1 裏顯示的跑馬燈字串變數
Dim TString As String

Private Sub Command1_Click()
'宣告儲存 Text1 字串長度的變數
Dim TWidth As Long

Command2.Enabled = True
'啟動 Timer 顯示跑馬燈
Timer1.Enabled = True
Command1.Enabled = False

'text2 裏必須輸入跑馬燈字串
If Text2.Text = "" Then
MsgBox "請輸入跑馬燈文字"
'沒有輸入就按下 Command2 跑馬燈結束鈕
Command2_Click
Exit Sub
End If

'統計 Text1Box 裏到底放的下幾個字
Do While TextWidth(Space(TWidth)) <= Text1.Width
TWidth = TWidth + 1
Loop

'設定跑馬燈字串為 Text1 寬度個空白
'加原輸入的 跑馬燈文字
TString = Space(TWidth) + Text2.Text

End Sub

Private Sub Command2_Click()
Text1.Text = ""

Command1.Enabled = True

Command2.Enabled = False
'關閉跑馬燈顯示
Timer1.Enabled = False

Text2.SetFocus
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 200
Command2.Enabled = False

'將各元件 Font 統一，利於計算字串寬度
Text1.Font = Me.Font
Text2.Font = Me.Font

Me.Show

Text2.SetFocus

End Sub

Private Sub Timer1_Timer()
'開始頡取跑馬燈字串之位置指標
Static TPos As Long

'如果位置指標越過了整個字串
If TPos > Len(TString) Then
'把位置指標移到最開頭
TPos = 1
Else
'把位置指標移到下一個字
TPos = TPos + 1
End If

'逐字顯示跑馬燈字串
Text1.Text = Mid(TString, TPos)

End Sub