We need to make some changes to the code so that a number of extra features can be made available to potential users. For instance, we need to let the user have some means of updating the default settings for the company data. Also the user should be able to use different tables and workspaces with the atlas program.
Here is a screen shot of the atlas code showing the ribbon interface set up in MapInfo Pro.
As mentioned in previous blogs, in order to create this atlas ribbon based program within MapInfo Pro, we first need to create a definition file, relevant modules and a project file.
Here is the code for the 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 CreateMaps
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 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 As String
Global sFont, sRegion, sRegionTitle, sPrinterName, sDocTitle, sPapersize, sOutputFolder as String
Global iRegionsSelectedArray(), iPaperChoice, iPapersize, iLogoWindowID, iMapWindowID, iLayoutWindowID As Integer
Global iLayoutFontSize1, iLayoutFontSize2, iLayoutFontSize3, iLayoutFontSize4, iOrientation as Integer
Global fZoom, fMp, fPaper1, fPaper2, fPaperWidth, fPaperHeight, fHorizontalDistance, fVerticalDistance, fPos1, fPos2 As Float
Global lRegionObjectsSelected As Logical
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=CreateMaps.mbo
'** Project Atlas
'**
'** Module AtlasRibbonInterface
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Enums.def"
Include "Library\RIBBONLib.def"
Include "Atlas.def"
'******************************************
Sub Main
sOutputFolder = ApplicationDirectory$() + "Output\"
Dim nCtrlIdx as Integer
Dim sTabName, sGroupName, marrModProgramsNames(), marrModProgramsImages() as String
' Check for the existence of the TAB named tabAtlasApp
sTabName = "tabAtlasApp"
If NOT RBNTabExists(sTabName) Then
nCtrlIdx = RBNAddTab(sTabName,"Atlas App","F")
If nCtrlIdx = 0 Then
Note "An error occurred whilst adding a new tab called + '" + sTabName + "' to the ribbon"
Exit Sub
End If
End If
sGroupName = "grpAtlasApp"
If NOT RBNTabGroupExists(sTabName,sGroupName) Then
nCtrlIdx = RBNTabAddGroup(sGroupName, "Atlas",sTabName)
If nCtrlIdx = 0 Then
Exit Sub
End If
End If
ReDim marrModProgramsNames(1)
ReDim marrModProgramsImages(1)
marrModProgramsNames(1) = "Atlas Example"
marrModProgramsImages(1) = ApplicationDirectory$() + "\Images\Output.png"
nCtrlIdx = RBNGroupAddButton("Atlas", marrModProgramsNames(1),"",sTabName,sGroupName)
If nCtrlIdx > 0 Then
' Create and set the button tooltip
Call RBNControlSetToolTipIdx(nCtrlIdx,"Atlas App","Start module '" + marrModProgramsNames(1)+ "'","")
' Set the button icon
Call RBNControlSetIconsIdx(nCtrlIdx,CONTROL_SIZE_LARGE,"",marrModProgramsImages(1))
' Set Custom MapBasic handle to the button
Call RBNControlSetCustomMBXHandlerIdx(nCtrlIdx,"Atlas_dialog")
End If
ReDim marrModProgramsNames(2)
ReDim marrModProgramsImages(2)
marrModProgramsNames(2) = "About Atlas example"
marrModProgramsImages(2) = ApplicationDirectory$() + "\Images\Info.png"
nCtrlIdx = RBNGroupAddButton("AboutAtlasExample", marrModProgramsNames(2),"",sTabName,sGroupName)
If nCtrlIdx > 0 Then
' Create and set the button tooltip
Call RBNControlSetToolTipIdx(nCtrlIdx,"Modular Programming Example App","Start module '" + marrModProgramsNames(2)+ "'","")
' Set the button icon
Call RBNControlSetIconsIdx(nCtrlIdx,CONTROL_SIZE_LARGE,"",marrModProgramsImages(2))
' Set Custom MapBasic handle to the button
Call RBNControlSetCustomMBXHandlerIdx(nCtrlIdx,"AtlasAbout")
End If
Call RBNNotificationShow("Atlas Sample Code App", "Launching....", Notify_Info, 4000)
End Sub
Sub Endhandler
'Ask the RibbonHandler to tidy up before the app ends
Call RBNEndHandler
End Sub
'** 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
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
'Print "Selected table: " & sTable
'Print "Selected column: " & sColA
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
'** 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.
If Ubound(iRegionsSelectedArray) = 0 Then
Call PopulateRegionsArray
End If
Dim l as Integer
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)) '"The departments of region " + sRegionsArray(iRegionsSelectedArray(l))
Call CreateMaps
Next
End If
End Sub MLB
'*********************************************************************************************
'** Project Atlas
'**
'** Module InputAtlasDefaultSettings
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"
'*********************************************************************************************
Sub InputAtlasDefaultSettings
'*********************************************************************************************
OnError Goto ErrorHandler
Dialog
Title "Default Settings"
Control StaticText
Title "Company Name" Position 1dW, 1dH
Control EditText
Value "JPS Services"
Into sAddressArray(1)
ID 1
Control StaticText
Title "Town" Position 1dW, 4dH
Control EditText
Value "Southport"
Into sAddressArray(2)
ID 2
Control StaticText
Title "Phone Number" Position 1dW, 8dH
Control EditText
Value "01704 579686"
Into sAddressArray(3)
ID 3
Control StaticText
Title "Email Address" Position 1dW, 12dH
Control EditText
Value "[email protected]"
Into sAddressArray(4)
ID 4
Control StaticText
Title "Web Address" Position 1dW, 16dH
Control EditText
Value "www.jpsservices.org.uk"
Into sAddressArray(5)
ID 5
Control OKButton
Control CancelButton
If CommandInfo(CMD_INFO_DLG_OK) Then
' ...then the user clicked OK, and the variable
' contains the text the user entered.
End If
sPrintDate = CurDate()
sPrintDate = RegionalLongDate(sPrintDate)
sFont = "Arial"
sCopyrightText = Chr$(169) + Chr$(32) + Year(CurDate()) + "- " + sAddressArray(1)
Exit Sub
'---------------------------
ErrorHandler:
Note Error$()
End Sub InputAtlasDefaultSettings
'** Project Atlas
'**
'** Module Create Maps
'**
'** Author: Joseph Short
'** Date: 14 September 2017
'************************************************************************************
Include "Atlas.def"
'*********************************************************************************************
Sub CreateMaps
'*********************************************************************************************
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())
Call AddMaps
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" '" + sColB + " 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,256,25,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 RegionSelected
Set Map Redraw On
Exit Sub
'---------------------------
ErrorHandler:
'Note Error$()
End Sub CreateMaps
Within the CreateMaps module is a call to AddMaps. 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
'*********************************************************************************************
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
Add Map Auto Layer tables(i)
MakeFont(sFont,257,9,255,16777215)
Set Map Layer tables(i) Label Auto On
Set Map Layer tables(i) Label Font MakeFont(sFont,257,9,255,16777215)
Next
iMapWindowID = WindowID(FrontWindow())
End Sub
Here is the code for the LayoutPortrait module:-
'** 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
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
'*******************************************************************************
Position (11*fMp,179*fMp) Units "mm"
Width 22 Units "mm"
Height 16 Units "mm"
From File sAppPath + "\Images\Company_logo.png"