一个大方的男孩送你200分!快来吧,犹豫什么呢?(200分)

  • 主题发起人 主题发起人 wwz
  • 开始时间 开始时间
W

wwz

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样作坐标图?
现有数组A,I=20 我想用VB6.0来在坐标系统里动态地显示出来
请问各位大侠怎么编程,请附上源程序,好吗?
还有mschart怎么用。
 
你问完问题是不是就不来了?
那样请注销你的帐号
 
要源程序? 那你不久什么都不用做了么.
be a programmer!
 
哥们儿,这儿是讨论delphi的地方
 
你干嘛不到VB的论坛上去问
 
呵呵,你用delphi中的teechart就可以实现你的功能,
delphi中也有demo。
 
大家态度友善一点吧,不就是找错了门罢了!^o^
 
delphi里用teechart空间就行了。
 
首先,新建一个窗体,名称frmmain,上面加一个picturebox,名称为picpaint
加一个按钮,双击,代码如下:
Option Explicit

Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private fnt As CLogFont



Private x(1 To 8) As Single
Private y(1 To 8) As Single
Private xcaption As String
Private Ycaption As String
Private n As Integer

Public Xo As Single
Public Yo As Single
Public Xlast As Single 'X 轴终点坐标
Public Ylast As Single 'Y 轴终点坐标

'***********************选坐标系子过程**************************
'说明:该程序为任何无附着点的数组选坐标系

Sub PaintAxis(XL() As Single, YL() As Single, _
n As Integer, _
Optional xcaption As String = "X_Axis", Optional Ycaption As String = "Y_Axis", _
Optional Title As String)
Dim Ox As Single 'X 最大值
Dim PX As Single 'X 最小值
Dim Qy As Single 'Y 最大值
Dim Ry As Single 'Y 最小值
Dim OP As Single 'X 值长
Dim QR As Single 'Y 值长

Dim xo1 As Single
Dim Yo1 As Single
Dim XLast1 As Single
Dim YLast1 As Single
Dim XoXL1 As Single
Dim YoYL1 As Single

Dim LscaleX As Single '左上角坐标
Dim LscaleY As Single
Dim RscaleX As Single '右下角坐标
Dim RscaleY As Single
Dim XoXL As Single 'X 轴长
Dim YoYL As Single 'Y 轴长
Dim i As Single
Dim Picobj As Object
Set Picobj = frmmain.picpaint
With Picobj
Picobj.Cls
Picobj.Scale
Picobj.FontSize = 9
'***************以下计算最大最小值**************
Ox = -10 ^ 38
PX = 10 ^ 38
Qy = Ox
Ry = PX
For i = 1 To n
If Ox < XL(i) Then Ox = XL(i)
If PX > XL(i) Then PX = XL(i)
If Qy < YL(i) Then Qy = YL(i)
If Ry > YL(i) Then Ry = YL(i)
Next i
'************以下计算方次 mx my************************
Dim mx As Single '计算 X轴方次
Dim Px2 As Single

Dim AverX, AverY As Single
AverX = 0: AverY = 0
For i = 1 To n
AverX = AverX + XL(i)
AverY = AverY + YL(i)
Next i
AverX = AverX / n
AverY = AverY / n
mx = 0
Px2 = AverX
Select Case Abs(Px2)
Case Is < 0.1
Do
Px2 = Px2 * 10
mx = mx + 1
Loop Until Abs(Px2) >= 1
Case Is >= 100
Do
Px2 = Px2 / 10
mx = mx - 1
Loop Until Abs(Px2) < 10
Case Else
mx = 0
End Select
'* * * * * * * * * * * * * * * * * * * * *
Dim my As Single '计算 Y轴方次
Dim Ry2 As Single
my = 0
Ry2 = AverY
Select Case Abs(Ry2)
Case Is < 0.1
Do
Ry2 = Ry2 * 10
my = my + 1
Loop Until Abs(Ry2) >= 1
Case Is >= 100
Do
Ry2 = Ry2 / 10
my = my - 1
Loop Until Abs(Ry2) < 10
Case Else
my = 0
End Select
'*************以下确定坐标系统*******************
xo1 = 800
Yo1 = .ScaleHeight - 600
XLast1 = .ScaleWidth - 800
YLast1 = 600 '600 越小,上框越上
XoXL1 = XLast1 - xo1
YoYL1 = Yo1 - YLast1

OP = Ox - PX
QR = Qy - Ry

Xo = Format((((PX - OP / 8)) * 10 ^ mx), "#0.00") / 10 ^ mx '20越大,点越稀
Yo = Format((((Ry - QR / 8)) * 10 ^ my), "#0.00") / 10 ^ my
Xlast = Xo + 10 * Format(OP / 8 * 10 ^ mx, "#0.00") / 10 ^ mx
Ylast = Yo + 10 * Format(QR / 8 * 10 ^ my, "#0.00") / 10 ^ my

XoXL = Xlast - Xo 'X轴长度
YoYL = Ylast - Yo 'Y轴长度

LscaleX = Xo - XoXL / XoXL1 * xo1
LscaleY = Ylast + YoYL / YoYL1 * YLast1
RscaleX = Xlast + XoXL / XoXL1 * (.ScaleWidth - XLast1)
RscaleY = Yo - YoYL / YoYL1 * (.ScaleHeight - Yo1)

'****************画轴*********************
.FontBold = False
.DrawWidth = 1
Picobj.Line (xo1, Yo1)-(XLast1, Yo1)
Picobj.Line (xo1, Yo1)-(xo1, YLast1)

'****************以下画刻度****************************************************************
For i = 1 To 10
Picobj.Line (xo1 + XoXL1 / 10 * i, Yo1)-(xo1 + XoXL1 / 10 * i, Yo1 - 80)
Picobj.Line (xo1, Yo1 - YoYL1 / 10 * i)-(xo1 + 80, Yo1 - YoYL1 / 10 * i)
Next i
'******************以下标注坐标轴*********************************

.FontSize = 9

For i = 0 To 10
Dim Ax As Single
Ax = XoXL / 10 * i + Xo '标注 X轴
.CurrentX = xo1 + XoXL1 / 10 * i
.CurrentY = Yo1
Picobj.Print Format(Ax * (10 ^ mx), "#0.00")

Dim Ay As Single
Ay = YoYL / 10 * i + Yo '标注 Y轴
.CurrentX = xo1 - 500 '500越大,Y轴坐标离Y轴越远
.CurrentY = Yo1 - YoYL1 / 10 * i
Picobj.Print Format(Ay * (10 ^ my), "#0.00")
Next i
'**************打印坐标轴名称*************************************
'* * * *打印 X轴名称
.FontSize = 12
.FontBold = True
.CurrentX = xo1 + XoXL1 / 2 '定在中间
.CurrentY = Yo1 + 150 '300越大,距轴越远
Select Case mx
Case Is >= 2
Picobj.Print xcaption &amp; "(" &amp; "×E-" &amp; mx &amp; ")"
Case Is <= -2
Picobj.Print xcaption &amp; "(" &amp; "×E+" &amp; Abs(mx) &amp; ")"
Case Else
Picobj.Print xcaption
End Select

'* * * * * 打印 Y轴名称 * * * *
' .CurrentX = xo1 - 500 '500越大,越往左
' .CurrentY = YLast1 - 300 '200越大,越往上
' Select Case my
' Case Is >= 2
' Picobj.Print Ycaption &amp; "(" &amp; "×E-" &amp; my &amp; ")"
' Case Is <= -2
' Picobj.Print Ycaption &amp; "(" &amp; "×E+" &amp; Abs(my) &amp; ")"
' Case Else
' Picobj.Print Ycaption
' End Select

Set fnt = New CLogFont
Set fnt.LogFont = Picobj.Font
Dim hFont As Long
fnt.Rotation = 90

hFont = SelectObject(.hDC, fnt.Handle)
.CurrentX = 50
.CurrentY = .ScaleHeight / 2
Select Case my
Case Is >= 2
Picobj.Print Ycaption &amp; "(" &amp; "×E-" &amp; my &amp; ")"
Case Is <= -2
Picobj.Print Ycaption &amp; "(" &amp; "×E+" &amp; Abs(my) &amp; ")"
Case Else
Picobj.Print Ycaption
End Select


Call SelectObject(.hDC, hFont)




'****************打印标题***********************
' .FontName = "隶书"
.FontSize = 15
Dim Length As Integer
Length = Len(Title)
If Length <= 10 Then .CurrentX = .ScaleWidth / 3
If Length > 10 Then .CurrentX = .ScaleWidth / 4

.CurrentY = 50
Picobj.Print Title
'***************确定实际坐标系统*********************************
Picobj.Scale (LscaleX, LscaleY)-(RscaleX, RscaleY)
End With

End Sub


'****************描点子过程****************
'条件:坐标系统必须已定
Sub PaintSet(x() As Single, y() As Single, n As Integer)
Dim i As Integer
For i = 1 To n
frmmain.picpaint.DrawWidth = 5
frmmain.picpaint.CurrentX = x(i)
frmmain.picpaint.CurrentY = y(i)
frmmain.picpaint.PSet (x(i), y(i))
Next i
End Sub

'*************作直线子程序*************************
'说明:1.坐标系统必须已给出
' 2.坐标轴原点坐标Xo,Yo及终点坐标Xlast,Ylast已算出,并设为公共变量
Sub PaintLine(x() As Single, y() As Single, n As Integer)
Dim k As Single
Dim B As Single
Dim xx1 As Single
Dim xx2 As Single
Dim yy1 As Single
Dim yy2 As Single
k = KK(x(), y(), n)
B = BB(x(), y(), n)
yy1 = k * Xo + B
xx1 = (Yo - B) / k
yy2 = k * Xlast + B
xx2 = (Ylast - B) / k
frmmain.picpaint.DrawWidth = 1
If k > 0 Then
If xx1 < Xo Then xx1 = Xo
If yy1 < Yo Then yy1 = Yo
If xx2 > Xlast Then xx2 = Xlast
If yy2 > Ylast Then yy2 = Ylast
frmmain.picpaint.Line (xx1, yy1)-(xx2, yy2), QBColor(12)
End If
If k < 0 Then
If xx2 < Xo Then xx2 = Xo
If yy1 > Ylast Then yy1 = Ylast
If xx1 > Xlast Then xx1 = Xlast
If yy2 < Yo Then yy2 = Yo
frmmain.picpaint.Line (xx2, yy1)-(xx1, yy2), QBColor(12)
End If

End Sub













 

来了就好。

用Delphi吧!

 
for i:=1 to 20 do
begin
...
TChart.Series.Add( A )
...
end

// Easy !!!!
 
接受答案了.
 
后退
顶部