midmif.bas

MapInfo 行业应用源代码

Public Sub MIFMID_CreateRegion(X() As Double, Y() As Double, N As Integer)
Dim I As Integer, Xcentroid As Double, Ycentroid As Double

'输出封闭多边形
Print #MIFNo, "Region  1"
If (X(1) = X(N) And Y(1) = Y(N)) Then '最后一点与第一点重合
    Print #MIFNo, Format(N, "####0")
    Xcentroid = -X(1)
    Ycentroid = -Y(1)
    For I = 1 To N
        Print #MIFNo, Format(X(I), "#####0.000000 "); Format(Y(I), "#####0.000000")
        Xcentroid = Xcentroid + X(I)
        Ycentroid = Ycentroid + Y(I)
    Next I
    Xcentroid = Xcentroid / (N - 1)
    Ycentroid = Ycentroid / (N - 1)
Else '最后一点与第一点不重合
    Print #MIFNo, Format(N + 1, "####0")
    Xcentroid = 0#
    Ycentroid = 0#
    For I = 1 To N
        Print #MIFNo, Format(X(I), "#####0.000000 "); Format(Y(I), "#####0.000000")
        Xcentroid = Xcentroid + X(I)
        Ycentroid = Ycentroid + Y(I)
    Next I
    Print #MIFNo, Format(X(1), "#####0.000000 "); Format(Y(1), "#####0.000000")
    Xcentroid = Xcentroid / N
    Ycentroid = Ycentroid / N
End If
'输出边框参数
Print #MIFNo, "    Pen ("; Format(BorderWidth, "#0"); ","; Format(BorderStyle, "#0"); ","; Format(BorderColor, "############0"); ")"
'输出填充参数
If (FillBackGround = 0) Then '没有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ")"
Else '有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ","; Format(FillBackGround, "############0"); ")"
End If
'输出质心
Print #MIFNo, "    Center "; Format(Xcentroid, "#####0.000000 "); Format(Ycentroid, "#####0.000000")
End Sub
Public Sub MIFMID_MakeBrush(FillPatternT As Integer, FillForeGroundT As Long, FillBackGroundT As Long, BorderStyleT As Integer, BorderColorT As Long, BorderWidthT As Integer)
FillPattern = FillPatternT
FillForeGround = FillForeGroundT
FillBackGround = FillBackGroundT

BorderStyle = BorderStyleT
BorderColor = BorderColorT
BorderWidth = BorderWidthT
End Sub

Public Sub MIFMID_MakeFont(TextFontT As String, TextSizeT As Integer, TextColorT As Long, TextNoBackgroundColorT As Integer, TextBackgroundColorT As Long, iBoldT As Integer, iUnderlineT As Integer, iShadowT As Integer, iItalicT As Integer, iAllCapsT As Integer, iExpandedT As Integer)

TextFont = TextFontT
TextSize = TextSizeT
TextColor = TextColorT

TextNoBackgroundColor = TextNoBackgroundColorT
TextBackgroundColor = TextBackgroundColorT

TextEffects = 0
If (TextNoBackgroundColor = 1) Then TextEffects = TextEffects + 256
If (iBoldT = 1) Then TextEffects = TextEffects + 1
If (iItalicT = 1) Then TextEffects = TextEffects + 2
If (iUnderlineT = 1) Then TextEffects = TextEffects + 4
If (iShadowT = 1) Then TextEffects = TextEffects + 32
If (iAllCapsT = 1) Then TextEffects = TextEffects + 512
If (iExpandedT = 1) Then TextEffects = TextEffects + 1024
End Sub
Public Sub MIFMID_CreateText(X As Double, Y As Double, Text As String, Angle As Double)
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, Cd As Double, LenText As Double

Print #MIFNo, "Text"
Print #MIFNo, "    "; """"; Trim(Text); """"

Cd = Atn(1#) / 45#
LenText = Len(Trim(Text)) / 2
X1 = X - (TextSize * Sin(Angle * Cd) + TextSize * LenText * Cos(Angle * Cd)) / XYFact / 2
Y1 = Y + (TextSize * Cos(Angle * Cd) - TextSize * LenText * Sin(Angle * Cd)) / XYFact / 2

X2 = X1 + TextSize * Len(Trim(Text)) / XYFact
Y2 = Y1 - TextSize / XYFact

Print #MIFNo, "    "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000")
If (TextNoBackgroundColor = 0) Then '没有背景
    Print #MIFNo, "    Font ("; """"; TextFont; """"; ","; Format(TextEffects, "###0"); ",0,"; Format(TextColor, "########0"); ")"
Else
    Print #MIFNo, "    Font ("; """"; TextFont; """"; ","; Format(TextEffects, "###0"); ",0,"; Format(TextColor, "########0"); ","; Format(TextBackgroundColor, "########0"); ")"
End If
Print #MIFNo, "    Angle "; Format(Angle, "###0.00")
Print #MIFNo, ""
End Sub

Public Sub MIFMID_Close()
Close (MIFNo)
Close (MIDNo)
End Sub

Public Sub MIFMID_MakeSymbol(Shape As Integer, Color As Long, Size As Integer)

SymbolShape = Shape
SymbolColor = Color
SymbolSize = Size
SymbolFontName = "MAPINFO 3.0 COMPATIBLE"
'SymbolFontStyle = FontStyle
'SymbolRotation = Rotation

End Sub

Public Sub MIFMID_MakeFontSymbol(Shape As Integer, Color As Long, Size As Long, FontName As String, FontStyle As Integer, Rotation As Double)

SymbolShape = Shape
SymbolColor = Color
SymbolSize = Size
SymbolFontName = FontName
SymbolFontStyle = FontStyle
SymbolRotation = Rotation

End Sub


Public Sub OutMID(V As Variant)
Dim I As Integer

For I = 1 To ColumnsN - 1
    If (InStr(ColumnsType(I), "CHAR(") > 0) Then
        Print #MIDNo, """"; V(I); """,";
    Else
        Print #MIDNo, V(I); ",";
    End If
Next I
If (InStr(ColumnsType(ColumnsN), "CHAR(") > 0) Then
    Print #MIDNo, """"; V(I); """"
Else
    Print #MIDNo, V(I)
End If

End Sub
Public Sub MIFMID_CreateSymbol(X As Double, Y As Double)
Dim I As Integer

Print #MIFNo, "Point "; Format(X, "#####0.000000"); " "; Format(Y, "#####0.000000")

If (InStr(UCase(SymbolFontName), "MAPINFO 3.0") > 0 Or Len(Trim(SymbolFontName)) < 2) Then
    Print #MIFNo, "    Symbol ("; Format(SymbolShape, "#0"); ","; Format(SymbolColor, "########0"); ","; Format(SymbolSize, "#0"); ")"
Else
    Print #MIFNo, "    Symbol ("; Format(SymbolShape, "#0"); ","; Format(SymbolColor, "########0"); ","; Format(SymbolSize, "#0"); ","; """"; Trim(SymbolFontName); """"; ","; Format(SymbolFontStyle, "###0"); ","; Format(SymbolRotation, "###0.0"); ")"
End If
''For I = 1 To ColumnsN - 1
''    If (InStr(ColumnsType(I), "CHAR(") > 0) Then
''        Print #MIDNo, """"; """,";
''    Else
''        Print #MIDNo, "0,";
''    End If
''Next I
''If (InStr(ColumnsType(ColumnsN), "CHAR(") > 0) Then
''    Print #MIDNo, """"; """"
''Else
''    Print #MIDNo, "0"
''End If

End Sub


Public Sub MIFMID_CreateRoundrect(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, Radius As Double)
Print #MIFNo, "Roundrect "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000 "); Format(Radius, "######0.000000")
'输出边框参数
Print #MIFNo, "    Pen ("; Format(BorderWidth, "#0"); ","; Format(BorderStyle, "#0"); ","; Format(BorderColor, "############0"); ")"
'输出填充参数
If (FillBackGround = 0) Then '没有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ")"
Else '有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ","; Format(FillBackGround, "############0"); ")"
End If
End Sub
Public Sub MIFMID_CreateRect(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double)
Print #MIFNo, "Rect "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000")
'输出边框参数
Print #MIFNo, "    Pen ("; Format(BorderWidth, "#0"); ","; Format(BorderStyle, "#0"); ","; Format(BorderColor, "############0"); ")"
'输出填充参数
If (FillBackGround = 0) Then '没有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ")"
Else '有背景
    Print #MIFNo, "    Brush ("; Format(FillPattern, "#0"); ","; Format(FillForeGround, "#########0"); ","; Format(FillBackGround, "############0"); ")"
End If
End Sub


Public Sub MIFMID_CreateArc(X As Double, Y As Double, RadiusX As Double, RadiusY As Double, StartAngle As Double, EndAngle As Double)
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double

X1 = X - RadiusX
X2 = X + RadiusX
Y1 = Y - RadiusY
Y2 = Y + RadiusY
If (Abs(StartAngle - EndAngle) >= 360#) Then
    Print #MIFNo, "Arc "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000 "); "0 0"
Else
    Print #MIFNo, "Arc "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000 "); Format(StartAngle, "###0.0 "); Format(EndAngle, "###0.0")
End If
'输出边框参数
Print #MIFNo, "    Pen ("; Format(BorderWidth, "#0"); ","; Format(BorderStyle, "#0"); ","; Format(BorderColor, "############0"); ")"
End Sub
Public Sub MIFMID_CreateLine(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double)
Print #MIFNo, "Line "; Format(X1, "######0.000000 "); Format(Y1, "######0.000000 "); Format(X2, "######0.000000 "); Format(Y2, "######0.000000")
'输笔参数
Print #MIFNo, "    Pen ("; Format(PenWidth, "#0"); ","; Format(PenPattern, "#0"); ","; Format(PenColor, "############0"); ")"
End Sub

Public Sub MIFMID_CreateEllipse(EllipsLon As Double, EllipsLat As Double, EllipsAxisShort As Double, EllipsAxisLong As Double, EllipsAngle As Double)
    Dim Loni As Double, Lati As Double
    Dim Pi As Double, Cd As Double
    Dim XX() As Double, YY() As Double, Nxy As Integer, I As Integer
    Dim X0 As Double, Y0 As Double

    Pi = 4 * Atn(1#)
    Cd = Pi / 180

    Call Ellips(0#, 0#, EllipsAxisLong, EllipsAxisShort, EllipsAngle, XX, YY, Nxy)

    Print #MIFNo, "Region  1"
    Print #MIFNo, Format(Nxy, "##0")
    X0 = 0
    Y0 = 0
    For I = 1 To Nxy
        Lati = EllipsLat + YY(I) / 111.199
        Loni = EllipsLon + XX(I) / (111.199 * Cos((EllipsLat + Lati) * 0.5 * Cd))
        Print #MIFNo, Format(Loni, "#####0.000000 "); Format(Lati, "#####0.000000")
        X0 = X0 + Loni
        Y0 = Y0 + Lati
    Next I
    X0 = X0 / Nxy
    Y0 = Y0 / Nxy
    Print #MIFNo, "    Pen (1,2,16711680)"
    Print #MIFNo, "    Brush (1,0,16777215)"
    Print #MIFNo, "    Center "; Format(93.340137, "##0.000000 "); Format(Y0, "##0.000000")
End Sub