甜橘子，专注成都网站制作网站设计与营销型网站建设与优化
QQ :532337155
电话：028-86922220
窗体上放一碧明局个textbox 两条line 一槐裤个label 代码粘贴 运行 即见效果
成都创新互联成立于2013年，先为叙永等服务建站，叙永等地企业，进行企业商务咨询服务。为叙永企业网站制作PC+手机+微官网三网同步一站式服务解决您的所有建站问题。
'*************************************************************************
'**工程名悔让称：平面座标
'**说 明：小鸟工作室 版权所有2007 - 2008(C)1
'**创 建 人：秋色烽火
'**日 期：2007-12-18 14:08:15
'**版 本：V1.0.0
'*************************************************************************
Const DPITCH = 300 '点距
Dim WithEvents oControlx1 As Line
Dim WithEvents oControlx2 As Line
Dim WithEvents oControly1 As Line
Dim WithEvents oControly2 As Line
Dim WithEvents oControlShape As Shape
Dim WithEvents oControlPixinfo As Label
Dim DPCound%, PixID%, PixBackColor, dotx%, doty%
Private Sub Form_Load()
Me.Caption = "平面座标 - by 秋色烽火[小鸟工作室]"
Me.Height = 9300
Me.Width = 9300
Line1.X1 = 150
Line1.X2 = Me.Width - 150
Line1.Y1 = Me.Height / 2
Line1.Y2 = Line1.Y1
Line2.Y1 = 150
Line2.Y2 = Me.Height - 150
Line2.X1 = Me.Width / 2
Line2.X2 = Line2.X1
Label1.Width = 255
Label1.Height = 255
Label1.AutoSize = ture
Label1.BackStyle = 0
Label1.FontItalic = True
Label1.FontBold = True
Label1.FontSize = 10
Label1.ForeColor = HFF
Label1.Caption = "O"
Label1.Left = Me.Width / 2 + Label1.Width - 100
Label1.Top = Me.Height / 2 - Label1.Height
Text1.Text = ""
Call AddLine
Text1.ToolTipText = "请输入整数座标(x,y) 中间用英文逗号分隔~~~,双击文本框或回车开始标注" vbCrLf " 右击显示帮助信息 " vbCrLf "输入座标请介乎于" DPCound \ 2 "至" -1 * DPCound \ 2 "之间~~"
PixID = 0
End Sub
Sub AddLine()
DPCound = (Me.Width - 300) / DPITCH - 2
For i = DPCound \ 2 + 1 To DPCound
Set oControlx1 = Controls.Add("VB.Line", "lineW" i, Me)
Set oControlx2 = Controls.Add("VB.Line", "lineW" DPCound \ 2 - (i - (DPCound \ 2 + 1)), Me)
Set oControly1 = Controls.Add("VB.Line", "lineH" i, Me)
Set oControly2 = Controls.Add("VB.Line", "lineH" DPCound \ 2 - (i - (DPCound \ 2 + 1)), Me)
With oControlx1
.Visible = True '显示
.X1 = Me.Width / 2 + (i - DPCound \ 2) * DPITCH
.X2 = Me.Width / 2 + (i - DPCound \ 2) * DPITCH
.Y1 = Me.Height / 2 - 60
.Y2 = Me.Height / 2 + 60
End With
With oControlx2
.Visible = True '显示
.X1 = Me.Width / 2 - (i - DPCound \ 2) * DPITCH
.X2 = Me.Width / 2 - (i - DPCound \ 2) * DPITCH
.Y1 = Me.Height / 2 - 60
.Y2 = Me.Height / 2 + 60
End With
With oControly1
.Visible = True '显示
.Y1 = Me.Height / 2 + (i - DPCound \ 2) * DPITCH
.Y2 = Me.Height / 2 + (i - DPCound \ 2) * DPITCH
.X1 = Me.Width / 2 - 60
.X2 = Me.Width / 2 + 60
End With
With oControly2
.Visible = True '显示
.Y1 = Me.Height / 2 - (i - DPCound \ 2) * DPITCH
.Y2 = Me.Height / 2 - (i - DPCound \ 2) * DPITCH
.X1 = Me.Width / 2 - 60
.X2 = Me.Width / 2 + 60
End With
Next
End Sub
Sub AddPix()
If InStr(Text1.Text, ",") 0 Then
If IsNumeric(Mid$(Text1.Text, 1, InStr(Text1.Text, ",") - 1)) And IsNumeric(Mid$(Text1.Text, InStr(Text1.Text, ",") + 1, Len(Text1.Text))) Then
If CInt(Mid$(Text1.Text, 1, InStr(Text1.Text, ",") - 1)) = DPCound \ 2 And CInt(Mid$(Text1.Text, 1, InStr(Text1.Text, ",") - 1)) = -1 * DPCound \ 2 Then
PixID = PixID + 1
Set oControlShape = Controls.Add("VB.Shape", "Pix" PixID, Me)
Set oControlPixinfo = Controls.Add("VB.Label", "Pixinfo" PixID, Me)
With oControlShape
.Visible = True '显示
.Shape = 3
'.BorderColor = HFF
.BackColor = HFF 'RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) 'HFF
.BackStyle = 1
.BorderStyle = 0
.Width = 75
.Height = 75
.Left = Me.Width / 2 + CInt(Mid$(Text1.Text, 1, InStr(Text1.Text, ",") - 1)) * DPITCH
.Top = Me.Height / 2 - CInt(Mid$(Text1.Text, InStr(Text1.Text, ",") + 1, Len(Text1.Text))) * DPITCH
dotx = .Left
doty = .Top
PixBackColor = .BackColor
End With
With oControlPixinfo
.Visible = True '显示
.BackStyle = 0
' .FontItalic = True
'.FontBold = True
.FontSize = 9
.ForeColor = HFF 'PixBackColor 'HFF
.Caption = "[" PixID "]" CStr(CInt(Mid$(Text1.Text, 1, InStr(Text1.Text, ",") - 1))) "," CInt(Mid$(Text1.Text, InStr(Text1.Text, ",") + 1, Len(Text1.Text)))
.Width = 1000
.Height = 255
.Left = dotx
.Top = doty - .Height
.AutoSize = ture
End With
Text1.Text = ""
Else
MsgBox "输入座标请介乎于" DPCound \ 2 "至" -1 * DPCound \ 2 "之间~~", , "错误"
Text1.Text = ""
End If
Else
MsgBox "座标请使用数字输入", , "错误"
Text1.Text = ""
End If
Else
MsgBox "输入的座标请使用英文逗号 , 进行分隔", , "错误"
Text1.Text = ""
End If
End Sub
Sub init()
If PixID 0 Then
If MsgBox("确实要清空所有标注点吗？", vbOKCancel + vbInformation + vbDefaultButton2 + vbMsgBoxSetForeground + vbSystemModal, "信息！") = vbOK Then
For i = 1 To PixID
Controls.Remove "Pix" i
Controls.Remove "Pixinfo" i
Next
PixID = 0
End If
End If
End Sub
Private Sub Text1_DblClick()
Call AddPix
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call AddPix
End If
End Sub
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
MsgBox "请输入整数座标(x,y) 中间用英文逗号分隔~~~,双击文本框或回车开始标注" vbCrLf "输入座标请介乎于" DPCound \ 2 "至" -1 * DPCound \ 2 "之间~~" vbCrLf "中键清空所有创建的座标", , "帮助"
End If
If Button = 4 Then
Call init
End If
End Sub
'好玩的东东
'****************************
'如果加上下面的就好罗
'定时设为500
'Dim a, b As Integer
'a = 14
'b = 14
'Private Sub Timer1_Timer()
'Text1.Text = a "," b
'a = a - 1
'b = b - 1
'Call Text1_KeyDown(13, 1)
'End Sub
代码就不写了,给你思路,默认左上角是原点,所以x的位置=窗口高度-y.
这哗携样就获得xy
复杂核芦肢点的办法是重写绘制,绘制十字,
简单点的办法就是十字放到picbox或者image里,然后取中,然后隐藏,确定按钮点击显示,中心位置等于坐标点,然后换算左上角控件位置改世,然后设置坐标.
scale(x1,y1)-(x2,y2)
你只要记住，这里的x1,y1是左上角的坐标，x2,y2是右下角的坐标，通过这两个点的坐标设定，就可以决定坐标原点的位启斗置以及坐标轴的方向了，比如
Scale (-300,200)-(300,-200)
以上是把坐标原点悄乱磨设在窗体中心，x轴长600，方向从左到右，y轴长400，方向从陪稿下向上。
Scale (800,0)-(0,600)
以上是把坐标原点设在窗体右上角，x轴长800，方向从右到左，y轴长600，方向从上向下。
下面说坐标轴和原点的标示法：
假定自定义坐标设为：
Scale (-300, 200)-(300, -200)
则
Line (-300, 0)-(300, 0) '画x轴
Line (0, 200)-(0, -200) '画y轴
CurrentX = 290
CurrentY = -5
Print "x" '标示x轴
CurrentX = 5
CurrentY = 200
Print "y" '标示y轴
CurrentX = 5
CurrentY = -5
Print "0" '标示原点
Private Sub PictureBox2_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox2.Paint
Dim points As New List(Of Point)
points.Add(New Point(0, 0))
points.Add(New Point(1, 10))
points.Add(New Point(3, 15))
points.Add(New Point(14, 0))
points.Add(New Point(20, 60))
points.Add(New Point(40, 20))
points.Add(New Point(70, 50))
e.Graphics.DrawCurve(Pens.Red, points.ToArray)
End Sub
供参考，points可设为全局变量，那样add随便在哪增加，想要看见看上去动态的雹圆图，那就在新增完n个后，继续此燃增加n+1个之源扒塌时，放弃points中的第一个。