vb 彩色等值线图.docx
- 文档编号:5608692
- 上传时间:2022-12-29
- 格式:DOCX
- 页数:10
- 大小:19.30KB
vb 彩色等值线图.docx
《vb 彩色等值线图.docx》由会员分享,可在线阅读,更多相关《vb 彩色等值线图.docx(10页珍藏版)》请在冰豆网上搜索。
vb彩色等值线图
vb彩色等值线图
这里所谓“彩色等值线图”,是在彩色屏幕上利用颜色的变化表示观测值或处理结果的区域分布。
1.功能和特点
•在绘制等值线图时,使用图片框作为图形容器(参见第1章)。
•所提供的彩色等值线图程序,只能用于网格化后的数据。
非网格化的离散数据需要使用本书第8章所提供的方法先进行网格化,然后再调用程序作图。
•与本书所规定的数据文件配套使用。
数据文件的行,相当于图形网格的Y方向,数据文件的列,相当于图形网格的X方向。
数据文件的标题相当于图题。
屏幕将显示图题。
•坐标系与系统所规定的坐标系一致。
即原点在屏幕的左上角,Y轴向下为正,X轴向右为正。
这样做的一个好处是,图形与数据文件的排列一致。
在读者建立数据文件时,对区域数据按上北下南,左西右东的顺序,所绘制的等值线图也保持这样的格局。
在图形的高度不超过16厘米、图形的宽度不超过20厘米的情况下,绘图时所用的单位为厘米。
只要有一方超过了,则程序将自动换成自定义坐标系,不管图形有多大,都将压缩到自定义坐标系所规定的区域内,Y轴仍保持向下为正,X轴仍保持向右为正。
•通过菜单可以实现数据行和数据列的倒转,有关数据倒转可以参阅5.4.4的图5-9。
•网格在X和Y两个方向上的缺省间距都设定为1,即DX=1,DY=1。
可以通过“改变参数”菜单,改变DX或DY的设置。
在厘米坐标系下,DX或DY值的改变都可以使图形大小或形状发生变化。
在自定义坐标系下,DX或DY的改变,只要两者相等,就不再影响到图形的大小,如果不等,将使图形拉长或压缩。
•起始等值线PA固定取函数的最小值,终止等值线PB固定取函数的最大值。
设定12条等值线,这样等值线的间隔PC=(PB-PA)/12,也是固定的。
“改变参数”菜单中,不再包括改变PA或PB或PC的设置。
•每条等值线对应一种颜色,一共有12种颜色。
在设定颜色时使用VB的QBColor函数。
在图形的右侧包括有图例,可以看出不同的颜色所表示的数值。
•图题与图形的相对位置可以用菜单命令进行调整。
•在编制这个程序时,在指导思想上要求图形尽量保持原始状态,没有进行光顺处理,输出的图形是锯齿状的。
但如果我们预先利用插值方法增加数据点的密度,减少数据点的间距,如果需要也可以进行光顺处理,也会得到很美观的图形。
2.程序组成
(1)BAS模块modParameter
声明公有变量。
(2)窗体frmFileName
利用驱动器列表框、目录列表框和文件列表框提供绘制等值线图的数据文件全名。
(3)窗体frmChange
在文本框中重新键入数据点间隔DX和DY,可以改变参数的缺省设置。
(4)窗体frmContour
窗体包括作为图形容器的图片框pic,加载标题的标签lblTitle,以及显示图例的图片框picLegend。
操作是通过菜单进行的,菜单项有“作图”、“退出”、“移动图题”、“改变参数”和“数据倒转”。
作图的思路很简单,作起来更简单。
判断网格点的数值大小,按图例所规定的颜色“对号入座”,在数据点上画一个正方形。
3.程序代码
(1)BAS模块modParameter
’绘彩色等值线图
OptionExplicit
PublicintRowAsInteger’行数
PublicintRowAllAsInteger’总行数
PublicintColAsInteger’列数
PublicstrFileNameAsString’数据文件
PublicstrLabelNameAsString’图形标题
PublicintMAsInteger,intNAsInteger
PublicV()AsDouble,V1()AsDouble
PublicMAsInteger,NAsInteger’数据点的行数和列数
PublicDXAsDouble,DYAsDouble’数据点在X和Y方向上的间距
’PA是初始等值线,缺省以最小值作为初始等值线值
’PB是终止等值线,缺省以最大值作为终止等值线值
’PC是等值线间距,缺省按12条等值线计算
PublicPAAsDouble,PBAsDouble,PCAsDouble
(2)窗体frmFileName
’文件窗体
OptionExplicit
DimintIAsInteger,intJAsInteger
DimintFileNumberAsInteger’文件号
DimstrDataAsString’临时保存数据
DimblnTitleAsBoolean’是否有图题
DimblnRowLabelAsBoolean’是否有行标
DimblnColLabelAsBoolean’是否有列标
PrivateSubForm_Load()
File1.Pattern="*.dat"’只显示数据文件
Me.Width=5760
EndSub
’选择目录
PrivateSubDir1_Change()
File1.Path=Dir1.Path
EndSub
’选择驱动器
PrivateSubDrive1_Change()
Dir1.Path=Drive1.Drive
EndSub
’确定数据文件
PrivateSubFile1_Click()
txtFile.Text=Dir1.Path&"\"&File1.FileName
EndSub
’确定,给出文件名和行数、列数后单击
PrivateSubcmdOK_Click()
strFileName=txtFile.Text’文件名
intFileNumber=FreeFile’取得空闲的文件号码
OpenstrFileNameForInputAsintFileNumber
Input#intFileNumber,strData’读列数
intCol=Val(strData)’取得列数
IfintCol>=2Then
ForintI=2TointCol’空转,读*****
Input#intFileNumber,strData
NextintI
EndIf
Input#intFileNumber,strData’读行数
intRow=Val(strData)’取得行数
IfintCol>=2Then
ForintI=2TointCol’空转,读*****
Input#intFileNumber,strData
NextintI
EndIf
intM=intRow:
intN=intCol
M=intM:
N=intN
’重新定义图形数据数组
ReDimV(1TointM,1TointN)’数据
ReDimV1(1TointM,1TointN)’数据
Input#intFileNumber,strData’读总行数
intRowAll=Val(strData)’取得总行数
IfintCol>=2Then
ForintI=2TointCol’空转,读*****
Input#intFileNumber,strData
NextintI
EndIf
blnTitle=False:
blnRowLabel=False:
blnColLabel=False
’优先考虑图题
IfintRowAll>intRow+3ThenblnTitle=True’有图题
’其次考虑行标
IfintRowAll>2*intRow+3Then
blnRowLabel=True’有行标
ReDimstrRowLabel(1TointRow)’重新定义行标数组
EndIf
’最后考虑列标
IfintRowAll>2*intRow+4Then
blnColLabel=True’有列标
ReDimstrColLabel(1TointCol)’重新定义列标数组
EndIf
IfblnTitleThen
Input#intFileNumber,strData’读图形标题
strLabelName=strData’保存图题
IfintCol>=2Then
ForintI=2TointCol’空转,读*****号
Input#intFileNumber,strData
NextintI
EndIf
EndIf
IfblnRowLabelThen
ForintI=1TointRow
Input#intFileNumber,strData’读行标题
IfintCol>=2Then
ForintJ=2TointCol’空转,读*****号
Input#intFileNumber,strData
NextintJ
EndIf
NextintI
EndIf
IfblnColLabelThen
ForintI=1TointCol’读列标题
Input#intFileNumber,strData
NextintI
EndIf
ForintI=1TointRow
ForintJ=1TointCol
Input#intFileNumber,strData’读图形数据
V(intI,intJ)=Val(strData)
V1(intI,intJ)=V(intI,intJ)
NextintJ
NextintI
Close
frmContour.Visible=True
EndSub
’退出
PrivateSubcmdEXIT_Click()
UnloadMe
End
EndSub
(3)窗体frmChange
’改变参数
OptionExplicit
’确定
PrivateSubcmdOK_Click()
’重新取得参数值
DX=Val(txtX):
DY=Val(txtY)’数据点间距
UnloadMe
EndSub
(4)窗体frmContour
’彩色等值线图
’与系统所规定的屏幕坐标系一致
’既原点在左上角,Y方向向下为正,X方向向右为正
OptionExplicit
DimsngXAsSingle,sngYAsSingle
DimWWAsSingle
DimIAsInteger,JAsInteger,KAsInteger
DimDAsDouble
’画彩色等值线过程
PrivateSubContour(M,N,DX,DY,S)
Dimlegend(1To12)AsDouble,WAsDouble
K=1
ForW=PAToPB+0.00000001StepPC
legend(K)=W
K=K+1
NextW
’画图例
picLegend.CurrentX=0.5
picLegend.CurrentY=1
ForK=1To12’12个等级
picLegend.Line-(1,K+1),QBColor(K),BF
picLegend.CurrentX=0.5
picLegend.CurrentY=K+1
NextK
’为图例写数字
ForK=1To12
picLegend.CurrentX=1
picLegend.CurrentY=K+0.3
picLegend.Printlegend(K)
NextK
’根据网格点数值在网格点上画不同颜色的正方形
ForI=1ToM
ForJ=1ToN
ForK=1To12
IfS(I,J)
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- vb 彩色等值线图 彩色 等值 线图