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