James
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