Updating the MapInfo Pro Ribbon based Atlas program MapBasic code with a Mask Facility

In the last blog we developed an atlas program to create A4 and A3 printable maps from tables and workspaces. We could further enhance the program by adding a mask facility. The code for the mask was originally developed by Egge-Jan Pollé.

Here is a screen shot of the updated ribbon based atlas program including the mask option.

If we now use the Canadian maps provided in the MapInfo Pro trial data folder we can see how the mask works. Here is a screen shot after the Mask Settings OK button is pressed.

The Create Mask Settings dialogue box allows the user to select a Border style and Translucency level if the Create Mask Settings option is enabled. If the OK button is pressed with the default settings a map will be printed with the following border style.

The translucency and border options are shown below:-

Having clicked the OK button these settings will be reflected in the maps selected. If we choose the Atlas Example button a dialogue box appears. Her you can choose a table and a column for your map/s as shown in the next screenshot:-

Clicking OK brings up the Default Settings dialogue box. Here you can make changes as required. Here is a screen shot of the dialogue box.

Clicking on OK will bring up the Ribbon Based Atlas Sample Code dialogue box as shown in this screen shot.

Having chosen one or more regions clicking on the Print button will produce output like the following screen shot.

We could change the translucency level or the borders by clicking on the Mask button. The screen shot shows the proposed changes.

Here is a screen shot of a printed map after making these changes to the border type.

If you require a map without a mask you can do this by clicking on the Mask Settings button and deselecting the mask option. Here is a map created after deselecting the mask option:_

The Atlas program requires the updating of the definition file, the project file and the addition of a number of modules for the mask option to be available.

Here is the revised definition file:

'************************************************************************************
'** 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 Function LongDate(ByVal dDate As Date) 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 as String
Global iRegionsSelectedArray(), iPaperChoice, iPapersize, iLogoWindowID, iMapWindowID, 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 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 As Alias

Here is the project file:-

[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

Here is the code for the MLB module:-

'************************************************************************************
'** Project Atlas
'**
'** MLB
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"
'*********************************************************************************************
Sub MLB
'*********************************************************************************************
' Processing a MultiListBox control
'
' To read what items the user selected from a MultiListBox control, assign a handle r procedure
' that is called when the user dismisses the dialog box (for example, assign a handler to the
' OKButton control). Within the handler procedure, set up a loop to call the ReadControlValue( )
' function repeatedly.
'
' The first call to the ReadControlValue( ) function returns the number of the first selected
' item; the second call to the ReadControlValue( ) function returns the number of the second
' selected item; etc. When the ReadControlValue( ) function returns zero, you have exhausted the
' list of selected items. If the first call to the ReadControlValue( ) function returns zero,
' there are no list items selected.

Dim l as Integer

If Ubound(iRegionsSelectedArray) > 0 Then

For l = 1 To Ubound(sRegionsArray())
sRegionsArray(l) = ""
Call PopulateRegionsArray
Next

End If

If Ubound(iRegionsSelectedArray) = 0 Then

Call PopulateRegionsArray

End If

Call InputAtlasDefaultSettings

Dialog
Title AppName
Calling HighLightSelectedRegions
Control StaticText Title "Print map for one or more regions:" Position 1dW, 1dH
Control MultiListBox Title from variable sRegionsArray Width 35dW Height 23dH Position 1dW, 2.5dH ID MLBID
Control CheckBox Title "Select &All " Value 0 Position 1dW, 26dH ID SelectAllMLBID Calling SelectAllFromMLB
Control GroupBox Title "Select Paper Size:" Position 37dW,2.5dH Height 5.5dH Width 30dW
Control RadioGroup Title "A&4;A&3" into iPaperChoice Position 39dW, 4.5dH
Control OKButton Title "&Print" Calling MLBOKButton
Control CancelButton

If CommandInfo(CMD_INFO_DLG_OK) Then

For l = 1 To Ubound(iRegionsSelectedArray)
sRegion = sRegionsArray(iRegionsSelectedArray(l))
sRegionTitle = "Map of " + sRegionsArray(iRegionsSelectedArray(l))
Call CreateMaskMaps
Next

End If

End Sub MLB

'*********************************************************************************************

Here is the code for the CreateRibbonMask module:-

'************************************************************************************
'** Project Atlas
'**
'** Module CreateRibbonMask
'**
'** Author: Joseph Short
'** Date: 14th September 2017
'************************************************************************************
Include "Atlas.def"
'************************************************************************************
Sub CreateRibbonMask
'************************************************************************************
OnError Goto HandleError

sMaskTable = PathToTableName$("Mask_" + sTable) 'By default the mask table has the same name
'as the selection table with the prefix Mask_. The function PathToTableName$() is used here to
'avoid the concatenated table name become too long (i.e. more than 30 characters)
sMaskTabFilePath = PathToDirectory$(TableInfo(sTable, TAB_INFO_TABFILE)) + sMaskTable + ".TAB"
'By default the mask table is stored in the same folder as the selection table

Set CoordSys Table sTable

'Take the minimum and maximum x- and y-coordinates of all objects in the table
fX1 = TableInfo(sTable, TAB_INFO_MINX)
fY1 = TableInfo(sTable, TAB_INFO_MINY)
fX2 = TableInfo(sTable, TAB_INFO_MAXX)
fY2 = TableInfo(sTable, TAB_INFO_MAXY)

'Put an additional margin around all the objects in the table
fX1 = fX1 - .60*(fX2-fX1)
'Note fX1 + "fX1 - .60*(fX2-fX1)"
fY1 = fY1 - .60*(fY2-fY1)
'Note fY1 + " fY1 - .60*(fY2-fY1)"
fX2 = fX2 + .60*(fX2-fX1)
'Note fX2 + " fY1 - .60*(fY2-fY1)"
fY2 = fY2 + .60*(fY2-fY1)
'Note fX2 + " fY1 - .60*(fY2-fY1)"

Create Rect Into Variable oRectangle (fX1,fY1) (fX2,fY2) Pen pPenStyle Brush (2,WHITE,WHITE)

alAlias = "RegionSelected.obj"
oCutter = alAlias

'Now use the cutter object to create the mask (by cutting a hole in the rectangle)
oMask = Erase(oRectangle, oCutter)

If(FileExists(sMaskTable + ".TAB")) Then
' Open and drop it
Open Table sMaskTable
Drop Table sMaskTable
End If

'Create a table to store the mask
Create Table sMaskTable (TableName Char(31), MaskCreation DateTime) File sMaskTabFilePath TYPE NATIVE Charset "WindowsLatin1"
Create Map For sMaskTable CoordSys Table sTable

Add Map Layer sMaskTable

Insert Into sMaskTable (obj, TableName, MaskCreation) Values (oMask, sTable, CurDateTime())
Commit Table sMaskTable

'Set the translucency of the mask layer
Set Window FrontWindow() Enhanced On

Set Map Layer sMaskTable Translucency iPctTranslucency

Exit Sub
'---------------------------

HandleError:
Note Error$()

End Sub CreateRibbonMask
'*********************************************************************************************

Here is the code for CreateMaskMaps:-

'************************************************************************************
'** Project Atlas
'**
'** Module Create Mask Maps
'**
'** Author: Joseph Short
'** Date: 14th September 2017
'************************************************************************************
Include "Atlas.def"
'*********************************************************************************************
Sub CreateMaskMaps
'*********************************************************************************************
OnError GoTo ErrorHandler

Dim sQuery, sCommand As String

Set Map Redraw OFF

sPrinterName = "MapInfo PDF Printer Version " + Format$(SystemInfo(SYS_INFO_MIVERSION)/100,"#.##")

If iPaperChoice = 1 Then
fMp = 1
iPapersize = 9
sPapersize = "A4"
fPaper1 = 21
fPaper2 = 29.7
iLayoutFontSize1 = 6
iLayoutFontSize2 = 8
iLayoutFontSize3 = 18
iLayoutFontSize4 = 4
ElseIf iPaperChoice = 2 Then
fMp = 1.4142857142857142857142857142857
iPapersize = 8
sPapersize = "A3"
fPaper1 = 29.7
fPaper2 = 42
iLayoutFontSize1 = 8
iLayoutFontSize2 = 11
iLayoutFontSize3 = 25
iLayoutFontSize4 = 5
End If

Set CoordSys Table sTable

sQuery = "Select * From " + sTable + " Where " + sColA + " = " + Chr$(34) + sRegion + Chr$(34) + " into RegionSelected"
Run Command sQuery

fHorizontalDistance = TableInfo("RegionSelected",TAB_INFO_MAXX) - TableInfo("RegionSelected",TAB_INFO_MINX)
fVerticalDistance = TableInfo("RegionSelected",TAB_INFO_MAXY) - TableInfo("RegionSelected",TAB_INFO_MINY)
If fHorizontalDistance <= fVerticalDistance Then
iOrientation = 1
Else
iOrientation = 2
End If

Map From RegionSelected

iMapWindowID = WindowID(FrontWindow())

If l_create_mask Then

Call CreateRibbonMask

End If

Call AddMaps

If l_create_mask Then

Set Map Layer sMaskTable Translucency iPctTranslucency

End If

iMapWindowID = WindowID(FrontWindow())

If iOrientation = 1 Then
Set Window FrontWindow() Position (0,0) units "cm" Width 19*fMp units "cm" Height 24.5*fMp units "cm"
ElseIf iOrientation = 2 Then
Set Window FrontWindow() Position (0,0) units "cm" Width 27.7*fMp units "cm" Height 15.8*fMp units "cm"
End If

Set Map Window iMapWindowID Zoom Entire Layer RegionSelected

sCommand = "Set Map Window " + iMapWindowID + " Layer RegionSelected Label With " + sColA + " Auto Retry On"
Run Command sCommand
Set Map Window iMapWindowID Layer RegionSelected Label Auto On
Set Map Window iMapWindowID Layer RegionSelected Label Font MakeFont (sFont,257,14,255,16777215) '(sFont,257,9,255,16777215)
sDocTitle = sRegionTitle

Set Window FrontWindow() Title sDocTitle + " Map"

Set Distance Units "cm"
Set Paper Units "cm"

fZoom = MapperInfo(FrontWindow(),MAPPER_INFO_SCALE)

If fZoom < 100000 Then 'under 1:100,000 round to 1,000
fZoom = fZoom + 500
fZoom = Round(fZoom, 1000)
ElseIf fZoom < 1000000 Then 'between 1:100,000 and 1:1,000,000 round to 10,000
fZoom = fZoom + 5000
fZoom = Round(fZoom, 10000)
ElseIf fZoom >= 1000000 Then 'above 1:1,000,000 round to 100,000
fZoom = fZoom + 50000
fZoom = Round(fZoom, 100000)
End If

Set Map Scale 1 Units "cm" For fZoom Units "cm"

Run Menu Command 304 'Unselect All

Create Adornment From Window FrontWindow() Type Scalebar Position 6 Offset (0.000000, 0.000000) Units "cm" Background Brush (2,16777215,16777215) Pen (1,2,0) BarType 3 Ground Units "km" Display Units "mm" BarLength 50.000000 BarHeight 2.000000 BarStyle Pen (1,2,0) Brush (2,0,16777215) Font MakeFont(sFont,0,iLayoutFontSize2,BLACK,WHITE) Scale Off

If iOrientation = 1 Then
fPaperWidth = fPaper1
fPaperHeight = fPaper2
Call LayoutPortrait
ElseIf iOrientation = 2 Then
fPaperWidth = fPaper2
fPaperHeight = fPaper1
Call LayoutLandscape
End If

Save Window FrontWindow() As sOutputFolder + sDocTitle + ".png" Type "PNG" Width fPaperWidth Units "cm" Height fPaperHeight Units "cm" Resolution 300
'PrintWin Window FrontWindow( ) File ApplicationDirectory$( )+ "\Output " + sDocTitle + ".pdf"

Close Window iLayoutWindowID
Close Window iMapWindowID
'Close Table My_own_company_logo
Close Table RegionSelected
Close Table sMaskTable
Set Map Redraw On

Exit Sub
'---------------------------
ErrorHandler:
'Note Error$()

End Sub CreateMaskMaps

Finally here is the code for the AddMaps 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

'*********************************************************************************************
Sub AddMaps
'*********************************************************************************************
Dim i, nCols, nTables, iMapWindowID 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

End Sub

The other modules are the same as those used to create the original ribbon based atlas program discussed in the previous blog. This atlas program could be further improved, to meet specific organisation requirements, by adding further modules or modifying the existing code.

Here some further examples of States maps generated by this Atlas program code:-

The program could be further enhanced by including specific information about individual regions derived possibly from the browser data within the map table.