1. 注释使用小写的' ，但是至今不知道整段注释用什么。
2. 不规则窗口，以椭圆形为例
全局声明函数如下
'以下两个函数声明用于把窗体变成椭圆形
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
在From的load里面：
'SetWindowRgn hwnd, CreateEllipticRgn(0, 0, 800, 400), True
3. 使窗体全屏
'FrmBall.Top = 0 '设置窗体上边界位置
'FrmBall.Left = 0 '设置窗体左边界位置
'FrmBall.Width = Screen.Width * 800 / 1024 '设置窗体宽度为屏幕宽度
'FrmBall.Height = Screen.Height * 400 / 768 '设置窗体高度为屏幕高度
4. 其他的见程序：
VERSION 5.00
Begin VB.Form FrmBall
BackColor = &H00808000&
Caption = "圆球运动演示 -MyDream"
ClientHeight = 7800
ClientLeft = 2685
ClientTop = 2190
ClientWidth = 10005
Icon = "FrmBall.frx":0000
LinkTopic = "FrmBall"
ScaleHeight = 7800
ScaleWidth = 10005
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
ItemData = "FrmBall.frx":000C
Left = 360
List = "FrmBall.frx":001F
TabIndex = 10
Text = "选择方式"
Top = 360
Width = 1815
End
Begin VB.CommandButton Cmd_Stop
Caption = "Stop"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 5
Top = 960
Width = 855
End
Begin VB.Timer TimerPos
Enabled = 0 'False
Left = 240
Top = 3840
End
Begin VB.CommandButton Cmd_Clear
Caption = "Clear"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 4
Top = 960
Width = 855
End
Begin VB.CommandButton Cmd_End
Caption = "End"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5880
TabIndex = 3
Top = 960
Width = 855
End
Begin VB.CommandButton Cmd_Start
Caption = "Start"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2040
TabIndex = 2
Top = 960
Width = 1455
End
Begin VB.Frame Frame1
Height = 735
Left = 120
TabIndex = 0
Top = 120
Width = 9735
Begin VB.TextBox Txt_VRate
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5400
TabIndex = 9
Text = "20"
Top = 240
Width = 615
End
Begin VB.TextBox Txt_MaxR
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3360
TabIndex = 8
Text = "3000"
Top = 240
Width = 855
End
Begin VB.TextBox Txt_R
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6240
TabIndex = 1
Text = "这里将显示当前半径"
Top = 240
Width = 3375
End
Begin VB.Label Label1
Caption = "线速度:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 4440
TabIndex = 7
Top = 240
Width = 855
End
Begin VB.Label Label1
Caption = "最大半径:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 2160
TabIndex = 6
Top = 240
Width = 1095
End
End
Begin VB.Timer TimerSharp
Enabled = 0 'False
Interval = 20
Left = 240
Top = 2880
End
Begin VB.Shape Shape_C
BackColor = &H00FF00FF&
BackStyle = 1 'Opaque
Height = 255
Left = 6000
Shape = 3 'Circle
Top = 3600
Width = 255
End
End
Attribute VB_Name = "FrmBall"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CenterX As Double, CenterY As Double
Dim BigR As Double, BigDg As Double
Dim MaxR As Double '最大半径，改变这个值可以改变轨迹的最大半径
Dim VRate As Double '线速度，改变这个可以改变加速度，
Dim ConstValue As Double
Dim ShowType As Integer
Dim LastX As Double, LastY As Double
Const PI2 = 3.141592 * 2
Const BeginDg = 90
'以下两个函数声明用于把窗体变成椭圆形
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Cmd_Clear_Click()
Cls
TimerSharp.Enabled = False
TimerPos.Enabled = False
Cmd_Start.Caption = "Start"
Call Init
End Sub
Private Sub Init()
BigDg = BeginDg '轨迹的角度
BigR = MaxR ' 大轨迹的最大半径
CenterX = FrmBall.Width / 2 - 1500
CenterY = (FrmBall.Height - Frame1.Top - Frame1.Height) / 2 + 1500
Call Draw_Sharp(BigR, 90)
Circle (CenterX, CenterY), 40
LastX = 0
LastY = 0
End Sub
Private Sub Cmd_End_Click()
End
End Sub
Private Sub Cmd_Start_Click()
If Cmd_Start.Caption = "Start" Then
MaxR = Val(Txt_MaxR.Text)
If (MaxR = 0) Then
MaxR = 4000
End If
VRate = Val(Txt_VRate.Text)
If (VRate = 0) Then
VRate = 10
End If
ConstValue = MaxR * VRate
Call Init
Circle (CenterX, CenterY), 40
Else
Cmd_Start.Caption = "Start"
End If
TimerSharp.Enabled = True
TimerPos.Interval = TimerSharp.Interval
TimerPos.Enabled = True
'Txt_R.Text = ShowType
End Sub
Private Sub Cmd_Stop_Click()
TimerSharp.Enabled = False
TimerPos.Enabled = False
Cmd_Start.Caption = "Continue"
End Sub
Private Sub Combo1_Click()
Dim str As String
str = Combo1.List(Combo1.ListIndex)
If str = "采样" Then
ShowType = 1
ElseIf str = "轨迹" Then
ShowType = 2
ElseIf str = "运动" Then
ShowType = 10
ElseIf str = "运动+采样" Then
ShowType = 11
ElseIf str = "运动+轨迹" Then
ShowType = 12
End If
End Sub
Private Sub Form_Load()
'FrmBall.Top = 0 '设置窗体上边界位置
'FrmBall.Left = 0 '设置窗体左边界位置
'FrmBall.Width = Screen.Width * 800 / 1024 '设置窗体宽度为屏幕宽度
'FrmBall.Height = Screen.Height * 400 / 768 '设置窗体高度为屏幕高度
'SetWindowRgn hwnd, CreateEllipticRgn(0, 0, 800, 400), True
Randomize '初始化随机数
ShowType = 1
Call Init
End Sub
Private Sub SetSharp(X As Double, Y As Double)
'本函数将圆放在x,y位置并随即变化颜色
Dim ColorB As Integer, ColorR As Integer, ColorG As Integer
ColorR = &HFF&
ColorG = Rnd() * &H80& '随机的粉红
ColorB = &HFF&
Shape_C.BackColor = RGB(ColorR, ColorG, ColorB) '设置颜色
PosX = X - Shape_C.Width / 2
PosY = Y - Shape_C.Height / 2
Shape_C.Move PosX, PosY
End Sub
Private Sub Draw_Sharp(PosBigR As Double, Dg As Double)
Dim Rx As Double, Ry As Double
Dim dgp As Double
dgp = PI2 * Dg / 360
Rx = CenterX + PosBigR * Sin(dgp)
Ry = CenterY + PosBigR * Cos(dgp)
Call SetSharp(Rx, Ry)
End Sub
Private Sub Draw_Circle(PosBigR As Double, Dg As Double)
Dim Rx As Double, Ry As Double
Dim dgp As Double
dgp = PI2 * Dg / 360
Rx = CenterX + PosBigR * Sin(dgp)
Ry = CenterY + PosBigR * Cos(dgp)
Circle (Rx, Ry), 10, RGB(255, 0, 0)
End Sub
Private Sub Draw_Line(PosBigR As Double, Dg As Double)
Dim Rx As Double, Ry As Double
Dim dgp As Double
dgp = PI2 * Dg / 360
Rx = CenterX + PosBigR * Sin(dgp)
Ry = CenterY + PosBigR * Cos(dgp)
If (LastX > 0) Then
Circle (Rx, Ry), 3, RGB(255, 0, 0)
End If
LastX = Rx
LastY = Ry
End Sub
Private Sub Draw_Pos(PosBigR As Double, PosDg As Double)
Dim CurR As Double, CurDg As Double, AddDg As Double
CurDg = BeginDg
CurR = MaxR
Do While (CurR > PosBigR)
AddDg = ConstValue / CurR
If CurR > 1 Then
If (CurR <= AddDg) Then
AddDg = CurR - 1
End If
CurR = CurR - AddDg
AddDg = 360 * AddDg / (CurR + AddDg / 2)
Else
TimerSharp.Enabled = False
TimerPos.Enabled = False
BigR = 0
End If
CurDg = CurDg + AddDg
Call Draw_Circle(CurR, CurDg)
Loop
End Sub
Private Sub Draw_Road(PosBigR As Double, PosDg As Double)
Dim CurR As Double, CurDg As Double, AddDg As Double
CurDg = BeginDg
CurR = MaxR
Do While (CurDg < PosDg)
AddDg = 3
If CurR > AddDg Then
CurR = CurR - AddDg
AddDg = 360 * AddDg / (CurR + AddDg / 2)
Else
TimerSharp.Enabled = False
TimerPos.Enabled = False
BigR = 0
End If
CurDg = CurDg + AddDg
Call Draw_Line(CurR, CurDg)
Loop
End Sub
Private Sub TimerPos_Timer()
If (ShowType Mod 10) = 1 Then
'Call Draw_Pos(BigR, BigDg)
End If
End Sub
Private Sub TimerSharp_Timer()
Dim AddDg As Double
If (BigR = 0) Then
TimerSharp.Enabled = False
TimerPos.Enabled = False
Txt_R.Text = "半径：0"
If (ShowType >= 10) Then
Call SetSharp(CenterX, CenterY)
End If
End If
AddDg = ConstValue / BigR
If BigR > AddDg Then
BigR = BigR - AddDg
AddDg = 360 * AddDg / (BigR + AddDg / 2)
Else
TimerSharp.Enabled = False
TimerPos.Enabled = False
Txt_R.Text = "半径：0"
If (ShowType >= 10) Then
Call SetSharp(CenterX, CenterY)
End If
BigR = 0
End If
BigDg = BigDg + AddDg
If BigR > 0 And AddDg > 0 Then
Txt_R.Text = "当前半径：" & BigR
If (ShowType >= 10) Then
Call Draw_Sharp(BigR, BigDg)
End If
If (ShowType Mod 10) = 1 Then
Call Draw_Pos(BigR, BigDg)
End If
If (ShowType Mod 10) = 2 Then
Call Draw_Road(BigR, BigDg)
End If
End If
End Sub
你可以使用这个链接引用该篇文章 http://publishblog.blogchina.com/blog/tb.b?diaryID=383054