Mapbasic: "Shade" statement without knowing layer's individual values?
Mal
Mapbasic without knowing the exact values that'll be in the layer at
the time? I've got a variable number/format of thematic values that I
want to apply, and what I really want is for Mapbasic to just do what
Mapinfo does when I select Create Thematic Map, ie read all the values
in the field and spit out a default theme. I don't even care what the
theme looks like, I just want it to differentiate between the
categories.
But it looks like the shade statement has to have an exact amount of
values to work. Is there any way to just have it style by whatever is
in the field, the way it works in Mapinfo?
Mal
after posting I found this: http://www.mail-archive.com/mapi...@csn.net/msg02430.html
Pretty much exactly what I was looking for!
Rob Schneider - Aurchem Exploration
creates themes based on fixed values or percentages.
INCLUDE "mapbasic.def"
INCLUDE "icons.def"
INCLUDE "menu.def"
INCLUDE "global.def"
DECLARE SUB stdTheme
DECLARE SUB pctTheme
DECLARE SUB fxdTheme
DECLARE SUB dialogSetup
DECLARE SUB fillBreakBox
DECLARE SUB writeBreakBox
DECLARE SUB fillColumnListBox
DECLARE SUB selectColumn
DIM sTableList, sTableName, sTableNameShade, sColumnList, sBreak,
sDataCol, sDefaultSymbol, sTheme, sThemeBuild, sLegendTitle, sLegendSub
AS STRING
DIM nValueMax, nValueMin, nStepVal, nBreak, nBreakNext AS FLOAT
DIM nRows, nRowNum, nStep, nControl101, nControl102 AS INTEGER
DIM nSampleType, nRangeType AS SMALLINT
DIM aDataCol AS ALIAS
DIM symStyle AS SYMBOL
DIM penStyle AS PEN
DIM brushStyle As BRUSH
'*************************************************************
'THEME DIALOG AND SETUP
'*************************************************************
SUB stdTheme
'OnError GoTo ThemeError
sIniFile = ApplicationDirectory$() + "aurchem.ini"
winID = FrontWindow()
winType = WindowInfo(winID,WIN_INFO_TYPE)
if winID = 0 then
note "Open a MAP window first"
exit sub
end if
If (wintype <> WIN_MAPPER) Then
note "Select an open MAP window first"
exit sub
end if
' CREATE DIALOGUE
sTableList = MakeTabsList$(3)
sTableName = ""
sColumnlist = ""
sBreak= ""
Dialog Title "APPLY AURCHEM THEME" Calling dialogSetup
Control GroupBox Title "Range Type:" Position 5,5 Width 100 Height 45
Control RadioGroup Title "Fixed;Percentile" Value 1 Into nRangeType
ID 99 Position 12,19 Width 90 Calling fillBreakBox
Control GroupBox Title "Sample Type:" Position 5,55 Width 100 Height 45
Control RadioGroup Title "Rock | Drill;Soil | Geochem" Value 1 Into
nSampleType ID 100 Position 12,69 Width 90 Calling fillBreakBox
Control GroupBox Title "Colour Ranges For:" Position 110,5 Width
215 Height 95
Control StaticText Title "Table:" Position 115,16
Control StaticText Title "Column:" Position 220,16
Control ListBox Position 115,26 Width 100 Height 70 Title From
Variable sTablelist Value 1 ID 101 Calling fillColumnListBox Into
nControl101
Control ListBox Position 220,26 Width 100 Height 70 Title From
Variable sColumnList Value 1 ID 102 Calling selectColumn Into nControl102
Control StaticText Title "Min," Position 5,108
Control EditText Position 20,106 Width 120 ID 103 Into sBreak
Control StaticText Title ",Max" Position 140,108
Control OKButton Position 245,105
Control CancelButton Position 286,105
Control GroupBox Position 5,122 Width 320 Height 18
Control StaticText Title "Up to 10 ranges (ie.9 numbers in above
list) <|> Min to first range shows symbol ""+""" Position 10,128
If CommandInfo(CMD_INFO_DLG_OK) Then
sTableName = GetListItem$(sTableList,nControl101,";")
sDataCol = GetListItem$(sColumnList,nControl102,";")
aDataCol = sDataCol
Else
Exit Sub
End if
'WRITE BREAK TYPES TO INI
CALL WriteBreakBox
'SETUP BREAK TYPES
Select aDataCol From sTableName Into percenttemp Order By
aDataCol NOSELECT
nRows = Tableinfo("percenttemp",tab_info_nrows)
Fetch first From percenttemp
nValueMin = percenttemp.col1
Fetch last From percenttemp
nValueMax = percenttemp.col1
nStep = GetListLen$(sBreak,",")
' SETUP COLOURS - Chooses from highest to lowest - if less needed
bottoms are discarded
Dim nColour (9) as Integer
nColour(1) = rgb(255,240,240) ' very light pink
nColour(2) = rgb(255,220,220) ' light pink
nColour(3) = rgb(255,160,255) ' pink
nColour(4) = rgb(144,32,255) ' purple
nColour(5) = rgb(0,0,255) ' blue
nColour(6) = rgb(0,255,0) ' green
nColour(7) = rgb(255,255,0) ' yellow
nColour(8) = rgb(255,128,0) ' orange
nColour(9) = rgb(255,0,0) ' red
' SETUP STYLES
symStyle = MakeSymbol(49,12632256,10)
penStyle = MakePen (1,1,0)
brushStyle = MakeBrush (1,16777215,0)
' CALCULATE RANGE BREAKS
nBreak = 0
sThemeBuild = ""
sLegendTitle = sTableName + " ("+ sDataCol+" ppm)"
Do Case (nRangeType+(nSampleType*2)-2) '[Fixed(1)|Percent(2)] +
([Rock(1)|Soil(2)] * 2)-2 {ie. fixed soil = 1+(2*2)-2=3}
Case 1,3 'Fixed
For counter = 1 to nStep
nBreakNext = GetListItem$(sBreak,counter,",")
sThemeBuild=sThemeBuild + nBreak + ":" + nBreakNext+"
"+brushStyle + " " + penStyle + " " + symStyle + ","
symStyle=MakeSymbol(sDefaultSymbol,nColour(counter+(Ubound(nColour)-nStep)),
(int(counter/nStep +.5)+3) *2 +2)
brushStyle=MakeBrush(2,nColour(counter+(Ubound(nColour)-nStep)),0)
nBreak = nBreakNext
Next
sThemeBuild=sThemeBuild + nBreak + ":" + nValueMax+"
"+brushStyle + " " + penStyle + " " + symStyle
sLegendSub = ""
Case 2,4 'Percent
For counter = 1 to nStep
nStepVal = GetListItem$(sBreak,counter,",")
nRowNum = round(nStepVal*nRows/100,1)
Fetch rec(nRowNum) FROM percenttemp
nBreakNext = percenttemp.col1
sThemeBuild=sThemeBuild + nBreak + ":" + nBreakNext+"
"+brushStyle + " " + penStyle + " " + symStyle + ","
symStyle=MakeSymbol(sDefaultSymbol,nColour(counter+(Ubound(nColour)-nStep)),
(int(counter/nStep +.5)+3) *2 +2)
brushStyle=MakeBrush(2,nColour(counter+(Ubound(nColour)-nStep)),0)
nBreak = nBreakNext
Next
sThemeBuild=sThemeBuild + nBreak + ":" + nValueMax+"
"+brushStyle + " " + penStyle + " " + symStyle
sLegendSub = "Split by Percentile ("+sBreak+")"
End Case
'CREATE THEME MAP
sTheme = "Shade Window "+winID+" "+sTableName+" with "+sDataCol+"
ranges " + sThemeBuild
Run Command sTheme
'CREATE THEME LEGEND
Set Legend window WinID layer prev display on shades off symbols on
lines off count on title sLegendTitle Font ("Arial",0,9,0) subtitle
sLegendSub Font ("Arial",0,7,0) ascending off ranges Font
("Arial",0,8,0) auto display off ,auto display on ,auto display on ,auto
display on ,auto display on ,auto display on ,auto display on ,auto
display on ,auto display on
Open window legend
Close Table percenttemp
EXIT Sub
ThemeError:
Note "Something bad happened"
END SUB
'*************************************************************
SUB dialogSetup
CALL fillBreakBox
CALL fillColumnListBox
END SUB
'*************************************************************
SUB fillBreakBox
Do Case (ReadControlValue(99)+(ReadControlValue(100)*2)-2)
'[Fixed(1)|Percent(2)] + ([Rock(1)|Soil(2)] * 2)-2 {ie. fixed soil =
1+(2*2)-2=3}
Case 1 'Fixed Rock
sDefaultSymbol = GetIni("Theme", "symbolR", "32", sIniFile)
sBreak = GetIni("Theme", "fixedbreakR", "1,10,20,30,40,50,60",
sIniFile)
Case 2 'Percentile Rock
sDefaultSymbol = GetIni("Theme", "symbolR", "32", sIniFile)
sBreak = GetIni("Theme", "percentbreakR",
"50,90,95,96,97,98,99,99.5", sIniFile)
Case 3 'Fixed Soil
sDefaultSymbol = GetIni("Theme", "symbolG", "34", sIniFile)
sBreak = GetIni("Theme", "fixedbreakG",
".05,.12,.15,.18,.25,.4,.7", sIniFile)
Case 4 'Percentile Soil
sDefaultSymbol = GetIni("Theme", "symbolG", "34", sIniFile)
sBreak = GetIni("Theme", "percentbreakG",
"90,95,96,97,98,99,99.5", sIniFile)
End Case
Alter Control 103 Value sBreak
END SUB
'*************************************************************
SUB writeBreakBox
Do Case (ReadControlValue(99)+(ReadControlValue(100)*2)-2)
'[Fixed(1)|Percent(2)] + ([Rock(1)|Soil(2)] * 2)-2 {ie. fixed soil =
1+(2*2)-2=3}
Case 1 'Fixed Rock
sDefaultSymbol = GetIni("Theme", "symbolR", "32", sIniFile)
sBreak = GetIni("Theme", "fixedbreakR", "1,10,20,30,40,50,60",
sIniFile)
'CALL WriteINI ("Export" , " directory" , sExport , sIniFile)
Case 2 'Percentile Rock
sDefaultSymbol = GetIni("Theme", "symbolR", "32", sIniFile)
sBreak = GetIni("Theme", "percentbreakR",
"50,90,95,96,97,98,99,99.5", sIniFile)
Case 3 'Fixed Soil
sDefaultSymbol = GetIni("Theme", "symbolG", "34", sIniFile)
sBreak = GetIni("Theme", "fixedbreakG",
".05,.12,.15,.18,.25,.4,.7", sIniFile)
Case 4 'Percentile Soil
sDefaultSymbol = GetIni("Theme", "symbolG", "34", sIniFile)
sBreak = GetIni("Theme", "percentbreakG",
"90,95,96,97,98,99,99.5", sIniFile)
End Case
Alter Control 103 Value sBreak
END SUB
'*************************************************************
SUB fillColumnListBox
sTableName = GetListItem$(sTableList,ReadControlValue(101),";")
sColumnList = MakeNumericColList$(sTableName)
Alter Control 102 Title From Variable sColumnList Value 1
END SUB
'*************************************************************
SUB selectColumn
sDataCol = GetListItem$(sColumnList,ReadControlValue(102),";")
aDataCol = sDataCol
END SUB
Driver, Greg 9434
"Calculates the thematic ranges and stores the ranges in an array, which you can then use in the Shade statement".
You can then use the ranges created and stored in the array with the Shade statement to create the thematic map.
HTH
Greg Driver
NOT PROTECTIVELY MARKED
--
You received this message because you are subscribed to the Google Groups "MapInfo-L" group.
To post to this group, send email to mapi...@googlegroups.com.
To unsubscribe from this group, send email to mapinfo-l+...@googlegroups.com.
For more options, visit this group at http://groups.google.com/group/mapinfo-l?hl=en.
Information about this E-mail
This email and any files or attachments with it are intended solely for the use of the individual(s) or organisation(s) to whom it is addressed.
It may contain information that is confidential or subject to legal and/or professional privilege.
If you have received this email in error please notify the sender and delete it including any files or attachments from your e-mail account or computer.
Any opinions expressed in this email are those of the individual and not necessarily those of Surrey Police.
Surrey Police monitor incoming and outgoing e-mail.