关于PictureBox绘图,该如何处理
关于PictureBox绘图
能否用picturebox实现动态绘图，如绘制一条随时间延长的曲线，怎样使picturebox不出现闪烁现象？怎样实现双缓冲？
------解决方案--------------------
'PictureBox控件作进度条演示，不会闪烁
'在窗体Form1中放2个命令按钮Command1、Command2，1个滑杆控件Slider1，1个图片框控件Picture1，Picture1和Slider1的宽度可以不一样，1个定时器控件Timer1
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Sub Command1_Click()
Dim S As String, fName As String, sName As String
On Error Resume Next
fName = "E:\超级电影院\今日下载\qq爱_(s.w.in).mp3"
S = String(LenB(fName), Chr(0))
GetShortPathName fName, S, Len(S)
sName = Left(S, InStr(S, Chr(0)) - 1)
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
Call mciSendString("open " & Trim(sName) & " alias MEDIA", vbNullString, 256, 0)
S = String(256, Chr(0))
mciSendString "status MEDIA length", S, Len(S), 0
Slider1.Max = Val(S)
Slider1.Min = 0
Slider1.TickFrequency = Int(Val(S) / 3)
Timer1.Enabled = True
Picture1.BackColor = RGB(74, 74, 82)
mciSendString "play MEDIA", vbNullString, 0, 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
Timer1.Enabled = False
mciSendString "pause MEDIA", vbNullString, 0, 0
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
End Sub
Private Sub Form_Load()
Form1.BackColor = &H0&
Command1.Caption = "播放音乐"
Command2.Caption = "停止播放"
Picture1.BackColor = &HC0C000
Picture1.FillColor = &H0&
Picture1.ForeColor = &H80000008
Picture1.Height = 65 '图片框的高度
Timer1.Interval = 100
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Dim S As String '记录当前时间
Dim cjlS1 As Long, cjlS2 As Long
Dim cjlDB As Double
On Error Resume Next
S = String(256, Chr(0))
mciSendString "status MEDIA position", S, Len(S), 0
Slider1.Value = Val(S) '当前播放时间进度，单位是毫秒
Debug.Print " Slider1.Value=" & Slider1.Value
'除以1000全都化成秒
cjlS1 = (Slider1.Value / 1000) * Int(Picture1.Width / (Slider1.Max / 1000)) '基本值
cjlDB = (Picture1.Width / (Slider1.Max / 1000)) - Int(Picture1.Width / (Slider1.Max / 1000))
cjlS2 = Int((Slider1.Value / 1000) * (cjlDB)) '误差
Picture1.Line (0, 0)-(cjlS1 + cjlS2, Picture1.Height), RGB(157, 217, 253), BF '播放时间进度显示器
End Sub
------解决方案--------------------
方法很多
首先AutoDraw=True'相当Delphi的双缓冲
其次
1种:将以前画的图用Bitblt平移,在其后画新的线段(每次只需要用LINE画一条线段);
2种:用polyline重画所有线段
能否用picturebox实现动态绘图，如绘制一条随时间延长的曲线，怎样使picturebox不出现闪烁现象？怎样实现双缓冲？
------解决方案--------------------
'PictureBox控件作进度条演示，不会闪烁
'在窗体Form1中放2个命令按钮Command1、Command2，1个滑杆控件Slider1，1个图片框控件Picture1，Picture1和Slider1的宽度可以不一样，1个定时器控件Timer1
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Sub Command1_Click()
Dim S As String, fName As String, sName As String
On Error Resume Next
fName = "E:\超级电影院\今日下载\qq爱_(s.w.in).mp3"
S = String(LenB(fName), Chr(0))
GetShortPathName fName, S, Len(S)
sName = Left(S, InStr(S, Chr(0)) - 1)
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
Call mciSendString("open " & Trim(sName) & " alias MEDIA", vbNullString, 256, 0)
S = String(256, Chr(0))
mciSendString "status MEDIA length", S, Len(S), 0
Slider1.Max = Val(S)
Slider1.Min = 0
Slider1.TickFrequency = Int(Val(S) / 3)
Timer1.Enabled = True
Picture1.BackColor = RGB(74, 74, 82)
mciSendString "play MEDIA", vbNullString, 0, 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
Timer1.Enabled = False
mciSendString "pause MEDIA", vbNullString, 0, 0
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
End Sub
Private Sub Form_Load()
Form1.BackColor = &H0&
Command1.Caption = "播放音乐"
Command2.Caption = "停止播放"
Picture1.BackColor = &HC0C000
Picture1.FillColor = &H0&
Picture1.ForeColor = &H80000008
Picture1.Height = 65 '图片框的高度
Timer1.Interval = 100
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Dim S As String '记录当前时间
Dim cjlS1 As Long, cjlS2 As Long
Dim cjlDB As Double
On Error Resume Next
S = String(256, Chr(0))
mciSendString "status MEDIA position", S, Len(S), 0
Slider1.Value = Val(S) '当前播放时间进度，单位是毫秒
Debug.Print " Slider1.Value=" & Slider1.Value
'除以1000全都化成秒
cjlS1 = (Slider1.Value / 1000) * Int(Picture1.Width / (Slider1.Max / 1000)) '基本值
cjlDB = (Picture1.Width / (Slider1.Max / 1000)) - Int(Picture1.Width / (Slider1.Max / 1000))
cjlS2 = Int((Slider1.Value / 1000) * (cjlDB)) '误差
Picture1.Line (0, 0)-(cjlS1 + cjlS2, Picture1.Height), RGB(157, 217, 253), BF '播放时间进度显示器
End Sub
------解决方案--------------------
方法很多
首先AutoDraw=True'相当Delphi的双缓冲
其次
1种:将以前画的图用Bitblt平移,在其后画新的线段(每次只需要用LINE画一条线段);
2种:用polyline重画所有线段