'********************************************************
'* SDDBOXH.bas is a DeltaCad macro for producing a      *
'* Pocket Folding Box Horizontal Altitude Sundial       *
'* with Longitude Correction and EOT Correction.        *
'* Created by Valentin Hristov (valhrist@bas.bg).       *
'* The central edge is used as a gnomon.                *
'* I was inspired by Mac Oglesby to use the             *
'* North American Sundial Society DeltaCad programs     *
'* as tutorials (http://sundials.org)                   *
'* and made with DeltaCad (www.deltacad.com)            *
'* different types of sundials.                         *
'********************************************************

'* To assemble the sundial, cut along the solid lines, make mountain folds
'* along the lines with long dashes, and valley folds along the lines
'* with short dashes.

'* To find the time simply put the box on a horizontal place and rotate
'* it until the direction of the central arrow for MORNING or AFTERNOON
'* is towards the Sun.

'* Unfortunately such type of sundial is not useful close to the local
'* noon and also at places with bigger latitude (i.e. closer to the
'* poles) because the height (altitude) of the sun changes then very
'* slow.

'* The small circles outside are the vertices of the main rectangle for
'* an origami design which can be applied. It can be found in the file
'* http://www.origamiaustria.at/diagrams/simple_box.pdf.
'* Do not cut inside this rectangle if you want to apply this design.

'* You can see the picture of another type of sundial generated by one
'* of my DeltaCad macros at
'* www.flickr.com/photos/Valentin_Hristov/261303801/
'* Click on the button "All sizes" to see a bigger photo with details.
'* I am very grateful to my friends Daniela (www.danyo.net) and
'* Todor (www.todor.org) who converted my drawing into a real art piece!!!

'* Some of my DeltaCad macros for drawing Box Dials without gnomon
'* were added to the DeltaCad library on the NASS web page
'* http://www.sundials.org/links/local/deltacad/

'* A beautiful presentation (with many pictures and details) of all my
'* sundial macro files for DeltaCad can be found on Carl Sabanski's page
'* http://www.mysundial.ca/DeltaCad_Sundial_Macros_VH.html.
'* I am very grateful to Carl for his fruitful cooperation!

'* There is a Demo version of DeltaCad at www.deltacad.com.
'* Use the menu "Options - Macro - Run..." or the separate "Macro"
'* button - "Edit Macro List", add the file, and "Run Macro".

'* In the dialog box use DECIMAL DEGREES. Negative values indicate
'* South for latitude and West for longitude and central meridian.
'* Using "NO" for EOT and longitude corrections will give the local time.

'* The initial opening screen contains data for my place. If you want
'* the parameters for your place and your preferences to appear as
'* default, use any text editor to change the lines around 139-145
'* and save the file as text (ASCII) file.

'* After printing "landscape" on A4 paper, you can make a bigger A3
'* copy, which allows easier reading. The size of the box is still
'* small enough.

'* The short diadonal mountain folds (with long dashes) allow flat
'* folding of the sundial.

'* E N J O Y !!!

Option Explicit ' Force all variables to be declared before they are used. No adhoc variables

dcSetLineParms dcBlack, dcSolid, dcThin

Dim l,p,lon,cm,rot,i,pi,d2r,r2d,dm,dmr,w,ll,ud,lol,s,cs As Double
Dim ha,ham,ham1,has,has1,lc,hac,tir,hacr,thac,xe,ye,xb,yb As Double
Dim x,y,d,h,lcr,slc,clc,lr,sl,cl,dr,sd,cd,ir,si,ci As Double
Dim xN0,yN0,zN0,xZ0,yZ0,zZ0,xZZ0,yZZ0,zZZ0,rr,sr,cr as Double
Dim xNN0,yNN0,zNN0,lNN0,xNN,yNN,xpr,ypr,zpr,dsr,sds,cds as Double
Dim lpr0,xpr0,ypr0,zpr0,lpr1,xpr1,ypr1,zpr1,cg,gr,g,sg as Double
Dim x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,shac,chac as Double
Dim beta,betar,sb,cb,feot,flon,ceot,clon,sh,th,noon,hh,ww,www,a as Double
Dim eot_c,lon_c,dst_c,fdst as Double

Dim decl(366),eot(366),spl(732) As Double

Dim button,count,nl As Integer

Dim outtext As String

Dim bm(13),datetext(13) As String

Dim hhv,hhb,hhe,nlcheck As Boolean


dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetCircleParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcPurple, "Tahoma","Bold",0,12,21,0,0

'Establish the 5 standard line thicknesses in thousands of an inch.
dcSetDrawingData dcLineThin,   .003
dcSetDrawingData dcLineNormal, .008
dcSetDrawingData dcLineThick,  .012
dcSetDrawingData dcLineHeavy,  .024
dcSetDrawingData dcLineWide,   .048

'Maximize the window, close any existing drawing without saving, and start a new drawing.
dcSetDrawingWindowMode dcMaximizeWin
dcCloseWithoutSaving
dcNew ""


'**************************************

'Start of program
call Sundial
'********************
Sub Sundial
init_constants
Input_constants_of_sundial
if button=0 then goto cncl
Angles
Main
dcViewAll
cncl:
End Sub
'End of program


'**************************************
'Start of subroutines
'''''''''''''''''''''''''''''''''''''''
Sub Input_constants_of_sundial
Begin Dialog CONSTANTS_INPUT 13,1,200,150, "Input data for the sundial"
 Text 15,0,180,10, "DOUBLE BOX ALTITUDE (HEIGHT) SUNDIAL"
 Text 15,8,180,10, "with corrections for the latitude and the EOT"
 Text 15,20,150,10, "Place"
 TextBox 65,20,120,10, .p
 Text 15,32,180,10, "Latitude(N>0)    Longitude(E>0) Central meridian(E>0)"
 TextBox 15,44,34,10, .l
 TextBox 83,44,34,10, .lon
 TextBox 151,44,34,10, .cm
 Text 15,56,180,10, "Lines per hour (1=1hr, 2=30m, 4=15m)"
 TextBox 151,56,34,10, .nl
 Text 15,68,80,10, "EOT correction"
 OptionGroup .eot_c
 OptionButton 15,78,30,10, "Yes"
 OptionButton 50,78,30,10, "No"
 Text 115,68,80,10, "Longitude correction"
 OptionGroup .lon_c
 OptionButton 115,78,30,10, "Yes"
 OptionButton 150,78,30,10, "No"
 Text 15,93,150,10, "Is Daylight Savings Time used?"
 OptionGroup .dst_c
 OptionButton 130,88,30,10, "Yes"
 OptionButton 130,98,30,10, "No"
 Text 15,110,80,10, "Height of the gnomon"
 TextBox 151,110,34,10, .hh
 Text 15,122,180,10, "Width of one box ( at least  2 * height )"
 TextBox 151,122,34,10, .ww

 OKButton 42,135,37,12
 CANCELButton 115,135,37,12

End Dialog

'Initialize 
Dim prompt As constants_input

prompt.p = "Lozen - Sofia - Bulgaria" 'Place
prompt.l = 42.602                     'Latitude
prompt.lon = 23.501                   'Longitude
prompt.cm = 30                        'Central meridian
prompt.nl = 4                         'Lines per hour
prompt.eot_c = 0
prompt.lon_c = 0
prompt.dst_c = 0
prompt.hh = 1
prompt.ww = 3


repeat_until_inputcorrect: 'label to return if input is not correct

button = Dialog(prompt)    'get the input

If (button=0) Then GoTo end_input

If test("l",prompt.l,-90,90) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("lon",prompt.lon,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("cm",prompt.cm,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If

'Set program variables with input variables, angles in degrees
p = prompt.p
l = prompt.l
lon = prompt.lon
cm = prompt.cm
nl=prompt.nl
eot_c=prompt.eot_c
lon_c=prompt.lon_c
dst_c=prompt.dst_c
if eot_c=0 then feot=1 else feot=0
if lon_c=0 then flon=1 else flon=0
if dst_c=0 then fdst=1 else fdst=0
hh=prompt.hh
hh=0-hh
hh=0-hh
ww=prompt.ww
ww=0-ww
ww=0-ww

end_input:

End Sub

'''''''''''''''''''''''''''''''''''''''
Sub init_constants
pi = 4 * Atn(1)
d2r = pi/180
r2d = 180/pi
dm = 23.43954
dmr = dm*d2r

bm( 1)=  1 '1jan
bm( 2)= 32 '1feb
bm( 3)= 60
bm( 4)= 91
bm( 5)=121
bm( 6)=152
bm( 7)=182
bm( 8)=213
bm( 9)=244
bm(10)=274
bm(11)=305
bm(12)=335 '1dec
bm(13)=366 '1jan

for count=1 to 365
w=.017202792*(count-(cm-15)/360)
decl(count)=.367402-23.275*cos(w+.178044)-.38506*cos(2*w+.0687076)-.16046*cos(3*w+.451301)+.00315469*cos(4*w+.876643)
next count
decl(366)=decl(1)

for count=1 to 365
w=.017202792*(count-(cm-15)/360)
eot(count)=.00884207-7.36034*cos(w+1.49487)+9.91068*cos(2*w-1.21808)-.306344*cos(3*w+1.82055)+.204774*Cos(4*w-.875115)
next count
eot(366)=eot(1)

datetext( 1) = "JAN"
datetext( 2) = "FEB"
datetext( 3) = "MAR"
datetext( 4) = "APR"
datetext( 5) = "MAY"
datetext( 6) = "JUN"
datetext( 7) = "JUL"
datetext( 8) = "AUG"
datetext( 9) = "SEP"
datetext(10) = "OCT"
datetext(11) = "NOV"
datetext(12) = "DEC"
datetext(13) = "JAN"

End Sub

Sub Angles

lc=lon-cm    'longitude correction
lcr=lc*d2r   'longitude correction in radians
slc=sin(lcr) 'sin(longitude correction)
clc=cos(lcr) 'cos(longitude correction)

lr=l*d2r     'longitude in radians
sl=sin(lr)   'sin(latitude)
cl=cos(lr)   'cos(latitude)

dr=d*d2r     'declination in radians
sd=sin(dr)   'sin(declination)
cd=cos(dr)   'cos(declination)

ir=i*d2r     'inclination in radians
si=sin(ir)   'sin(inclination)
ci=cos(ir)   'cos(inclination)

rr=rot*d2r   'rotation in radians
sr=sin(rr)   'sin(rotation)
cr=cos(rr)   'cos(rotation)

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''
Sub Main

A=297/210
'A=11/8.5
'A=17/11

www=(ww+(4-A)*hh)/(1.05*A)

dcCreateLine -hh-ww,www*1.05+hh,-hh,www*1.05+hh
dcCreateLine -hh,www*1.05+hh,0,www*1.05+.9*hh
dcCreateLine -2*hh-ww,www*1.05+.9*hh,-hh-ww,www*1.05+hh
dcCreateLine hh+ww,www*1.05+hh,hh,www*1.05+hh
dcCreateLine hh,www*1.05+hh,0,www*1.05+.9*hh
dcCreateLine 2*hh+ww,www*1.05+.9*hh,hh+ww,www*1.05+hh
dcCreateLine -hh-ww,-www*1.05-hh,-hh,-www*1.05-hh
dcCreateLine -hh,-www*1.05-hh,0,-www*1.05-.9*hh
dcCreateLine -2*hh-ww,-www*1.05-.9*hh,-hh-ww,-www*1.05-hh
dcCreateLine hh+ww,-www*1.05-hh,hh,-www*1.05-hh
dcCreateLine hh,-www*1.05-hh,0,-www*1.05-.9*hh
dcCreateLine 2*hh+ww,-www*1.05-.9*hh,hh+ww,-www*1.05-hh
dcCreateLine -4*hh-ww,-www*1.05,-4*hh-ww,www*1.05
dcCreateLine 4*hh+ww,-www*1.05,4*hh+ww,www*1.05
dcCreateLine -4*hh-ww,www*1.05,-hh-ww,www*1.05
dcCreateLine -hh,www*1.05,hh,www*1.05
dcCreateLine hh+ww,www*1.05,4*hh+ww,www*1.05
dcCreateLine -4*hh-ww,0-www*1.05,-hh-ww,-www*1.05
dcCreateLine -hh,-www*1.05,hh,-www*1.05
dcCreateLine hh+ww,-www*1.05,4*hh+ww,-www*1.05
dcCreateLine -2*hh-ww,-www*1.05-.9*hh,-2*hh-ww,-www*1.05
dcCreateLine 2*hh+ww,-www*1.05-.9*hh,2*hh+ww,-www*1.05
dcCreateLine -2*hh-ww,www*1.05,-2*hh-ww,www*1.05+.9*hh
dcCreateLine 2*hh+ww,www*1.05,2*hh+ww,www*1.05+.9*hh

dcCreateCircle -3*hh-ww,-www*1.05-hh,hh*.05
dcCreateCircle 3*hh+ww,-www*1.05-hh,hh*.05
dcCreateCircle -3*hh-ww,www*1.05+hh,hh*.05
dcCreateCircle 3*hh+ww,www*1.05+hh,hh*.05
dcCreateCircle -2*hh-ww,-www*1.05-hh,hh*.05
dcCreateCircle 2*hh+ww,-www*1.05-hh,hh*.05
dcCreateCircle -2*hh-ww,www*1.05+hh,hh*.05
dcCreateCircle 2*hh+ww,www*1.05+hh,hh*.05
dcCreateCircle 0,www*1.05+hh,hh*.05
dcCreateCircle 0,-www*1.05-hh,hh*.05

'Arrows
dcSetLineParms dcRed, dcSolid, dcHeavy
dcCreateLine hh,0,1.5*hh,.25*hh
dcCreateLine hh,0,1.5*hh,-.25*hh
dcCreateLine 1.11*hh,0,1.5*hh,.25*hh
dcCreateLine 1.11*hh,0,1.5*hh,-.25*hh
dcCreateLine -hh,0,-1.5*hh,.25*hh
dcCreateLine -hh,0,-1.5*hh,-.25*hh
dcCreateLine -1.11*hh,0,-1.5*hh,.25*hh
dcCreateLine -1.11*hh,0,-1.5*hh,-.25*hh

'Smiling Sun
dcSetLineParms dcRed, dcSolid, dcThick
dcSetCircleParms dcRED, dcSOLID, dcTHICK
dcCreateCircle -.5*hh,0,.25*hh
for count=.5 to 11.5
 x1=-.5*hh+.25*hh*cos(count*pi/6)
 y1=.25*hh*sin(count*pi/6)
 x2=-.5*hh+.4*hh*cos(count*pi/6)
 y2=.4*hh*sin(count*pi/6)
 dcCreateLine x1,y1,x2,y2
next count
dcCreateLine -.45*hh,0,-.55*hh,0
dcCreateCircle -.4*hh,.1*hh,.05*hh
dcCreateCircle -.4*hh,-.1*hh,.05*hh
dcCreateCircleEx -.55*hh,0,-.55*hh,.015*hh,-.55*hh,-.015*hh,.15*hh,.1*hh,0,2
dcCreateCircle .5*hh,0,.25*hh
for count=.5 to 11.5
 x1=.5*hh+.25*hh*cos(count*pi/6)
 y1=.25*hh*sin(count*pi/6)
 x2=.5*hh+.4*hh*cos(count*pi/6)
 y2=.4*hh*sin(count*pi/6)
 dcCreateLine x1,y1,x2,y2
next count
dcCreateLine .45*hh,0,.55*hh,0
dcCreateCircle .4*hh,.1*hh,.05*hh
dcCreateCircle .4*hh,-.1*hh,.05*hh
dcCreateCircleEx .55*hh,0,.55*hh,-.015*hh,.55*hh,.015*hh,.15*hh,.1*hh,0,1

'Circle arrows on the teeth
dcSetCircleParms dcBlack, dcArrow, dcThin
dcCreateCircleEx -hh-ww,1.05*www,-1.5*hh-ww,1.05*www+hh,-2*hh-ww,1.05*www+.5*hh,.9*hh,.9*hh,0,2
dcCreateCircleEx hh,1.05*www,.5*hh,1.05*www+hh,0,1.05*www+.5*hh,.9*hh,.9*hh,0,2
dcCreateCircleEx hh+ww,1.05*www,2*hh+ww,1.05*www+.5*hh,1.5*hh+ww,1.05*www+hh,.9*hh,.9*hh,0,1
dcCreateCircleEx -hh,1.05*www,0,1.05*www+.5*hh,-.5*hh,1.05*www+hh,.9*hh,.9*hh,0,1
dcCreateCircleEx hh+ww,-1.05*www,1.5*hh+ww,-1.05*www-hh,2*hh+ww,-1.05*www-.5*hh,.9*hh,.9*hh,0,2
dcCreateCircleEx -hh,-1.05*www,-.5*hh,-1.05*www-hh,0,-1.05*www-.5*hh,.9*hh,.9*hh,0,2
dcCreateCircleEx -hh-ww,-1.05*www,-2*hh-ww,-1.05*www-.5*hh,-1.5*hh-ww,-1.05*www-hh,.9*hh,.9*hh,0,1
dcCreateCircleEx hh,-1.05*www,0,-1.05*www-.5*hh,.5*hh,-1.05*www-hh,.9*hh,.9*hh,0,1

dcSetLineParms dcBlack, dcCutting, dcThin
dcCreateLine 0,-www*1.05-.9*hh,0,www*1.05+.9*hh
dcCreateLine -2*hh-ww,-www*1.05,-2*hh-ww,www*1.05
dcCreateLine 2*hh+ww,-www*1.05,2*hh+ww,www*1.05
dcCreateLine -3*hh-ww,-www*1.05,-3*hh-ww,www*1.05
dcCreateLine 3*hh+ww,-www*1.05,3*hh+ww,www*1.05
dcCreateLine -ww-hh,-www*1.05,-ww,-www*1.05-hh
dcCreateLine -ww-hh,www*1.05,-ww,www*1.05+hh
dcCreateLine -hh,-www*1.05,-2*hh,-www*1.05-hh
dcCreateLine -hh,www*1.05,-2*hh,www*1.05+hh
dcCreateLine ww+hh,-www*1.05,ww,-www*1.05-hh
dcCreateLine ww+hh,www*1.05,ww,www*1.05+hh
dcCreateLine hh,-www*1.05,2*hh,-www*1.05-hh
dcCreateLine hh,www*1.05,2*hh,www*1.05+hh

dcSetLineParms dcBlack, dcStitch, dcThin
dcCreateLine -hh,-www*1.05-hh,0-hh,www*1.05+hh
dcCreateLine -ww-hh,-www*1.05-hh,-ww-hh,www*1.05+hh
dcCreateLine hh,-www*1.05-hh,hh,www*1.05+hh
dcCreateLine ww+hh,-www*1.05-hh,ww+hh,www*1.05+hh
dcCreateLine -hh,-www*1.05,-ww-hh,-www*1.05
dcCreateLine -hh,www*1.05,-ww-hh,www*1.05
dcCreateLine hh,-www*1.05,ww+hh,-www*1.05
dcCreateLine hh,www*1.05,ww+hh,www*1.05

if l>=0 then
 ll=CStr(l)+" N"
 ud=0
else
 ll=CStr(-Val(l))+" S"
 ud=180
end if
if lon>=0 then lol=CStr(lon)+" E" else lol=CStr(-Val(lon))+" W"
dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,12,21,0,0
dcCreateText -2.3*hh-ww,0,0,p
dcCreateText -2.55*hh-ww,ww/2,0,"Latitude "+ll
dcCreateText -2.55*hh-ww,-ww/2,0,"Longitude "+lol
dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,10,21,0,0
if flon=0 then
 dcCreateText -2.8*hh-ww,www/2,0,"Without EOT correction"
else
 dcCreateText -2.8*hh-ww,www/2,0,"With EOT correction"
end if
if feot=0 then
 dcCreateText -2.8*hh-ww,-www/2,0,"Without Longitude correction"
else
 dcCreateText -2.8*hh-ww,-www/2,0,"With Longitude correction"
end if

dcSetLineParms dcBlack, dcSolid, dcThin

dcSetTextParms dcBlack,"Tahoma","Bold",90,10,21,0,0
dcCreateText 2.3*hh+ww,0,0,"Author: Valentin Hristov, Sofia, Bulgaria"
dcCreateText 2.55*hh+ww,0,0,"E-mail: valhrist@bas.bg"
dcSetTextParms dcBlack,"Tahoma","Standard",90,8,21,0,0
dcCreateText 2.8*hh+ww,0,0,"Web page: www.math.bas.bg/complan/valhrist/mystuff.htm"
dcCreateText 3.25*hh+ww,0,0,"The box sundial is horizontal and measures the height (altitude) of the sun."
dcCreateText 3.5*hh+ww,0,0,"Unfortunately the change of the height is very small close to noon."
dcCreateText 3.75*hh+ww,0,0,"The direction toward the sun is given by the central arrow."

dcSetTextParms dcBlue,"Tahoma","Standard",0,8,21,0,0
dcCreateText hh+ww/2,www*1.1,0,"Civil (Winter) time"
dcCreateText -hh-ww/2,www*1.1,0,"Civil (Winter) time"
if fdst=0 then
 dcSetTextParms dcBlue,"Tahoma","Standard",180,8,21,0,0
 dcCreateText hh+ww/2,-www*1.1,0,"Civil (Winter) time"
 dcCreateText -hh-ww/2,-www*1.1,0,"Civil (Winter) time"
else
 dcSetTextParms dcRed,"Tahoma","Standard",180,8,21,0,0
 dcCreateText hh+ww/2,-www*1.1,0,"Daylight Savings (Summer) time"
 dcCreateText -hh-ww/2,-www*1.1,0,"Daylight Savings (Summer) time"
end if
dcSetTextParms dcBlack,"Tahoma","Bold",-90,8,21,0,0
dcCreateText -3.3*hh-ww,0,0,"Cut along the solid lines."
dcCreateText -3.5*hh-ww,0,0,"Make mountain folds along the lines with long dashes."
dcCreateText -3.7*hh-ww,0,0,"Make valley folds along the lines with short dashes."

for count=1 to 13
if count-1=Int((count-1)/3)*3 then
 dcSetLineParms dcBlack, dcSolid,dcThick
else
 dcSetLineParms dcBlack, dcSolid,dcNormal
end if
dcCreateLine -2*hh-ww,www-2*www*bm(count)/366,2*hh+ww,www-2*www*bm(count)/366
dcSetLineParms dcBlack, dcSolid,dcThin
if count<13 then dcCreateLine -2*hh-ww,www-2*www*(bm(count)+10)/366,2*hh+ww,www-2*www*(bm(count)+10)/366
if count<13 then dcCreateLine -2*hh-ww,www-2*www*(bm(count)+20)/366,2*hh+ww,www-2*www*(bm(count)+20)/366
dcSetTextParms dcDarkGreen, "Tahoma","Bold",-90,14,21,0,0
dcCreateText -.3*hh,.5*www,0,"MORNING"
dcCreateText -.3*hh,-.5*www,0,"MORNING"
dcSetTextParms dcDarkGreen, "Tahoma","Bold",-90,12,21,0,0
if count<13 then dcCreateText -hh+.35,.912*www-2*www*bm(count)/366,0,datetext(count)
dcSetTextParms dcDarkGreen, "Tahoma","Bold",-90,8,21,0,0
if count<13 then dcCreateText -hh+.15,www-2*www*(bm(count)+10)/366,0,"11"
if count<13 then dcCreateText -hh+.15,www-2*www*(bm(count)+20)/366,0,"21"
dcSetTextParms dcDarkGreen, "Tahoma","Bold",90,14,21,0,0
dcCreateText .3*hh,.5*www,0,"AFTERNOON"
dcCreateText .3*hh,-.5*www,0,"AFTERNOON"
dcSetTextParms dcDarkGreen, "Tahoma","Bold",90,12,21,0,0
if count<13 then dcCreateText hh-.35,.912*www-2*www*bm(count)/366,0,datetext(count)
dcSetTextParms dcDarkGreen, "Tahoma","Bold",90,8,21,0,0
if count<13 then dcCreateText hh-.15,www-2*www*(bm(count)+10)/366,0,"11"
if count<13 then dcCreateText hh-.15,www-2*www*(bm(count)+20)/366,0,"21"

dcSetLineParms dcBlack, dcSolid, dcThin
next count

if flon=0 then
 noon=12
else
 noon=12-int(lc/15+.5) 'civil hour closest to the "mean local noon"
end if

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
cs=0                         'counter for spline
for ha=0 to noon step 1/nl
 ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 end if
 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

 hhv=False
 hhb=True
 hhe=False
' for count=1 to 366 'max number of points in Spline is 248
 for count=1 to 366 step 2
  hac=ha*15+flon*lc-feot*eot(count)/4
  hac=hac+180
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(dsr)
  cds=cos(dsr)
  sh=sds*sl+cds*cl*chac 'sin of the height
  th=sh/sqr(1-sh*sh)    'tan of the height
  if sh>=0 then
    cs=cs+1
    if th<hh/ww then
     spl(2*cs-1)=-2*hh-ww+ww*th
    else
     spl(2*cs-1)=-hh-hh/th
    end if
    spl(2*cs)=www-2*www*count/366
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True or cs=1 then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if ha=Int(ha) then
      if xb>-1.96*hh-ww then
       dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
       dcCreateText xb,yb+.1*hh,0,CStr(ham)
      else
       dcSetTextParms dcBlue, "Tahoma","Standard",-90,8,21,0,0
       dcCreateText xb-.1*hh,yb,0,CStr(ham)
      end if
     end if
     hhb=False
     hhv=True
    end if
  else
   if cs>2 then
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
 if ha=Int(ha) and hhe=False and hhv=True then
  if xe>-1.96*hh-ww then
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham)
   end if
  else
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",-90,8,21,0,0
    dcCreateText xe-.1*hh,ye,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",-90,8,21,0,0
    dcCreateText xe-.1*hh,ye,0,CStr(ham)
   end if
  end if
 end if
    cs=0
   end if
  end if
 next count

 hhe=False
 if cs>2 then                       'if the hour line finishes at 365
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
 if ha=Int(ha) and hhe=False and hhv=True then
  if xe>-1.96*hh-ww then
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham)
   end if
  else
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",-90,8,21,0,0
    dcCreateText xe-.1*hh,ye,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",-90,8,21,0,0
    dcCreateText xe-.1*hh,ye,0,CStr(ham)
   end if
  end if
 end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin

next ha

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
cs=0			     'counter for spline
for ha=noon to 24 step 1/nl
 ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 end if
 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

 hhv=False
 hhb=True
 hhe=False
' for count=1 to 366 'max number of points in Spline is 248
 for count=1 to 366 step 2
  hac=ha*15+flon*lc-feot*eot(count)/4
  hac=hac+180
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(dsr)
  cds=cos(dsr)
  sh=sds*sl+cds*cl*chac 'sin of the height
  th=sh/sqr(1-sh*sh)    'tan of the height
  if sh>=0 then
    cs=cs+1
    if th<hh/ww then
     spl(2*cs-1)=2*hh+ww-ww*th
    else
     spl(2*cs-1)=hh+hh/th
    end if
    spl(2*cs)=www-2*www*count/366
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True or cs=1 then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if ha=Int(ha) then
      dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
      if xb<1.96*hh+ww then
       dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
       dcCreateText xb,yb+.1*hh,0,CStr(ham)
      else
       dcSetTextParms dcBlue, "Tahoma","Standard",90,8,21,0,0
       dcCreateText xb+.1*hh,yb,0,CStr(ham)
      end if
     end if
     hhb=False
     hhv=True
    end if
  else
   if cs>2 then
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcRed, "Tahoma","Standard",0,8,21,0,0
  if xe<1.96*hh+ww then
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham)
   end if
  else
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",90,8,21,0,0
    dcCreateText xe+.1*hh,ye,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",90,8,21,0,0
    dcCreateText xe+.1*hh,ye,0,CStr(ham)
   end if
  end if
 end if
    cs=0
   end if
  end if
 next count

 hhe=False
 if cs>2 then                       'if the hour line finishes at 365
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcRed, "Tahoma","Standard",0,8,21,0,0
  if xe<1.96*hh+ww then
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",180,8,21,0,0
    dcCreateText xe,ye-.1*hh,0,CStr(ham)
   end if
  else
   if fdst=1 then
    dcSetTextParms dcRed, "Tahoma","Standard",90,8,21,0,0
    dcCreateText xe+.1*hh,ye,0,CStr(ham1)
   else
    dcSetTextParms dcBlue, "Tahoma","Standard",90,8,21,0,0
    dcCreateText xe+.1*hh,ye,0,CStr(ham)
   end if
  end if
 end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin

next ha

End Sub

'''''''''''''''''''''''''''''''''''''''
Function arcsin(ByVal x) As Double
If Abs(x) > 0.999999999999 Then x = sgn(x)*0.999999999999
  arcsin = Atn(x/Sqr(1-x*x))
End Function

Function arccos(ByVal x) As Double
  arccos = pi/2-arcsin(x)
End Function

Function test(varname,x,minval,maxval) As boolean
If IsNumeric(x) = false Then
test = false
outtext = varname & " must be numeric"
MsgBox outtext
exit Function
End If
If x < minval Or x > maxval Then
outtext = varname & " must be between " & chr$(13) & minval & "  and  " & maxval
MsgBox outtext
exit Function
End If
test = true
End Function