jps services
  • Home Page
  • GIS Training Courses
    • QGIS Training Courses
    • ArcGIS Training Courses
    • MapInfo Pro Training Courses >
      • MapBasic Training Course
  • About
  • Blog

MapBasic code to add cartographic and thematic legends in MapInfo Professional using the Atlas program

26/10/2017

0 Comments

 
So far in previous blogs we have used MapBasic to create an Atlas program which can iterate through the regions of a specified layer in order to create individual customised maps. The Atlas program could be further enhanced if the user could have cartographic and thematic legends automatically created as required. Additionally the thematic layer should also be made available for the user to include in the printouts.
In the following screen shot a workspace has just been loaded into MapInfo Pro. As you can see the Legend Designer window is in focus. (As seen by the blue band at the top of its window).   
Picture
The Atlas program requires the map window to be in focus in order to create a cartographic or thematic legend for each selected region. In the next screen shot a Note message informs the user of the need to change the focus if they require a cartographic or thematic legend. If they ignore this message a map or maps can still be created but without a legend being included in the output.
Here is a screen shot of the Note message.
Picture
Assuming that the focus is on the map window, output can be obtained like the following screen shots which are based on the Canadian map provided in the MapInfo Professional trial data. Note that in this map the capital and highways data is not particularly informative.  It is recommended that you save the layers with more meaningful names as is shown in further examples.
Picture
Here we have saved the capital and highway layers with more meaningful names:-
Picture
The cartographic legend can also be incorporated into maps which have a mask element as in the following screen shots:-

Picture
Picture
Having created cartographic legends automatically from a workspace the next stage is to also be able to automatically create output from thematic maps with an appropriate legend.

Here is another workspace of the Canadian regions which has a thematic theme and legend.

Picture
The Atlas program has MapBasic code to check whether a thematic layer is present. In that case the program creates maps which reflect the theme and also includes a thematic legend as in the following screen shots.
Picture
Here is another example:-
Picture
As with the cartographic examples, maps with a thematic element can also can be enhanced with a mask. Here are some examples:-
Picture
And here is another example:-
Picture
The Atlas program needs several new modules in order to be able to create maps which have thematic layers or cartographic legends.

Here is the project code showing the respective modules.

Project file: Atlas.mbp
[Link]
Application=..\Atlas.mbx
Module=Library\ARRAYLib.mbo
Module=Library\DEBUGLib.mbo
Module=Library\ERRORLib.mbo
Module=Library\RIBBONLib.mbo
Module=AtlasRibbonInterface.mbo
Module=Functions.mbo
Module=End_Program.mbo
Module=AtlasAbout.mbo
Module=MLB.mbo
Module=LayoutPortrait.mbo
Module=LayoutLandscape.mbo
Module=MLBOKButton.mbo
Module=SelectAllFromMLB.mbo
Module=HighLightSelectedRegions.mbo
Module=PopulateRegionsArray.mbo
Module=InputAtlasDefaultSettings
Module=Atlas_dialog.mbo
Module=AddMaps.mbo
Module=CreateRibbonMask.mbo
Module=RibbonMaskSettings.mbo
Module=CreateMaskMaps.mbo
Module=ShadeInfo1.mbo
Module=SearchReplace.mbo
Module=ThematicName.mbo
Module=CartoLegend
In all we are adding four new modules, ShadeInfo1, SearchReplace, ThematicName and CartoLegend.

​Additionally, Atlas.def has also been updated.
''************************************************************************************
'**  Project Atlas
'**  
'**  Definition file
'**  
'**  Author: Joseph Short
'**  Date: 14 September 2017
'**  Version: AppVersion (see below)
'************************************************************************************
Include "MAPBASIC.DEF"
Include "ICONS.DEF"
Include "MENU.DEF"

Declare Sub Main
Declare Sub End_Program
Declare Sub Endhandler
Declare Sub InputAtlasDefaultSettings
Declare Sub MLB
Declare Sub LayoutPortrait
Declare Sub LayoutLandscape
Declare Sub MLBOKButton
Declare Sub SelectAllFromMLB
Declare Sub HighLightSelectedRegions
Declare Sub PopulateRegionsArray
Declare Sub DlgHandler
Declare Sub Atlas_dialog
Declare Sub AddMaps
Declare Sub DialogHandler
Declare Sub AtlasAbout
Declare Sub RibbonMaskSettings
Declare Sub CreateMaskMaps
Declare Sub CreateRibbonMask
Declare Sub ShadeInfo1
Declare Sub ThematicName
Declare Sub LegendInfo
Declare Sub CartoLegend
Declare Sub WinFocusChangedHandler 
Declare Function LongDate(ByVal dDate As Date) As String
Declare Function SearchReplace(ByVal strInput as String, ByVal strReplace as String, ByVal strReplacement as String) as String

'Function to check whether a table is open or not
Declare Function TableIsOpen (ByVal sTabName As String) As Logical

' /////     Class "MBExtensions.MBDateAndTime"     /////
' Allows you to retreive information from a MapBasic Date (i.e. YYYYMMDD) or
' DateTime (i.e. YYYYMMDDHHMMSSFFF) string
 
' Convert the string to it's equivalent long date string representation
' (depends on Control Panel > Regional and Language Options)
Declare Method RegionalLongDate
    Class "MBExtensions.MBDateAndTime"
    Lib "MBExtensions.dll" (ByVal sDateString as string) As String

Define AppName "Ribbon Based Atlas Sample Code"
Define AppVersion "0.70"
Define MLBID 1001
Define SelectAllMLBID 1002 

'Defining Dialog Width and Height
'This allows you to specify with and height clauses in terms of characters (i.e., Width 30dW, Height 10dH).
Define dW *4 'Four dialog units equals one character in width
Define dH *8 'Eight dialog units equals one character in height

Global tTime as Time
Global dDate as Date
Global sTabFile, sTable, sColA, sColB, sRegionsArray(), sAddressArray(5), sPrintDate, sCopyrightText, sFont, sRegion, sRegionTitle, sPrinterName, sDocTitle, sPapersize, sOutputFolder, sThematicLayer, sShadeText, sTotalString,sFirstLine, sFirstPart, sSecondPart,sFirstPartThematic, sSecondPartThematic, s_title, sColumn,sRec1, sLegendText As String 
Global iRegionsSelectedArray(), iPaperChoice, iPapersize, iLogoWindowID, iMapWindowID, iInitialMapWindowID,iLayoutWindowID, iLayoutFontSize1, iLayoutFontSize2, iLayoutFontSize3, iLayoutFontSize4, iOrientation as Integer
Global fZoom, fMp, fPaper1, fPaper2, fPaperWidth, fPaperHeight, fHorizontalDistance, fVerticalDistance, fPos1, fPos2 As Float
Global lRegionObjectsSelected As Logical
Global l_create_mask, l_shadeInfo, is_thematic, is_legend, is_cartographic As Logical 'TRUE means include mask 
Global sMaskTable, sMaskTabFilePath As String
Global sPctTranslucencyArray(5) As String
Global fX1, fY1, fX2, fY2 As Float
Global oRectangle, oCutter, oMask, ObjRegion As Object
Global iPctTranslucency As Integer
Global pPenStyle As Pen
Global alAlias,alTable As Alias
Here is the CartoLegend code which creates the cartographic legend.
'************************************************************************************
'** Project Atlas
'**
'** Module CartoLegend
'**
'** Author: Joseph Short
'** Date: 18 October 2017
'************************************************************************************
Include "Atlas.def"

Dim tables(), columns() as String '// Dim your array outside of any subs or functions so it is accessible to all in the module
'***************************************************************************************
Sub CartoLegend

Dim i, nCols, nTables, iMapWindowID, iWndLegend as Integer
Dim iColSelection, iTabSelection as Integer

iMapWindowID = FrontWindow()
'Check to see if the map window is in focus. When a workspace is loaded the 'cartographic legend is highlighted. For the program to work you need the focus 'in the map window

If WindowInfo(iMapWindowID, WIN_INFO_TYPE) <> WIN_MAPPER Then

Note "You need the map window in focus to use" + Chr$(10) + " thematic and cartographic options." + Chr$(10) + " Please click in the map window and start the Atlas program again" + Chr$(10) + " if you want to enable these features"

Exit Sub

End If

' Note that this code was created with information in the MapBasic Help LegendInfo() section.

For i = 1 to NumWindows()

If WindowInfo(WindowID(i), WIN_INFO_TYPE) = WIN_MAPPER Then
iMapWindowID = WindowInfo(WindowID(i), WIN_INFO_WINDOWID)
End if

If WindowInfo(WindowID(i), WIN_INFO_TYPE) = WIN_LEGEND_DESIGNER Then
iWndLegend = WindowInfo(WindowID(i), WIN_INFO_WINDOWID)
is_cartographic = TRUE
End if

Next

Call ThematicName
'******************************************************************************************
End Sub CartoLegend
'******************************************************************************************
Here is the code for the ThematicName module:-

'************************************************************************************
'** Project Atlas
'**
'** Module ThematicName
'**
'** Author: Joseph Short
'** Date: 14 October 2017
'************************************************************************************
Include "Atlas.def"
Dim j,i as Integer
'*********************************************************************************************
Sub ThematicName
'*********************************************************************************************
If NumAllWindows() > 1 Then

iMapWindowID = FrontWindow()

If WindowInfo(iMapWindowID, WIN_INFO_TYPE) <> WIN_MAPPER Then

Note "You need the map window in focus to use" + Chr$(10) + " thematic and cartographic options." + Chr$(10) + " Please click in the map window and start the Atlas program again" + Chr$(10) + " if you want to enable these features"

Exit Sub

End If

' Check to see if there is a thematic layer

j= iMapWindowID

If WindowInfo(iMapWindowID, WIN_INFO_TYPE) = WIN_MAPPER Then

for i = 1 to MapperInfo(j,MAPPER_INFO_LAYERS)
If LayerInfo(j,i,LAYER_INFO_TYPE) = 3 Then

sThematicLayer = LayerInfo(j,i,LAYER_INFO_NAME)
is_thematic = TRUE

End If

Next

End If

End If

' If there is a thematic layer disable the cartographic option

If is_thematic = TRUE Then

is_cartographic = FALSE

End If
'*********************************************************************************************
End Sub ThematicName
'*********************************************************************************************
Here is the code for the SearchReplace module which is used in the ShadeInfo1 module by tidying up the sColumn by removing any underscore and replacing it with a space:
'************************************************************************************
'** Project Atlas
'**
'** Module SearchReplace
'**
'** Author: Egg-Jan Polle
'** Date: 10th October 2017
'************************************************************************************
Include "Atlas.def"

'Search and replace function takes a string and returns a string as output
'For example: sTextField = SearchReplace(sTextField, ",","")

Function SearchReplace(ByVal strInput as String, ByVal strReplace as String, ByVal strReplacement as String) as String

Dim iPos as Integer
Dim strOut as String
Dim i as Integer
iPos = InStr(1, strInput, strReplace)
If iPos < 1 then '// nothing to replace, return original string
SearchReplace = strInput
Exit Function
End If

While iPos > 0 '// loop until nothing left to replace
If iPos > 1 then
strOut = Left$(strInput, iPos - 1)
End if
strOut = strOut & strReplacement
If iPos + Len(strReplace) - 1 < Len(strInput) then
strOut = strOut & Mid$(strInput, iPos + Len(strReplace), Len(strInput) - (iPos + Len(strReplace)) + 1)
End If

strInput = strOut
iPos = InStr(iPos + 1, strInput, strReplace)
Wend

SearchReplace = strOut

End Function
Here is the code for ShadeInfo1 module which checks for a thematic layer and then creates the thematic layer in the individual maps. This is a modified version of code originally provided by Bill Theon.
'************************************************************************************
'** Project Atlas
'**
'** Module ShadeInfo1
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"

Declare Function GetNextRecord(
ByVal sText As String, ' lines of text to parse
n As Integer) ' updated pointer into the text
As String ' returns the next line of text
'*********************************************************************************************
Sub ShadeInfo1
'*********************************************************************************************
Dim i, j, iResult, iFirstLine,iTotalLine, iDifference As Integer
Dim m,n, iLength, iStart, x, iPos1, iPos2, iPos3,iPos4, iPos5, iPos6 As Integer
Dim sText, sFirstLine, sPartial As String
Dim sRec As String

If is_thematic = True Then

If Len(sShadeText) > 0 Then

Exit Sub

End If

CLS

sText = WindowInfo(FrontWindow(), WIN_INFO_CLONEWINDOW )

'Print sText

j = Len(sText )

n = 1

Do While n < j

sRec = GetNextRecord( sText, n )

' look for the start of the shade clause

If Left$(sRec, 5) = "shade" Then

sRec1 = sRec

'Note "This is sRec1 " + sRec1

iPos1 = InStr(1, sRec,"with")


iPos2 = InStr(1, sRec,"ranges")

iPos3 = InStr(1, sRec1,"with")+ 4

iPos6 = InStr(1, sRec,"ignore")

If iPos6 > 0 Then

iPos4 = InStr(1, sRec1,"ignore")

Else

iPos4 = InStr(1, sRec1,"ranges")

End If

iLength = Len(sRec)

iStart = iLength - iPos1

iResult = iPos4 - iPos3

sColumn = Mid$(sRec1,iPos3,iResult)

iPos5 = InStr(1, sColumn,"_")

If iPos5 > 0 Then

sColumn = SearchReplace(sColumn, "_"," ")

End If

sFirstPart = Left$(sRec,6)

sSecondPart = Mid$(sRec,iPos1,iStart)

sFirstPartThematic = Left$(sRec,60)

sSecondPartThematic = Mid$(sRec,iPos1,iResult)

' gather up all the lines in the shade clause

sShadeText = ""

End If

If Like(sRec,"%0:%","") Then

Do While n < j
sShadeText = sShadeText + sRec
sRec = GetNextRecord( sText, n )
' all lines in the shade clause after the first start with a space.
If Like(sRec,"%#%","") Then
Exit Do
End If
Loop

End If

' if any thematic clause was found, display it and exit the loop
If Len(sShadeText) > 0 Then

l_shadeInfo = True

Exit Do

End If

Loop

End If

End Sub ShadeInfo1

Function GetNextRecord( ByVal sText As String, n As Integer ) As String

' Read the next record in a body of text

Dim m As Integer

Dim sRec As String

m = InStr( n, sText, "" + Chr$(10)) ' This code calculates the length of the string

sRec = Mid$( sText, n, (m-n+1)) 'This code calculates the text starting at n then going to length of the string minus n+1

n = m+1 'This code increments n to read length of m + 1

GetNextRecord = sRec

End Function
When you run the Atlas program the AtlasRibbonInterface module creates the ribbon interface. Clicking on the Atlas Example icon in MapInfo Professional calls the Atlas_Dialog module.

As this module has been updated since the last blog here is the code:
'************************************************************************************
'** Project Atlas
'**
'** Module Atlas_dialog
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"
Dim tables(), columns() as String '// Dim your array outside of any subs or functions so it is accessible to all in the module

'*********************************************************************************************
Sub Atlas_dialog
'*********************************************************************************************
Dim i, nCols, nTables as Integer
Dim iColSelection, iTabSelection as Integer

nTables = NumTables() '// get number of open tables
If nTables < 1 then
Note "Please open tables to create an atlas"
Exit Sub 'Exit Sub
End If

Call CartoLegend

If is_thematic = True Then

iInitialMapWindowID = FrontWindow()

If Len(sShadeText) > 0 Then

sShadeText = ""

End If

Call ShadeInfo1

End If

Redim tables(nTables) '// resize tables array to fit the number of open tables

For i = 1 to nTables
tables(i) = TableInfo(i, TAB_INFO_NAME) '// populate array with table names
Next

nCols = TableInfo(1, TAB_INFO_NCOLS) '// get number of columns from the first table
Redim columns(nCols) '// resize columns array to hold column names from first table
For i = 1 to nCols
columns(i) = ColumnInfo(1, "COL" & i, COL_INFO_NAME) '// populate array with column names
Next

Dialog
Title "Choose a table and column for your atlas"
Control PopUpMenu
ID 10
Width 100
Calling DlgHandler '// *** CHANGING THE VALUE OF THIS CONTROL WILL CALL DlgHandler ***
Title From Variable tables() '// Use array to get values for popupmenu
Into iTabSelection '// Store index of selected value into iSelection
Control PopupMenu
ID 20
Width 100
Title From Variable columns()
Into iColSelection
Control OkButton
Position 10, 28

If CommandInfo(CMD_INFO_DLG_OK) then '// Check that the OK button was clicked in dialog box

sTable = tables(iTabSelection) '// Get selected table value from array
sColA = columns(iColSelection) '// Get selected column value from array

End If

Call MLB

End Sub Atlas_dialog

Sub DlgHandler

Dim selID as Integer
Dim selTable as String
Dim nCols, i as Integer

If TriggerControl() = 10 then
selID = ReadControlValue(10) '// get the index of the selected item from the Control with ID 10
selTable = tables(selID) '// get the table name from the tables array using the index we just got

'// Resize and populate the columns array with the columns from the new table
nCols = TableInfo(selTable, TAB_INFO_NCOLS) '// get number of columns from the selected table
Redim columns(nCols) '// resize columns array to hold column names from selected table
For i = 1 to nCols
columns(i) = ColumnInfo(selTable, "COL" & i, COL_INFO_NAME) '// populate array with column names
Next

'// Now update the column popupmenu (ID 20) to use the new columns array
Alter Control 20 Title From Variable columns()

End If
'*********************************************************************************************
End Sub Atlas_dialog
'********************************************************************************************
Within the Atlas_dialog module is a call to the CartoLegend module which in turn calls the ThematicName module. When control passes back to the Atlas_dialog module ShadeInfo1 is called. If is_thematic = TRUE then ShadeInfo1 first tests to see if this is the first call to the module. If it is a second or subsequent call then the module is exited as the necessary information is available to the program. If it is the first time then information about the map window is passed to sText. I have left the Print statement in the code, but disabled, as you may wish to enable it to print out sText to get a better idea of how this section of code works.

After this stage the control again passes back to Atlas_dialog and a menu appears to enable the user to choose the appropriate layer and column to create the atlas.

Atlas_dialog then calls MLB which creates the list of regions present in the chosen map layer. When the user chooses one or more regions to print, the control is then passed to the CreateMasks module.

In the CreateMasks module there is a check to see if a mask is required. Then the AddMaps module is called to add all the other layers to the final map output. As this module has been updated to include code to create thematic maps here is the code for this module:
'************************************************************************************
'** Project Atlas
'**
'** Module Add Maps
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"

Dim tables(), columns() as String '// Dim your array outside of any subs or functions so it is accessible to all in the module
Global aTable, aCategory As Alias

'*********************************************************************************************
Sub AddMaps
'*********************************************************************************************
Dim i, nCols, nTables, iMapWindowID, iAddMapsWinID as Integer
Dim iColSelection, iTabSelection as Integer

nTables = NumTables() '// get number of open tables

If nTables < 1 then
Note "Please open tables to create the atlas"
Exit Sub 'Exit Sub
End If

Redim tables(nTables) '// resize tables array to fit the number of open tables

For i = 1 to nTables

tables(i) = TableInfo(i, TAB_INFO_NAME) '// populate array with table names

If tables(i) <> RegionSelected Then

Add Map Auto Layer tables(i)

Set Map Layer tables(i) Label Auto On
Set Map Layer tables(i) Label Font MakeFont(sFont,256,9,BLACK,16777215)

End If

Next

iMapWindowID = WindowID(FrontWindow())

If is_thematic = True Then

If Left$(sShadeText, 5) = "shade" Then

'Note "This is the second or subsequent time"

Run Command sShadeText

Else

'Note "This is the first time "

sShadeText = sFirstPart & sTable & " " & sSecondPart & sShadeText

'Print sShadeText

Run Command sShadeText

End If

End If
'*********************************************************************************************
End Sub AddMaps
'*******************************************************************************
There are some Note statements which are currently disabled. You may wish to enable them to see how this code functions. Basically, we check to see if there are several maps being created. In this case we can just run sShadeText as it is as it contains the necessary information needed.

Control then passes back to CreateMaskMaps. Here the LayoutPortrait and LayoutLandscape modules have been modified to accommodate cartographic and thematic legends.

Here is the code for LayoutPortrait:
'************************************************************************************
'** Project Atlas
'**
'** Module LayoutPortrait
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"
'*********************************************************************************************
Sub LayoutPortrait
'*********************************************************************************************
OnError Goto ErrorHandler

Dim i As Integer
Dim sAppPath As String

sAppPath = ApplicationDirectory$( )

Layout Designer
Position (10,10) Units "mm"
Width 210*fMp Units "mm" Height 297*fMp Units "mm"
iLayoutWindowID = WindowID(FrontWindow())
Set CoordSys Layout Units "mm"
Create Frame (10*fMp,20*fMp) (200*fMp,265*fMp)
Pen (1,2,0)
Brush (2,16777215,16777215)
From Window iMapWindowID
FillFrame On
'***************************************************************************************
If is_thematic = True Then

Create Designer Legend
     Position (0,0) Units "mm"
     Width 0 Units "mm" Height 0 Units "mm"
     Custom

Default Frame Title "# Legend" Font ("Calibri",1,12,16711680)
Default Frame Subtitle "#" Font ("Arial",2,10,255)
Default Frame Style "%" Font ("Lucida Calligraphy",0,8,16732240)
Default Frame Line Width 36 Units "pt"
Default Frame Region Width 32 Units "pt"
Default Frame Region Height 14 Units "pt"
Default Frame Auto Font Size ON

' Note that here we need to use
' the thematic layer name from
' code provided earlier in the program

Frame From Layer sThematicLayer
     Position (20*fMp,210*fMp) Units "mm"
     Title sTable + " by " + sColumn
     Priority 10
End If
'******************************************************************************************
If is_cartographic = True Then

Create Designer Legend
     Position (0,0) Units "mm"
     Width 0 Units "mm" Height 0 Units "mm"
     Custom

Default Frame Title "# Legend" Font ("Calibri",1,12,16711680)
Default Frame Subtitle "#" Font ("Arial",2,10,255)
Default Frame Style "%" Font ("Lucida Calligraphy",0,8,16732240)
Default Frame Line Width 36 Units "pt"
Default Frame Region Width 32 Units "pt"
Default Frame Region Height 14 Units "pt"
Default Frame Auto Font Size ON

Frame From Layer 1
Using column object
label default
Position (20*fMp,30*fMp) Units "mm"

Frame From Layer 2
Using column object
label default
Position (20*fMp,50*fMp) Units "mm"

Frame From Layer 3
Using column object
label default
Position (20*fMp,65*fMp) Units "mm"

End If
'******************************************************************************************
Create Text
sCopyrightText
(197*fMp,264*fMp) (197*fMp,350*fMp)
'(197*fMp,264*fMp) (200*fMp,350*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,6316128,WHITE)
Angle 90

Create Text
sDocTitle
(10*fMp,10*fMp) (200*fMp,20*fMp)
Font MakeFont(sFont,0,iLayoutFontSize3,BLACK,WHITE)

Create Text
"Print Date:"
(64*fMp,266*fMp) (200*fMp,274*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)
Create Text
sPrintDate
(80*fMp,266*fMp) (200*fMp, 274*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)

Create Text
"Scale:"
(64*fMp,270*fMp) (200*fMp,278*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)
Create Text
"1 : " + Format$(fZoom, ",#")
(80*fMp,270*fMp) (200*fMp, 278*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)
Create Text
"Paper Size:"
(64*fMp,274*fMp) (200*fMp,282*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)
Create Text
sPapersize
(80*fMp,274*fMp) (200*fMp, 282*fMp)
Font MakeFont(sFont,0,iLayoutFontSize1,BLACK,WHITE)

Add Image Frame Window iLayoutWindowID
Position (11*fMp,269*fMp) Units "mm" '(1.139, 26.535) Units "cm" (39*fMp,287*fMp)
Width 22 Units "mm" '6.112 Units "cm"
Height 16 Units "mm" '1.455 Units "cm"
From File sAppPath + "\Images\Company_logo.png"

fPos1 = 275.5*fMp
fPos2 = 283.5*fMp

For i = 1 to 5
fPos1 = fPos1 + 2*fMp
fPos2 = fPos2 + 2*fMp
Create Text
sAddressArray(i)
(42*fMp,fPos1) (90*fMp,fPos2)
Font MakeFont(sFont,0,iLayoutFontSize4,BLACK,WHITE)
Next

Create Rect (10*fMp,265*fMp) (200*fMp,288*fMp)
Pen (1,2,8421504)
Brush (1,16777215,16777215)
Create Line (62*fMp,265*fMp) (62*fMp,277*fMp)
Pen (1,2,8421504)
Create Line (78*fMp,265*fMp) (78*fMp,277*fMp)
Pen (1,2,8421504)
Create Line (110*fMp,265*fMp) (110*fMp,277*fMp)
Pen (1,2,8421504)
Create Line (62*fMp,269*fMp) (110*fMp,269*fMp)
Pen (1,2,8421504)
Create Line (62*fMp,273*fMp) (110*fMp,273*fMp)
Pen (1,2,8421504)
Create Line (40*fMp,277*fMp) (200*fMp,277*fMp)
Pen (1,2,8421504)
'Create Frame (11*fMp,266*fMp) (39*fMp,287*fMp)
'Pen (1,1,0)
'Brush (2,16777215,16777215)
'From Window iLogoWindowID
Create Line (40*fMp,265*fMp) (40*fMp,288*fMp)
Pen (1,2,8421504)

Set Layout Ruler On Pagebreaks On Frame Contents On
Zoom 33.3333
Set Window FrontWindow() Autoscroll On
Set Window FrontWindow() Title sDocTitle + " Layout"
Set Window FrontWindow() Printer
Name sPrinterName Orientation Portrait Copies 1
Papersize iPapersize

Exit Sub
'---------------------------
ErrorHandler:
'Note Error$()
'*********************************************************************************************
End Sub LayoutPortrait
'********************************************************************************************
As we do not know the details of the maps being produced we have to accept a compromise as to how the cartographic legend appears. Whilst we can control fonts and colours other factors are entirely dependent on the names given to layers. You could avoid cryptic output by saving the map layers with meaningful names. This assumes that you do not want to resort to putting specific data into your layout code which would obviously limit the scope of the program. Another issue which may arise is if a layer has more than one symbol set. Again you can hard code for this problem but ideally you should create layers with only one symbol per layer to avoid the legend being misaligned because of spacing issues.

The same code changes are also incorporated in the LayoutLandscape module. These changes enable the user to produce a series of maps with either a cartographic legend or a thematic layer and thematic legend.

Here are some more examples from the MapInfo trial data set.
Picture
Picture
Picture
As the above examples show it is possible to create a series of maps in MapInfo Professional through the power of MapBasic code.

The Atlas program could be customised further to enable a company or organisation to include data in their maps about population, area, sales or other relevant data which may need to be updated on a daily, weekly, monthly, quarterly or yearly basis. As you can see with the Atlas program, using MapBasic code you can automate many mapping tasks which would otherwise take considerable time and effort to carry out by manual efforts using MapInfo Professional.
0 Comments

Your comment will be posted after it is approved.


Leave a Reply.

    Author

    Joe Short BSc has been involved with various mapping solutions for over twenty years.  If you are considering implementing a GIS  or have ArcGIS Pro, MapInfo Pro or QGIS training requirements, jps services would be happy to be of assistance to your organisation. 

    Archives

    April 2020
    March 2020
    October 2019
    September 2019
    August 2019
    July 2019
    March 2019
    November 2018
    October 2018
    August 2018
    July 2018
    November 2017
    October 2017
    September 2017
    July 2017
    February 2017
    January 2017
    December 2016
    November 2016
    October 2016
    May 2016
    February 2016
    September 2015
    August 2015
    April 2015
    February 2015
    November 2014
    October 2014
    July 2014
    June 2014
    May 2014
    March 2014
    February 2014
    December 2013
    November 2013
    October 2013
    September 2013
    August 2013
    June 2013
    May 2013
    April 2013
    February 2013
    December 2012
    October 2012
    September 2012
    August 2012
    July 2012

    Categories

    All
    Arc Gis
    Arcview
    Autodesk
    Cad
    Gis Training
    Local Government
    Mapbasic
    Mapinfo
    Quantum Gis
    Relational Databases
    Saga Gis

    RSS Feed