vb 彩色等值线图Word文档下载推荐.docx

vb 彩色等值线图Word文档下载推荐.docx

《vb 彩色等值线图Word文档下载推荐.docx》由会员分享，可在线阅读，更多相关《vb 彩色等值线图Word文档下载推荐.docx（10页珍藏版）》请在冰豆网上搜索。

2．程序组成

（1）BAS模块modParameter

声明公有变量。

（2）窗体frmFileName

利用驱动器列表框、目录列表框和文件列表框提供绘制等值线图的数据文件全名。

（3）窗体frmChange

在文本框中重新键入数据点间隔DX和DY，可以改变参数的缺省设置。

（4）窗体frmContour

窗体包括作为图形容器的图片框pic，加载标题的标签lblTitle，以及显示图例的图片框picLegend。

操作是通过菜单进行的，菜单项有“作图”、“退出”、“移动图题”、“改变参数”和“数据倒转”。

作图的思路很简单，作起来更简单。

判断网格点的数值大小，按图例所规定的颜色“对号入座”，在数据点上画一个正方形。

3．程序代码

’绘彩色等值线图

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

’文件窗体

DimintIAsInteger,intJAsInteger

DimintFileNumberAsInteger’文件号

DimstrDataAsString’临时保存数据

DimblnTitleAsBoolean’是否有图题

DimblnRowLabelAsBoolean’是否有行标

DimblnColLabelAsBoolean’是否有列标

PrivateSubForm_Load（）

File1.Pattern="

*.dat"

’只显示数据文件

Me.Width=5760

EndSub

’选择目录

PrivateSubDir1_Change（）

File1.Path=Dir1.Path

’选择驱动器

PrivateSubDrive1_Change（）

Dir1.Path=Drive1.Drive

’确定数据文件

PrivateSubFile1_Click（）

txtFile.Text=Dir1.Path&

"

\"

&

File1.FileName

’确定，给出文件名和行数、列数后单击

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）’取得行数

intM=intRow:

intN=intCol

M=intM:

N=intN

’重新定义图形数据数组

ReDimV（1TointM,1TointN）’数据

ReDimV1（1TointM,1TointN）’数据

Input#intFileNumber,strData’读总行数

intRowAll=Val（strData）’取得总行数

blnTitle=False:

blnRowLabel=False:

blnColLabel=False

’优先考虑图题

IfintRowAll>

intRow+3ThenblnTitle=True’有图题

’其次考虑行标

2*intRow+3Then

blnRowLabel=True’有行标

ReDimstrRowLabel（1TointRow）’重新定义行标数组

’最后考虑列标

2*intRow+4Then

blnColLabel=True’有列标

ReDimstrColLabel（1TointCol）’重新定义列标数组

IfblnTitleThen

Input#intFileNumber,strData’读图形标题

strLabelName=strData’保存图题

ForintI=2TointCol’空转，读*****号

IfblnRowLabelThen

ForintI=1TointRow

Input#intFileNumber,strData’读行标题

ForintJ=2TointCol’空转，读*****号

NextintJ

IfblnColLabelThen

ForintI=1TointCol’读列标题

ForintJ=1TointCol

Input#intFileNumber,strData’读图形数据

V（intI,intJ）=Val（strData）

V1（intI,intJ）=V（intI,intJ）

Close

frmContour.Visible=True

’退出

PrivateSubcmdEXIT_Click（）

UnloadMe

End

’改变参数

’确定

’重新取得参数值

DX=Val（txtX）:

DY=Val（txtY）’数据点间距

’彩色等值线图

’与系统所规定的屏幕坐标系一致

’既原点在左上角，Y方向向下为正，X方向向右为正

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.CurrentY=K+1

NextK

’为图例写数字

ForK=1To12

picLegend.CurrentX=1

picLegend.CurrentY=K+0.3

picLegend.Printlegend（K）

’根据网格点数值在网格点上画不同颜色的正方形

ForI=1ToM

ForJ=1ToN

IfS（I,J）<

legend（K）+PC/3Then

pic.CurrentX=J*DX-DX/2

pic.CurrentY=I*DY-DY/2

pic.Line-（J*DX+DX/2,I*DY+DY/2）,QBColor（K）,BF

GoToL

L:

NextJ

NextI

Me.Top=0

Me.Left=0

Me.Height=10000:

Me.Width=14600

PA=100000000

PB=-100000000

IfV（I,J）>

PBThenPB=V（I,J）

IfV（I,J）<

PAThenPA=V（I,J）

PC=（PB-PA）/11

DX=1:

DY=1’缺省设置间距为1厘米

lblTitle.Visible=False’图题标签不可视

mnuMove.Enabled=False’移动图题不可用

PrivateSubmnuChange_Click（）

’在参数窗体显示参数

frmChange.txtX=Str（DX）

frmChange.txtY=Str（DY）

frmChange.Visible=True

’屏幕绘图

PrivateSubmnuDraw_Click（）

pic.Cls

pic.ScaleMode=7’图片框以厘米为单位

picLegend.ScaleMode=7’图例图片框以厘米为单位

Printer.ScaleMode=7’打印机以厘米为单位

pic.Height=16:

pic.Width=20

picLegend.Left=20.5:

picLegend.Height=16

’如果点数很多，按厘米计会超出图幅，这时将使用自定义坐标系

IfN*DX>

=pic.WidthOrM*DY>

=pic.HeightThen

IfN*DX<

1.25*M*DYThen

WW=M*DY

Else

WW=N*DX/1.25

’建立自定义坐标系

pic.Scale（0,0）-（WW*1.25,WW）

lblTitle.Caption=strLabelName

ContourintM,intN,DX,DY,V

lblTitle.Visible=True’图题可视

mnuMove.Enabled=True’移动图题菜单可用

’退出，结束程序运行

PrivateSubmnuExit_Click（）

frmFileName.Visible=True

’将图片框pic的DragMode属性设为0-Manual，可以利用鼠标手动拖动pic

PrivateSubpic_DragDrop（SourceAsControl,XAsSingle,YAsSingle）

Source.MoveX+pic.Left-sngX,Y+pic.Top-sngY

’按下鼠标时记下pic的当前位置

PrivateSubpic_MouseDown（ButtonAsInteger,ShiftAsInteger,_

XAsSingle,YAsSingle）

sngX=X:

sngY=Y

pic.DragvbBeginDrag

’下移标题

PrivateSubmnuDown_Click（）

lblTitle.Top=lblTitle.Top+0.1

lblTitle.MovelblTitle.Left,lblTitle.Top

’左移标题

PrivateSubmnuLeft_Click（）

lblTitle.Left=lblTitle.Left-0.1

’右移标题

PrivateSubmnuRight_Click（）

lblTitle.Left=lblTitle.Left+0.1

’上移标题

PrivateSubmnuUP_Click（）

lblTitle.Top=lblTitle.Top-0.1

’数据行和数据列都倒转

PrivateSubmnuBoth_Click（）

IfintRow<

>

intColThen

MsgBox"

数据行数与数据列数不相等，不能交换数据！

"

ExitSub

’数据列倒转

ForI=1TointRow

ForJ=1TointCol\2

D=V（intCol-J+1,I）

V（intCol-J+1,I）=V（J,I）

V（J,I）=D

’数据行倒转

ForI=1TointRow\2

ForJ=1TointCol

D=V（J,intRow-I+1）

V（J,intRow-I+1）=V（J,I）

PrivateSubmnuRow_Click（）

PrivateSubmnuCol_Click（）

’使用原始数据

PrivateSubmnuSource_Click（）

V（J,I）=V1（J,I）

4．运行

（1）确定作图文件

启动后，可以通过驱动器列表框、目录列表框和文件列表框选择作图文件（见图5-3）。

这一次仍然使用“网格_6.dat”，其路径可以从图5-3了解。

（2）改变参数

单击“确定”后，进入图形窗体。

缺省的数据点在X和Y两个方向上的间距都是1。

单击“改变参数”菜单，将间距（DX和DY）都改成0.5。

（3）作图

单击图形窗体的“作图”菜单，程序用所提供的数据文件绘制彩色等值线图（见图5-5）。

在等值线图的右侧显示图例（见图5-6）。

在改变参数或进行数据倒转之后，都需要单击“作图”菜单重新绘图。

（4）移动图题

原来的图题在图片框的右上方，可以使用“移动图题”菜单中的子菜单改变图题的位置。

直接使用快捷键会更方便。

上移可以使用Ctrl+U，下移可以使用Ctrl+D，右移可以使用Ctrl+R，左移可以使用Ctrl+L。

图5-5的图题位置在图形的下方，是使用快捷键移动后的结果。

图5-5按数据“网格_6”所绘制的彩色等值线图图5-6彩色等值线图所显示的图例

（5）打印

程序不再具有直接打印功能，但可以用键盘上的抓图键将图件放入剪贴板，然后利用Windows的画图软件进行编辑并打印。