surfer 8 scripter 学习笔记9surfer与VB结合的VB源代码

抽空写了一个。

发现删除surfer 8,安装surfer11，程序仍能运行。

'2013.05.19
'白话魔法师

Option Explicit

Private Sub Command1_Click()
    Dim srf        As New Surfer.Application
    Dim poltDoc    As Surfer.IPlotDocument
    Dim mapFrame   As Surfer.IMapFrame
    Dim mapContour As Surfer.IContourMap
    Dim ColorScale As Surfer.IdiscreteColorScale
    Dim mapBase    As Surfer.IBaseMap
    Dim shpText    As Surfer.IText
    Dim Axis       As Surfer.IAxis

    '是否显示surfer界面
    srf.Visible = False
    '增加绘图文档
    Set poltDoc = srf.Documents.Add(srfDocPlot)
    '网格化
    srf.GridData DataFile:=App.Path & "\1.xls",xCol:=1,yCol:=2,zCol:=3,NumCols:=200,NumRows:=200,xMin:=106.6333,xMax:=108.5333,_
            yMin:=30.3333,yMax:=32.35,showreport:=False,outgrid:=App.Path & "\1.Grd"
    DoEvents
    '白化
    srf.GridBlank ingrid:=App.Path & "\1.Grd",blankfile:=App.Path & "\CityBlank.bln",outgrid:=App.Path & "\out.Grd"
    '等值线
    Set mapFrame = poltDoc.Shapes.AddContourMap(App.Path & "\out.Grd")

    '轴线
    For Each Axis In mapFrame.Axes
        Axis.Visible = False
    Next
    '等值线属性设置
    Set mapContour = mapFrame.Overlays(1)

    With mapContour
        .FillContours = True
        .BlankLine.Style = "solid"
        '        .BlankLine.Width = 0.015
        .SmoothContours = srfConSmoothHigh
        .Levels.LoadFile App.Path & "\R24level.lvl"
    End With
    '加载底图
    Set mapFrame = poltDoc.Shapes.AddBaseMap(App.Path & "\MidCountry.bna")
    Set mapBase = mapFrame.Overlays(1)
    mapBase.Line.Width = 0.01
    '    Set mapFrame = poltDoc.Shapes.AddBaseMap(App.Path & "\CityBlank.bln")
    '    Set mapBase = mapFrame.Overlays(1)
    '    mapBase.Line.Width = 0.015
    '叠放
    poltDoc.Shapes.SelectAll
    poltDoc.Selection.OverlayMaps
    mapContour.ShowColorScale = True
    Set ColorScale = mapContour.ColorScale
    
    With ColorScale
        .LabelFont.Size = 22
        .Top = 4
        .Left = 6.2
        .Height = 1.2
        .Width = 0.5
    End With
    '加载文字--标题
    Set shpText = poltDoc.Shapes.AddText(1,1,"不明物质分布图")

    With shpText
        .Top = 2.2
        .Left = 4.3
        .Font.VAlign = srftAVCenter
        .Font.HAlign = srftACenter
        .Font.Bold = True
        .Font.Size = 12
    End With
    '加载文字--图例
    Set shpText = poltDoc.Shapes.AddText(1,"图例")

    With shpText
        .Top = 4.2
        .Left = 6.4
        .Font.VAlign = srftAVCenter
        .Font.HAlign = srftACenter
        .Font.Bold = True
    End With
    '输出图片，加载到程序中
    poltDoc.Export App.Path & "\p1.emf"
    Image1.Picture = LoadPicture(App.Path & "\p1.emf")
    srf.Documents.CloseAll srfSaveChangesNo
    srf.Quit
End Sub

-----------------------

右边是一些设置，是一个完善和自制化。

比如：

1、设置文本内容，这样就可以自定义文本了。

2、选择是否显示边界、站点名（就是加载Post图，程序中没有编出）

3、还可以设置一些颜色条的自制。

等等，这个是根据个人需要自已来弄。

感觉，全英文的的确费力。还好Scripter的较简单，加上微软的翻译。

推荐一下，还是用必应的翻译，因为这个对编程的翻译比金山和有道更强一些（其它类的还是用金山和有道吧）