Attribute VB_Name = "Module1"
Public Const TO_DEGREES = 57.2957795130823
Public Const TO_RADIANS = 1.74532925199433E-02
Public Const PI = 3.14159265358979
Public Const BK = 6

Public wmargin As Long  ' assume equal width margins, twips (side margins)
Public hmargin As Long  '   "                               (top/bottom margins)

Public Pheight As Long   ' total height in twips of the page
Public Pwidth As Long    ' total width in twips of the page

Public TwipToMeter As Double  ' ratio bewteen a logical twip unit and map meter

Public Maxdim As Long ' maximum number of twips (either horizontal or vertival)

Type POINTAPI
 X As Long
 Y As Long
End Type

Public Type Size
        cx As Long
        cy As Long
End Type

Public Type Point2DLong
 X As Long
 Y As Long
End Type

Public Type Point3D
 X As Double
 Y As Double
 z As Double
End Type

Public Type Point2D
 X As Double
 Y As Double
End Type

Public Type Tree
 plot As Long
 Pos As Point3D
 z_dtm As Double
 spec As Long
 state As Long
 statusnew As Long
 Foto_h As Double
 Lidar_h As Double
 Dcrm_Foto As Double
 Dcrm_Lidar As Double
 Dcrm_RMSE As Double
 Dist_Cent As Double
 d13 As Double
 Bussol As Double
 inside As Long
 insideplot As String
 cf As Double
 pw As Double
 cont As Double
 Num As String
 col As Long
 row As Long
 Label As Boolean
 Strip As Long
 sigmaX As Double
 sigmaY As Double
 subplot As String
 geoloctype As Long
End Type

Public Type NeighborTree
  Num As Long
  Pos As Point3D
  spec As Long
  dist As Double
  azim As Double
End Type

Public Neighbor() As NeighborTree
Public Trees() As Tree

Type Plot_info
 Num As Long
 X As Double
 Y As Double
 Vol_Lidar As Double
 G As Double
 n As Double
 H As Double
 D As Double
End Type

Type height_model
 ncols As Double
 nrows As Double
 xllcorner As Double
 yllcorner As Double
 CellSize As Double
 nodata_value As Double
 filepath As String * 80
End Type

Public Zmodel As height_model
Public ZfXY() As Single

Public CSV_Filename As String


Public triangle(0 To 2) As POINTAPI
Public rectang(0 To 3) As POINTAPI
Public cross(0 To 3) As POINTAPI
Public elliple(0 To 1) As POINTAPI

Public lpPoint As POINTAPI
Public lpSize As Size
Public lpstring As String * 6
Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal ncount As Long) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Public Declare Function rectangle Lib "gdi32" Alias "Rectangle" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpstring As String, ByVal ncount As Long) As Long
Public Declare Function GetWindowExtEx Lib "gdi32" (ByVal hdc As Long, lpSize As Size) As Long
Public Declare Function MYFUNC_ATAN2 Lib "c:\data\pascaldll.dll" (ByVal v1 As Double, ByVal v1 As Double) As Double



Public Sub DrawLines(apu1 As Long, corn() As Point2DLong, hmargin As Long, wmargin As Long, ymax As Long)

Printer.DrawStyle = 0
Printer.DrawWidth = 5
apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + corn(1).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(1).Y / Printer.TwipsPerPixelY)), lpPoint)
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(3).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(3).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(6).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(6).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(4).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(4).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(7).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(7).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(9).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(9).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(12).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(12).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(10).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(10).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(1).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(1).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(2).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(2).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(11).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(11).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(12).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(12).Y / Printer.TwipsPerPixelY)))
apu = LineTo(ByVal apu1, ByVal CLng(wmargin + corn(3).X / Printer.TwipsPerPixelX), ByVal CLng(ymax - (hmargin + corn(3).Y / Printer.TwipsPerPixelY)))

End Sub
Public Sub FindNeighbors(l As Long, m As Long, Ntau() As Long, distA As Double)

Rem Find neighbors for tree l
Dim i As Long

distA = 2

Do While True
  m = 0
  For i = 1 To UBound(Trees())
    If Abs(Trees(i).Pos.X - Trees(l).Pos.X) < distA And Abs(Trees(i).Pos.Y - Trees(l).Pos.Y) < distA Then
      m = m + 1
    End If
  Next i
  
  If m > 6 Or distA > 12 Then Exit Do
  distA = distA + 2
Loop

m = 0
For i = 1 To UBound(Trees())
  If i = l Then GoTo nextTree
  If Abs(Trees(i).Pos.X - Trees(l).Pos.X) < distA And Abs(Trees(i).Pos.Y - Trees(l).Pos.Y) < distA Then
    m = m + 1
    Ntau(m) = i
  End If
nextTree: Next i

End Sub

Public Sub DrawNumber(apu1 As Long, M_in As Long, l As Long, orix As Long, oriY As Long, hmargin As Long, wmargin As Long, ymax As Long)
Dim apustring As String * 60

Printer.FontSize = 12
Printer.FontBold = True
apustring = CStr("sn:o " & M_in)
apu = TextOut(ByVal apu1, ByVal wmargin + orix / Printer.TwipsPerPixelX + 40, ByVal ymax - (hmargin + oriY / Printer.TwipsPerPixelY - 40), ByVal apustring, ByVal 30)

If Trees(l).insideplot <> "Null" Then
 If Trees(l).subplot = "0" Then
  apustring = "Kaista: " & Trees(l).Strip & "  " & CSV_Filename ' Trees(l).plot ' &'  "  Dist: " & Format$(Trees(l).Dist_Cent, "0.0") & " m   Azim: " & Format$(Trees(l).Bussol, "0.0") & " degr"
 Else
  apustring = "Kaista: " & Trees(l).Strip & "  " & CSV_Filename ' Trees(l).plot & Trees(l).subplot ' &'  "  Dist: " & Format$(Trees(l).Dist_Cent, "0.0") & " m   Azim: " & Format$(Trees(l).Bussol, "0.0") & " degr"
 End If
Else
 apustring = "Strip: " & Trees(l).Strip & CStr(" Buffer tree")
End If
ncount = Len(apustring)
apu = TextOut(ByVal apu1, ByVal wmargin + orix / Printer.TwipsPerPixelX + 460, ByVal ymax - (hmargin + oriY / Printer.TwipsPerPixelY - 40), ByVal apustring, ByVal ncount)

If Len(Trees(l).Num) > 3 Then Printer.FontSize = 120
If Len(Trees(l).Num) < 4 Then Printer.FontSize = 140
Printer.FontBold = True
apustring = CStr(Trees(l).Num)
If Trees(l).inside = 0 Then
 Printer.ForeColor = RGB(0, 0, 0)
Else
 Printer.ForeColor = RGB(0, 0, 0)
End If
addmarg = 0
If Len(Trees(l).Num) < 2 Then addmarg = 300
If Len(Trees(l).Num) > 1 And Len(Trees(l).Num) < 3 Then addmarg = 150
If Len(Trees(l).Num) > 2 Then addmarg = -100

apu = TextOut(ByVal apu1, ByVal wmargin + addmarg + orix / Printer.TwipsPerPixelX + (Printer.ScaleWidth / Printer.TwipsPerPixelX) * 0.03, ByVal ymax - (hmargin + oriY / Printer.TwipsPerPixelY - (Printer.ScaleHeight / Printer.TwipsPerPixelY) * 0.03), ByVal apustring, ByVal 30)
 Printer.ForeColor = RGB(0, 0, 0)
End Sub

Public Sub DrawNeighbors(l As Long, k As Long, Ntau() As Long, apu1 As Long, wmargin As Long, hmargin As Long, orix As Long, oriY As Long, ymax As Long, distA As Double)

Dim i As Long, dx As Double, dy As Double, tau As Double
Dim apustring As String * 60

' The map is distA x distA in size
For i = 1 To k
 dx = Trees(Ntau(i)).Pos.X - Trees(l).Pos.X
 dy = Trees(Ntau(i)).Pos.Y - Trees(l).Pos.Y
 tau = MYFUNC_ATAN2(dy, dx)
 Rem Now tau is angle from x-axis, bussol will have an offset of BK (6.5 degrees)
 If tau <= 0 Then
  Bussol = 90 + (-tau) * TO_DEGREES
 End If
 If tau > 0 And tau <= PI / 2 Then
  Bussol = 90 - tau * TO_DEGREES
 End If
 If tau >= PI / 2 Then
  Bussol = ((tau - (5 * PI / 2)) * -360 / (2 * PI))
 End If
 Rem If the Bussol-reading is within 0 to BK (positive BK) then we must do a trick
 If Bussol > 0 And Bussol < BK Then
  Bussol = Bussol + (360 - BK)
 Else
  Bussol = Bussol - BK
 End If
 
 rho = Sqr(dx ^ 2 + dy ^ 2)
 
 Ltm = 80 * 6# / distA * 0.9
 
 rectang(0).X = wmargin + 500 + orix / Printer.TwipsPerPixelX + Ltm * dx - Trees(Ntau(i)).d13 / 10 / 3
 rectang(0).Y = ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX + Ltm * dy + Trees(Ntau(i)).d13 / 10 / 3)
 rectang(2).X = wmargin + 500 + orix / Printer.TwipsPerPixelX + Ltm * dx + Trees(Ntau(i)).d13 / 10 / 3
 rectang(2).Y = ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX + Ltm * dy - Trees(Ntau(i)).d13 / 10 / 3)
 Printer.FillStyle = 0
 apu = Ellipse(ByVal apu1, ByVal rectang(0).X, ByVal rectang(0).Y, ByVal rectang(2).X, ByVal rectang(2).Y)
 
 Printer.FontSize = 6
 Printer.FontBold = True
 'apustring = " " & Trees(Ntau(i)).Num & "/" & CStr(Format$(Bussol, "#")) & Chr(176) & "/" & CStr(Format$(Sqr(dx ^ 2 + dy ^ 2), "#.0")) & " m"
 apustring = " " & Trees(Ntau(i)).Num & "/" & CStr(Format$(Bussol, "#")) & Chr(176)
 apu = TextOut(ByVal apu1, ByVal rectang(0).X + 15, ByVal rectang(0).Y - 8, ByVal apustring, ByVal 30)
 
 Rem Draw a 2 x 2 m cross to mark the tree pf Interest
 apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX + Ltm * 1), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)))
 apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX - Ltm * 1), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)))
 apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX) + Ltm * 1))
 apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX) - Ltm * 1))
 
 Rem Draw the error ellipse
 dx = Trees(l).sigmaX
 dy = Trees(l).sigmaY
 If dx > 0 Then
 rectang(0).X = wmargin + 500 + orix / Printer.TwipsPerPixelX - Ltm * dx
 rectang(0).Y = ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX - Ltm * dy)
 rectang(2).X = wmargin + 500 + orix / Printer.TwipsPerPixelX + Ltm * dx
 rectang(2).Y = ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX + Ltm * dy)
 Printer.FillStyle = 1
 apu = Ellipse(ByVal apu1, ByVal rectang(0).X, ByVal rectang(0).Y, ByVal rectang(2).X, ByVal rectang(2).Y)
  End If
 
 Printer.DrawWidth = 3
 
 Rem Draw a cross to mark the tree pf Interest
 'apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 'apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX + 50), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)))
 'apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 'apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX - 50), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)))
 'apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 'apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX) + 50))
 'apu = MoveToEx(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX)), lpPoint)
 'apu = LineTo(ByVal apu1, ByVal CLng(wmargin + 500 + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX) - 50))
'' apu = LineTo(ByVal apu1, ByVal CLng((rectang(0).x + rectang(2).x) / 2), ByVal CLng(CLng((rectang(0).y + rectang(2).y) / 2)))


Next i

 Printer.FontSize = 12
 Dim cs As String
 If Trees(l).spec = 1 Then
     cs = "Mänty"
 ElseIf Trees(l).spec = 2 Then
     cs = "Näre"
 ElseIf Trees(l).spec = 3 Then
     cs = "Ra-Ko"
 ElseIf Trees(l).spec = 4 Then
     cs = "Hi-Ko"
 ElseIf Trees(l).spec = 5 Then
     cs = "Haapa"
 ElseIf Trees(l).spec = 6 Or Trees(l).spec = 7 Then
     cs = "Leppä"
 ElseIf Trees(l).spec = 8 Then
     cs = "Tuomi"
 ElseIf Trees(l).spec = 9 Then
     cs = "Leku"
 ElseIf Trees(l).spec = 13 Then
     cs = "Raita"
 ElseIf Trees(l).spec = 16 Then
     cs = "Pihlaja"
 ElseIf Trees(l).spec = 20 Then
     cs = "Muu lehtipuu"
 ElseIf Trees(l).spec = 21 Then
     cs = "Muu havupuu"
 ElseIf Trees(l).spec = 50 Then
     cs = "Kulmapaalu"
 End If
 
 
 
 Dim cs2 As String
 If Trees(l).geoloctype = 1 Then
    cs2 = "Takymetrilla"
 ElseIf Trees(l).geoloctype = 2 Then
    cs2 = "Ilmakuvalta"
 ElseIf Trees(l).geoloctype = 3 Then
    cs2 = "Maastokolmioitu"
 ElseIf Trees(l).geoloctype = 4 Then
    cs2 = "GPS-mitatu"
 End If
 
 apustring = cs
 x_siirto = 1500
 apu = TextOut(ByVal apu1, ByVal CLng(wmargin + x_siirto + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1650 - (hmargin + oriY / Printer.TwipsPerPixelX) - 100), ByVal apustring, ByVal 30)
 apustring = CStr(Format$(Trees(l).d13 / 10, "#.0")) & " cm"
 apu = TextOut(ByVal apu1, ByVal CLng(wmargin + x_siirto + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1800 - (hmargin + oriY / Printer.TwipsPerPixelX) - 100), ByVal apustring, ByVal 30)
 apustring = cs2
 apu = TextOut(ByVal apu1, ByVal CLng(wmargin + x_siirto + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 1950 - (hmargin + oriY / Printer.TwipsPerPixelX) - 100), ByVal apustring, ByVal 30)
 If Trees(l).Foto_h > 0 Then
    apustring = CStr(Format$(Trees(l).Foto_h, "#.0")) & " m"
 Else
    apustring = " "
 End If
 apu = TextOut(ByVal apu1, ByVal CLng(wmargin + x_siirto + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 2100 - (hmargin + oriY / Printer.TwipsPerPixelX) - 100), ByVal apustring, ByVal 30)
 apustring = " "
 If Trees(l).state = 13 Then
    apustring = "13, Kituva"
 End If
 If Trees(l).state = 14 Then
    apustring = "14, Vino"
 End If
 If Trees(l).state = 21 Then
    apustring = "21, Kelo"
 End If
 If Trees(l).state = 22 Then
    apustring = "22, Katkennut"
 End If
 apu = TextOut(ByVal apu1, ByVal CLng(wmargin + x_siirto + orix / Printer.TwipsPerPixelX), ByVal CLng(ymax + 2250 - (hmargin + oriY / Printer.TwipsPerPixelX) - 100), ByVal apustring, ByVal 30)
 
End Sub
Public Sub DrawPlotBorders(apu1 As Long, Filename As String, xc As Double, yc As Double, wmargin As Double, ymax As Double, hmargin As Double, Ltm As Double)
Rem Finally draw borders
ReDim corn(1 To 12) As Point2DLong
'Open Filename For Input As 2
Exit Sub
Nc = 0
Do Until EOF(2)
Input #2, X, Y
Nc = Nc + 1
 X = X - xc
 Y = Y - yc
 corn(Nc).X = wmargin + Ltm * X:   corn(Nc).Y = ymax - (hmargin + Ltm * Y)
Loop
Close (2)
Printer.DrawStyle = 0
Printer.DrawWidth = 5
apu = MoveToEx(ByVal apu1, ByVal CLng(corn(1).X), ByVal CLng(corn(1).Y), lpPoint)
apu = LineTo(ByVal apu1, ByVal CLng(corn(2).X), ByVal CLng(corn(2).Y))
apu = LineTo(ByVal apu1, ByVal CLng(corn(3).X), ByVal CLng(corn(3).Y))
apu = LineTo(ByVal apu1, ByVal CLng(corn(4).X), ByVal CLng(corn(4).Y))
apu = LineTo(ByVal apu1, ByVal CLng(corn(5).X), ByVal CLng(corn(5).Y))


End Sub
Public Function getheight(ByRef X As Double, Y As Double) As Double

Dim row As Integer, col As Integer

 col = CInt((X - Zmodel.xllcorner) / Zmodel.CellSize)
 row = -Int((Zmodel.yllcorner - Y) / Zmodel.CellSize)
 
 If col < 0 Or col > Zmodel.ncols - 1 Or row < 0 Or row > Zmodel.nrows - 1 Then
  'MsgBox ("Point falls outside Zmodel!")
  getheight = 0#
  Exit Function
 End If
 getheight = ZfXY(col, row)
 Exit Function
End Function