VB怎么建立用户坐标系统？

使用对象的ScaleMode 属性指示对象坐标的度量单位。

ScaleMode 属性

当使用图形方法或调整控件位置时，返回或设置一个值，该值指示对象坐标的度量单位。

改变对象的坐标系统

可用对象的刻度属性和 Scale 方法，设置特定对象（窗体或控件）的坐标系统。使用坐标系统有以下三种不同的方法：

使用缺省的刻度。

选择标准刻度。

创建自定义刻度。

改变坐标系统的刻度，使得在窗体上缩放图形和定位图形变得更容易。例如，一个在图片框里创建条形图的应用程序，能改变坐标系统，把控件分成四列，每列代表图表中的一条。以下部分，说明如何设置缺省、标准和自定义刻度，来改变坐标系统。

使用缺省刻度

每个窗体和图片框都有几个刻度属性（ScaleLeft、ScaleTop、ScaleWidth、ScaleHeight

和 ScaleMode）和一个方法（Scale），它们可用来定义坐标系统。对于 Visual Basic

中的对象，缺省刻度把坐标（0，0）放置在对象的左上角。缺省刻度单位为缇。

若要返回缺省刻度，可使用无参数的 Scale 方法。

选择标准刻度

若不直接定义单位，可通过设置 ScaleMode 属性，用标准刻度来定义它们。属性设置值见下表。

太好玩啦~~~~~哈哈 终于完工啦

窗体上放一个textbox 两条line 一个label 代码粘贴 运行 即见效果

'*************************************************************************

'**工程名称：平面座标

'**说明：小鸟工作室 版权所有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

'***************************

---