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

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

20/9/2017

1 Comment

 
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.
Picture
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.
Picture
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.
Picture
The translucency and border options are shown below:-
Picture
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:-
Picture
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.

Picture
Clicking on OK will bring up the Ribbon Based Atlas Sample Code dialogue box as shown in this screen shot.
Picture
Having chosen one or more regions clicking on the Print button will produce output like the following screen shot.
Picture
We could change the translucency level or the borders by clicking on the Mask button. The screen shot shows the proposed changes.
Picture
Here is a screen shot of a printed map after making these changes to the border type.
Picture
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:_
Picture
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:-
Picture
Picture
The program could be further enhanced by including specific information about individual regions derived possibly from the browser data within the map table.
1 Comment
Peter Horsbøll Møller link
13/12/2017 09:07:49 am

This is starting to become quite a nice tool, Joseph. Have you considered sharing the tool on the Pitney Bowes Community Download page? Feel free to reach out to me via email if you want to discuss this

Reply

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