MapX系列-- 使用LayerInfo object 在map中添加栅格图层

使用LayerInfo object map中添加栅格图层

     对于一副栅格图像,在Mapinfo里配准后就会发现在原来的.bmp或者.jpg文件的基础上会新生成一个同名的.tab文件。

mapX支持的栅格格式还是比较多的,包括:

l         TIFF (*.tif)

l         MrSID (*.sid)

l         ECW (*.ecw)

l         Spot (*.bil)

l         Jpeg (*.jpg)

l         PCX (*.pcx)

l         GIF (*.gif)

l         Windows Bitmap (*.bmp)

l         PNG (*.png)

l         Photoshop (*.psd)

l         Targa (*.tga)

l         Windows Metafile (*.wmf)

l         JPEG200 (*.jp2)

如果是未配准的栅格图像,用LayerInfo object加载图层时需要将LayerType设为miLayerInfoTypeRaster,如果是做了配准的图像,即拥有.tab文件,就可以通过LayerTypemiLayerInfoTypeTab来添加。这里需要指定一个类型为miLayerInfoTypeTabLayerInfo,然后在AddParameter里指定文件路径即可。如下例:

Dim LInfo As Object

            LInfo = New LayerInfo

            LInfo.Type = miLayerInfoTypeTab

            LInfo.AddParameter("FileSpec", App.Path + "/MAP/TEST.TAB")

            Map.Layers.Add(LInfo)

        LInfo = Nothing

这里需要注意的是栅格图像的配准至少要有四个控制点,因为在mapInfo下加三个控制点就能显示,但这并不意味着在mapX下也可以这样做。可以将rasterTAB文件用记事本打开,其基本内容很简单,主要信息就是控制点和投影、地图单位等信息。如下例:

!table

!version 300

!charset WindowsSimpChinese

 

Definition Table

  File "d.jpg"

  Type "RASTER"

  (96686758.790000007,147368076) (0,0) Label "Pt 1",

  (97313387.459999993,147467938.80000001) (636,464) Label "Pt 2",

  (97101838.840000004,146804580.19999999) (18,460) Label "Pt 3",

  (96987043.680000007,147744129.69999999) (624,22) Label "Pt 4",

  (96980018.010000005,147320946.59999999) (318,212) Label "Pt 5",

  (96995695.459999993,147086037.90000001) (154,310) Label "Pt 6"

  CoordSys Earth Projection 8, 104, "m", -57, 0, 0.9996, 500000, 10000000

  Units "m"

*注意:最后一个控制点记录后没有逗号。

做测试时,可以随便拿一个jpg或者bmp文件在mapInfo里做简单的配准,只要能和矢量叠加显示即可,但要保证至少4个控制点,否则mapX加载栅格时会出现Unexpected error in MapXError N10011),No source field specifiedError N1017),或者Invalid datum错误。

以下VB代码允许用户在地图框里通过拖绘矩形动态地生成一个栅格图层,栅格图像的位置及大小与拖绘的矩形一样。栅格文件使用bmp格式,用矩形的四个角的坐标为控制点,这里是人为生成对应于该栅格图层的.tab文件,然后把这个栅格图层加载进来,实现拖框画矩形栅格的功能。bmp文件是借助一个不可见的PictureBox来生成的,其中LoadPicture()SavePicture()VB自己的函数。其中Picture1.Picture = LoadPicture()PictureBox的图片清空,CreateRasterBlock(Picture1.hdc, Rw, Rh)是自定义的函数,用于生成bmp位图。如果是VB.NET那么位图可以不借助picbox来做,这里借用Pixbox主要是为了在内存中生成一个bimap并且把它存储出来。另外pgFoMain里的一个状态条,即ProgressBar

Private Sub Map_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)

    If Me.Map.CurrentTool = CREATE_RASTER_BLOCK_TOOL And mDown Then

        Dim legth As Long

        Me.Map.MapUnit = miUnitMeter

        SBRX = x

        SBRY = y

        MBRX = MapX

        MBRY = MapY

        legth = Me.Map.Distance(MTLX, MTLY, MBRX, MBRY)

            If legth > 150 Thene

            Dim Rh As Long, Rw As Long, Rn As Boolean  'Raster height,raster width ,raster name

            Rw = Map.Distance(MTLX, MTLY, MBRX, MTLY) / RASTER_RESOLUTION

            Rh = Map.Distance(MTLX, MTLY, MTLX, MBRY) / RASTER_RESOLUTION

            Picture1.Width = Rw     如果Formscalemode使用twip,而Picturebox使用Pixel,则存在像素于提的转换问题

            Picture1.Height = Rh '   '1像素=20twip

            Picture1.Picture = LoadPicture()

            Rn = CreateRasterBlock(Picture1.hdc, Rw, Rh)

            StatusBar.Panels.Item(2).Text = "Raster size:" + Str(Rw) + "x" + Str(Rh)

            '输出栅格文件

            SavePicture(Picture1.Image, App.Path + "/MAP/TEST.BMP")

            '生成对应的.tab文件

            Dim FileNum As Integer, s As String

            s = ""

            s = "!table" + Chr$(13) + Chr$(10) + "!version 300"

            s = s + vbCrLf + "!charset WindowsSimpChinese"

            s = s + vbCrLf + vbCrLf

            s = s + "Definition Table" + vbCrLf

            s = s + "  File " + Chr$(34) + "TEST.BMP" + Chr$(34) + vbCrLf

            s = s + "  Type " + Chr$(34) + "RASTER" + Chr$(34) + vbCrLf

            s = s + "  (" + Left$(Trim$(Str$(MTLX)), 10) + "," + Left$(Trim$(Str$(MTLY)), 9) + ")" + " (" + Trim$(Str$(0)) + "," + Trim$(Str$(0)) + ") Label " + Chr$(34) + "Pt 1" + Chr$(34) + "," + vbCrLf

            s = s + "  (" + Left$(Trim$(Str$(MBRX)), 10) + "," + Left$(Trim$(Str$(MBRY)), 9) + ")" + " (" + Trim$(Str$(Rw)) + "," + Trim(Str$(Rh)) + ") Label " + Chr$(34) + "Pt 2" + Chr$(34) + "," + vbCrLf

            s = s + "  (" + Left$(Trim$(Str$(MTLX)), 10) + "," + Left$(Trim$(Str$(MBRY)), 9) + ")" + " (" + Trim$(Str$(0)) + "," + Trim$(Str$(Rh)) + ") Label " + Chr$(34) + "Pt 3" + Chr$(34) + "," + vbCrLf

            s = s + "  (" + Left$(Trim$(Str$(MBRX)), 10) + "," + Left$(Trim$(Str$(MTLY)), 9) + ")" + " (" + Trim(Str$(Rw)) + "," + Trim$(Str$(0)) + ") Label " + Chr$(34) + "Pt 4" + Chr$(34) + vbCrLf

            s = s + "  CoordSys Earth Projection 1, 104" + vbCrLf

            s = s + "  Units " + Chr$(34) + "degree" + Chr$(34)

            FileNum = FreeFile

           Open App.Path + "/MAP/TEST.TAB" For Output As #FileNum

           Print #FileNum, s

           Close #FileNum

            '-- 变量复原

            mDown = False

            Map.CurrentTool = miPanTool

            '加载栅格图

            Dim LInfo As Object

            LInfo = New LayerInfo

            LInfo.Type = miLayerInfoTypeTab

            LInfo.AddParameter("FileSpec", App.Path + "/MAP/TEST.TAB")

            Map.Layers.Add(LInfo)

            LInfo = Nothing

        End If

    End If

End Sub

以下是生成位图的代码:

Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Global RaArry() As Byte 'Raster Arry

Global PiArry() As Long 'Pixel color Arry

Public Function CreateRasterBlock(ByVal hdc As Long, ByVal BiW As Long, ByVal BiH As Long) As Boolean

ReDim RaArry(1 To 3, 1 To BiW, 1 To BiH)   'vb 定义数据A(2,3) 表示三行四列矩阵

ReDim PiArry(1 To BiW, 1 To BiH)

    InitializeRasterValue(BiW, BiH)

    '给位图点阵指定颜色

    Dim j As Long, k As Long

    For j = 1 To BiW

        For k = 1 To BiH

            PiArry(j, k) = RGB(RaArry(1, j, k), RaArry(2, j, k), RaArry(3, j, k))

            'SetPixel hDCMem, j, k, PiArry(j, k)

            SetPixel(hdc, j - 1, k - 1, PiArry(j, k))

        Next k

        FoMain.pg.Value = j * 100 / BiW

    Next j

    FoMain.pg.Value = 0

    CreateRasterBlock = True

End Function

Public Sub InitializeRasterValue(ByVal Col As Long, ByVal Row As Long)

    Dim r As Integer, g As Integer, b As Integer, j As Long, k As Long

    For j = 1 To Col

        For k = 1 To Row

            RaArry(1, j, k) = 0 'GetR()

            RaArry(2, j, k) = (2 * j + k) Mod 255 '(255 - (j + k) * (j - k) Mod 255) Mod 255  'GetG()

            RaArry(3, j, k) = 0 'GetB()

        Next k

        FoMain.pg.Value = j * 100 / Col

    Next j

    FoMain.pg.Value = 0

End Sub

Public Function GetR() As Integer

    Dim r As Integer

    'r = Int(Rnd * 255)

    r = 200

    GetR = r

End Function

Public Function GetG() As Integer

    Dim g As Integer

    g = 10 'Int(Rnd * 255)

    GetG = g

End Function

Public Function GetB() As Integer

    Dim b As Integer

    b = 0 'Int(Rnd * 255)

    GetB = b

End Function

这里补充一点,mapX支持矢量图的显示,通过栅格格式句柄(Raster Format Handler)来自动地检查栅格的格式并且显示。Raste Format Handler以动态链接库的形式安装在mapX的安装目录里,当加载栅格图像时mapX通过检索动态链接库(.dll)来进行测试,一旦一个.dll可以读该文件,并且返回是(yes),那么mapX就可以确定用该dll来处理当前的栅格格式。格式句柄文件以“.RHx”做后缀,不同的栅格格式由第三个字符x来确定,可以是A-Z的任意字符。mapX检索栅格句柄时从A开始往后检索,并且通过检索建立优先级顺序,后续的加载都先用之前的可用句柄来测试可处理性。比如spot影像是一种原始数据,易于与其他格式混淆,因此要先检测是否是spot影像,其格式句柄的扩展名为“.RHD”。安装mapX时要安装相应的动态库和格式句柄。具体可查看mapX帮助文档中的“Installing RasterFormat Handlers”主题。

你可能感兴趣的:(object,function,table,Integer,vb,VB.NET)