Есть ли способ применить случайный цвет, чтобы изменить стиль выбранных точек на этот цвет?
Итак, у меня есть функция случайного цвета, которую я хочу применить к выборке точек, но она дает мне случайный цвет для каждой точки, а не один случайный цвет для выбора точек. Я знаю, что часть выбора работает, но я не уверен, как чтобы заставить его вызывать этот генератор случайных цветов только один раз для каждого цвета. Вот что у меня есть на данный момент. Спасибо за любой совет / помощь!
include "mapbasic.def"
include "menu.def"
include "icons.def"
Declare Sub Main
Declare Sub Color
Declare Sub RndColor
Declare Function ChangeSymbolColour (ByVal objTarget as Object, ByVal stringAttribute as String) as Object
' ==========================
Sub Main
Dim i, nRecords as integer
Dim ColValue As Alias
Dim s_ColValues(50) as String
'// - Query your table and group wanted column (list of unique values)
Select Symbology from YOUR_TABLE2 group by Symbology into UNIQUE_values
'// - Populate array with all unique values (from first column in UNIQUE_values table)
print "new"
For i = 1 to SelectionInfo(SEL_INFO_NROWS)
ReDim s_ColValues(i)
Fetch rec i From UNIQUE_values
ColValue = UNIQUE_values + ".col1"
s_ColValues(i) = ColValue
Select * from Your_Table2 where Symbology= s_ColValues(i) into Selection
Call Color
Next
End Sub
Sub RndColor
Dim Color as integer
Color = RGB((254*Rnd(1)+1),(254*Rnd(1)+1),(254*Rnd(1)+1))
End Sub
Sub Color
Update Your_table2 set Obj = ChangeSymbolColour(obj, symbology)
End Sub
Function ChangeSymbolColour (ByVal objTarget as Object, ByVal stringAttribute as String) as Object
Dim newSymbol as Symbol
Dim nColour as Integer
'nColour=RGB((254*Rnd(1)+1),(254*Rnd(1)+1),(254*Rnd(1)+1))
ncolour=RED
newSymbol = MakeFontSymbol(36, nColour, 5, "Map Symbols", 0, 0)
Alter Object objTarget Info OBJ_INFO_SYMBOL, newSymbol
ChangeSymbolColour = objTarget
End Function
1 ответ
Решение
Вам нужно сгенерировать случайный цвет вне функции, а затем передать его в качестве параметра, а не генерировать новый цвет при каждом вызове функции. Кроме того, похоже, вы не используете параметр StringAttribute функции, действительно ли это требуется?
например
Sub Main
Dim nColour as Integer
...
Select * from MyTable where ... into MySelection
nColour = GetRandomColour()
Update MySelection Set Obj = ChangeSymbolColour(obj, nColour)
End Sub
Function GetRandomColour() as Integer
GetRandomColour = RGB((254*Rnd(1)+1),(254*Rnd(1)+1),(254*Rnd(1)+1))
End Function
Function ChangeSymbolColour (ByVal objTarget as Object, ByVal nColour as Integer) as Object
Dim newSymbol as Symbol
newSymbol = MakeFontSymbol(36, nColour, 5, "Map Symbols", 0, 0)
Alter Object objTarget Info OBJ_INFO_SYMBOL, newSymbol
ChangeSymbolColour = objTarget
End Function