如何用vb实现坐标图

2024-11-16 08:47:25

推荐回答（5个）

回答1：

太好玩啦~~~~~哈哈终于完工啦
窗体上放一个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

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

回答2：

VB可使用Line 方法在窗体或图片框实现坐标图。

Line 方法，在对象上画直线和矩形。
ScaleMode 属性，当使用图形方法或调整控件位置时，返回或设置一个值，该值指示对象坐标的度量单位。
CurrentX、CurrentY
属性，返回或设置下一次打印或绘图方法的水平 (CurrentX) 或垂直
(CurrentY) 坐标。设计时不可用。
Line 方法示例代码：

Option Explicit
    Dim i As Long
    Dim x, y, fnt, txt, dd

Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = 6 'mm
    Picture1.Scale (-15, 110)-(105, -10) '
    Picture1.DrawWidth = 1
    Picture1.DrawWidth = 1
    Picture1.Line (0, 0)-(0, 100), vbRed
    Picture1.Line (100, 0)-(100, 100), vbRed
    Picture1.Line (0, 0)-(100, 0), vbRed
    Picture1.Line (0, 100)-(100, 100), vbRed
    For i = 1 To 10
        Picture1.Line (10 * i, -1)-(10 * i, 0), vbRed
    Next
    For i = 1 To 10
        Picture1.Line (-1, 10 * i)-(0.5, 10 * i), vbRed
    Next
    x = 40
    y = -3
    fnt = 12
    txt = "vb实现坐标图"
    dd = prnt(x, y, fnt, txt)
End Sub

Public Function prnt(x As Variant, y As Variant, fnt As Variant, txt As Variant)
    Picture1.CurrentX = x
    Picture1.CurrentY = y
    Picture1.FontSize = fnt
    Picture1.Print txt
End Function

回答3：

在VB中绘制实时曲线是比较难的，一般要应用第三方控件或是Windows API函数来完成，但是如果你对实时曲线的要求不是很高，只要能表示出当前的一般情况的话，我们可以直接应用VB提供给我们的空间来完成。

原则上讲，直接在Form里绘制曲线都是可以的，MSDN上面很多例程就是直接在Form里面绘制图形的，Form作为绘制图形的容器，不过一般应用中Form中不可避免的会有很多其他控件，所以我们选择PictureBox作为绘制曲线的容器。

实时曲线的绘制一般借助于Timer控件来完成，使用Timer控件，定期将串口或是其他仪器中监测到的数据送往PictureBox1，而曲线的绘制一般画成折线图，采用PictureBox1的Line方法绘制.具体实现如下:

1.选择需要显示的窗体Picture1，加入图片框Picture1，根据实际需要设置图片的大小并移到合适的位置，并在图片的外面画好量程----时间坐标系；然后加上Timer控件以及两个CommandButton，界面就基本设置好了。

2.建立坐标系，根据Picture1的大小和高度设置画出坐标系的X轴和Y轴:
http://www.builder.com.cn/2007/1014/552620.shtml

回答4：

整体思路如下
具体的改改：
(有哪里需要多加改进的发消息给我)

Const so = 50 '1单位长度可根据情况改之
Private Sub f(x, y)
Form1.PSet (x * so + ScaleWidth / 2, ScaleHeight - y * so - ScaleHeight / 2), vbRed
End Sub

Private Sub Command1_Click()
Form1.Line (0, ScaleHeight / 2)-(ScaleWidth, ScaleHeight / 2), vbBlack
Form1.Line (ScaleWidth / 2, 0)-(ScaleWidth / 2, ScaleHeight), vbBlack
x = InputBox("请输入横坐标")
y = InputBox("请输入纵坐标")

Call f(x, y)
Label1.Visible = True
Label1.Left = x * so + ScaleWidth / 2 + so
Label1.Top = ScaleHeight - y * so - ScaleHeight / 2
Label1.Caption = "(" & x & "," & y & ")"
End Sub

Private Sub Form_Load()
Label1.Caption = ""
Label1.Visible = False'Label1是用来标注点坐标的，高宽适当调
End Sub

回答5：

vb的左上角的坐标是0,0 如果你输入了(x,y)

Line (0, Y)-(容器.Width, Y), , BF '横线

Line (X, 0)-(X, 容器.Height), , BF '竖线

容器为你要画点的控件,上面的两条代码会画出一个横线和一个竖线,交点就是你给的坐标