一个画圆的程序
Private Type Point '自定义point型数据,保存点的坐标
x As Single
y As Single
End Type
Dim pointfirst As Point '第一次mousedown事件所得点坐标
Dim pointlast As Point '最后一次mousemove事件所得点坐标
Dim pointmid1 As Point '中间量1
Dim pointmid2 As Point '中间量2
Dim downthing As Boolean '判定mousedown事件是否发生,保证在mousemove前先确定起始点
Dim pictype As Integer '判断画图类型
Dim downtime As Integer '判断mousedown事件发生的次数
Dim mybackcolor As Integer
Dim myforecolor As Integer
'初始化变量
Private Sub Form_Load()
downthing = False
pictype = 0
downtime = 0
Label1.Caption = ""
Label1.ForeColor = Me.ForeColor
Label1.BackColor = Me.ForeColor
End Sub
'mousedown事件,取得点坐标
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Label1.Caption = "X:" & Space(3) & x & vbCrLf & "Y:" & Space(3) & y
downtime = downtime + 1
If downtime = 1 Then
If Button And vbLeftButton Then
downthing = True
pointfirst.x = x
pointfirst.y = y
pointmid1.x = pointfirst.x
pointmid1.y = pointfirst.y
ElseIf Button And vbRightButton Then
PopupMenu mnuPictype
downtime = 0
End If
Else
downthing = False
downtime = 0 '单击第二次则获得最终图形
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label1.Caption = "X:" & Space(3) & x & vbCrLf & "Y:" & Space(3) & y
If downthing = False Then
Exit Sub '未确定起始点则不于处理
Else
Select Case pictype
Case 0
Exit Sub
Case 1 '画直线
paintline x, y
Case 2 '画矩形
paintrect x, y
Case 3 '画圆
paintcircle x, y
End Select
End If
End Sub
'响应菜单
Private Sub Form_Resize()
Label1.Left = 0
Label1.Top = Me.ScaleHeight - Label1.Height
End Sub
Private Sub mnulinestyleDash_Click()
Me.DrawStyle = vbDash
End Sub
Private Sub mnulinestyleDashDot_Click()
Me.DrawStyle = vbDashDot
End Sub
Private Sub mnulinestyleDashDotDot_Click()
Me.DrawStyle = vbDashDotDot
End Sub
Private Sub mnulinestyleDot_Click()
Me.DrawStyle = vbDot
End Sub
Private Sub mnulinestyleSolid_Click()
Me.DrawStyle = vbSolid
End Sub
Private Sub mnuPictypeCircle_Click()
Cls
pictype = 3
End Sub
Private Sub paintcircle(x, y) '画圆过程
Dim radius As Single '半径
radius = Sqr((pointfirst.x - pointmid1.x) ^ 2 + (pointfirst.y - pointmid1.y) ^ 2)
Circle (pointfirst.x, pointfirst.y), radius / 2, Me.BackColor
pointmid2.x = x
pointmid2.y = y
radius = Sqr((pointfirst.x - pointmid2.x) ^ 2 + (pointfirst.y - pointmid2.y) ^ 2)
Circle (pointfirst.x, pointfirst.y), radius / 2, Me.ForeColor
pointmid1.x = pointmid2.x
pointmid1.y = pointmid2.y
End Sub
Private Sub mnuPictypeLine_Click() '响应菜单mnupictypeline
Cls
pictype = 1
End Sub
Private Sub paintline(x, y) '画直线过程
Line (pointfirst.x, pointfirst.y)-(pointmid1.x, pointmid1.y), Me.BackColor
pointmid2.x = x
pointmid2.y = y
Me.Line (pointfirst.x, pointfirst.y)-(pointmid2.x, pointmid2.y), Me.ForeColor
pointmid1.x = pointmid2.x
pointmid1.y = pointmid2.y
End Sub
Private Sub mnuPictypeRect_Click() '响应菜单munpictyperect
Cls
pictype = 2
End Sub
Private Sub paintrect(x, y) '画矩形过程
Line (pointfirst.x, pointfirst.y)-(pointmid1.x, pointmid1.y), Me.BackColor, B
pointmid2.x = x
pointmid2.y = y
Me.Line (pointfirst.x, pointfirst.y)-(pointmid2.x, pointmid2.y), Me.ForeColor, B
pointmid1.x = pointmid2.x
pointmid1.y = pointmid2.y
End Sub
Private Sub mnuPictyperesh_Click() '刷新操作
Cls
End Sub
Private Sub mnucolorBackcolor_Click() '选背景色
Me.BackColor = selectcolor(Me.BackColor)
Label1.BackColor = Me.BackColor
End Sub
Private Sub mnucolorForecolor_Click() '选前景色
Me.ForeColor = selectcolor(Me.ForeColor)
Label1.ForeColor = Me.ForeColor
End Sub
Private Function selectcolor(inicolor As Variant)
With CommonDialog1
.Flags = cdlCCRGBInit
.Color = inicolor
.CancelError = False
.ShowColor
selectcolor = .Color
End With
End Function
————————————————————————————————————
为什么,我画出的圆不是不像画图软件的效果呢,如何修正?
我的一个大二的女生,在学习的过程中遇到了问题,请高手多多指教哦