VB 坐标系的问题
我是VB菜鸟，想参考并利用上面链接文章里提供的自适应坐标系，但是为何我画的曲线显示不出来？如果您能解决的话，最好留个QQ给我，150银子答谢。
怎么没人帮忙啊，我着急解决啊，十一点之前可给答案的，追加50银子答谢。 展开
{已按你的要求修改了代码}你QQ我忘了是哪个，发不了，，（需要源码文件Q我）
已按要救改了代码，，给分哈哈，200哈哈
我整理了一下，你新建一个工程，到代码中全部复制，
控件先：
1． 进入VB6开发环境，打开新的标准工程（Standard EXE），工程名称可改为prjCdntDemo,Form1的Name改为frmMain，Caption为“自适应坐标演示:dFindStep()函数”，Width为6150， Height为4995。
2． 按图一布置9个CommandButton控件和一个PictureBox控件,各CommandButton的Name,Caption属性为：cmdXUp, 水平放大；cmdXDown, 水平缩小；cmdYUp, 垂直放大；cmdYDown, 垂直缩小；cmdLeft, 向左移动；cmdRight, 向右移动；cmdUp, 向上移动；cmdDown, 向下移动；cmdClose, 退出；PictureBox控件的Name为picCoordinate,Top为1020,Left为0,Width为6000,Height为3500。其它属性缺省。
这个是必须的，，下面就是复制代码了，，，，
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private dStartX As Double '物理坐标水平起始值
Private dEndX As Double '物理坐标水平终止值
Private dStartY As Double '物理坐标垂直起始值
Private dEndY As Double '物理坐标垂直终止值
Private b(100) As Double
Private Function dFindStep(StepMin As Double) As Double
Dim dStep As Double '搜索比较值
Dim dStepOld As Double
If StepMin = 0 Then '若StepMin等于零则返回零
dFindStep = 0
Exit Function
End If
StepMin = Abs(StepMin) '若小于零则取其绝对值
dStep = 50 '从规范间隔数序列中的50开始搜索
If StepMin < dStep Then '若X<50，则不断往左搜索
While StepMin < dStep '此时dStep=50,5,0.5...等
dStepOld = dStep
dStep = dStep / 2.5 '此时dStep=20,2,0.2...等
If StepMin < dStep Then
dStepOld = dStep
dStep = dStep / 2 '此时dStep=10,1,0.1...等
If StepMin < dStep Then
dStepOld = dStep
dStep = dStep / 2 '此时dStep=5,0.5,0.05...等
End If
End If
Wend
dFindStep = dStepOld ' 因为dStep<StepMin<dStepOld,所以返回值为dStepOld
Else '若X>=50，则不断往右搜索
While StepMin > dStep '此时dStep=50,500,5000...等
dStep = dStep * 2 '此时dStep=100,1000,10000...等
If StepMin > dStep Then
dStep = dStep * 2 '此时dStep=200,2000,20000...等
If StepMin > dStep Then
dStep = dStep * 2.5 '此时dStep=500,5000,50000...等
End If
End If
Wend
dFindStep = dStep '返回dStep
End If
End Function
Private Sub DrawCoordinate(iCrossX As Integer, iCrossY As Integer, iWidth As Integer, iHeight As Integer, dStartX As Double, dStartY As Double, dEndX As Double, dEndY As Double)
Dim dCdnStep As Double '物理数值步长
Dim lCdnStep As Long '窗口数值步长
Dim crtPosition As Long '当前窗口坐标位置
Dim UpN As Double '最大格数
Dim dRemain As Double '第一个坐标格的物理坐标长度
Dim dValue As Double '当前物理坐标位置
Dim i As Integer
Dim strTemp As String '存储坐标标注文本
Dim strFormat As String '坐标标注文本的格式
Dim dHeight As Double '物理坐标高度
Dim dWidth As Double '物理坐标宽度
dHeight = dEndY - dStartY
dWidth = dEndX - dStartX
picCoordinate.Cls '对画图区域进行清屏
'画带有箭头的两根坐标轴
picCoordinate.Line (iCrossX, iCrossY)-(iCrossX + iWidth + 200, iCrossY), RGB(0, 0, 255)
picCoordinate.Line (iCrossX, iCrossY)-(iCrossX, iCrossY - iHeight - 200), RGB(0, 0, 255)
picCoordinate.Line (iCrossX, iCrossY - iHeight - 200)-(iCrossX - 30, iCrossY - iHeight), RGB(0, 0, 255)
picCoordinate.Line (iCrossX, iCrossY - iHeight - 200)-(iCrossX + 30, iCrossY - iHeight), RGB(0, 0, 255)
picCoordinate.Line (iCrossX + iWidth + 200, iCrossY)-(iCrossX + iWidth, iCrossY - 30), RGB(0, 0, 255)
picCoordinate.Line (iCrossX + iWidth + 200, iCrossY)-(iCrossX + iWidth, iCrossY + 30), RGB(0, 0, 255)
'接着画Y轴坐标格
'计算屏幕显示的像素限制下的坐标格最大数目
UpN = iHeight / Me.picCoordinate.TextHeight("8")
'计算自适应坐标格间隔大小
dCdnStep = dFindStep(dHeight / UpN)
'计算坐标格起始位置
dRemain = (Int(dStartY / dCdnStep) + 1) * dCdnStep - dStartY
If dRemain = dCdnStep Then dRemain = 0
dValue = dStartY + dRemain
lCdnStep = dCdnStep * iHeight / dHeight
crtPosition = iCrossY - dRemain * iHeight / dHeight
'计算自适应坐标间隔后的实际坐标格数目
UpN = Int(dHeight / dCdnStep)
If crtPosition - UpN * lCdnStep > iCrossY - iHeight Then UpN = UpN + 1
'根据坐标间隔大小选择不同的坐标值显示格式
If dCdnStep > 1 Then
strFormat = "######0"
Else
strFormat = "#####0.#####"
End If
'画坐标格
For i = 1 To UpN
picCoordinate.Line (iCrossX, crtPosition)-(iCrossX + 100, crtPosition), RGB(0, 0, 255)
strTemp = CStr(Format(dValue, strFormat))
TextOut picCoordinate.hdc, (iCrossX - 40 - Len(strTemp) * picCoordinate.TextWidth("8")) / Screen.TwipsPerPixelX, (crtPosition - picCoordinate.TextHeight("8") / 2) / Screen.TwipsPerPixelY, strTemp, Len(strTemp)
dValue = dValue + dCdnStep ' WaveScreen.Left - 100 ,
crtPosition = crtPosition - lCdnStep
Next i
'然后画X轴坐标格，方法步骤与画Y轴坐标类似
UpN = iWidth / Me.picCoordinate.TextWidth("8") / CInt(Abs(Log(dEndX - dStartX) / Log(10#)) + 4)
dCdnStep = dFindStep(dWidth / UpN)
dRemain = Int(dStartX / dCdnStep + 1) * dCdnStep - dStartX
If dRemain = dCdnStep Then dRemain = 0
dValue = dStartX + dRemain
lCdnStep = dCdnStep * iWidth / dWidth
crtPosition = iCrossX + dRemain * iWidth / dWidth
UpN = Int(dWidth / dCdnStep)
If crtPosition + UpN * lCdnStep < iCrossX + iWidth Then UpN = UpN + 1
If dCdnStep > 1 Then
strFormat = "######0"
Else
strFormat = "#####0.#####"
End If
For i = 1 To UpN
picCoordinate.Line (crtPosition, iCrossY)-(crtPosition, iCrossY - 100), RGB(0, 0, 255)
strTemp = CStr(Format(dValue, strFormat))
TextOut picCoordinate.hdc, (crtPosition - Len(strTemp) * picCoordinate.TextWidth("8") / 2) / Screen.TwipsPerPixelX, (iCrossY + 240 - picCoordinate.TextHeight("8")) / Screen.TwipsPerPixelY, strTemp, Len(strTemp)
dValue = dValue + dCdnStep
crtPosition = crtPosition + lCdnStep
Next i
End Sub
Private Sub cmdClose_Click()
End '结束程序
End Sub
Private Sub cmdDown_Click()
Dim dStep As Double
dStep = (dEndY - dStartY) / 4
dStartY = dStartY + dStep
dEndY = dEndY + dStep
画坐标轴
定义的函数关系
End Sub
Private Sub cmdLeft_Click()
Dim dStep As Double
dStep = (dEndX - dStartX) / 4
dStartX = dStartX + dStep
dEndX = dEndX + dStep
画坐标轴
定义的函数关系
End Sub
Private Sub cmdRight_Click()
Dim dStep As Double
dStep = (dEndX - dStartX) / 4
dStartX = dStartX - dStep
dEndX = dEndX - dStep
画坐标轴
定义的函数关系
End Sub
Private Sub cmdUp_Click()
Dim dStep As Double
dStep = (dEndY - dStartY) / 4
dStartY = dStartY - dStep
dEndY = dEndY - dStep
画坐标轴
定义的函数关系
End Sub
Private Sub cmdXDown_Click()
dEndX = dStartX + (dEndX - dStartX) * 1.5
画坐标轴
定义的函数关系
End Sub
Private Sub cmdXUp_Click()
dEndX = dStartX + (dEndX - dStartX) / 1.5
画坐标轴
定义的函数关系
End Sub
Private Sub cmdYDown_Click()
dEndY = dStartY + (dEndY - dStartY) * 1.5
画坐标轴
定义的函数关系
End Sub
Private Sub cmdYUp_Click()
dEndY = dStartY + (dEndY - dStartY) / 1.5
画坐标轴
定义的函数关系
End Sub
Private Sub Command3_Click()
a = Int(100 * Rnd + 1)
Text1.Text = a
End Sub
Private Sub Form_Load()
dStartX = 0
dStartY = 0
dEndX = 1000
dEndY = 600
End Sub
Private Sub 画坐标轴()
Dim iCrossX As Integer '两坐标轴交点的窗口坐标X
Dim iCrossY As Integer '两坐标轴交点的窗口坐标Y
Dim iHeight As Integer '坐标轴的窗口坐标高度
Dim iWidth As Integer '坐标轴的窗口坐标宽度
Dim i As Integer
Dim dX As Double '示意波形的物理坐标X
Dim dY As Double '示意波形的物理坐标Y，或窗口坐标Y
iCrossX = 600
iCrossY = picCoordinate.Height - 500
iWidth = picCoordinate.Width - 1000
iHeight = picCoordinate.Height - 1000
Call DrawCoordinate(iCrossX, iCrossY, iWidth, iHeight, dStartX, dStartY, dEndX, dEndY)
End Sub
Private Sub Form_Resize()
If Me.Height < 4000 Then Me.Height = 4000
picCoordinate.Width = Me.Width - 150
picCoordinate.Height = Me.Height - 1500
画坐标轴
定义的函数关系
End Sub
Private Sub 画图(x As Double, y As Double)
picCoordinate.PSet (600 + (x * ((picCoordinate.Width - 1000) / (dEndX - dStartX))), picCoordinate.Height - 500 - (y * ((picCoordinate.Height - 1000) / (dEndY - dStartY)))), RGB(255, 0, 0)
End Sub
Private Sub 定义的函数关系()
Dim a As Integer
Dim c As Double
Dim d As Double
For a = 0 To 100
If b(a) = 0 Then
b(a) = Int(100 * Rnd + 1)
d = b(a)
If dStartY < 0 Then
d = d + Abs(dStartY)
End If
Else
d = b(a)
If dStartY < 0 Then
d = d + Abs(dStartY)
End If
End If
If dStartX < 0 Then
c = Abs(dStartX) + a
Else
c = a
End If
画图 c, d
Next a
End Sub
QQ:506653350 注明百度知道
