VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Private Sub UIButtonControl1_Click()

'1989        Michael Silberbauer - Pascal program to draw individual symbols, stuck on map by hand
'1992        Michael Silberbauer - C version
'1993-10     Michael Silberbauer - AML version in ArcInfo (see comments at end of procMauchaPolygon() )
'2000-10     Michael Silberbauer - Avenue version
'2006-03-03? Michael Silberbauer - Adapted code by Hagen Probsthain 2003-03-25 that drew lines, polylines on open map
'2006-05-12  Willie Geldenhuys   - produced a different procedure in Visual Basic, based on this
'2008-05-08  Michael Silberbauer - Got successful plots, with the rays in the correct colours for the first time
'2008-05-13  Michael Silberbauer - Incorporated suggestions of Abel Perez [Abel.Perez@aa.com] for projecting points
'2008-05-14  Michael Silberbauer - added grouping of symbol components (can only move them with arrow keys, not mouse)

  Call procGraphicMaucha

End Sub
Sub procGraphicMaucha()

Dim pPoint As IPoint
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pProjCoordSys As IProjectedCoordinateSystem
Dim pGeoCoordSystem As ISpatialReference
Dim pSpatialReferenceMap As ISpatialReference
Dim pSpatRefFact As ISpatialReferenceFactory
  Set pSpatRefFact = New SpatialReferenceEnvironment
  Set pGeoCoordSystem = pSpatRefFact.CreateGeographicCoordinateSystem(esriSRGeoCS_WGS1984)
Dim pGraphicsContainer As IGraphicsContainer
Dim pPolygonElement As IPolygonElement
Dim pElement As IElement
Dim theCoords As Variant
Dim SymbolScale As Single
Dim xCentre As Double, yCentre As Double
Dim Potassium As Single, Sodium As Single, Calcium As Single, Magnesium As Single
Dim Chloride As Single, Sulphate As Single, TotalAlk As Single, pH As Single
Dim TotalDisSalt As Single
Dim pApp As IApplication
  Set pApp = Application
  
Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Set pActiveView = pDoc.ActiveView
  Set pMap = pDoc.FocusMap
  Set pSpatialReferenceMap = pMap.SpatialReference

'symbolScale = ( x2m - x1m ) / 100 ' based on screen extent
SymbolScale = InputBox("Please enter a scale", "Maucha symbols", 25000)
  
Set pGraphicsContainer = pActiveView.GraphicsContainer

'erst mal alle vorhandenen GraphicLines löschen (delete all existing graphic-lines and polygons):
pGraphicsContainer.Reset
Set pElement = pGraphicsContainer.Next
Do Until pElement Is Nothing
    If (pElement.geometry.GeometryType = esriGeometryPolygon) Then
      pGraphicsContainer.DeleteElement pElement
    ElseIf TypeOf pElement Is IGroupElement Then
      pGraphicsContainer.DeleteElement pElement
    End If
  Set pElement = pGraphicsContainer.Next
Loop

'Draw Maucha polygons (MJS)

Dim varList(88)
Close #1    ' Close file, n case still open from previous crash

Dim NR As Integer ' counter
NR = 0
Open "C:\data\AV\National_water_quality\National\bcjuanita20060201all2001-2005_latlon.csv" For Input As #1    ' Open file for input.
Do While Not EOF(1)    ' Loop until end of file. Must be a more efficient way to parse the string.
'Do While NR < 3
NR = NR + 1
  Input #1, varList(1), varList(2), varList(3), varList(4), varList(5), varList(6), varList(7), varList(8), varList(9), varList(10), varList(11), varList(12), varList(13), varList(14), varList(15), varList(16), varList(17), varList(18), varList(19), varList(20), varList(21), varList(22), varList(23), varList(24), varList(25), varList(26), varList(27), varList(28), varList(29), varList(30), varList(31), varList(32), varList(33), varList(34), varList(35), varList(36), varList(37), varList(38), varList(39), varList(40), varList(41), varList(42), varList(43), varList(44), varList(45), varList(46), varList(47), varList(48), varList(49), varList(50), varList(51), varList(52), varList(53), varList(54), varList(55), varList(56), varList(57), varList(58), varList(59), varList(60), varList(61), varList(62), varList(63), varList(64), varList(65), varList(66), _
    varList(67), varList(68), varList(69), varList(70), varList(71), varList(72), varList(73), varList(74), varList(75), varList(76), varList(77), varList(78), varList(79), varList(80), varList(81), varList(82), varList(83), varList(84), varList(85), varList(86), varList(87), varList(88)
  If NR > 1 Then ' skipped header
    pApp.StatusBar.Message(0) = varList(2) & varList(36) & varList(48) & varList(52) & varList(56) & varList(60) & varList(64) & varList(68) & varList(72) & varList(76) & varList(87) & varList(88)
    Set pPoint = New Point
    pPoint.SetEmpty
    pPoint.PutCoords varList(87), varList(88)
    Set pPoint.SpatialReference = pGeoCoordSystem
    pPoint.Project pSpatialReferenceMap
    'Set pPoint = funcProjectEx(varList(87), varList(88))
    pPoint.QueryCoords xCentre, yCentre
    Call procMauchaPolygon(SymbolScale, xCentre, yCentre, varList(60), varList(56), varList(68), varList(64), varList(48), varList(36), varList(52), varList(72), varList(76))
    'pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
  End If
Loop
Close #1    ' Close file.

pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
'pActiveView.Refresh
End Sub


Function funcProjectEx(dLonDecimalDegrees, dLatDecimalDegrees) As IPoint

Dim pPoint As IPoint
  Set pPoint = New Point
  pPoint.SetEmpty
  pPoint.PutCoords dLonDecimalDegrees, dLatDecimalDegrees
Dim pProjCoordSys As IProjectedCoordinateSystem
Dim pGeoCoordSystem As ISpatialReference
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pSpatialReferenceMap As ISpatialReference
Dim pSpatRefFact As ISpatialReferenceFactory
  Set pSpatRefFact = New SpatialReferenceEnvironment
  Set pGeoCoordSystem = pSpatRefFact.CreateGeographicCoordinateSystem(esriSRGeoCS_WGS1984)
  Set pPoint.SpatialReference = pGeoCoordSystem

Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Set pActiveView = pDoc.ActiveView
  Set pMap = pDoc.FocusMap
  Set pSpatialReferenceMap = pMap.SpatialReference
  If Not Nothing Is pSpatialReferenceMap Then
    pPoint.Project pSpatialReferenceMap
  End If
  Set funcProjectEx = pPoint
End Function
Sub procMauchaPolygon(SymbolScale, xCentre, yCentre, Potassium, Sodium, Calcium, Magnesium, Chloride, Sulphate, TotalAlk, logH, TotalDisSalt)

Dim pActiveView As IActiveView
Dim pDoc As IMxDocument
Dim pPointColl As IPointCollection
Dim pCircColl As IPointCollection
Dim pSegColl As ISegmentCollection
Dim pCentrePoint As IPoint
Dim pPolygon As IPolygon
Dim pPolygonElement As IPolygonElement
Dim pElement As IElement
Dim pGroupElement As IGroupElement
  Set pGroupElement = New GroupElement
Dim pCircle As IPolygon
Dim pPoint As IPoint
Dim pGraphicsContainer As IGraphicsContainer
Dim pCoord As Variant
Dim xyv As Variant
Dim pX As Double, pY As Double
Dim i As Long
Const pi As Double = 3.14159265358979
Dim xSymbol As Double, ySymbol As Double
Dim A As Single, Ion(7) As Single, TDS As Single
Dim AnionSum As Single, CationSum As Single, EquivSum As Single
Dim io As Variant
Dim RayNumber As Integer, dAng As Integer
Dim angrad As Single
Dim TotalArea As Double, TotalRadius As Double, AnnoRadius As Double
Dim xcirc As Double, ycirc As Double, RadiusCirc As Double
Dim Equivalents As Single
Dim IonArea As Double, IonRadius As Double, angle As Double
Dim StartAngle As Double, IonAngle As Double, Io1Angle As Double, Io2Angle As Double, EndAngle As Double
Dim x(4) As Double, y(4) As Double
Dim xc(360) As Double, yc(360) As Double
Dim x2 As Double, y2 As Double, x3 As Double, y3 As Double, x4 As Double, y4 As Double, x5 As Double, y5 As Double
Dim pFillSymbol As ISimpleFillSymbol
Dim pOutline As ILineSymbol
Dim pColour As IRgbColor
Dim pRgbColor As IRgbColor
Dim pApp As IApplication
Dim pIFillShapeElement As IFillShapeElement
Dim prgbray As Variant

Set pDoc = ThisDocument
Set pActiveView = pDoc.ActiveView
Set pApp = Application
Set pGraphicsContainer = pActiveView.GraphicsContainer
'Dim pFillSymbol As ISimpleFillSymbol
Dim pRgb_red As IRgbColor
Dim pRgb_wht As IRgbColor
Dim pRgb_gry As IRgbColor
Dim pRgb_ray(8) As IRgbColor

Set pRgb_red = New RgbColor
pRgb_red.RGB = RGB(255, 0, 0)
Set pRgb_wht = New RgbColor
pRgb_wht.RGB = RGB(255, 255, 255)
pRgb_wht.Transparency = 75
Set pRgb_gry = New RgbColor
pRgb_gry.RGB = RGB(200, 200, 200)
'For Each prgbray In pRgb_ray
  'Set pRgb_ray(prgbray) = New RgbColor
'Next prgbray
Set pRgb_ray(0) = New RgbColor
Set pRgb_ray(1) = New RgbColor
Set pRgb_ray(2) = New RgbColor
Set pRgb_ray(3) = New RgbColor
Set pRgb_ray(4) = New RgbColor
Set pRgb_ray(5) = New RgbColor
Set pRgb_ray(6) = New RgbColor
Set pRgb_ray(7) = New RgbColor

pRgb_ray(0).RGB = RGB(255, 255, 0)
pRgb_ray(1).RGB = RGB(255, 0, 255)
pRgb_ray(7).RGB = RGB(255, 0, 0)
pRgb_ray(6).RGB = RGB(127, 127, 127)
pRgb_ray(5).RGB = RGB(0, 0, 255)
pRgb_ray(4).RGB = RGB(0, 255, 0)
pRgb_ray(3).RGB = RGB(0, 255, 255)
pRgb_ray(2).RGB = RGB(0, 0, 0)


' Convert milligrams per litre to equivalents per litre (equivalents =
' molarity times charge on ion) altering the sequence to allow for the
' way in which AML works out its degrees...

Ion(1) = Potassium * 1 / 39.1
Ion(0) = Sodium * 1 / 22.99
Ion(7) = Calcium * 2 / 40.08
Ion(6) = Magnesium * 2 / 24.31
Ion(5) = Sulphate * 2 / 96.07
Ion(4) = Chloride * 1 / 35.45
A = TotalAlk * 2 / 100
TDS = TotalDisSalt
Ion(3) = A
Ion(2) = 0
AnionSum = Ion(2) + Ion(3) + Ion(4) + Ion(5)
CationSum = Ion(0) + Ion(1) + Ion(6) + Ion(7)
EquivSum = CationSum + AnionSum
'MsgBox "Anions " & AnionSum & "; Cations " & CationSum & ";Total " & EquivSum
pApp.StatusBar.Message(0) = "Anions " & AnionSum & "; Cations " & CationSum & ";Total " & EquivSum
angrad = pi / 180
TotalArea = Log(EquivSum + 1)
TotalRadius = Sqr((0.125 * TotalArea) / Sin(angrad * 22.5))
AnnoRadius = 1.5 * TotalRadius

Set pPolygonElement = New PolygonElement
Set pElement = pPolygonElement
Set pCircColl = New Polygon

For angle = 0 To 360 Step 5
  xc(angle) = TotalRadius * Cos(angrad * angle)
  yc(angle) = TotalRadius * Sin(angrad * angle)
  pX = (xc(angle) * SymbolScale) + xCentre
  pY = (yc(angle) * SymbolScale) + yCentre
  Set pPoint = New Point
  pPoint.SetEmpty
  pPoint.PutCoords pX, pY
  pCircColl.AddPoint pPoint
  Set pPoint = Nothing
Next angle

Set pFillSymbol = New SimpleFillSymbol
Set pOutline = New SimpleLineSymbol
Set pColour = New RgbColor
'pColour.NullColor = True
pColour.RGB = RGB(210, 210, 210)
pOutline.Color = pColour
pOutline.Width = 0.1
With pFillSymbol
  .Style = esriSFSSolid
  .Color = pRgb_wht
  .Outline = pOutline
End With

Set pCircle = pCircColl
pElement.geometry = pCircle
Set pIFillShapeElement = pElement
pIFillShapeElement.Symbol = pFillSymbol
Set pElement = pIFillShapeElement
pGroupElement.AddElement pElement
'pGraphicsContainer.AddElement pElement, 0
'pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing

RayNumber = 0
For Each io In Ion
  Equivalents = Ion(RayNumber)
  angle = RayNumber
  RayNumber = RayNumber + 1
  IonArea = Equivalents / EquivSum * TotalArea
  IonRadius = IonArea / (TotalRadius * Sin(angrad * 22.5))
  StartAngle = angle * 45
  IonAngle = StartAngle + 22.5
  EndAngle = RayNumber * 45
  x(0) = 0
  y(0) = 0
  x(1) = TotalRadius * Cos(angrad * StartAngle)
  y(1) = TotalRadius * Sin(angrad * StartAngle)
  x(2) = IonRadius * Cos(angrad * IonAngle)
  y(2) = IonRadius * Sin(angrad * IonAngle)
  x(3) = TotalRadius * Cos(angrad * EndAngle)
  y(3) = TotalRadius * Sin(angrad * EndAngle)
  x(4) = x(0)
  y(4) = y(0)
  'MsgBox "Ion (" & RayNumber & ") = " & io & "; Ray point " & x(2) & y(2)
  xyv = 0
  Set pPointColl = New Polygon
  Do While xyv < 5
    Set pPoint = New Point
    pPoint.SetEmpty
    pX = (x(xyv) * SymbolScale) + xCentre
    pY = (y(xyv) * SymbolScale) + yCentre
    pPoint.PutCoords pX, pY
    pPointColl.AddPoint pPoint
    Set pPoint = Nothing
    xyv = xyv + 1
  Loop
  Set pFillSymbol = New SimpleFillSymbol
'  Set pOutline = New SimpleLineSymbol
'  Set pColour = New RgbColor
'  pColour.NullColor = True
'  pOutline.Color = pColour

  With pFillSymbol
    .Style = esriSFSSolid
    .Color = pRgb_ray(RayNumber - 1)
    .Outline = pOutline
  End With

  Set pPolygonElement = New PolygonElement
  Set pElement = pPolygonElement
  Set pPolygon = New Polygon

  Set pPolygon = pPointColl
  pElement.geometry = pPolygon
  Set pIFillShapeElement = pElement
  pIFillShapeElement.Symbol = pFillSymbol
  Set pElement = pIFillShapeElement
  pGroupElement.AddElement pElement

Next io
'Dim pEnvelope As IEnvelope
'MsgBox "Envelope " & pGroupElement.XMax
pGraphicsContainer.AddElement pGroupElement, 2
pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing

End Sub
'-----------------------------------------------------------------------------
' Comments from the original AML:
' Michael Silberbauer - August to October 1993
' mauchsym.aml takes a set of chemical concentrations in mg/L
' (K+, Na+, Ca++, Mg++, SO4=, Cl-, HCO3-, CO3=) and produces the
' coordinates required to plot them in the format used by
' Maucha (1932) Hydrochemische Metoden in der Limnologie.
' Binnengewasser 12, 173p,
' and modified by
' Broch E S & Yake W (1969)  A modification of Maucha's
' ionic diagram to include ionic concentrations.
' Limnology and Oceanography 14, 933-935.
'
' Please refer to
' "Silberbauer M J & King J M (1991) Geographical trends in the
' water chemistry of wetlands in the south-western Cape Province, South
' Africa.  Southern African Journal of Aquatic Sciences 17 (1/2) 82 - 88."
' if you wish to cite this programme or use it for any publication.
' Other useful documents are:
' Day J A & King J M (1995) Geographical patterns, and their origins, in the
' dominance of major ions in South African rivers.
' South African Journal of Science 91, 299-306.
' Day J A (1993) The major ion chemistry of some southern African saline systems.
' Hydrobiologia 267, 37-59.
'
' The Maucha diagram is the specific case of a radial plot in which the major
' cations are plotted on the right-hand side of an eight-point star and the
' major anions are plotted on the left-hand side.
'
' The aqueous CO2 should be split between H2CO3, HCO3- and CO3= using the approach of
' Mackereth FJH, Heron J & Talling JF (1978)  Water Analysis: Some Revised
' Methods for Limnologists.  Freshwater Biological Association Scientific
' Publication No 36. pp39-42. (but this option not implemented)
'
' Broch and Yake's modification was to use the TDS value to scale the whole
' diagram up or down, so that an idea of the relative concentration of various
' samples can be obtained.  A logarithmic scale is necessary when widely
' differing concentrations are plotted on the same map.
'-----------------------------------------------------------------------------

Private Sub UIButtonControl2_Click()

End Sub
'*************************************************************************
'* NAME : createMultipartPolygonRingPointCollection
'* DESCRIPTION : Create a multipart polygon using rings via IPointCollection.
'* This sub is demonstrating it by creating 1001
'* concentric square rings and add those to a polygon.
'*************************************************************************
Private Sub createMultipartPolygonRingPointCollection()
Dim pGraphicsContainer As IGraphicsContainer
Dim pPolygonElement As IPolygonElement
Dim pElement As IElement
Dim pActiveView As IActiveView
Dim pDoc As IMxDocument
Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Set pActiveView = pDoc.ActiveView
   Dim pPointsRing0(4) As IPoint, pPointsRing1(4) As IPoint, pRingsColl(1) As IPointCollection
   Dim pGeometry(1) As IGeometry, i As Long, pGonColl As IGeometryCollection
   Dim d0X0 As Double, d0X1 As Double, d0X2 As Double, d0X3 As Double, d0Y0 As Double, d0Y1 As Double
   Dim d0Y2 As Double, d0Y3 As Double, d1X0 As Double, d1X1 As Double, d1X2 As Double, d1X3 As Double
   Dim d1Y0 As Double, d1Y1 As Double, d1Y2 As Double, d1Y3 As Double, j As Long, k As Long
   Dim pspref As ISpatialReference, pGeoSpRef As IGeometry
   'Create the resulting polygon
   Set pGonColl = New Polygon
   '*********************************************************
   'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE POLYGON
   'Here the spatial reference is created in memory but could also come from various sources:
   'IMap, IGeodataset, IGeometry etc...
   Set pspref = New UnknownCoordinateSystem
   pspref.SetFalseOriginAndUnits -10000, -10000, 100000  'Set the false origin and units.
   'The XYUnits value is equivalent to the precision specified when creating a feature class
   Set pGeoSpRef = pGonColl
   Set pGeoSpRef.SpatialReference = pspref
   '*********************************************************
   d0X0 = 0: d0Y0 = 0: d0X1 = 0: d0Y1 = 0: d0X2 = 0: d0Y2 = 0: d0X3 = 0: d0Y3 = 0
   d1X0 = 10000: d1Y0 = 10000: d1X1 = 10000: d1Y1 = 10000: d1X2 = 10000: d1Y2 = 10000: d1X3 = 10000: d1Y3 = 10000
   'Loop to change the coordinates of the points
   For i = 0 To 1000
   Set pRingsColl(0) = New Ring
   Set pRingsColl(1) = New Ring
   'QI(Query Interface) to make sure that we have the correct type of geometry when passing this array to the addsegments
   Set pGeometry(0) = pRingsColl(0)
   Set pGeometry(1) = pRingsColl(1)
      'Create the new points
      For k = 0 To 4
         Set pPointsRing0(k) = New EsriGeometry.Point
         Set pPointsRing1(k) = New EsriGeometry.Point
      Next
      d0X0 = d0X0 - 5: d0Y0 = d0Y0 - 5: d0X1 = d0X1 + 5: d0Y1 = d0Y1 - 5: d0X2 = d0X2 + 5: d0Y2 = d0Y2 + 5: d0X3 = d0X3 - 5: d0Y3 = d0Y3 + 5
      'Put the coordinates of the points to use in the first ring
      pPointsRing0(0).PutCoords d0X0, d0Y0
      pPointsRing0(1).PutCoords d0X1, d0Y1
      pPointsRing0(2).PutCoords d0X2, d0Y2
      pPointsRing0(3).PutCoords d0X3, d0Y3
      pPointsRing0(4).PutCoords d0X0, d0Y0
      'Add the points to the ring
      pRingsColl(0).AddPoints 5, pPointsRing0(0)
      d1X0 = d1X0 - 5: d1Y0 = d1Y0 - 5: d1X1 = d1X1 + 5: d1Y1 = d1Y1 - 5: d1X2 = d1X2 + 5: d1Y2 = d1Y2 + 5: d1X3 = d1X3 - 5: d1Y3 = d1Y3 + 5
      'Put the coordinates of the points to use in the second ring
      pPointsRing1(0).PutCoords d1X0, d1Y0
      pPointsRing1(1).PutCoords d1X1, d1Y1
      pPointsRing1(2).PutCoords d1X2, d1Y2
      pPointsRing1(3).PutCoords d1X3, d1Y3
      pPointsRing1(4).PutCoords d1X0, d1Y0
        
      'Add the points to the ring
      pRingsColl(1).AddPoints 5, pPointsRing1(0)
      'Add the rings to the polygon
      pGonColl.AddGeometries 2, pGeometry(0)
   Next
   'You can draw, store or use the polygon (pGonColl) in other geometry operations at this point
   pActiveView.Refresh

End Sub
Function funcProjectEx1(dLonDecimalDegrees, dLatDecimalDegrees) As IPoint

Dim pPoint As IPoint
  Set pPoint = New Point
  pPoint.SetEmpty
  pPoint.PutCoords dLonDecimalDegrees, dLatDecimalDegrees
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Set pActiveView = pDoc.ActiveView
  Set pMap = pDoc.FocusMap
  
IProjectedCoordinateSystem pMapSR = pMap.SpatialReference
IGeographicCoordinateSystem pMapGraphicsContainerS = pMapSR.GeographicCoordinateSystem
Set pPoint.SpatialReference = pMapGraphicsContainerS
pPoint.Project (pMapSR)


End Function

Private Function IsNaN(expression As Variant) As Boolean
  On Error Resume Next
  If Not IsNumeric(expression) Then
    IsNaN = False
    Exit Function
  End If
  If (CStr(expression) = "1.#QNAN") Or (CStr(expression) = "1,#QNAN") Then ' can vary by locale
    IsNaN = True
  Else
    IsNaN = False
  End If
End Function