Here is a screen shot of the updated ribbon based atlas program including the mask option.
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
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
'** 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
'*********************************************************************************************
'** 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
'*********************************************************************************************
'** 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
'** 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
Here some further examples of States maps generated by this Atlas program code:-