'====================== SIMPLE CALENDAR PRINTING ======================================
'     Made using Bill Haesslein's code for the calendar shell and his date routines
'                        John Paterson - Dec 2008
'	This program is designed to produce simple, clear, high-contrast, large-font
'   print-outs of month-to-view calendars.  It is aimed at persons who have very poor
'	vision.  No provision for images is made; just text with some space for writing
'	your own, very limited, notes each day
'	Extensive commenting of code may help beginners. Others can delete it if it annoys!
'				Please amend and improve the code as you wish
'======================================================================================

' Previously called Jonz Calendar - I only renamed it 'cos I am called Brian, not Jon!

' Modified Dec 2019. Leap Year of 2020 was causing days to be printed out of order
' Checked with a calendar for 2019 and 2020 - all appears correct
' Added ability to print any month as required
' Using the Dates.txt file, ages for the printed year are calculated and printed
' Companion program Dates Editor can be used to create, delete, sort and save dates

'Jan 3, 2020 - Combined both Calendar program and Dates Editor program

AUTODEFINE "off"
$INCLUDE "windowssdk.inc"

$INCLUDE "commctrl.inc"


TYPE NMCUSTOMDRAWINFO
   NMHDR Hdr
   UINT dwDrawStage
   UINT hDc
   WINRECT rc
   UINT dwItemSpec
   UINT uItemState
   UINT lItemlParam
ENDTYPE

'Used by ColorListView()
TYPE NMLVCUSTOMDRAW
   NMCUSTOMDRAWINFO NmCd
   UINT ClrText
   UINT ClrTextBk
   INT iSubItem
ENDTYPE

LVHITTESTINFO LvHit
   LVITEM lItem,lvi1,lvi2
   WINRECT rc

'Calendar variables
DIALOG d1,d2
WINDOW w1,w2
INT colWidth,rowHeight
INT xOrigin,yOrigin,l,x
ISTRING year$[32]
INT EasterMonth,EasterDay
INT c,day,year,i,j,z 'Define variables for c=cell location, day=day number, year=year number, x=columns in table, y=rows in table
ISTRING day$[32] 'Define variable to hold day number
INT FirstDay 'Define variable to hold cell location for first day of month
ISTRING m$[32]
ISTRING iDate[32]
STRING temp,tempp
INT t,countRows,nState,clik,pages[13]
FILE cFile,dFile
ISTRING txt1[260],txt2[260]
STRING ItemText,EditText,dTemp
INT HotItem,HotSubitem,LvCols,LvFgC,LvBgLo,LvBgHi,editActive,loop,lvi,ClickedColumn,LastClickedColumn,SortAscDesc,dCountRows
UINT hInstance,hEdit,WindowOriginalProc,EditOriginalProc,listviewOriginalProc,hFont,hListView,hTooltip

CONST CHECKED=1

'Listview columns, 0=Disable tabbing
LvCols=3
'Listview item text colour, BGR
LvFgC=0x0A0A0A
'Listview colour for odd numbered items, BGR
LvBgLo=0xFFFFFF
'Listview colour for even numbered items, BGR
LvBgHi=0xE8E8E8

ENUM day_names
   Monday
   Tuesday
   Wednesday
   Thursday
   Friday
   Saturday
   Sunday
ENDENUM

ENUM calControls
   EditDate=100
   staticYear
   lvCal
   CheckAll
   UncheckAll
   PrintCal
   DateEdit
   Cancel
ENDENUM

ENUM dateControls
   lvDate=200
   AddLine
   DelLine
   Close
   CancelDate
ENDENUM

CREATEDIALOG d1,0,0,292,296,0x80C80080,0,"Brian's Calendar",&d1_handler
   CONTROL d1,@EDIT,DATE$("yyyy"),16,16,70,20,0x50810000,EditDate
   CONTROL d1,@STATIC,"Enter the Year to be printed",99,20,141,20,0x5000010B,staticYear
   CONTROL d1,@LISTVIEW,"",16,56,130,226,0x5080000D,lvCal
   CONTROL d1,@SYSBUTTON,"Check All",160,56,114,20,0x50018000,CheckAll
   CONTROL d1,@SYSBUTTON,"Uncheck All",160,96,114,20,0x50018000,UncheckAll
   CONTROL d1,@SYSBUTTON,"Print",160,150,114,20,0x50018000,PrintCal
   CONTROL d1,@SYSBUTTON,"Edit Dates",160,204,114,20,0x50018000,DateEdit
   CONTROL d1,@SYSBUTTON,"Cancel and Close",160,260,114,20,0x50018001,Cancel

CREATEDIALOG d2,0,0,640,406,0x80C80080,d1,"Dates Editor",&mainDates
   CONTROL d2,@SYSBUTTON,"Add a Line",512,30,114,20,0x50008000,AddLine
   CONTROL d2,@SYSBUTTON,"Delete a Line",512,80,114,20,0x50008000,DelLine
   CONTROL d2,@SYSBUTTON,"Close and Save",512,130,114,20,0x50008000,Close
   CONTROL d2,@SYSBUTTON,"Cancel",512,180,114,20,0x50008000,CancelDate
   CONTROL d2,@LISTVIEW,"",0,0,504,408,@LVSREPORT|@LVSSHOWSELALWAYS|@HSCROLL|@BORDER,lvDate

DOMODAL d1

WAITUNTIL w2=0

'Now set the number of days in each month, taking into account leap years
'Define an integer array to hold the max days in each month
INT mo[12],v400,v100,v4

'Set max days in each month
'mnth:1  2  3  4  5  6  7  8  9 10 11 12
'indx:0  1  2  3  4  5  6  7  8  9 10 11
   mo=31,28,31,30,31,30,31,31,30,31,30,31
'Check for leap year and, if so, adjust max days in Feb
   v400=year-(year/400)*400
IF v400=0 THEN mo[1]=29
   v100=year-(year/100)*100
IF v100<>0 THEN mo[1]=29 ELSE mo[1]=28
   v4=year-(year/4)*4
IF v4=0 THEN mo[1]=29 ELSE mo[1]=28

'This application was originally designed for a 1280 x 1024 pixel screen
'Automatic scaling has since been added, to cater for any size of screen
'So, first, measure screen size, then apply scaling factors later in code
UINT screen_width,screen_height
   GETSCREENSIZE screen_width,screen_height

'Set calendar grid size
CONST num_cols=7
CONST num_rows=7

'Define 3D integer array to map table with size: 7 rows x 7 columns x 2 (x & y) dimensions
INT pixelxy[num_cols,num_rows,2],row,column

'Colour Constants
UINT cFG=0
UINT cBG=0xFFFFFFFF

'Calculate column width and row height
colWidth=10*INT(INT(screen_width/num_cols)/10)
rowHeight=10*INT(INT(screen_height/num_rows)/10)

'calculate co-ordinates of top left corner of 7 x 7 grid
xOrigin=(screen_width-(colWidth*num_cols))/2
yOrigin=(screen_height-(rowHeight*num_rows))/2

'calculate and store co-ordinates of top left corners of all cells
FOR row=0 TO 6
FOR column=0 TO 6
   pixelxy[column,row,0]=xOrigin+(column*colWidth)
   pixelxy[column,row,1]=yOrigin+(row*rowHeight)
NEXT column
NEXT row

'Determine Easter for chosen Year
iDate=Easter(year)
EasterMonth=VAL(MID$(iDate,6,2))
EasterDay=VAL(MID$(iDate,9,2))

'Define variables for storing messages
INT year_num,month_num,day_num,age
STRING mess[13,32] 'String array for month, day, but only 1 message per day

FOR i=0 TO 12
FOR j=0 TO 31
   mess[i,j]=""
NEXT j
NEXT i

'Store permanent messages...
'Store New Year's Day
mess[1,1]="-New Year"
'Store the message for Easter Sunday in the correct day
mess[EasterMonth,EasterDay]="-Easter Day"
'Store Christmas & Boxing Day
mess[12,25]="-Xmas Day"
mess[12,26]="-Boxing Day"

'Load text file with dates and names
   ReadNames()

'List of month names
DATABEGIN month_names
   DATA 1,"January"
   DATA 2,"February"
   DATA 3,"March"
   DATA 4,"April"
   DATA 5,"May"
   DATA 6,"June"
   DATA 7,"July"
   DATA 8,"August"
   DATA 9,"September"
   DATA 10,"October"
   DATA 11,"November"
   DATA 12,"December"
DATAEND

ISTRING month_name[32]
INT month,max_day

'Display each month of the year in turn, complete with all day numbers aligned with correct days-of-the-week and showing any messages on the correct day
'Offers the ability to print the page or to cancel print dialog and move on to display next month
   RESTORE month_names

FOR month=1 TO 12
   GETDATA month_names,month_num
   GETDATA month_names,month_name

'Find the first day of this month
   FirstDay=DayOfWeek(year,month,01)
   IF FirstDay=0 THEN FirstDay=7

   SETWINDOWCOLOR w1,cBG					'Sets the background color of a window
   FRONTPEN w1,cFG						'Sets the foreground colour for drawing

   OPENWINDOW w1,0,0,screen_width,screen_height,@MINBOX|@MAXBOX|@SIZE,0,"Brian's Calendar",&main

IF pages[month-1]=1 'bkh

'draw month name rectangle across top of screen
   RECT w1,pixelxy[0,0,0],pixelxy[0,0,1],(num_cols*colWidth),rowHeight

'draw day rectangles across lower part of month rectangle
   FOR column=0 TO 6
      RECT w1,pixelxy[column,0,0],pixelxy[column,0,1]+(0.6*rowHeight),colWidth,(rowHeight*0.4)
   NEXT column

'draw an array of 7 cols x 6 rows of rectangular cells on screen
   FOR row=1 TO 6
      FOR column=0 TO 6
         RECT w1,pixelxy[column,row,0],pixelxy[column,row,1],colWidth,rowHeight
      NEXT column
   NEXT row

'Now print the month, year and day headings...
   SETFONT w1,"Tahoma",(48*screen_height/1024),900,0			'Sets the font of a window or control, ready to print the Month, Name & Year

   m$=month_name+STR$(year)
   z=LEN(m$)
   MOVE w1,(screen_width/2)-(17*z*screen_width/1280),12+(4*screen_height/1024)		'Move the pen position in the window, w1, to co-ordinates

FRONTPEN w1,RGB(0,0,255)
PRINT w1,m$						'Print in window, w1, the Month Name & Year, at the location set by the line immediately above
FRONTPEN w1,cFG						'Sets the foreground colour for drawing

   SETFONT w1,"Arial",(30*screen_height/1024),900,0			'Sets the font of a window or control, ready to print Day Names

   MOVE w1,pixelxy[0,0,0]+(0.25*colWidth),pixelxy[0,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"MON"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[1,0,0]+(0.25*colWidth),pixelxy[1,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"TUE"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[2,0,0]+(0.25*colWidth),pixelxy[2,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"WED"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[3,0,0]+(0.25*colWidth),pixelxy[3,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"THU"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[4,0,0]+(0.25*colWidth),pixelxy[4,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"FRI"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[5,0,0]+(0.25*colWidth),pixelxy[5,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"SAT"					'Print in window, w1, the text shown, at the location set by the line immediately above

   MOVE w1,pixelxy[6,0,0]+(0.25*colWidth),pixelxy[6,0,1]+(0.65*rowHeight)		'Move the pen in the window, w1, to co-ordinates
   PRINT w1,"SUN"					'Print in window, w1, the text shown, at the location set by the line immediately above

   c=0							'Initialise cell-pointer c
   day=1							'Set the first day of the month as 1
   max_day=mo[month-1]			'Set last day of month
   column=0

'Now print all the Day Numbers in the correct cells, and also print any messages in the appropriate cells
   FOR row=1 TO 6
      WHILE day<=max_day
         c++															'Increment cell pointer
         MOVE w1,pixelxy[column,row,0]+2,pixelxy[column,row,1]+2		'Move the pen position in the window, w1, to co-ordinates x=pxy[y,x,0], y=pxy[y,x,1]
         IF c>=FirstDay										'Check that the cell-pointer c points to a cell greater than the first day cell...
            day$=LTRIM$(STR$(day))								'Convert the integer day number into a string ready for justified printing
            IF LEN(day$)<2 THEN day$=""+day$					'Right-justify single-digit days, using an underline character
            SETFONT w1,"Tahoma",(45*screen_height/1024),900,0		'Set font for Day Numbers
            PRINT w1,day$,											'Print Day Number in each cell
            SETFONT w1,"Tahoma",(16*screen_height/1024),600,0							'Reduce font size to fit message into cell
            IF mess[month,day]<>"" 							'only print messages if they are not null
FRONTPEN w1,RGB(0,0,255)
               temp=mess[month,day]
               'messagebox 0,STR$(month)+STR$(day)+mess[month,day],"info"
               l=INSTR(temp,",")
               x=0
               MOVE w1,pixelxy[column,row,0]+80,pixelxy[column,row,1]+2+x
               WHILE l>0
                  tempp=MID$(temp,1,l-1)
                  temp=MID$(temp,l+1)
                  IF MID$(tempp,1,1) = "-"
                     FRONTPEN w1,RGB(220,20,60)
                     tempp = MID$(tempp,2)
                  ENDIF
                  PRINT w1,tempp						'Print any message for this cell
                  x+=26
                  MOVE w1,pixelxy[column,row,0]+80,pixelxy[column,row,1]+2+x
                  l=INSTR(temp,",")
               ENDWHILE
               IF MID$(temp,1,1) = "-"
                  FRONTPEN w1,RGB(220,20,60)
                  temp = MID$(temp,2)
               ENDIF
               PRINT w1,temp,""
FRONTPEN w1,cFG						'Sets the foreground colour for drawing
            ENDIF
            day++													'Increment the day number
         ENDIF
         column++									    			'Increment the column number
      ENDWHILE
   NEXT row

   SETCAPTION w1,m$
   PRINTWINDOW w1			'Display print dialog, ready to send contents of window (scaled & sized for both portrait or landscape) to printer
   WAITUNTIL w1=0		'Wait until page has been printed or print cancelled
ENDIF 'bkh
   CLOSEWINDOW w1
   NEXT month
END

SUB main(),INT
IF @MESSAGE=@IDCLOSEWINDOW
   CLOSEWINDOW w1
ENDIF
RETURN 0
ENDSUB

SUB Easter(y:INT),STRING
   INT century,g,k,i,j,l,EasterMonth,EasterDay
   century = y / 100
   g = y - (y / 19) * 19
   k = (century - 17) / 25
   i = century - century / 4 - (century - k) / 3 + 19 * g + 15
   i = i - (i / 30) * 30
   i = i - (i / 28) * (1 - (i / 28) / (i + 1)) * ((21 - g) / 11)
   j = y + y / 4 + i + 2 - century + century / 4
   j = j - (j / 7) * 7
   l = i - j
   EasterMonth = 3 + (l + 40) / 44
   EasterDay = l + 28 - 31 * (EasterMonth / 4)
RETURN ISODate(y,EasterMonth,EasterDay)
ENDSUB

SUB ISODate(yyyy:INT,mm:INT,dd:INT),STRING
RETURN USING("0####",yyyy) + "-" + USING("0##",mm)+ "-" + USING("0##",dd)
ENDSUB

SUB DayOfWeek(yyyy:INT,mm:INT,dd:INT),INT
   INT t[12],y
   t = 0,3,2,5,0,3,5,1,4,6,2,4
   y = yyyy
   y -= (mm < 3) ? 1: 0
RETURN (y + y/4 - y/100 + y/400 + t[mm-1] + dd) % 7
ENDSUB

SUB d1_handler(),INT
   SELECT @MESSAGE
CASE @IDINITDIALOG
   CENTERWINDOW d1
   SENDMESSAGE d1,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_GRIDLINES|LVS_EX_FULLROWSELECT|LVS_EX_CHECKBOXES,lvCal
   SENDMESSAGE d1,0x1024,0,0x000000,lvCal
   SENDMESSAGE d1,0x1026,0,0xFFC078,lvCal
   SENDMESSAGE d1,0x1001,0,0xFFFFFF,lvCal
   CONTROLCMD d1,lvCal,@LVINSERTCOLUMN,0,"Set Months to Print"
   CONTROLCMD d1,lvCal,@LVSETCOLWIDTH,0,124
   CONTROLCMD d1,lvCal,@LVINSERTITEM,0,"January"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,1,"February"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,2,"March"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,3,"April"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,4,"May"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,5,"June"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,6,"July"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,7,"August"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,8,"September"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,9,"October"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,10,"November"
   CONTROLCMD d1,lvCal,@LVINSERTITEM,11,"December"
   SENDMESSAGE(d1,LVM_SETBKCOLOR,0,0x12B0E0,lvCal) 'Set Background Colour
   SENDMESSAGE(d1,LVM_SETTEXTBKCOLOR,0,0x12B0E0,lvCal) 'Set Text Background Colour
   conLVSetCheckState(d1,lvCal,-1,1)
   SETFOCUS d1,EditDate
CASE @IDCLOSEWINDOW
   w2=0
   CLOSEDIALOG d1,@IDOK
   END
CASE @IDCONTROL
   SELECT @CONTROLID
CASE CheckAll 'Check all
IF @NOTIFYCODE=0
   conLVSetCheckState(d1,lvCal,-1,1)
ENDIF
CASE UncheckAll 'Uncheck all
IF @NOTIFYCODE=0
   conLVSetCheckState(d1,lvCal,-1,0)
ENDIF
CASE PrintCal 'Print
IF @NOTIFYCODE=0
   year$=GETCONTROLTEXT(d1,EditDate)
   year=VAL(year$)
   countRows=CONTROLCMD(d1,lvCal,@LVGETCOUNT)
   t=0
WHILE t<countRows+1
   clik=conLVGetCheckState(d1,lvCal,t)
   pages[t]=clik
   t++
ENDWHILE
   CLOSEDIALOG d1,@IDOK
ENDIF
CASE DateEdit
   DOMODAL d2,d1
CASE Cancel 'Cancel
IF @NOTIFYCODE=0
   w2=0
   CLOSEDIALOG d1,@IDOK
   END
ENDIF
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB conLVSetCheckState(win:WINDOW,cid:INT,index:INT,ticked:INT)
   lItem.mask=LVIF_STATE
IF ticked THEN ticked=0x2000 ELSE ticked=0x1000
   lItem.state=ticked
   lItem.stateMask=LVIS_STATEIMAGEMASK
   SENDMESSAGE(d1,LVM_SETITEMSTATE,index,lItem,cid)
ENDSUB

SUB conLVGetCheckState(win:WINDOW,cid:INT,index:INT),INT
   nState=(SENDMESSAGE(d1,LVM_GETITEMSTATE,index,LVIS_STATEIMAGEMASK,cid))/4096
RETURN (nState=2)
ENDSUB

SUB ReadNames()
IF OPENFILE(cFile,GETSTARTPATH+"Dates.txt","R")=0
WHILE (READ(cFile,temp)=0)
   year_num=VAL(MID$(temp,1,4))
   month_num=VAL(MID$(temp,6,2))
   day_num=VAL(MID$(temp,9,2))
   age=year-year_num
   tempp=mess[month_num,day_num]
IF tempp<>"" THEN tempp+=","
   tempp+="("+LTRIM$(STR$(age))+") "+MID$(temp,12)
   mess[month_num,day_num]=tempp
ENDWHILE
   CLOSEFILE cFile
ENDIF
FOR i=1 TO 12
FOR j=1 TO 31
IF mess[i,j]<>"" THEN PRINT i,j,mess[i,j]
NEXT j
NEXT i
ENDSUB

SUB mainDates(),INT
   SELECT @MESSAGE
CASE @IDINITDIALOG
   CENTERWINDOW d2
   hListView=GetDlgItem(d2.hWnd,lvDate)
   SENDMESSAGE d2,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_FLATSB|LVS_EX_FULLROWSELECT|LVS_EX_GRIDLINES,lvDate
FOR loop=AddLine TO CancelDate
   SETFONT d2,"Tahoma",10,400,0,loop
NEXT loop
'Populate the listview
CONTROLCMD d2,lvDate,@LVINSERTCOLUMN,0,"Year"
   CONTROLCMD d2,lvDate,@LVINSERTCOLUMN,1,"Month"
   CONTROLCMD d2,lvDate,@LVINSERTCOLUMN,2,"Day"
   CONTROLCMD d2,lvDate,@LVINSERTCOLUMN,3,"Name or Note"
   CONTROLCMD d2,lvDate,@LVSETCOLWIDTH,0,60
   CONTROLCMD d2,lvDate,@LVSETCOLWIDTH,1,60
   CONTROLCMD d2,lvDate,@LVSETCOLWIDTH,2,60
   CONTROLCMD d2,lvDate,@LVSETCOLWIDTH,3,-2
'Open 'Dates.txt'
IF OPENFILE(dFile,GETSTARTPATH+"Dates.txt","R")=0
   lvi=-1
WHILE (READ(dFile,dTemp)=0)
   lvi++
   CONTROLCMD d2,lvDate,@LVINSERTITEM,lvi,MID$(dTemp,1,4)
   CONTROLCMD d2,lvDate,@LVSETTEXT,lvi,1,MID$(dTemp,6,2)
   CONTROLCMD d2,lvDate,@LVSETTEXT,lvi,2,MID$(dTemp,9,2)
   CONTROLCMD d2,lvDate,@LVSETTEXT,lvi,3,MID$(dTemp,12)
ENDWHILE
   CLOSEFILE dFile
   RowCount()
ELSE
   CONTROLCMD d2,lvDate,@LVINSERTITEM,0,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,1,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,2,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,3,""
   CONTROLCMD d2,lvDate,@LVSETSELECTED,0
   SENDMESSAGE d2,LVM_ENSUREVISIBLE,0,FALSE,lvDate
   WriteData()
   SETCAPTION d2,"Dates Editor [1 entry]"
   MESSAGEBOX(d2,"Could not find 'Dates.txt' in the startup directory\n\nA default 'Dates.txt' has been created, with a blank line","File error",@MB_ICONINFORMATION|@MB_OK)
   SETFOCUS d2,lvDate
ENDIF
'Set Tooltips
   DoTooltips()
'Sub-classing calls
   hInstance=GetModuleHandleA(0)
'Subclass the window
   WindowOriginalProc=GetWindowLongA(d2.hWnd,GWL_WNDPROC)
   SetWindowLongA(d2.hWnd,GWL_WNDPROC,&SubclassWindow)
'Subclass the listview
   listviewOriginalProc=GetWindowLongA(hListView,GWL_WNDPROC)
   SetWindowLongA(hListView,GWL_WNDPROC,&SubclassListview)

CASE @IDCLOSEWINDOW
   CLOSEDIALOG d2,@IDOK
CASE @IDCONTROL
   SELECT @CONTROLID
CASE lvDate
IF @NOTIFYCODE=@LVNCOLUMNCLICK
   ClickedColumn=*<NMLISTVIEW>@LPARAM.iSubItem
   BeginSort()
ENDIF
CASE AddLine 'Add a blank line to listview
IF @NOTIFYCODE=0
   CONTROLCMD d2,lvDate,@LVINSERTITEM,0,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,1,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,2,""
   CONTROLCMD d2,lvDate,@LVSETTEXT,0,3,""
   CONTROLCMD d2,lvDate,@LVSETSELECTED,0
   SENDMESSAGE d2,LVM_ENSUREVISIBLE,0,FALSE,lvDate
   RowCount()
   SETFOCUS d2,lvDate
ENDIF
CASE DelLine 'Delete a single line
   DeleteLine()
CASE Close 'Close and save listview data
   WriteData()
   CLOSEDIALOG d2,@IDOK
CASE CancelDate 'Cancel and don't save data
   CLOSEDIALOG d2,@IDCANCEL
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB SubclassWindow(hWnd:UINT,uMsg:UINT,wParam:UINT,lParam:UINT),UINT
   SELECT uMsg
CASE (WM_NOTIFY)
   SELECT (*<NMHDR>lParam.code)
CASE @NMCLICK 'Edit an item
   CreateCustomEdit(-1,0)
CASE NM_CUSTOMDRAW 'Item colouring
   RETURN ColorListView(hWnd,lParam)
CASE HDN_BEGINTRACKA
CASE& HDN_BEGINTRACKW 'Quit edit mode
IF (hEdit)
   DestroyWindow(hEdit)
   editActive=FALSE
RETURN 0
ENDIF
ENDSELECT
ENDSELECT
RETURN CallWindowProcA(WindowOriginalProc,hWnd,uMsg,wParam,lParam)
ENDSUB

SUB CreateCustomEdit(Item:INT,SubItem:INT),INT
   HotItem=Item
   HotSubitem=SubItem
IF Item<0 'Then edit from the current position
   GetCursorPos(LvHit.Pt)
   ScreenToClient(d2.hWnd,LvHit.Pt)
   LvHit.Flags=LVHT_NOWHERE
   SendMessageA(hListView,LVM_SUBITEMHITTEST,0,&LvHit)
   HotItem=LvHit.iItem
   HotSubitem=LvHit.iSubItem
IF HotItem<0 THEN RETURN 0
ENDIF
'Get subitem rect
   rc.Top=HotSubitem
   rc.Left=LVIR_BOUNDS
   SendMessageA(hListView,LVM_GETSUBITEMRECT,HotItem,&rc)
   rc.Right=CONTROLCMD(d2,lvDate,@LVGETCOLWIDTH,HotSubitem) 'Item width
   rc.Bottom-=rc.Top 'Item height
'Create the edit control
   hEdit=CreateWindowExA(0,"Edit","",0x50800080,0,0,0,0,hListView,0,hInstance,0)
IF hEdit=0
   editActive=FALSE
RETURN False
ELSE
   editActive=TRUE
ENDIF
   hFont=SendMessageA(hListView,WM_GETFONT,0,0)
   SendMessageA(hEdit,WM_SETFONT,hFont,True) 'Redraw
   SendMessageA(hEdit,EM_SETLIMITTEXT,254,0)
   CONTROLCMD d2,lvDate,@LVGETTEXT,HotItem,HotSubitem,ItemText,254
   SendMessageA(hEdit,EM_REPLACESEL,0,&ItemText)
   SendMessageA(hEdit,EM_SETSEL,0,-1)
   _SetFocus(hEdit)
'Move the edit control to edited (sub)item position
   SetWindowPos(hEdit,HWND_TOP,rc.Left,rc.Top,rc.Right,rc.Bottom,0x60)
'Subclass the edit control
   EditOriginalProc=GetWindowLongA(hEdit,GWL_WNDPROC)
   SetWindowLongA(hEdit,GWL_WNDPROC,&SubclassEdit)
RETURN True
ENDSUB

SUB SubclassEdit(hWnd:UINT,uMsg:UINT,wParam:UINT,lParam:POINTER),UINT
IF (uMsg=WM_CHAR)
IF (wParam=13) OR (wParam=9)
   SendMessageA(hEdit,EM_SETSEL,0,-1)
   SendMessageA(hEdit,WM_GETTEXT,254,&EditText)
   CONTROLCMD d2,lvDate,@LVSETTEXT,HotItem,HotSubitem,EditText
   DestroyWindow(hEdit)
   editActive=FALSE
'Edit the next subitem
IF HotSubitem<=LvCols
   HotSubitem++
IF HotSubItem>LvCols
   HotSubItem=0
ENDIF
   CreateCustomEdit(Hotitem,HotSubitem)
ENDIF
RETURN 0
ENDIF
IF (wParam=27) 'Escape editing, killfocus saves the text
   DestroyWindow(hEdit)
   editActive=FALSE
RETURN 0
ENDIF
ENDIF
IF (uMsg=WM_KILLFOCUS) 'Save the current edit text
   SendMessageA(hEdit,EM_SETSEL,0,-1)
   SendMessageA(hEdit,WM_GETTEXT,254,&EditText)
   CONTROLCMD d2,lvDate,@LVSETTEXT,HotItem,HotSubitem,EditText
   DestroyWindow(hEdit)
   editActive=FALSE
RETURN 0
ENDIF
RETURN CallWindowProcA(EditOriginalProc,hWnd,uMsg,wParam,lParam)
ENDSUB

SUB ColorListView(hWnd:UINT,lParam:UINT),UINT
'Item colouring, handles alternating item colours
   SELECT *<NMLVCUSTOMDRAW>lParam.nmcd.dwDrawStage
CASE CDDS_PREPAINT
   RETURN CDRF_NOTIFYITEMDRAW
CASE CDDS_ITEMPREPAINT
   RETURN CDRF_NOTIFYSUBITEMDRAW
CASE CDDS_SUBITEMPREPAINT
'Fg colour
   *<NMLVCUSTOMDRAW>lParam.clrText=LvFgC
IF (*<NMLVCUSTOMDRAW>lParam.nmcd.dwItemSpec%2)
'Even item numbers, highlight colour
   *<NMLVCUSTOMDRAW>lParam.clrTextBk=LvBgHi
ELSE
'Odd item numbers, normal colour
   *<NMLVCUSTOMDRAW>lParam.clrTextBk=LvBgLo
ENDIF
RETURN CDRF_NEWFONT
ENDSELECT
RETURN CDRF_DODEFAULT
ENDSUB

SUB SubclassListview(hWnd:UINT,uMsg:UINT,wParam:UINT,lParam:POINTER),UINT
   SELECT uMsg
CASE WM_NCLBUTTONDOWN
IF editActive 'Save the current edit text
   SendMessageA(hEdit,EM_SETSEL,0,-1)
   SendMessageA(hEdit,WM_GETTEXT,254,&EditText)
   CONTROLCMD d2,lvDate,@LVSETTEXT,HotItem,HotSubitem,EditText
   DestroyWindow(hEdit)
   editActive=FALSE
ENDIF
ENDSELECT
RETURN CallWindowProcA(listviewOriginalProc,hWnd,uMsg,wParam,lParam)
ENDSUB

SUB DoTooltips()
   hTooltip=TOOLTIPCONTROL(d2,@TTS_ALWAYSTIP|@TTS_NOANIMATE|@TTS_NOFADE|@TTS_BALLOON,0)
   TTADDTOOL hTooltip,@TTF_SUBCLASS|@TTF_IDISHWND|@TTF_CENTERTIP,GETCONTROLHANDLE(d2,AddLine),d2.hWnd,"Add a blank line to the listview"
   TTADDTOOL hTooltip,@TTF_SUBCLASS|@TTF_IDISHWND|@TTF_CENTERTIP,GETCONTROLHANDLE(d2,DelLine),d2.hWnd,"Delete a line from the listview"
   TTADDTOOL hTooltip,@TTF_SUBCLASS|@TTF_IDISHWND|@TTF_CENTERTIP,GETCONTROLHANDLE(d2,Close),d2.hWnd,"Close and save listview data"
   TTADDTOOL hTooltip,@TTF_SUBCLASS|@TTF_IDISHWND|@TTF_CENTERTIP,GETCONTROLHANDLE(d2,CancelDate),d2.hWnd,"Cancel and lose any changes"
   SENDMESSAGE hTooltip,TTM_SETTIPBKCOLOR,0xC2C1BF,0
   SENDMESSAGE hTooltip,TTM_SETMAXTIPWIDTH,0,130
   SENDMESSAGE hTooltip,TTM_SETTITLEA,1,"Dates Editor"
ENDSUB

SUB WriteData()
   STRING tyyyy,tmm,tdd,tname
   ISTRING t[8]=","
   INT indx
IF OPENFILE(dFile,GETSTARTPATH+"Dates.txt","W")=0
   RowCount()
FOR indx=0 TO dCountRows-1
   CONTROLCMD(d2,lvDate,@LVGETTEXT,indx,0,tyyyy)
   CONTROLCMD(d2,lvDate,@LVGETTEXT,indx,1,tmm)
   CONTROLCMD(d2,lvDate,@LVGETTEXT,indx,2,tdd)
   CONTROLCMD(d2,lvDate,@LVGETTEXT,indx,3,tname)
IF LEN(tmm) < 2 THEN tmm = "0" + tmm
IF LEN(tdd) < 2 THEN tdd = "0" + tdd
   WRITE dFile,tyyyy+t+tmm+t+tdd+t+tname
NEXT indx
   CLOSEFILE dFile
ENDIF
ENDSUB

SUB DeleteLine()
   INT fnd=0
FOR lvi=0 TO dCountRows-1
IF CONTROLCMD(d2,lvDate,@LVGETSELECTED,lvi)
   CONTROLCMD(d2,lvDate,@LVDELETEITEM,lvi)
   fnd=1
ENDIF
NEXT lvi
IF fnd=1
   CONTROLCMD(d2,lvDate,@LVDELETEITEM,dCountRows)
ELSE
   MESSAGEBOX(d2,"There is no line selected to be deleted","Delete error",@MB_ICONEXCLAMATION|@MB_OK)
ENDIF
   RowCount()
   SENDMESSAGE d2,LVM_REDRAWITEMS,0,dCountRows,lvDate
ENDSUB

SUB RowCount()
   dCountRows=CONTROLCMD(d2,lvDate,@LVGETCOUNT)
   SETCAPTION d2,"Dates Editor ["+LTRIM$(STR$(dCountRows))+" entries]"
ENDSUB

SUB BeginSort()
   INT ColumnChanged
   ColumnChanged=0
IF LastClickedColumn<>ClickedColumn
   LastClickedColumn=ClickedColumn
   SortAscDesc=1
   ColumnChanged=1
ENDIF
IF GETSTATE(d2,2)=CHECKED
IF ColumnChanged=0
   SortAscDesc=NOT(SortAscDesc)
ENDIF
   SENDMESSAGE d2,LVM_SORTITEMSEX,0,&LVSortCallback2state,lvDate
ELSE
IF ColumnChanged=0
   SortAscDesc++
IF SortAscDesc=2 THEN SortAscDesc=-1
ENDIF
   SENDMESSAGE d2,LVM_SORTITEMSEX,0,&LVSortCallback3state,lvDate
ENDIF
ENDSUB

SUB LVSortCallback2state(lParam1:INT,lParam2:INT,lParamSort:UINT),INT
   lvi1.iItem=lParam1
   lvi2.iItem=lParam2
   lvi1.iSubItem=ClickedColumn 'The last clicked column
   lvi2.iSubItem=ClickedColumn 'The last clicked column
   lvi1.mask=LVIF_TEXT
   lvi2.mask=LVIF_TEXT
   lvi1.pszText=&txt1
   lvi2.pszText=&txt2
   lvi1.cchTextMax=260
   lvi2.cchTextMax=260
   SendMessageA(hListview,LVM_GETITEM,0,&lvi1)
   SendMessageA(hListview,LVM_GETITEM,0,&lvi2)
'Compare two strings
RETURN lstrcmpi(&txt1,&txt2)*SortAscDesc
ENDSUB

SUB LVSortCallback3state(lParam1:INT,lParam2:INT,lParamSort:UINT),INT
   INT CompareResult
   lvi1.iItem=lParam1
   lvi2.iItem=lParam2
   lvi1.iSubItem=ClickedColumn 'The last clicked column
   lvi2.iSubItem=ClickedColumn 'The last clicked column
IF (SortAscDesc=0)
   lvi1.iSubItem=0 'Sort by first column
   lvi2.iSubItem=0 'else sort by clicked column
ENDIF
   lvi1.mask=LVIF_TEXT
   lvi2.mask=LVIF_TEXT
   lvi1.pszText=&txt1
   lvi2.pszText=&txt2
   lvi1.cchTextMax=260
   lvi2.cchTextMax=260
   SendMessageA(hListview,LVM_GETITEM,0,&lvi1)
   SendMessageA(hListview,LVM_GETITEM,0,&lvi2)
IF (SortAscDesc<>0)
   CompareResult=lstrcmpi(&txt1,&txt2)*SortAscDesc
ELSE
   CompareResult=VAL(txt1)>VAL(txt2) 'The first subitem(0) is a numeric value
ENDIF
RETURN CompareResult
ENDSUB














