Get List Of Running MBXs

This example demonstrates how to use DDE to retrieve a topic string which contains the list of running mbx's within a mapinfo session. The function  GetMBXFromTopicString(strTopics As String) As String  extracts the mbx name from the topic string. I have used similar code in other applications to determine if an mbx was running in the current instance of mapinfo. If it was not found, I issued a Run Application statement to fire off the mbx


Include "Mapbasic.def"

Declare Sub Main
Declare Sub PrintListOfRunningMBXs
Declare Function GetMBXFromTopicString(strTopics As String) As String

'---------------------------------------------------------------------------------------
Sub Main
Print Chr$(12)
Set Window Message Position(1,1) Width 3 Height 5 Title "List of Running MBXs"

Call PrintListOfRunningMBXs
End Sub
'---------------------------------------------------------------------------------------
Sub PrintListOfRunningMBXs
OnError Goto CatchEx
   
   Dim nChan, i As Integer
   Dim sTopics, strMBX As String

   nChan = DDEInitiate("MapInfo", "System")
   sTopics = DDERequest$(nChan, "Topics")
   DDETerminate nChan
   strMBX = GetMBXFromTopicString(sTopics)
   i = 1
   
   Do While sTopics <> ""
      Print PathToFileName$(GetMBXFromTopicString(sTopics))
      i = i + 1
   Loop

Done:
   Exit Sub
CatchEx:
   Resume Done
End Sub
'---------------------------------------------------------------------------------------
Function GetMBXFromTopicString(strTopics As String) As String
OnError Goto CatchEx

   Dim iDelimPos As SmallInt
   strTopics = RTrim$(LTrim$(strTopics))
   iDelimPos = InStr(1, strTopics, Chr$(9))

   If iDelimPos Then
      GetMBXFromTopicString = Left$(strTopics, iDelimPos-1)
      strTopics = Right$(strTopics, Len(strTopics)-iDelimPos)
   Else
      GetMBXFromTopicString = strTopics
      strTopics = ""
   End If

Done:
   Exit Sub
CatchEx:
   Resume Done
End Function
'---------------------------------------------------------------------------------------

MapBasic Progress Bar Example 2: How to step progress bar for multiple tasks

Following on from Example 1, in this example I will demonstrate how I use a progress step sub routine as a way of calling many functions and sub routines to show progress through my mbx. The code uses a case statement to see what step count it is up to. It also demonstrates how to track if the progress bar cancel button was clicked, or if the code was ended prematurely because of user intervention. 

This example enables you to show the progress bar, and set up a sequence of routines / scripts / functions and update the progress bar with a progress percentage when each task is complete.


Include "Mapbasic.def"

Declare Sub Main
Declare Sub StepProgress
Declare Sub Wait3Seconds
Declare Function ReturnTrue() as Logical

Dim iProgress as Integer
Dim iProgressRange as Integer

Sub Main
   Print Chr$(12)
   Set Window Message Position(1, 1) Width 3 Height 1
   Print "*** Started Progress Bar Example ***"

   iProgress = 1
   iProgressRange = 5

   ProgressBar "Processing...."
      Calling StepProgress
      Range iProgressRange


   If CommandInfo(CMD_INFO_STATUS) then
      If iProgress <= iProgressRange then
         Note "You ended the Progress early because you only got to step " & iProgress
      Else
         Note "Progress Bar Example Complete!"
      End If
   Else
      Note "You clicked the cancel button on the Progress Bar!"
   End If

End Sub
'----------------------------------------------------------------
Sub StepProgress
   Print "Progress is @ step " & iProgress

   Do Case iProgress
      Case 1
         Note "Progress is @ step " & iProgress 'This is just an example process
      Case 2
          Note "Progress is @ step " & iProgress & ". Now going to wait 3 secs!"
          Call Wait3Seconds 'This is just an example process
      Case 3
          Note "Progress is @ step " & iProgress 'This is just an example process
      Case 4
          If NOT ReturnTrue() then 'This is just an example process
             Print "You eneded Progress"
             ProgressBar = -1 'Now the progress bar will stop and hide
             Exit Sub
         End If
      Case 5
         Note "Progress is @ step " & iProgress 'This is just an example process
   End Case

   iProgress = iProgress + 1
   
   If iProgress <= iProgressRange Then
      ProgressBar = iProgress
   Else
      ProgressBar = -1
   End If

End Sub
'----------------------------------------------------------------
Sub Wait3Seconds

   Print "Waiting for 3 seconds"

   Dim iCurrentTime, iElapsedTime, iWaitTime as Float

   iCurrentTime = Timer()
   iWaitTime= 3

   Do While iElapsedTime <= iCurrentTime + iWaitTime
      iElapsedTime = Timer()
   Loop

End Sub
'----------------------------------------------------------------
Function ReturnTrue() as Logical

   Dim bResult as Logical
   bResult = Ask("Progress is @ step " & iProgress & ". Do you want the progress bar to Contiue or End?", "Continue", "End")
   Print "Return True = " & bResult
   
   ReturnTrue = bResult

End Function

Mapbasic Progress Bar Example 1: How to step progress bar for each row in a table

The progress bar that is provided within Mapbasic is not very flexible. It is limited to calling sub routines and is designed in a way that it continues to call a the specified sub routine until you end it (ProgressBar = -1). This means you can't parse a variable and you can't just show the progress bar and update it's progress and any point in your code. 

It took me a while to harness it, and this example and Example 2 demonstrates how I use the Mapbasic progress bar in my mbx's. 

In this example I will demonstrate how to iterate through a table fetching each row. I use global variables to track progress and range and I create a selection table that I step through each row and print out the column 1 value. I would suggest you open a table with more than 1000 rows when you run this example mbx.



Include "Mapbasic.def"

Declare Sub Main
Declare Sub StepProgress　

Dim iProgress as Integer
Dim iProgressRange as Integer

'----------------------------------------------------------------
Sub Main
   Print Chr$(12)
   Set Window Message Position(1, 1) Width 3 Height 1
   Print "*** Started Progress Bar Example ***"

   If NumTables() < 1 then
      Note "This Progress Bar Example needs a table open to demonstrate"
      Exit Sub
   End If

   Select * from TableInfo(1,TAB_INFO_NAME) Where str$(Col1) <> "" Into Temp
   iProgressRange = TableInfo("Temp",TAB_INFO_NROWS)

   Fetch First From Temp
   iProgress = 1

   ProgressBar "Processing...."
      Calling StepProgress
      Range iProgressRange

   Close Table Temp

   If CommandInfo(CMD_INFO_STATUS) Then
      Note "Progress Bar Example Complete!"
   Else
      Note "You clicked the cancel button on the Progress Bar!"
   End If
End Sub
'----------------------------------------------------------------
Sub StepProgress

   Print "Row " & iProgress & " Value " & Temp.Col1
   'Do Something here
   'EG: Update Temp Set Col1 = "A New Vaule" Where RowID = iProgress

   iProgress = iProgress + 1
   Fetch Rec iProgress From Temp

   If iProgress <= iProgressRange Then
      ProgressBar = iProgress
   Else
      ProgressBar = -1
   End If
End Sub
'----------------------------------------------------------------

Change Object Style with Mapbasic (Alter or Change Front, Symbol, Pen or Brush Style of an object)

I have seen a lot of questions asking how to change an object style in MapInfo programatically with Mapbasic. This example demonstrates how to define a font, symbol, pen and brush style and apply a style to an object. To run and test this demo, copy the code below and compile, select an object in a map window and click the wrench tool button to see how the code modifies object styles base on the type of object selected. The image below shows what the object will look like when you click the change object style button. Feel free to use these functions in your code :)

James 

Include "Mapbasic.def"
Include "Icons.def"

Declare Sub Main
Declare Sub ChangeObjStyle

Declare Function AlterObjectFontStyle(ByVal oObject as Object, ByVal fFontStyle as Font) as Object
Declare Function AlterObjectSymbolStyle(ByVal oObject as Object, sSymbolStyle as Symbol) as Object
Declare Function AlterObjectPenStyle(ByVal oObject as Object, pPenStyle as Pen) as Object
Declare Function AlterObjectBrushStyle(ByVal oObject as Object, bBrushStyle as Brush) as Object
'-----------------------------------------------------------------
Sub Main
   Print Chr$(12)
   Print "Started ChangeObjStyle.mbx"

   Create ButtonPad "Change Obj Style" asPushButton
      Calling ChangeObjStyle
      ID 1
      Icon MI_ICON_WRENCH
End Sub
'-----------------------------------------------------------------
Sub ChangeObjStyle
OnError Goto CatchEx
   Print "Clicked on Change Object Style button"

   If SelectionInfo(SEL_INFO_NROWS) = 0 Then
      Print "No Selection"
      Note "You must select an object"
      Exit Sub
   End If
   
   If SelectionInfo(SEL_INFO_NROWS) > 1 Then
      Print "Selected " & SelectionInfo(SEL_INFO_NROWS) & " of objects"
      Note "This tool is only designed to alter the object style of 1 object at a time!"
      Exit Sub 
   End If
   
   Dim objModify as Object
   Fetch First From selection
   objModify = selection.obj
   
   Dim fFont as Font
   fFont = MakeFont("Courier New", 0, 16,BLUE, -1) 'This is how you define a font

   Dim sSymbol as Symbol
   sSymbol = MakeSymbol(67,RED, 25) 'This is how you define a symbol style

   Dim pPen as Pen
   pPen = MakePen(1,92, RED) 'This is how you define a pen style

   Dim bBrush as Brush
   bBrush = MakeBrush(7,MAGENTA,-1) 'This is how you define a brush style

   Do Case ObjectInfo(objModify, OBJ_INFO_TYPE)
      Case OBJ_TYPE_ARC
         objModify = AlterObjectPenStyle(objModify, pPen)
      Case OBJ_TYPE_ELLIPSE
         objModify = AlterObjectPenStyle(objModify, pPen)
         objModify = AlterObjectBrushStyle(objModify, bBrush)
      Case OBJ_TYPE_LINE
         objModify = AlterObjectPenStyle(objModify, pPen)
      Case OBJ_TYPE_PLINE
         objModify = AlterObjectPenStyle(objModify, pPen)
      Case OBJ_TYPE_POINT
         objModify = AlterObjectSymbolStyle(objModify, sSymbol)
      Case OBJ_TYPE_FRAME
         objModify = AlterObjectPenStyle(objModify, pPen)
         objModify = AlterObjectBrushStyle(objModify, bBrush)
      Case OBJ_TYPE_REGION
         objModify = AlterObjectPenStyle(objModify, pPen)
         objModify = AlterObjectBrushStyle(objModify, bBrush)
      Case OBJ_TYPE_RECT
         objModify = AlterObjectPenStyle(objModify, pPen)
         objModify = AlterObjectBrushStyle(objModify, bBrush)
      Case OBJ_TYPE_ROUNDRECT
         objModify = AlterObjectPenStyle(objModify, pPen)
         objModify = AlterObjectBrushStyle(objModify, bBrush)
      Case OBJ_TYPE_TEXT
         objModify = AlterObjectFontStyle(objModify, fFont)
      Case Else
         Note "The selected object is an unknown object type" 'OBJ_TYPE_MULTIPOINT, OBJ_TYPE_COLLECTION
   End Case

   Update selection set obj = objModify
Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'-----------------------------------------------------------------
Function AlterObjectFontStyle(ByVal oObject as Object, ByVal fFontStyle as Font) as Object
OnError Goto CatchEx
   Alter Object oObject
      Info OBJ_INFO_TEXTFONT, fFontStyleAlterObjectFontStyle = oObject
   Print "Altered font style"
Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done 
End Function
'-----------------------------------------------------------------
Function AlterObjectSymbolStyle(ByVal oObject as Object, sSymbolStyle as Symbol) as Object
OnError Goto CatchEx
   Alter Object oObject
      Info OBJ_INFO_SYMBOL, sSymbolStyle
   AlterObjectSymbolStyle = oObject
   Print "Altered symbol style"
Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done 
End Function
'-----------------------------------------------------------------
Function AlterObjectPenStyle(ByVal oObject as Object, pPenStyle as Pen) as Object
OnError Goto CatchEx
   Alter Object oObject
      Info OBJ_INFO_PEN, pPenStyle
   AlterObjectPenStyle = oObject
   Print "Altered pen style"
Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done 
End Function
'-----------------------------------------------------------------
Function AlterObjectBrushStyle(ByVal oObject as Object, bBrushStyle as Brush) as Object
OnError Goto CatchEx
   Alter Object oObject
       Info OBJ_INFO_BRUSH, bBrushStyle
   AlterObjectBrushStyle = oObject
   Print "Altered brush style"
Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done 
End Function

Set Map Window Projection from Layer - Alter Layer Control Right Click Menu

Hi All,
This is quick post to demonstrate a useful tool for changing map projections based on a layer. By default MapInfo will assign a map projection based on the dominant raster layer. If you change raster layers the map projection may, but not always change. This tool will allow you to select a layer in the layer control, right click and set projection from layer.


Include "Mapbasic.def"
Include "Menu.def"

Declare Sub Main
Declare Sub SetMapWinProjection
'----------------------------------------------------------------
Sub Main
OnError Goto CatchEx

   Alter Menu ID M_SHORTCUT_LC_LAYERS Add
   "(-",
   "Set Map Projection From Layer"
   Calling SetMapWinProjection

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'----------------------------------------------------------------
Sub SetMapWinProjectionOnError Goto CatchEx

   If LayerControlInfo(LC_INFO_SEL_COUNT) = 0 then
      Note "Please select a layer!"
      Goto Done
   End If

   If LayerControlInfo(LC_INFO_SEL_COUNT) > 1 then
      Note "Please select one layer you want to set the map projection from"
      Goto Done
   End If

   Dim strLayerAlias as String
   strLayerAlias = LayerControlSelectionInfo(1,LC_SEL_INFO_NAME)
   Print("Layer Name: " & strLayerAlias)

   Print("Layer Type: "  & LayerControlSelectionInfo(1,LC_SEL_INFO_TYPE))

   Dim iMapWinID as integer
   iMapWinID = LayerControlSelectionInfo(1,LC_SEL_INFO_MAPWIN_ID)
   Print("Layer's Map Window ID: " & iMapWinID)

   Dim strCmd as String
   strCmd = "Set Map " & TableInfo(strLayerAlias,TAB_INFO_COORDSYS_CLAUSE)
   Print "strCmd = " & strCmd
   Run Command strCmd

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done 
End Sub