MapWinGIS:SampleCode-VB Net:CustomShieldLabels

This is a back-up of the WIKI.
Not all links might work
We're working on a new wiki.

Main Page | Recent changes | View source | Page history | Log in / create account |

Printable version | Disclaimers | Privacy policy

Images to Label Roads

This example is fairly involved and quite long, but gives the general idea of how you can create a label system that is based on images instead of text. In this case, a template shield image is used as a basic graphic. Then, a roads shapefile is read, parsing the route numbers and creating a new output png for each road shape. Next a point shapefile is created. There is one point for each of the roads in the original road shapefile. The point stores the position of the center of the rectangular extents for the roads in each case. Finally, custom images are assigned to each of the points by setting the point type to ImageList and then adding each of the png files to the image list.

The performance of the original creation is not very good, but it is meant to work as a one time cost. The load times when the images are already created is actually pretty good. Also, more advanced treatments would test to see if the routing number was blank, and leave out those routes. It would also use a better placement algorithm.

Created by Shade1974 10/7/2008

 Public Class Form1
     Const YOUR_FILENAME As String = "C:\dev\SampleData\MapWindow Projects\UnitedStates\Shapefiles\roads.shp"
     Const YOUR_BASE_IMAGE As String = "C:\dev\SampleData\MapWindow Projects\UnitedStates\Shapefiles\ShieldBase.bmp"
     Const YOUR_SHIELD As String = "C:\dev\SampleData\MapWindow Projects\UnitedStates\Shapefiles\Shield"
     Const YOUR_SHIELD_POINTS As String = "C:\dev\SampleData\MapWindow Projects\UnitedStates\Shapefiles\Shields.shp"
     Dim Roads As MapWinGIS.Shapefile
     Dim Shields As MapWinGIS.Shapefile
     Dim iShieldLayer As Integer
     Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
         Roads = New MapWinGIS.Shapefile 'Shapefile object
         Dim iLayer As New Integer ' layer handle
         ' Attempt to load the file
         If Roads.Open(YOUR_FILENAME) = False Then
             ' Show an appropriate error message if the load fails
             Exit Sub
         End If
         ' assign the shapefile data as a new layer in the map
         iLayer = AxMap1.AddLayer(Roads, True)
         ' First generate the shield images dynamically from road attributes
         If System.IO.File.Exists(YOUR_SHIELD & 0 & ".png") = False Then
         End If
         Shields = New MapWinGIS.Shapefile
         ' Then generate the points based on the road extents
         If System.IO.File.Exists(YOUR_SHIELD_POINTS) Then
         End If
         ' Actually assign the symbology
         Dim iShieldLayer As Integer
         iShieldLayer = AxMap1.AddLayer(Shields, True)
         AxMap1.set_ShapeLayerPointType(iShieldLayer, MapWinGIS.tkPointType.ptImageList)
         For shp = 0 To Shields.NumShapes
             Dim shieldImage As New MapWinGIS.Image
             If shieldImage.Open(YOUR_SHIELD & shp & ".png") = False Then
             End If
             Dim indx As Integer
             indx = AxMap1.set_UDPointImageListAdd(iShieldLayer, shieldImage)
             AxMap1.set_ShapePointType(iShieldLayer, shp, MapWinGIS.tkPointType.ptImageList)
             AxMap1.set_ShapePointImageListID(iShieldLayer, shp, indx)
         Next shp
         AxMap1.set_ShapeLayerPointSize(iShieldLayer, 1)
     End Sub
     Private Sub Create_Shields()
         Dim f As New MapWinGIS.Field
         Dim pt As New MapWinGIS.Point
         Dim sh As New MapWinGIS.Shape
         Dim shp, pnt As Long
         Dim Result As Boolean
         'Create a new shapefile of type SHP_POINT
         If System.IO.File.Exists(YOUR_SHIELD_POINTS) Then
             System.IO.File.Delete(System.IO.Path.ChangeExtension(YOUR_SHIELD_POINTS, ".dbf"))
             System.IO.File.Delete(System.IO.Path.ChangeExtension(YOUR_SHIELD_POINTS, ".shx"))
         End If
         Result = Shields.CreateNew(YOUR_SHIELD_POINTS, MapWinGIS.ShpfileType.SHP_POINT)
         If Result = False Then GoTo ERRORHANDLER
         'Start Editing it...
         Result = Shields.StartEditingShapes(True)
         If Result = False Then GoTo ERRORHANDLER
         'Set up a new field to store the route that is a string
         f = New MapWinGIS.Field
         f.Type = MapWinGIS.FieldType.STRING_FIELD
         f.Name = "Route"
         f.Width = 20
         Result = Shields.EditInsertField(f, 0)
         If Result = False Then GoTo ERRORHANDLER
         ' For each shape, create a single point that is at the center of the extents of the road line
         For shp = 0 To Roads.NumShapes - 1
             'initialize the shape
             sh = New MapWinGIS.Shape
             sh.ShapeType = MapWinGIS.ShpfileType.SHP_POINT
             'Set up the point as the center of the rectangular extents.
             'This part isn't very good, but is simple for this demo.
             Dim Ext As MapWinGIS.Extents
             Ext = Roads.QuickExtents(shp)
             Dim X As Double = (Ext.xMax + Ext.xMin) / 2
             Dim Y As Double = (Ext.yMax + Ext.yMin) / 2
             pt = New MapWinGIS.Point()
             pt.x = X
             pt.y = Y
             'Add the point to a shape
             Result = sh.InsertPoint(pt, pnt)
             If Result = False Then GoTo ERRORHANDLER
             'Add the shape to the shapefile
             Result = Shields.EditInsertShape(sh, shp)
             If Result = False Then GoTo ERRORHANDLER
             'Edit the attributes for this shape record
             Result = Shields.EditCellValue(0, shp, Roads.CellValue(4, shp))
             If Result = False Then GoTo ERRORHANDLER
         Next shp
         Result = Shields.StopEditingShapes(True, True)
         Exit Sub
         'If any of our function calls returned false then jump here and tell us what went wrong...
         MsgBox("Shapefile Error: " & Shields.ErrorMsg(Shields.LastErrorCode) & vbCrLf & "Shape Error: " & _
         sh.ErrorMsg(sh.LastErrorCode) & vbCrLf & "Point Error: " & pt.ErrorMsg(pt.LastErrorCode) & _
         vbCrLf & "Field Error: " & f.ErrorMsg(f.LastErrorCode))
     End Sub
     Private Sub Create_Shield_Images()
         ' Put some kind of limit on how many sheilds we try to draw
         Dim BaseImage As New System.Drawing.Bitmap(YOUR_BASE_IMAGE)
         Dim iShape As New Integer ' iShape is the actual shape index in the Roads shapefile
         For iShape = 0 To Roads.NumShapes - 1
             ' Start with the basic shield image with no text
             Dim currentShield As New System.Drawing.Bitmap(BaseImage.Width, BaseImage.Height)
             Dim g As Graphics = Graphics.FromImage(currentShield)
             g.DrawImageUnscaled(BaseImage, 0, 0)
             ' Read the text from the attributes, where 4 is the 0 based column index 
             Dim Route As String
             Route = Roads.CellValue(4, iShape)
             ' Use MeasureString to center the text
             Dim TextSize As New SizeF
             TextSize = g.MeasureString(Route, New Font("Ariel", 10))
             ' Draw the string on top of the shield image 
             g.DrawString(Route, New Font("Ariel", 10), Brushes.Navy, BaseImage.Width / 2 - TextSize.Width / 2, BaseImage.Height / 2 - TextSize.Height / 2)
             ' Save each of the images to use later
             currentShield.Save(YOUR_SHIELD & iShape & ".png", System.Drawing.Imaging.ImageFormat.Png)
     End Sub
 End Class

Retrieved from ""

This page has been accessed 1,948 times. This page was last modified on 7 October 2008, at 22:26.