11-05-2015, 02:48 PM
Here is a simple macro that let's you change the color of each of the 7 different types of objects in one dialog box.
Code:
Sub Main
Dim button As Integer
Dim color As Long
Dim PTcolor As Long
Dim LNcolor As Long
Dim CLcolor As Long
Dim SHcolor As Long
Dim TXcolor As Long
Dim DMcolor As Long
Dim SPcolor As Long
Dim pointperm As Boolean
Dim LNlinetype As Long
Dim CLlinetype As Long
Dim SHlinetype As Long
Dim SPlinetype As Long
Dim LNlineweight As Long
Dim CLlineweight As Long
Dim SHlineweight As Long
Dim SPlineweight As Long
Dim TXfontname As String
Dim DMfontname As String
Dim TXfontstyle As String
Dim DMfontstyle As String
Dim TXangle As Double
Dim TXheight As Double
Dim DMheight As Double
Dim flags As Long
Dim excharspacing As Double
Dim exlinespacing As Double
Dim InOut As Boolean
Dim AlwaysHorz As Boolean
Dim ColorCode(30) As Integer
Dim ColorName$(30) As String
'***************************** Color Code List **************************
'<< Leave ColorName$(##) and ColorCode(##) numbers in sequence 1 - 30 >>
'<< Deltacad Color Names and Numbers can be in any order >>
'< Dialog Position Color Name Deltacad Color Number 0 - 159 >
ColorName$(1) = "Black": ColorCode(1) = 0
ColorName$(2) = "Red": ColorCode(2) = 1
ColorName$(3) = "Green": ColorCode(3) = 2
ColorName$(4) = "Yellow": ColorCode(4) = 3
ColorName$(5) = "Blue": ColorCode(5) = 4
ColorName$(6) = "Purple": ColorCode(6) = 5
ColorName$(7) = "Brown": ColorCode(7) = 6
ColorName$(8) = "Dark Gray": ColorCode(8) = 7
ColorName$(9) = "Light Gray": ColorCode(9) = 8
ColorName$(10) = "Light Blue": ColorCode(10) = 9
ColorName$(11) = "Dark Green": ColorCode(11) = 10
ColorName$(12) = "Green Yellow": ColorCode(12) = 11
ColorName$(13) = "Dark Blue": ColorCode(13) = 12
ColorName$(14) = "Dark Purple": ColorCode(14) = 13
ColorName$(15) = "Gray Blue": ColorCode(15) = 14
ColorName$(16) = "White": ColorCode(16) = 15
ColorName$(17) = "Dark Brown": ColorCode(17) = 16 '<-- I made this one up
'- - - - - - - - - - - - - - - New Colors - - - - - - - - - - - - - - - -
'ColorName$(18) = "Color Name": ColorCode(18) = 0 - 159
'ColorName$(19) = "Color Name": ColorCode(19) = 0 - 159
'ColorName$(20) = "Color Name": ColorCode(20) = 0 - 159
'ColorName$(21) = "Color Name": ColorCode(21) = 0 - 159
'ColorName$(22) = "Color Name": ColorCode(22) = 0 - 159
'ColorName$(23) = "Color Name": ColorCode(23) = 0 - 159
'ColorName$(24) = "Color Name": ColorCode(24) = 0 - 159
'ColorName$(25) = "Color Name": ColorCode(25) = 0 - 159
'ColorName$(26) = "Color Name": ColorCode(26) = 0 - 159
'ColorName$(27) = "Color Name": ColorCode(27) = 0 - 159
'ColorName$(28) = "Color Name": ColorCode(28) = 0 - 159
'ColorName$(29) = "Color Name": ColorCode(29) = 0 - 159
'ColorName$(30) = "Color Name": ColorCode(30) = 0 - 159
'*******************************************************************
GetButton:
ObjectType$="Point": dcGetPointParms color, pointperm
gosub GetColorCode: PTcolor=color2
ObjectType$="Line": dcGetLineParms color, LNlinetype, LNlineweight
gosub GetColorCode: LNcolor=color2
ObjectType$="Circle": dcGetCircleParms color, CLlinetype, CLlineweight
gosub GetColorCode: CLcolor=color2
ObjectType$="Shape": dcGetShapesParms color, SHlinetype, SHlineweight
gosub GetColorCode: SHcolor=color2
ObjectType$="Text": dcGetTextParms color, TXfontname, TXfontstyle, TXangle, TXheight, flags, excharspacing, exlinespacing
gosub GetColorCode: TXcolor=color2
ObjectType$="Dimension": dcGetDimParms color, DMfontname, DMfontstyle, DMheight, InOut, AlwaysHorz
gosub GetColorCode: DMcolor=color2
ObjectType$="Spline": dcGetSplineParms color, SPlinetype, SPlineweight
gosub GetColorCode: SPcolor=color2
'*******************************************************************
'<< The following OptionButton Color Names to match ColorName$(##) from above >>
Begin Dialog NEWDLG 144,4, 242, 180, "Color Dialog Box" '<== increase value 180 by 9 for each additional color added ==>
OptionGroup .ColorGroup
OptionButton 28, 16, 55, 9, "Black"
OptionButton 28, 25, 55, 9, "Red"
OptionButton 28, 34, 55, 9, "Green"
OptionButton 28, 43, 55, 9, "Yellow"
OptionButton 28, 52, 55, 9, "Blue"
OptionButton 28, 61, 55, 9, "Purple"
OptionButton 28, 70, 55, 9, "Brown"
OptionButton 28, 79, 55, 9, "Dark Gray"
OptionButton 28, 88, 55, 9, "Light Gray"
OptionButton 28, 97, 55, 9, "Light Blue"
OptionButton 28, 106, 55, 9, "Dark Green"
OptionButton 28, 115, 55, 9, "Green Yellow"
OptionButton 28, 124, 55, 9, "Dark Blue"
OptionButton 28, 133, 55, 9, "Dark Purple"
OptionButton 28, 142, 55, 9, "Gray Blue"
OptionButton 28, 151, 55, 9, "White"
OptionButton 28, 160, 55, 9, "Dark Brown"
'OptionButton 28, 169, 55, 9, "Color Name"
'OptionButton 28, 178, 55, 9, "Color Name"
'OptionButton 28, 187, 55, 9, "Color Name"
'OptionButton 28, 196, 55, 9, "Color Name"
'OptionButton 28, 205, 55, 9, "Color Name"
'OptionButton 28, 214, 55, 9, "Color Name"
'OptionButton 28, 223, 55, 9, "Color Name"
'OptionButton 28, 232, 55, 9, "Color Name"
'OptionButton 28, 241, 55, 9, "Color Name"
'OptionButton 28, 250, 55, 9, "Color Name"
'OptionButton 28, 259, 55, 9, "Color Name"
'OptionButton 28, 268, 55, 9, "Color Name"
'OptionButton 28, 277, 55, 9, "Color Name"
'Picture 10, 15, 15, 158, "C:\Program Files\DeltaCAD\ColorBar3.bmp" '<== Optional Color Bar (This file is 24 X 308)
GroupBox 5,2,100,175, "Select Color"
'. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
OptionGroup .TypeGroup
OptionButton 116,20,55,8, "PointType"
OptionButton 116,32,55,8, "LineType"
OptionButton 116,44,55,8, "CircleType"
OptionButton 116,56,55,8, "Shape Type"
OptionButton 116,68,55,8, "Text Type"
OptionButton 116,80,55,8, "Dim Type"
OptionButton 116,92,55,8, "Spline Type"
GroupBox 112,4,120,108, "Select Object Type / Current Color"
'. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
TextBox 176,20,48,8, .PointColor
TextBox 176,32,48,8, .LineColor
TextBox 176,44,48,8, .CircleColor
TextBox 176,56,48,8, .ShapeColor
TextBox 176,68,48,8, .TextColor
TextBox 176,80,48,8, .DimColor
TextBox 176,92,48,8, .SplineColor
'. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
OKButton 115,118,50,14
PushButton 115,135,50,14, "Done", .X
End Dialog
'*******************************************************************
Dim dlg As newdlg
dlg.PointColor = ColorName$(PTcolor)
dlg.LineColor = ColorName$(LNcolor)
dlg.CircleColor = ColorName$(CLcolor)
dlg.ShapeColor = ColorName$(SHcolor)
dlg.TextColor = ColorName$(TXcolor)
dlg.DimColor = ColorName$(DMcolor)
dlg.SplineColor = ColorName$(SPcolor)
button = Dialog(dlg)
If button = 0 Or button = 1 Then End
If button Then
ColorNum = ColorCode(newdlg.ColorGroup+1)
ObjectType = newdlg.TypeGroup
Select Case ObjectType
Case 0
dcSetPointParms ColorNum, pointperm
Case 1
dcSetLineParms ColorNum, LNlinetype, LNlineweight
Case 2
dcSetCircleParms ColorNum, CLlinetype, CLlineweight
Case 3
dcSetShapesParms ColorNum, SHlinetype, SHlineweight
Case 4
dcSetTextParms ColorNum, TXfontname, TXfontstyle, TXangle, TXheight, flags, excharspacing, exlinespacing
Case 5
dcSetDimParms ColorNum, DMfontname, DMfontstyle, DMheight, InOut, AlwaysHorz
Case 6
dcSetSplineParms ColorNum, SPlinetype, SPlineweight
End Select
GoTo GetButton
End If
End
'========================== Retrieves the color of each Object type =======================
GetColorCode:
For c = 1 to 30
If color = ColorCode(c) Then
color2 = c
Return
End If
Next c
MsgBox "Color code "+Str$(color)+" in "+ObjectType$+" type not found in 'Color Code List'"
Return
'===============================================================
End Sub