Есть ли способ применить случайный цвет, чтобы изменить стиль выбранных точек на этот цвет?

Итак, у меня есть функция случайного цвета, которую я хочу применить к выборке точек, но она дает мне случайный цвет для каждой точки, а не один случайный цвет для выбора точек. Я знаю, что часть выбора работает, но я не уверен, как чтобы заставить его вызывать этот генератор случайных цветов только один раз для каждого цвета. Вот что у меня есть на данный момент. Спасибо за любой совет / помощь!

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
Другие вопросы по тегам