我放个定时器好让lanel能够由下向上移动,怎么在移动过程中会闪烁呢?怎么才能解决啊!
Private Sub Form_Load()
Picture1.Left = (Form1.Width - Picture1.Width) \ 2 - 20
Label1.Left = (Form1.Width - Label1.Width) \ 2 - 20
Label2.Left = (Form1.Width - Label2.Width) \ 2 - 20
Timer1.Interval = 10
Timer1.Enabled = True
Label1.Top = Picture1.Top + Picture1.Height
Label1.Caption = "嗨！你好！"
End SubPrivate Sub Timer1_Timer()
Label1.Visible = False
Label1.Top = Label1.Top - 10 '移动时会眨眼的
Label1.Visible = True
If Label1.Top + Label1.Height = Picture1.Top Then
Label1.Top = Picture1.Top + Picture1.Height
End If
End Sub
Private Sub Form_Load()
Picture1.Left = (Form1.Width - Picture1.Width) \ 2 - 20
Label1.Left = (Form1.Width - Label1.Width) \ 2 - 20
Label2.Left = (Form1.Width - Label2.Width) \ 2 - 20
Timer1.Interval = 10
Timer1.Enabled = True
Label1.Top = Picture1.Top + Picture1.Height
Label1.Caption = "嗨！你好！"
End SubPrivate Sub Timer1_Timer()
Label1.Visible = False
Label1.Top = Label1.Top - 10 '移动时会眨眼的
Label1.Visible = True
If Label1.Top + Label1.Height = Picture1.Top Then
Label1.Top = Picture1.Top + Picture1.Height
End If
End Sub
你这样的移动速度很慢
而且对trim的时间控制下
timer1.interval=50
form.scalemode=3
label.move label.left,label1.top + 5
你再试试看
豆子帮我改了一下就不闪了，move方法比重绘要块的多明天早上在试，现在睡觉-_-#
Option Explicit
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As LongConst DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type'the actual text to scroll. This could also be loaded in from a text file
Const ScrollText As String = "My Application Title" & vbCrLf & _
vbCrLf & vbCrLf & _
"Producer: Myself" & vbCrLf & _
"Executive Producer: Myself" & _
vbCrLf & "Main programmer: Myself" & _
vbCrLf & "Main graphic artist: Myself" & _
vbCrLf & vbCrLf & _
"Sample from:" & _
vbCrLf & _
"HTTP://WWW.VBEXPLORER.COM"
Dim EndingFlag As Boolean
Private Sub RunMain()
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long'show the form
frmAbout.Refresh'Get the size of the drawing rectangle by suppying the DT_CALCRECT constant
rt = DrawText(picScroll.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)If rt = 0 Then 'err
MsgBox "Error scrolling text", vbExclamation
EndingFlag = True
Else
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Left = 0
DrawingRect.Right = picScroll.ScaleWidth
'Store the height of The rect
RectHeight = DrawingRect.Bottom
DrawingRect.Bottom = DrawingRect.Bottom + picScroll.ScaleHeight
End If
Do While Not EndingFlag
If GetTickCount() - LastFrameTime > IntervalTime Then
picScroll.Cls
DrawText picScroll.hdc, ScrollText, -1, DrawingRect, DT_CENTER Or DT_WORDBREAK
'update the coordinates of the rectangle
DrawingRect.Top = DrawingRect.Top - 1
DrawingRect.Bottom = DrawingRect.Bottom - 1
'control the scolling and reset if it goes out of bounds
If DrawingRect.Top < -(RectHeight) Then 'time to reset
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Bottom = RectHeight + picScroll.ScaleHeight
End If
picScroll.Refresh
LastFrameTime = GetTickCount()
End If
DoEvents
Loop
Unload Me
Set frmAbout = Nothing
End Sub
Private Sub Form_Activate()
RunMain
End Sub
Private Sub Form_Load()
picScroll.AutoRedraw = True
picScroll.ForeColor = vbYellow
picScroll.BackColor = vbBlack
picScroll.FontSize = 14
End Sub
Private Sub Form_Unload(Cancel As Integer)
EndingFlag = True
End Sub