使用LayerInfo object 在map中添加栅格图层
对于一副栅格图像，在Mapinfo里配准后就会发现在原来的.bmp或者.jpg文件的基础上会新生成一个同名的.tab文件。
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文件，就可以通过LayerType为miLayerInfoTypeTab来添加。这里需要指定一个类型为miLayerInfoTypeTab的LayerInfo，然后在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下也可以这样做。可以将raster的TAB文件用记事本打开，其基本内容很简单，主要信息就是控制点和投影、地图单位等信息。如下例：
!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.9996,500000,10000000
Units "m"
@H_683_403@*注意：最后一个控制点记录后没有逗号。
做测试时，可以随便拿一个jpg或者bmp文件在mapInfo里做简单的配准，只要能和矢量叠加显示即可，但要保证至少4个控制点，否则mapX加载栅格时会出现Unexpected error in MapX（Error N10011），No source field specified（Error 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并且把它存储出来。另外pg是FoMain里的一个状态条，即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) / RASTER_RESOLUTION
Rh = Map.Distance(MTLX,MTLX,MBRY) / RASTER_RESOLUTION
Picture1.Width = Rw 如果Form的scalemode使用twip，而PictureBox使用Pixel，则存在像素于提的转换问题
Picture1.Height = Rh ' '1像素=20twip
Picture1.Picture = LoadPicture()
Rn = CreateRasterBlock(Picture1.hdc,Rh)
StatusBar.Panels.Item(2).Text = "Raster size:" + Str(Rw) + "x" + Str(Rh)
SavePicture(Picture1.Image,App.Path + "/MAP/TEST.BMP")
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))," + 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))," + Trim$(Str$(Rh)) + ") Label " + Chr$(34) + "Pt 3" + Chr$(34) + ",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 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,RaArry(3,k))
'SetPixel hDCMem,k,PiArry(j,k)
SetPixel(hdc,j - 1,k - 1,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,k) = 0 'GetR()
RaArry(2,k) = (2 * j + k) Mod 255 '(255 - (j + k) * (j - k) Mod 255) Mod 255 'GetG()
RaArry(3,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”主题。
原文链接：https://www.f2er.com/vb/262118.html