Hallo everybody.
I hope my following massage is my misunderstanding of mitab.dll use
in VisualBasic, however, I'd like to report possible error in color
and symbol reading. Unfortunately, I can't attach file, so, I have to
send the whole code in this message.
Possible error consist in:
1) bad interpretation of color parts from the side of MITAB.DLL (see
all private procedures in my example)
2) wrong return values (no values, better say) of symbol_color,
symbol_no, symbol_size when reading symbols (see procedure
MapTab_ReadSymbols)
I hope, there is just error on my side (but I can't see it). Either
yes or not, please, could somebody explain what's wrong?
Greetings from Prague
Zdenek Pliska
'*********************************************************************
*******************************
'START - Background maps
'*********************************************************************
*******************************
Public Sub LoadingMapinfoTABForBackgroundMaps(ByVal pszFilename As
String)
Dim i As Long, k As Long, m As Long, p As Long
Dim dataset As Long, feature As Long, feature_id As Long,
feature_type As Long, num_points As Long
Dim dX() As Double, dY() As Double
Dim dblMinX As Double, dblMinY As Double, dblMaxX As Double,
dblMaxY As Double
Dim pen_color As Long, pen_pattern As Long, pen_width As Long
Dim brush_bgcolor As Long, brush_fgcolor As Long, brush_pattern
As Long, brush_transparent As Long
Dim symbol_color As Long, symbol_no As Long, symbol_size As Long
Dim text_vb As String, font_vb As String
Dim text_height As Double, text_width As Double, text_angle As
Double
Dim text_fgcolor As Long, text_spacing As Long,
text_justification As Long
'Dim text_bgcolor As Long, text_linetype As Long
If LBound(BackgroundMaps) = 1 Then
ReDim BackgroundMaps(0)
Else: ReDim Preserve BackgroundMaps(UBound(BackgroundMaps) + 1)
End If
i = UBound(BackgroundMaps)
dataset = mitab_c_open(pszFilename)
If dataset <> 0 Then
Set BackgroundMaps(i) = New clsPodkladniMapa
k = 0
dblMinX = 999999999
dblMinY = 999999999
dblMaxX = -999999999
dblMaxY = -999999999
feature_id = mitab_c_next_feature_id(dataset, -1)
Do While feature_id <> -1
'reading next feature object
feature = mitab_c_read_feature(dataset, feature_id)
feature_type = mitab_c_get_type(feature)
If (feature <> 0) And (feature_type <> TABFC_NoGeom) Then
'reading object vertexes
MapTab_ReadVertexes feature, dX, dY, dblMinX,
dblMinY, dblMaxX, dblMaxY
'the most probably there is bad interpretation of
color parts from the side of MITAB.DLL
'it is necessary to divide LONG color into RGB
pieces, switch red and blue and mix again
If (feature_type = TABFC_Point) Or (feature_type =
TABFC_FontPoint) _
Or (feature_type = TABFC_CustomPoint) Or
(feature_type = TABFC_MultiPoint) Then
MapTab_ReadSymbols feature, symbol_color,
symbol_no, symbol_size, font_vb
End If
If (feature_type = TABFC_Text) Then
MapTab_ReadText feature, text_vb, font_vb,
text_height, text_spacing, _
text_justification, text_angle, text_fgcolor
End If
If (feature_type = TABFC_Polyline) Or (feature_type =
TABFC_Arc) Or (feature_type = TABFC_Region) _
Or (feature_type = TABFC_Rectangle) Or
(feature_type = TABFC_Ellipse) Then
MapTab_ReadPen feature, pen_color, pen_pattern,
pen_width
End If
If (feature_type = TABFC_Region) Or (feature_type =
TABFC_Rectangle) Or (feature_type = TABFC_Ellipse) Then
MapTab_ReadBrush feature, brush_bgcolor,
brush_fgcolor, brush_pattern, brush_transparent, p
End If
Select Case feature_type
Case TABFC_Point '= 1
'error in mitab.dll - symbol_no should have
value (symbol_no+1)
symbol_no = symbol_no + 1
'error in mitab.dll - bad interpretation of
color - symbol_color
BackgroundMaps(i).InsertPoint "MapInfo
Symbols", symbol_size, symbol_color, symbol_no, dX(0), dY(0)
Case TABFC_FontPoint '= 2
'error in mitab.dll - never return values of
symbol_color, symbol_no, symbol_size
BackgroundMaps(i).InsertPoint font_vb, 16, RGB
(64, 128, 255), 107, dX(0), dY(0)
Case TABFC_CustomPoint '= 3
'not used now, I don't want to use bitmap yet
'however, bitmap name from mapinfo
directory "/CUSTSYMB" is hidden in font_vb
Case TABFC_Text '= 4
'error in mitab.dll - bad interpretation of
color - text_fgcolor
BackgroundMaps(i).InsertText font_vb,
text_height, text_width, text_spacing, text_angle,
text_justification, text_fgcolor, text_vb, dX(0), dY(0)
Case TABFC_Polyline '= 5
BackgroundMaps(i).InsertPolyline pen_color,
pen_pattern, pen_width, dX, dY
Case TABFC_Arc '= 6
'not used now
Case TABFC_Region '= 7
BackgroundMaps(i).InsertRegion 0, pen_color,
pen_pattern, pen_width, brush_bgcolor, brush_fgcolor, brush_pattern,
p, brush_transparent, dX, dY
Case TABFC_Rectangle '= 8
BackgroundMaps(i).InsertRegion 0, pen_color,
pen_pattern, pen_width, brush_bgcolor, brush_fgcolor, brush_pattern,
p, brush_transparent, dX, dY
Case TABFC_Ellipse '= 9
BackgroundMaps(i).InsertRegion 0, pen_color,
pen_pattern, pen_width, brush_bgcolor, brush_fgcolor, brush_pattern,
p, brush_transparent, dX, dY
Case TABFC_MultiPoint '= 10
End Select
mitab_c_destroy_feature (feature)
k = k + 1
End If
feature_id = mitab_c_next_feature_id(dataset, feature_id)
Loop
BackgroundMaps(i).Set_MaxMinZoomBlok dblMinX, dblMinY,
dblMaxX, dblMaxY
mitab_c_close (dataset)
Else
MsgBox "Background map not loaded:" & vbCrLf & pszFilename,
vbCritical, "ATTENTION"
If UBound(BackgroundMaps) = 0 Then
ReDim BackgroundMaps(1 To 1)
Else: ReDim Preserve BackgroundMaps(UBound(BackgroundMaps) -
1)
End If
End If
End Sub
Private Sub MapTab_ReadVertexes(ByVal feature As Long, dX() As
Double, dY() As Double, _
dblMinX
As Double, dblMinY As Double, dblMaxX As Double, dblMaxY As Double)
Dim m As Long, p As Long, num_points As Long
'until now, I suppose there are just objects consisting of just
one part (not rectangle with hole in the middle, for example)
p = 0
num_points = mitab_c_get_vertex_count(feature, p)
ReDim dX(num_points - 1)
ReDim dY(num_points - 1)
For m = 0 To num_points - 1
dX(m) = mitab_c_get_vertex_x(feature, p, m)
dY(m) = mitab_c_get_vertex_y(feature, p, m)
If dblMinX > dX(m) Then dblMinX = dX(m)
If dblMaxX < dX(m) Then dblMaxX = dX(m)
If dblMinY > dY(m) Then dblMinY = dY(m)
If dblMaxY < dY(m) Then dblMaxY = dY(m)
Next m
End Sub
Private Sub MapTab_ReadSymbols(ByVal feature As Long, symbol_color As
Long, symbol_no As Long, symbol_size As Long, font_vb As String)
Dim p As Long, r As Long, g As Long, b As Long
'error in mitab.dll - bad interpretation of color
symbol_color = mitab_c_get_symbol_color(feature)
'color parts determination
CopyMemory ByVal VarPtr(r), ByVal VarPtr(symbol_color), 1
CopyMemory ByVal VarPtr(g), ByVal VarPtr(symbol_color) + 1, 1
CopyMemory ByVal VarPtr(b), ByVal VarPtr(symbol_color) + 2, 1
'color parts switch and mix
symbol_color = RGB(b, g, r)
symbol_no = mitab_c_get_symbol_no(feature)
symbol_size = mitab_c_get_symbol_size(feature)
'for TABFC_CustomPoint - bitmap name
font_vb = Space(255)
p = mitab_c_get_font_vb(feature, font_vb, 255)
font_vb = Left(font_vb, p)
End Sub
Private Sub MapTab_ReadText(ByVal feature As Long, text_vb As String,
font_vb As String, text_height As Double, text_spacing As Long,
text_justification As Long, text_angle As Double, text_fgcolor)
Dim p As Long, r As Long, g As Long, b As Long
'error in mitab.dll - bad interpretation of color
text_vb = Space(255)
p = mitab_c_get_text_vb(feature, text_vb, 255)
text_vb = Left(text_vb, p)
font_vb = Space(255)
p = mitab_c_get_font_vb(feature, font_vb, 255)
font_vb = Left(font_vb, p)
text_height = mitab_c_get_text_height(feature)
'text_width = mitab_c_get_text_width(feature)
text_spacing = mitab_c_get_text_spacing(feature)
text_justification = mitab_c_get_text_justification(feature)
text_angle = mitab_c_get_text_angle(feature)
text_fgcolor = mitab_c_get_text_fgcolor(feature)
'color parts determination
CopyMemory ByVal VarPtr(r), ByVal VarPtr(text_fgcolor), 1
CopyMemory ByVal VarPtr(g), ByVal VarPtr(text_fgcolor) + 1, 1
CopyMemory ByVal VarPtr(b), ByVal VarPtr(text_fgcolor) + 2, 1
'color parts switch and mix, but swithc r <=> b doest work here,
the most probably there is some different combination
text_fgcolor = RGB(b, g, r)
'text_bgcolor = mitab_c_get_text_bgcolor(feature)
'text_linetype = mitab_c_get_text_linetype(feature)
End Sub
Private Sub MapTab_ReadPen(ByVal feature As Long, pen_color As Long,
pen_pattern As Long, pen_width As Long)
Dim r As Long, g As Long, b As Long
'error in mitab.dll - bad interpretation of color
pen_color = mitab_c_get_pen_color(feature)
'color parts determination
CopyMemory ByVal VarPtr(r), ByVal VarPtr(pen_color), 1
CopyMemory ByVal VarPtr(g), ByVal VarPtr(pen_color) + 1, 1
CopyMemory ByVal VarPtr(b), ByVal VarPtr(pen_color) + 2, 1
'color parts switch and mix
pen_color = RGB(b, g, r)
pen_pattern = mitab_c_get_pen_pattern(feature)
pen_width = mitab_c_get_pen_width(feature)
'pen_pattern returns position in "settings dialogue", so, pattern
should be like:
Select Case pen_pattern
Case 1
pen_pattern = PS_NULL
Case 2
pen_pattern = PS_SOLID
Case 3, 4, 10
pen_pattern = PS_DOT
Case 5, 6, 7, 8, 9, 11, 12, 13
pen_pattern = PS_DASH
Case 14, 15, 16, 17, 23, 26
pen_pattern = PS_DASHDOT
Case 18, 19, 20, 21, 25
pen_pattern = PS_DASHDOTDOT
Case Else
pen_pattern = PS_SOLID
End Select
End Sub
Private Sub MapTab_ReadBrush(ByVal feature As Long, brush_bgcolor As
Long, brush_fgcolor As Long, brush_pattern As Long, brush_transparent
As Long, p As Long)
Dim r As Long, g As Long, b As Long
'error in mitab.dll - bad interpretation of color
p = -1
brush_bgcolor = mitab_c_get_brush_bgcolor(feature)
'color parts determination
CopyMemory ByVal VarPtr(r), ByVal VarPtr(brush_bgcolor), 1
CopyMemory ByVal VarPtr(g), ByVal VarPtr(brush_bgcolor) + 1, 1
CopyMemory ByVal VarPtr(b), ByVal VarPtr(brush_bgcolor) + 2, 1
'color parts switch and mix
brush_bgcolor = RGB(b, g, r)
brush_fgcolor = mitab_c_get_brush_fgcolor(feature)
'color parts determination
CopyMemory ByVal VarPtr(r), ByVal VarPtr(brush_fgcolor), 1
CopyMemory ByVal VarPtr(g), ByVal VarPtr(brush_fgcolor) + 1, 1
CopyMemory ByVal VarPtr(b), ByVal VarPtr(brush_fgcolor) + 2, 1
'color parts switch and mix
brush_fgcolor = RGB(b, g, r)
brush_pattern = mitab_c_get_brush_pattern(feature)
brush_transparent = mitab_c_get_brush_transparent(feature)
'brush_pattern returns position in "settings dialogue", so,
pattern should be like:
Select Case brush_pattern
Case 1
brush_pattern = BS_NULL
Case 2
brush_pattern = BS_SOLID
Case 3, 4, 5, 6, 7, 8
'temporary variable determines HATCH
p = brush_pattern - 3
'in mapinfu HS_BDIAGONAL and HS_FDIAGONAL are switched
If p = HS_BDIAGONAL Then
p = HS_FDIAGONAL
ElseIf p = HS_FDIAGONAL Then
p = HS_BDIAGONAL
End If
brush_pattern = BS_HATCHED
Case Else
'should be: brush_pattern = BS_PATTERN, but I don't want
to make bitmaps
brush_pattern = BS_SOLID
End Select
End Sub
'*********************************************************************
*******************************
'END - Background maps
'*********************************************************************
*******************************
------------------------ Yahoo! Groups Sponsor --------------------~-->
Make a clean sweep of pop-up ads. Yahoo! Companion Toolbar.
Now with Pop-Up Blocker. Get it for free!
http://us.click.yahoo.com/L5YrjA/eSIIAA/yQLSAA/dkFolB/TM
--------------------------------------------------------------------~->
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/mitab/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
