'Tablets Database - Version 1.4

$main

autodefine "off"

$include "windowssdk.inc"
$include "commctrl.inc"
$include "ishelllink.inc"
$include "ddoc.inc"
$include "ctl.inc"

DECLARE IMPORT,SHGetSpecialFolderLocation(hWnd:UINT,nFolder:INT,ppITEMIDLIST:POINTER),INT
DECLARE IMPORT,SHGetPathFromIDList(pItemIDList:POINTER,path:POINTER),INT
DECLARE IMPORT,PathFileExistsA(pszPath:POINTER),INT

TYPE DateType
	UINT LowDW
	UINT HighDW
ENDTYPE

UNION uDT
	UINT64 qVar
	DateType dtVar
ENDUNION
	uDT u,s,e,d
	SYSTEMTIME st
	FILETIME ft

ISTRING sDate[11],eDate[11],tDate[11]
INT iVar
FILE iniFile
UINT hLV,origfp,hStmt,rv,hEdit
INT row,panes[3],left,top,width,height,rtn
POINTER pDB,pReturn,p,lpFn
UINT currentColour
UINT colour1=0xF2E4D7 'Text row background, even rows - light blue - swap if required for light grey
UINT colour2=0xFFFFFF 'Text colour, all rows, black
UINT colour3=0x000000 'Text row background, odd rows, white
STRING lvStr
ISTRING iStmt[512],temp[512]
INT numCols,t,rowNum,ID,lv,loop,dd,mm,yyyy,answer,count
ISTRING recID[6],Name[33],Dosage[6],Started[11],RunsOut[11],Reorder[11],ISOdate[11]
INT InStock,PerDay,Repeat=0
ISTRING bDate[11],calToday[11],path[260]
'Listview sort variables
INT clickedColumn,lastClickedColumn,sortAscDesc,columnChanged
ISTRING txt1[260],txt2[260]
'DDoc variables
FLOAT lm,ls,fws3,fws4
INT hFile,lvCount,countClicked,selected,amount
'Windows
DIALOG about,prefs
WINDOW win

LVITEM lvi1,lvi2

TYPE NMCUSTOMDRAWINFO
	NMHDR hdr
	UINT dwDrawStage
	UINT hDC
	WINRECT rc
	UINT dwItemSpec
	UINT uItemState
	UINT lItemlParam
ENDTYPE

TYPE NMLVCUSTOMDRAW
	NMCUSTOMDRAWINFO nmcd
	UINT clrText
	UINT clrTextBk
'If internet explorer version >= 0x0400)
	INT iSubItem
ENDTYPE

OPENWINDOW win,0,0,1024,768,@MINBOX|@CAPTION|@SYSMENU,0,"Tablets Database",&main
	CONTROL win,@STATUS,"",0,0,0,0,0,450
	CONTROL win,@STATIC,"Tablets list",6,4,138,20,0,199
	CONTROL win,@STATIC,"Prescription",180,434,126,24,0,201
	CONTROL win,@STATIC,"Started Course",180,464,100,24,0,203
	CONTROL win,@STATIC,"Dosage",500,434,70,24,0,205
	CONTROL win,@STATIC,"Per Day",660,474,60,24,0,207
	CONTROL win,@STATIC,"In Stock",758,434,70,24,0,209
	CONTROL win,@STATIC,"Repeat Presc",700,524,60,40,0,211
	CONTROL win,@STATIC,"",720,566,160,60,@SS_CENTER,213
	SETCONTROLTEXT win,213,"Enter number of Tablets dispensed when receiving a Repeat Prescription. All values will be updated"
	SetFont win,"Verdana",8,400,@SFITALIC|0,213
	CONTROL win,@STATIC,"Record ID",12,640,126,16,@CTEDITCENTER,214
	CONTROL win,@STATIC,"Days to remind: 0",6,600,138,16,@CTEDITCENTER,215
	SetFont win,"Verdana",10,400,@SFITALIC|0,215
	CONTROL win,@LISTBOX,"",6,24,140,276,@CTLISTSORT|@VSCROLL|@BORDER,1
	CONTROL win,@LISTVIEW,"",150,0,862,400,@LVSREPORT|@BORDER|@VSCROLL,100
	CONTROL win,@BUTTON,"New Prescription",12,320,126,22,0,404
	CONTROL win,@BUTTON,"Cancel New",12,384,126,22,0,405
	CONTROL win,@BUTTON,"Save Prescription",12,352,126,22,0,406
	CONTROL win,@BUTTON,"Update Prescription",632,640,126,22,0,407
	CONTROL win,@BUTTON,"Cancel Update",832,640,126,22,0,408
	CONTROL win,@EDIT,"",310,430,160,24,@TABSTOP,202 'Prescription Name
	CONTROLCMD win,202,@EDSETLIMITTEXT,32
	CONTROL win,@EDIT,"",310,460,160,24,@TABSTOP,204 'Started
	CONTROL win,@EDIT,"",570,430,160,24,@CTEDITCENTER|@TABSTOP,206 'Dosage
	CONTROL win,@EDIT,"",830,430,160,24,@CTEDITNUMBER|@CTEDITCENTER|@TABSTOP,208 'Instock
	CONTROL win,@EDIT,"",720,470,160,24,@CTEDITNUMBER|@CTEDITCENTER|@TABSTOP,210 'PerDay
	CONTROL win,@EDIT,"",760,530,80,24,@CTEDITNUMBER|@CTEDITCENTER|@TABSTOP,212 'Repeat
	CONTROL win,@EDIT,"",35,660,80,24,@CTEDITRO|@CTEDITCENTER,216 'recID
	CalendarControl win,172,490,400,185,@BORDER,0,250

SENDMESSAGE win,SB_SETICON,0,LOADIMAGE(103,@IMGICON),450
	GETCLIENTSIZE win,left,top,width,height
	panes=width-600,900,-1
	CONTROLCMD win,450,@SWSETPANES,3,panes
	SENDMESSAGE win,SB_SETBKCOLOR,0,RGB(247,217,196),450

ENABLETABS win,1
	SETWINDOWCOLOR win,GetSysColor(15)

ccSetColor win,250,MCSC_BACKGROUND,RGB(240,240,240)
	ccSetColor win,250,MCSC_TEXT,RGB(98,22,41)
	ccSetColor win,250,MCSC_TITLEBK,RGB(98,22,41)
	ccSetColor win,250,MCSC_TITLETEXT,RGB(255,255,255)
	ccSetColor win,250,MCSC_MONTHBK,RGB(240,240,240)
	ccSetColor win,250,MCSC_TRAILINGTEXT,RGB(70,70,70)

BEGINMENU win
	MENUTITLE "&File"
	MENUITEM "&Preferences",0,5
	SEPARATOR
	MENUITEM "Print All\tCtrl+P",0,6
	MENUITEM "Print Form\tCtrl+F",0,8
	SEPARATOR
	MENUITEM "E&xit Tablets",0,1
	MENUTITLE "&Edit"
	MENUITEM "&New Prescription",0,2
	MENUITEM "&Save Prescription",0,3
	MENUITEM "&Cancel Save",0,4
	MENUTITLE "&Utilities"
	MENUITEM "Reset Listview columns",0,10
	SEPARATOR
	MENUITEM "Compact &Database...",0,11
	MENUITEM "Database &Backup...",0,7
	SEPARATOR
	MENUITEM "Create Des&ktop Shortcut",0,12
	MENUTITLE "&Help"
	MENUITEM "&Tablets Help...\tCtrl+H",0,13
	SEPARATOR
	MENUITEM "&About Tablets...",0,14
ENDMENU

'Register hot key
	RegisterHotKey(win.hWnd,0x1000,0x2,0x50) 'Ctrl+P prints all lines
	RegisterHotKey(win.hWnd,0x1001,0x2,0x46) 'Ctrl+F prints prescription form
	RegisterHotKey(win.hWnd,0x1002,0x2,0x48) 'Ctrl+H calls the help file

'Load bitmaps for menus
UINT hBmp1=LOADIMAGE(301,@IMGBITMAP)
	UINT hBmp2=LOADIMAGE(302,@IMGBITMAP)
	UINT hBmp3=LOADIMAGE(303,@IMGBITMAP)
	UINT hBmp4=LOADIMAGE(304,@IMGBITMAP)
	UINT hBmp5=LOADIMAGE(305,@IMGBITMAP)
	UINT hBmp6=LOADIMAGE(306,@IMGBITMAP)
	UINT hBmp7=LOADIMAGE(307,@IMGBITMAP)
	UINT hBmp8=LOADIMAGE(308,@IMGBITMAP)
	UINT hBmp9=LOADIMAGE(309,@IMGBITMAP)
	UINT hBmp10=LOADIMAGE(310,@IMGBITMAP)
	UINT hBmp11=LOADIMAGE(311,@IMGBITMAP)
	UINT hBmp12=LOADIMAGE(312,@IMGBITMAP)
	UINT hBmp13=LOADIMAGE(313,@IMGBITMAP)
'Add bitmaps to menus. First get the menu handle of the application
	UINT hMenu=GetMenu(win.hWnd)
'Then get the handle of the first submenu
	UINT hSubmenu=GetSubMenu(hMenu,0)
'File menu
UINT hID=GetMenuItemID(hSubmenu,0)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp5,hBmp5)
hID=GetMenuItemID(hSubmenu,2)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp6,hBmp6)
hID=GetMenuItemID(hSubmenu,3)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp13,hBmp13)
hID=GetMenuItemID(hSubmenu,5)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp1,hBmp1)
'Edit menu
	hSubmenu=GetSubMenu(hMenu,1)
hID=GetMenuItemID(hSubmenu,0)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp2,hBmp2)
hID=GetMenuItemID(hSubmenu,1)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp4,hBmp4)
hID=GetMenuItemID(hSubmenu,2)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp3,hBmp3)
'Utilities menu
	hSubmenu=GetSubMenu(hMenu,2)
hID=GetMenuItemID(hSubmenu,0)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp7,hBmp7)
hID=GetMenuItemID(hSubmenu,2)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp9,hBmp9)
hID=GetMenuItemID(hSubmenu,3)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp8,hBmp8)
hID=GetMenuItemID(hSubmenu,5)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp10,hBmp10)
'About menu
	hSubmenu=GetSubMenu(hMenu,3)
hID=GetMenuItemID(hSubmenu,0)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp12,hBmp12)
hID=GetMenuItemID(hSubmenu,2)
	SetMenuItemBitmaps(hMenu,hID,MF_BITMAP,hBmp11,hBmp11)

'Subclass the listview control
	hLV=GetDlgItem(win.hWnd,100)
	origfp=GetWindowLongA(hLV,GWL_WNDPROC)
'Replace it with our main...
	SetWindowLongA(hLV,GWL_WNDPROC,&myLVHandler)

'Set up Listview header titles
	CONTROLCMD win,100,@LVINSERTCOLUMN,0,"ID"
	CONTROLCMD win,100,@LVINSERTCOLUMN,1,"recID"
	CONTROLCMD win,100,@LVINSERTCOLUMN,2,"Prescription"
	CONTROLCMD win,100,@LVINSERTCOLUMN,3,"Started Course"
	CONTROLCMD win,100,@LVINSERTCOLUMN,4,"Dosage Mg"
	CONTROLCMD win,100,@LVINSERTCOLUMN,5,"In Stock"
	CONTROLCMD win,100,@LVINSERTCOLUMN,6,"Per Day"
	CONTROLCMD win,100,@LVINSERTCOLUMN,7,"Runs Out"
	CONTROLCMD win,100,@LVINSERTCOLUMN,8,"Reorder"
	CONTROLCMD win,100,@LVINSERTCOLUMN,9,"ISOdate"
'Set Listview Header column widths
	SetLV()
SUB SetLV()
	CONTROLCMD win,100,@LVSETCOLWIDTH,0,0
	CONTROLCMD win,100,@LVSETCOLWIDTH,1,0
	CONTROLCMD win,100,@LVSETCOLWIDTH,2,200
	CONTROLCMD win,100,@LVSETCOLWIDTH,3,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,4,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,5,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,6,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,7,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,8,110
	CONTROLCMD win,100,@LVSETCOLWIDTH,9,0
ENDSUB
'Send Listview messages - gridlines and fullrowselect
	SENDMESSAGE win,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_GRIDLINES|LVS_EX_FULLROWSELECT,100
'Set text and background colours
	SENDMESSAGE win,0x1001,0,0xF0F0F0,100 'Set Back Colour
	SENDMESSAGE win,0x1024,0,0x000000,100 'Set Text Colour
	SENDMESSAGE win,0x1026,0,0xFFC078,100 'Set Text Back Colour
	RECT win,150,410,862,282,RGB(120,192,255),GetSysColor(15)

'Get the user name
string strUser
	int gunA=255
	GetUserNameA(strUser,&gunA)
'Get the computer name
string strComp
	int gcnA=255
	GetComputerNameA(strComp,&gcnA)

'Sub-class Dosage control
	NumEditSubclass(win,206)

SETCONTROLCOLOR win,1,RGB(255,255,255),RGB(112,128,144)
	SETFONT win,"Tahoma",10,600,0,1
	SetFont win,"Bahnschrift Regular",10,500,0,100
	SETCONTROLCOLOR win,199,RGB(112,128,144),GetSysColor(15)
	SETFONT win,"Tahoma",10,600,0,199
	SetFont win,"Verdana",10,400,0,214
	SetFont win,"Verdana",10,400,0,216
FOR loop=201 TO 211 STEP 2
	SetFont win,"Verdana",10,400,0,loop
NEXT loop
	SETCONTROLCOLOR win,216,0x0,RGB(201,228,222)
FOR loop=202 TO 210 STEP 2
	SETCONTROLCOLOR win,loop,0x0,0xF1DEC6
	SetFont win,"Verdana",10,400,0,loop
NEXT loop
FOR loop=404 TO 408
	SetFont win,"Verdana",8,400,0,loop
NEXT loop
SETCONTROLCOLOR win,212,0x0,0xC2C2F4
	SetFont win,"Verdana",10,400,0,212
SETCONTROLCOLOR win,404,0x0,RGB(247,217,196)
	SETCONTROLCOLOR win,405,0x0,RGB(198,222,241)
	SETCONTROLCOLOR win,406,0x0,RGB(201,228,222)
	SETCONTROLCOLOR win,407,0x0,RGB(201,228,222)
	SETCONTROLCOLOR win,408,0x0,RGB(198,222,241)

ENABLECONTROL win,404,1
	ENABLECONTROL win,405,0
	ENABLECONTROL win,406,0
	ENABLECONTROL win,407,0
	ENABLECONTROL win,408,0

ENABLEMENUITEM win,2,1
	ENABLEMENUITEM win,3,0
	ENABLEMENUITEM win,4,0

'Preferences stuff
INT OrderBy=8
'Open Ini file and load saved settings
IF(OPENFILE(iniFile,GETSTARTPATH+"Tablets.ini","R")=0)
	READ iniFile,OrderBy
	CLOSEFILE iniFile
	SETCONTROLTEXT win,215,"Days to remind:"+STR$(OrderBy)
ELSE
	MESSAGEBOX win,"Preferences File not found. Please select\nFile > Preferences to set Repeat Prescription days","Initialisation error",48
ENDIF

'Make sure backup directory exists, if not create
IF DirExists(GETSTARTPATH+"backup")=0
	INT create=CREATEDIR(GETSTARTPATH+"backup")
IF create=0 THEN MESSAGEBOX win,"Could not create "+GETSTARTPATH+"backup","Directory creation error",0x0|0x10
ENDIF

CREATEDIALOG about,0,0,300,150,0x80C80080,win,"About Tablets",&DoAbout
	CONTROL about,@GROUPBOX,"",6,6,288,136,0x50000007,1
	CONTROL about,@STATIC,"Tablets Database 1.4",14,24,274,14,0x50000101,2
	CONTROL about,@STATIC,"Designed and written by B. D. Pugh",14,42,274,14,0x50000101,3
	CONTROL about,@STATIC,"Version 1.4 - February 2024",14,58,274,14,0x50000101,4
	CONTROL about,@STATIC,"Written and compiled in IWBasic 2.095",14,74,274,14,0x50000101,5
	CONTROL about,@STATIC,"Copyright © Brian D. Pugh",14,90,274,14,0x50000101,6
	CONTROL about,@BUTTON,"OK",110,110,80,20,0x0,7

'Preferences
CREATEDIALOG prefs,0,0,230,96,0x80C80080,win,"Set Preferences",&PrefsSub
	CONTROL prefs,@STATIC,"Days to order a Repeat Prescription:",10,10,248,16,0x5000010B,1
	CONTROL prefs,@EDIT,"",90,28,50,20,@TABSTOP|@CTEDITNUMBER|@CTEDITCENTER,2
	CONTROL prefs,@BUTTON,"OK",38,64,58,20,0x50010001,3
	CONTROL prefs,@BUTTON,"Cancel",134,64,58,20,0x50010000,4

CONTROLCMD win,450,@SWSETPANETEXT,0,"Tablets  -  User: "+strUser+" on "+strComp
	CONTROLCMD win,450,@SWSETPANETEXT,1,DATE$("dddd', 'MMMM d, yyyy")
	CONTROLCMD win,450,@SWSETPANETEXT,2,TIME$
	STARTTIMER win,450,1

UINT gif=LOADIMAGE(104,@IMGSCALABLE)
	SHOWIMAGE win,gif,@IMGSCALABLE,12,440,128,128

	pDB=OpenDatabase(win)
IF pDB=NULL
	CLOSEWINDOW win
	END
ELSE
	SetupDB()
	ClearAndLoadLB()
ENDIF

WAITUNTIL ISWINDOWCLOSED(win)
IF hStmt THEN dbFreeSQL(hStmt)
IF pDB<>NULL THEN dbDisconnect(pDB)
	STOPTIMER win,1
	DELETEIMAGE 101,@IMGICON
	DELETEIMAGE 103,@IMGICON
	DELETEIMAGE 104,@IMGSCALABLE
FOR loop=301 TO 313
	DELETEIMAGE loop,@IMGBITMAP
NEXT loop
	SetWindowLongA(hLV,GWL_WNDPROC,origfp)
	NumEditUnSubclass(win,206)
'Unregister hot keys
	UnregisterHotKey(win.hWnd,0x1000)
	UnregisterHotKey(win.hWnd,0x1001)
	UnregisterHotKey(win.hWnd,0x1002)
END

SUB main(),INT
	SELECT @MESSAGE
CASE @IDCREATE
	CENTERWINDOW win
	SETICON win,LOADIMAGE(101,@IMGICON)
CASE @IDCLOSEWINDOW
	CLOSEWINDOW win
CASE @IDSIZE
	CONTROLCMD win,450,@SWRESIZE
CASE @IDTIMER 'Update statusbar time
	CONTROLCMD win,450,@SWSETPANETEXT,2,TIME$
CASE @IDMENUINIT
CASE WM_HOTKEY
	SELECT @CODE
CASE 0x1000 'Ctrl+P prints all lines
	loop=1
	RedrawLV()
	PrintAll()
	loop=0
	RedrawLV()
CASE 0x1001 'Ctrl+F prints form
	PrintForm()
CASE 0x1002 'Ctrl+H displays help file
	SYSTEM GETSTARTPATH+"Tablets.chm"
ENDSELECT
CASE @IDMENUPICK
	SELECT @MENUNUM
CASE 1 'Exit Tablets
	CLOSEWINDOW win
CASE 2 'Create New Listing
	DoNew()
CASE 3 'Save New Listing
	DoSave()
CASE 4 'Cancel Create
	DoCancel()
CASE 5 'Preferences
	DOMODAL prefs
CASE 6 'Print All Lines
	loop=1
	RedrawLV()
	PrintAll()
	loop=0
	RedrawLV()
CASE 7 'Backup Database
	BackupMDB()
CASE 8 'Print presc form
	PrintForm()
CASE 10 'Reset Listview Header columns
	SetLV()
	RedrawLV()
CASE 11 'Compact Database
	answer=MESSAGEBOX(win,"You are about to compact the Tablets database. Press OK to\ncontinue if you are sure, otherwise please press Cancel","Compact Database",@MB_OKCANCEL|0x100|@MB_ICONEXCLAMATION)
IF answer=@IDOK 'Close DB
	SETCAPTION win,"Tablets  -  Compacting Database..."
	SETCURSOR win,@CSWAIT
IF hStmt THEN dbFreeSQL(hStmt)
	dbDisconnect(pDB)
	answer=CompactMDB(GETSTARTPATH+"Tablets.mdb")
IF answer=0
	Sleep(500)
	MESSAGEBOX(win,"Compact completed","Done",@MB_ICONINFORMATION)
ELSE
	MESSAGEBOX(win,"Compact failed","Error",@MB_ICONEXCLAMATION)
ENDIF
	SETCURSOR win,@CSARROW
	SETCAPTION win,"Tablets Database"
	pDB=OpenDatabase(win) 'Reopen DB
ENDIF
CASE 12 'Create Shortcut
	CreateShortcut()
CASE 13 'Help
	SYSTEM GETSTARTPATH+"Tablets.chm"
CASE 14 'Do About
	DOMODAL about
ENDSELECT

CASE @IDCONTROL
	SELECT @CONTROLID
CASE 250 'Get Date from Calendar
	ccGetCurSel win,250,mm,dd,yyyy
	bDate=fixCalendarDate()
	SETCONTROLTEXT win,204,bDate
CASE 404 'Create new listing
	DoNew()
CASE 405 'Cancel create
	DoCancel()
CASE 406 'Save new prescription
	DoSave()
CASE 407 'Update prescription
	EditUpdate()
CASE 408 'Edit Cancel
	DoCancel()
	ENABLECONTROL win,408,0
CASE 100 'Listview
	SELECT @NOTIFYCODE

CASE @LVNCOLUMNCLICK
	clickedColumn=*<NMLISTVIEW>@LPARAM.iSubItem
	BeginSort()

CASE @NMCLICK 'User selects a line in the Listview
	lv=*<NMLISTVIEW>@LPARAM.iItem
IF lv > -1
	CONTROLCMD win,100,@LVSETSELECTED,lv
	SENDMESSAGE win,0x1000+19,lv,0,100 'LVM_ENSUREVISIBLE
	ENABLEMENUITEM win,5,TRUE
ELSE
	ENABLEMENUITEM win,5,FALSE
ENDIF

CASE @NMRCLICK 'Right click to delete a line
	lv=*<NMLISTVIEW>@LPARAM.iItem
	answer=MESSAGEBOX(win,"Delete this line?\n\nWarning - This action can't be undone!","Delete a Line",@MB_OKCANCEL|0x100|@MB_ICONEXCLAMATION)
IF answer=@IDOK
IF lv > -1
	CONTROLCMD(win,100,@LVGETTEXT,lv,1,lvStr,255) 'recID
	iStmt="DELETE FROM tablets WHERE recID="+lvStr
	hStmt=dbExecSQL(pDB,iStmt)
	CONTROLCMD win,100,@LVDELETEITEM,lv
	temp=dbGetErrorCode(hStmt)
IF LEN(temp)
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,temp
ENDIF
ENDIF
	dbFreeSQL(hStmt)
	hStmt=NULL
	ClearAndLoadLB()
	RedrawLV()
ELSE
	SETFOCUS win,100
ENDIF

CASE @NMDBLCLK 'Double click listview to retrieve a record
	lv=*<NMLISTVIEW>@LPARAM.iItem
IF lv > -1
	CONTROLCMD(win,100,@LVGETTEXT,lv,1,lvStr,255) 'RecID
	SETCONTROLTEXT win,216,lvStr
	CONTROLCMD(win,100,@LVGETTEXT,lv,2,lvStr,255) 'Name
	SETCONTROLTEXT win,202,lvStr
	CONTROLCMD(win,100,@LVGETTEXT,lv,3,lvStr,255) 'Started
	SETCONTROLTEXT win,204,lvStr
	CONTROLCMD(win,100,@LVGETTEXT,lv,4,lvStr,255) 'Dosage
	SETCONTROLTEXT win,206,lvStr
	CONTROLCMD(win,100,@LVGETTEXT,lv,5,lvStr,255) 'In Stock
	SETCONTROLTEXT win,208,lvStr
	InStock=VAL(lvStr)
	CONTROLCMD(win,100,@LVGETTEXT,lv,6,lvStr,255) 'Per Day
	SETCONTROLTEXT win,210,lvStr
	PerDay=VAL(lvStr)
	SETCONTROLTEXT win,212,LTRIM$(STR$(Repeat))
ENDIF
	ENABLECONTROL win,404,0
	ENABLECONTROL win,405,0
	ENABLECONTROL win,406,0
	ENABLECONTROL win,407,1
	ENABLECONTROL win,408,1
	ENABLEMENUITEM win,2,0
	ENABLEMENUITEM win,3,0
	ENABLEMENUITEM win,4,0

CASE NM_CUSTOMDRAW
RETURN ColourListView(win.hWnd,@LPARAM) 'Colour the listview items
ENDSELECT
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

'Listview sorting sub-routine
SUB BeginSort()
	ColumnChanged=0
IF LastClickedColumn<>ClickedColumn
	LastClickedColumn=ClickedColumn
	SortAscDesc=1
	ColumnChanged=1
ENDIF
IF ColumnChanged=0 THEN SortAscDesc = 0 - SortAscDesc
	SENDMESSAGE win,LVM_SORTITEMSEX,0,&LVSortCallback2State,100
ENDSUB

SUB LVSortCallback2State(lParam1:INT,lParam2:INT,lParamSort:UINT),INT
	ZeroMemory(lvi1,LEN(lvi1))
	ZeroMemory(lvi2,LEN(lvi2))
	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(hLV,LVM_GETITEM,0,&lvi1)
	SendMessageA(hLV,LVM_GETITEM,0,&lvi2)
RETURN lstrcmpi(&txt1,&txt2)*SortAscDesc
ENDSUB

SUB DoNew() 'New record
	DoMax()
	ENABLECONTROL win,404,0
	ENABLECONTROL win,405,1
	ENABLECONTROL win,406,1
	ENABLECONTROL win,407,0
	ENABLECONTROL win,408,0
	ENABLEMENUITEM win,2,0
	ENABLEMENUITEM win,3,1
	ENABLEMENUITEM win,4,1
	setcontroltext win,202,""
	setcontroltext win,204,DATE$("dd-MM-yyyy")
	setcontroltext win,206,""
	setcontroltext win,208,""
	setcontroltext win,210,""
	Repeat=0
	SETCONTROLTEXT win,212,LTRIM$(STR$(Repeat))
	SETCONTROLTEXT win,216,LTRIM$(recID)
	SETFOCUS win,202
ENDSUB

SUB DoSave() 'Save new record
	ENABLECONTROL win,404,1
	ENABLECONTROL win,405,0
	ENABLECONTROL win,406,0
	ENABLECONTROL win,407,0
	ENABLECONTROL win,408,0
	ENABLEMENUITEM win,2,1
	ENABLEMENUITEM win,3,0
	ENABLEMENUITEM win,4,0
	CopyData()
'Insert a blank record
	iStmt="INSERT INTO tablets (recID,Name,Started,Dosage,InStock,PerDay,RunsOut,Reorder,ISOdate) "
	iStmt+="VALUES("+LTRIM$(STR$(ID))+",'','',0,0,0,'','','')"
	hStmt=dbExecSQL(pDB,iStmt)
	temp=dbGetErrorCode(hStmt)
IF LEN(temp)
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,temp
ENDIF
	dbFreeSQL(hStmt)
	hStmt=NULL
'Insert correct data into new record
	iStmt="UPDATE tablets SET Name=?,Started=?,Dosage=?,InStock=?,PerDay=?,RunsOut=?,Reorder=?,ISOdate=? WHERE recID="+LTRIM$(STR$(ID))
	hStmt=dbPrepareSQL(pDB,iStmt)
	dbBindParameter(hStmt,1,Name,32)
	dbBindParameter(hStmt,2,Started,10)
	dbBindParameter(hStmt,3,Dosage,5)
	dbBindPARAMETER(hStmt,4,InStock,5)
	dbBindParameter(hStmt,5,PerDay,5)
	dbBindParameter(hStmt,6,RunsOut,10)
	dbBindParameter(hStmt,7,Reorder,10)
	dbBindParameter(hStmt,8,ISOdate,10)
	dbExecute(hStmt)
IF LEN(dbGetErrorCode(hStmt))
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,dbGetErrorCode(hStmt)
ENDIF
	SETCONTROLTEXT win,202,""
	SETCONTROLTEXT win,204,""
	SETCONTROLTEXT win,206,""
	SETCONTROLTEXT win,208,""
	SETCONTROLTEXT win,210,""
	Repeat=0
	SETCONTROLTEXT win,212,LTRIM$(STR$(Repeat))
	SETCONTROLTEXT win,216,""
'Reset the Calendar control to today's date
	calToday=DATE$("MM-dd-yyyy")
	ccSetCurSel(win,250,VAL(LEFT$(calToday,4)),VAL(MID$(calToday,4,2)),VAL(RIGHT$(calToday,4))) 'm,d,y
	dbFreeSQL(hStmt)
	hStmt=NULL
	ClearAndLoadLB()
	RedrawLV()
ENDSUB

SUB DoCancel() 'Cancel update
	ENABLECONTROL win,404,1
	ENABLECONTROL win,405,0
	ENABLECONTROL win,406,0
	ENABLECONTROL win,407,0
	ENABLECONTROL win,408,0
	ENABLEMENUITEM win,2,1
	ENABLEMENUITEM win,3,0
	ENABLEMENUITEM win,4,0
	SETCONTROLTEXT win,202,""
	SETCONTROLTEXT win,204,""
	SETCONTROLTEXT win,206,""
	SETCONTROLTEXT win,208,""
	SETCONTROLTEXT win,210,""
	Repeat=0
	SETCONTROLTEXT win,212,LTRIM$(STR$(Repeat))
	SETCONTROLTEXT win,216,""
'Reset the Calendar control to today's date
	calToday=DATE$("MM-dd-yyyy")
	ccSetCurSel(win,250,VAL(LEFT$(calToday,4)),VAL(MID$(calToday,4,2)),VAL(RIGHT$(calToday,4))) 'm,d,y
	SETFOCUS win,100
	CONTROLCMD win,100,@LVSETSELECTED,lv
ENDSUB

SUB EditUpdate()
	hStmt=NULL
	Repeat=VAL(GETCONTROLTEXT(win,212))
IF Repeat=0
	CopyData()
ELSE
	CONTROLCMD(win,100,@LVGETTEXT,row,3,sDate,11) 'Start Date
	sDate=RIGHT$(sDate,4)+MID$(sDate,3,4)+LEFT$(sDate,2)
	eDate=DATE$("yyyy-MM-dd") 'End Date is today
	Elapsed(sDate,eDate)
	Name=GETCONTROLTEXT(win,202)
	Started=DATE$("dd-MM-yyyy") 'Reset Started Course to now
	Dosage=GETCONTROLTEXT(win,206)
	InStock=VAL(GETCONTROLTEXT(win,208))
	Repeat=VAL(GETCONTROLTEXT(win,212))
	InStock+=Repeat
	InStock-=iVar
	PerDay=VAL(GETCONTROLTEXT(win,210))
	RunsOut=DateMath(Started,InStock/PerDay)
	Reorder=DateMath(RunsOut,-OrderBy)
	ISOdate=RIGHT$(Reorder,4)+MID$(Reorder,3,4)+LEFT$(Reorder,2)
	recID=GETCONTROLTEXT(win,216)
	ID=VAL(recID)
ENDIF
	iStmt="UPDATE tablets SET Name=?,Started=?,Dosage=?,InStock=?,PerDay=?,RunsOut=?,Reorder=?,ISOdate=? WHERE recID="+LTRIM$(STR$(ID))
	hStmt=dbPrepareSQL(pDB,iStmt)
	dbBindParameter(hStmt,1,Name,32)
	dbBindParameter(hStmt,2,Started,10)
	dbBindParameter(hStmt,3,Dosage,5)
	dbBindParameter(hStmt,4,InStock,5)
	dbBindParameter(hStmt,5,PerDay,5)
	dbBindParameter(hStmt,6,RunsOut,10)
	dbBindParameter(hStmt,7,Reorder,10)
	dbBindParameter(hStmt,8,ISOdate,10)
	dbExecute(hStmt)
IF LEN(dbGetErrorCode(hStmt))
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,dbGetErrorCode(hStmt)
ENDIF
	dbFreeSQL(hStmt)
	hStmt=NULL
	ENABLECONTROL win,404,1
	ENABLECONTROL win,405,0
	ENABLECONTROL win,406,0
	ENABLECONTROL win,407,0
	ENABLECONTROL win,408,0
	ENABLEMENUITEM win,2,1
	ENABLEMENUITEM win,3,0
	ENABLEMENUITEM win,4,0
	SETCONTROLTEXT win,202,""
	SETCONTROLTEXT win,204,""
	SETCONTROLTEXT win,206,""
	SETCONTROLTEXT win,208,""
	SETCONTROLTEXT win,210,""
	Repeat=0
	SETCONTROLTEXT win,212,LTRIM$(STR$(Repeat))
	SETCONTROLTEXT win,216,""
'Reset the Calendar control to today's date
	calToday=DATE$("MM-dd-yyyy")
	ccSetCurSel(win,250,VAL(LEFT$(calToday,4)),VAL(MID$(calToday,4,2)),VAL(RIGHT$(calToday,4))) 'm,d,y
	ClearAndLoadLB()
	RedrawLV()
	SETFOCUS win,100
ENDSUB

SUB ClearAndLoadLB()
IF pDB<>NULL
	conReset(win,1)
	hStmt=dbExecSql(pDB,"SELECT DISTINCT Name FROM tablets") 'Listbox is in sort order
WHILE dbGet(hStmt)
	dbGetData(hStmt,1,Name)
	ADDSTRING win,1,Name
ENDWHILE
	dbFreeSQL(hStmt)
	hStmt=NULL
ENDIF
ENDSUB

SUB ColourListView(hWnd:UINT,lParam:UINT),UINT
	row=*<NMLVCUSTOMDRAW>lParam.nmcd.dwItemSpec
IF (row % 2) THEN currentColour=colour2 ELSE currentColour=colour1
	SELECT *<NMLVCUSTOMDRAW>lParam.nmcd.dwDrawStage
CASE CDDS_PREPAINT
	rv=CDRF_NOTIFYITEMDRAW
CASE CDDS_ITEMPREPAINT
	rv=CDRF_NOTIFYSUBITEMDRAW
CASE CDDS_SUBITEMPREPAINT
	*<NMLVCUSTOMDRAW>lParam.clrText=colour3
	*<NMLVCUSTOMDRAW>lParam.clrTextBk=currentColour
	rv=CDRF_NEWFONT
	SELECT *<NMLVCUSTOMDRAW>lParam.iSubItem
CASE 8 'The Reorder column colour
	sDate=DATE$("yyyy-MM-dd") 'Start Date is today
	CONTROLCMD(win,100,@LVGETTEXT,row,7,eDate,11) 'End Date - Runs Out column
	eDate=RIGHT$(eDate,4)+MID$(eDate,3,4)+LEFT$(eDate,2)
	Elapsed(sDate,eDate)
'iVar holds the difference in days; OrderBy is the number of days required to re-order prescription
IF iVar<=OrderBy
	*<NMLVCUSTOMDRAW>lParam.clrText=RGB(255,255,255)
	*<NMLVCUSTOMDRAW>lParam.clrTextBk=RGB(235,76,66)
ENDIF
ENDSELECT
DEFAULT
	rv=CDRF_DODEFAULT
ENDSELECT
RETURN rv
ENDSUB

'Change the colour of the Header Control columns
SUB myLVHandler(hWnd:INT,uMsg:INT,wParam:INT,lParam:POINTER),INT
	SELECT uMsg
CASE WM_NOTIFY
IF (#<NMHDR>lParam.code=NM_CUSTOMDRAW)
	SELECT (#<NMCUSTOMDRAWINFO>lParam.dwDrawStage)
CASE CDDS_PREPAINT
	RETURN CDRF_NOTIFYITEMDRAW
CASE CDDS_ITEMPREPAINT
	SELECT #<NMCUSTOMDRAWINFO>lParam.dwItemSpec
CASE 2
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(198,222,241)) 'Blue
CASE 3
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(247,217,196)) 'Amber
CASE 4
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(201,228,222)) 'Pink
CASE 5
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(242,198,222)) 'Green
CASE 6
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(198,222,241)) 'Blue
CASE 7
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(201,228,222)) 'Green
CASE 8
	SetTextColor(#<NMCUSTOMDRAWINFO>lParam.hDC,0x0)
	SetBkColor(#<NMCUSTOMDRAWINFO>lParam.hDC,RGB(247,217,196)) 'Pink
ENDSELECT
RETURN CDRF_NEWFONT
ENDSELECT
RETURN CDRF_DODEFAULT
ENDIF
ENDSELECT
RETURN CallWindowProcA(origfp,hWnd,uMsg,wParam,lParam)
ENDSUB

SUB OpenDatabase(win:WINDOW),POINTER 'Open Database, create new one if not there
	pReturn=dbConnect("Microsoft Access Driver (*.mdb)",GETSTARTPATH+"Tablets.mdb","",win)
IF pReturn=NULL
'Couldn't open, so try creating
	dbCreateMDB(GETSTARTPATH+"Tablets.mdb")
	pReturn=dbConnect("Microsoft Access Driver (*.mdb)",GETSTARTPATH+"Tablets.mdb","",win)
IF pReturn<>NULL
'Create Tablets table
	iStmt="CREATE TABLE tablets (id COUNTER(1,1),recID INTEGER,Name VARCHAR(32),Started CHAR(10),Dosage VARCHAR(5),InStock INTEGER,PerDay INTEGER,RunsOut CHAR(10),Reorder CHAR(10),ISOdate CHAR(10))"
	hStmt=dbExecSQL(pReturn,iStmt)
'Check for errors
IF LEN(dbGetErrorCode(hStmt))
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,dbGetErrorCode(hStmt)
ENDIF
	dbFreeSQL(hStmt)
	hStmt=NULL
'Create index on ISOdate field
	iStmt="CREATE INDEX idxUSdate ON tablets (ISOdate)"
	hStmt=dbExecSQL(pReturn,iStmt)
	dbFreeSQL(hStmt)
	hStmt=NULL
ELSE
	MESSAGEBOX win,"Could not connect or create Tablets Database","Database error"
ENDIF
ENDIF
IF pReturn<>NULL
	count=dbCardinality(pReturn,"tablets")
ENDIF
RETURN pReturn
ENDSUB

SUB DateMath(dateID:STRING,diff:INT),STRING
'First get the system time so that all the other structure members are filled
	GetSystemTime(st)
'Set up the SYstructure with the original date like so:
	st.wDay=VAL(LEFT$(dateID,2))
	st.wMonth=VAL(MID$(dateID,4,2))
	st.wYear=VAL(RIGHT$(dateID,4))
'Convert the system time to filetime
	rtn=SystemTimeToFileTime(st,ft)
'Move the FILETIME info into a UINT64 variable and add days using the Quad variable (this is how M$ recommends doing it)
	u.dtVar.LowDW=ft.dwLowDateTime
	u.dtVar.HighDW=ft.dwHighDateTime
'Add days using the Quad variable - 1 day in nano seconds 24 * 60 * 60 * 10000000
	u.qVar+=((24*60*60*10000000)*diff) ' <---- diff days
	ft.dwLowDateTime=u.dtVar.LowDW
	ft.dwHighDateTime=u.dtVar.HighDW
'Convert the file time to system time
	rtn=FileTimeToSystemTime(ft,st)
'Now your new date will be in the SYSTEMTIME structure members
	dd=st.wDay
	mm=st.wMonth
	yyyy=st.wYear
RETURN USING("0##",dd)+"-"+USING("0##",mm)+"-"+USING("0####",yyyy)
ENDSUB

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

SUB CompactMDB(path:STRING),HRESULT
'Returns zero on success
	ISTRING newPath[MAX_PATH]=path
	HRESULT iHresult=E_FAIL
	IDispatch engine
	newPath[LEN(newPath)-1]=`1`
'1. DAO engine at least 3.5
	DELETEFILE newPath
	engine=CreateComObject("DAO.DBEngine.120")
IF (!engine) THEN engine=CreateComObject("DAO.DBEngine.36")
IF (!engine) THEN engine=CreateComObject("DAO.DBEngine.35")
IF (engine)
	iHresult=engine.CompactDatabase(path,newPath)
	engine->Release()
IF (CompactMDB_Replace(iHresult,path,newPath)) THEN RETURN 0
ENDIF
'2. JRO, MDAC must be at least 2.1
	DELETEFILE newPath
	engine=CreateComObject("JRO.JetEngine")
IF (engine)
	iHresult=engine.CompactDatabase(APPEND$("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=",path), _
	APPEND$("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=",newPath))
	engine->Release()
IF (CompactMDB_Replace(iHresult,path,newPath)) THEN RETURN 0
ENDIF
'3. Use Access
	DELETEFILE newPath
	engine=CreateComObject("Access.Application")
IF (engine)
	iHresult=engine.DBEngine.CompactDatabase(path,newPath)
	engine->Release()
IF (CompactMDB_Replace(iHresult,path,newPath)) THEN RETURN 0
ENDIF
RETURN iHresult ? iHresult : E_FAIL
ENDSUB

SUB CompactMDB_Replace(iHresult:INT,path:STRING,newPath:STRING),BOOL
	INT success=FALSE
IF (iHresult>=0 AND PathFileExistsA(newPath))
IF (PathFileExistsA(path))
	SHFILEOPSTRUCT SHop=0
	SHop.wFunc=FO_DELETE
	SHop.pFrom=path
	SHop.fFlags=FOF_NOCONFIRMATION|FOF_ALLOWUNDO
IF (SHFileOperation(&SHop)) THEN RETURN FALSE
ENDIF
	success=MoveFileA(newPath,path)
ENDIF
RETURN success
ENDSUB

SUB CopyData() 'From edit controls to variables
	Name=GETCONTROLTEXT(win,202)
	Started=GETCONTROLTEXT(win,204)
	Dosage=GETCONTROLTEXT(win,206)
	InStock=VAL(GETCONTROLTEXT(win,208))
	Repeat=VAL(GETCONTROLTEXT(win,212))
	InStock+=Repeat
	PerDay=VAL(GETCONTROLTEXT(win,210))
	RunsOut=DateMath(Started,InStock/PerDay)
	Reorder=DateMath(RunsOut,-OrderBy)
	ISOdate=RIGHT$(Reorder,4)+MID$(Reorder,3,4)+LEFT$(Reorder,2)
	recID=GETCONTROLTEXT(win,216)
	ID=VAL(recID)
ENDSUB

SUB RedrawLV() 'Redraw Listview
IF pDB<>NULL
	conDrawOff(win,100)
IF loop=1
	hStmt=dbExecSql(pDB,"SELECT * FROM tablets ORDER BY Name")
ELSE
	hStmt=dbExecSql(pDB,"SELECT * FROM tablets ORDER BY ISOdate")
ENDIF
	CONTROLCMD win,100,@LVDELETEALL 'Clear Listview
	numCols=dbGetNumCols(hStmt)
	p=NEW(STRING,numCols)
FOR t=1 TO numCols
	dbBindVariable(hStmt,t,#<STRING>p[t-1,0])
NEXT t
	rowNum=0
WHILE dbGet(hStmt)
	CONTROLCMD win,100,@LVINSERTITEM,rowNum,RIGHT$(#<STRING>p[0,0],2)+"-"+MID$(#<STRING>p[0,0],6,2)+"-"+LEFT$(#<STRING>p[0,0],4)
FOR t=0 TO numCols
	CONTROLCMD win,100,@LVSETTEXT,rowNum,t-1,#<STRING>p[t-1,0]
NEXT t
	rowNum++
ENDWHILE
	dbFreeSQL(hStmt)
	hStmt=NULL
	CONTROLCMD win,100,@LVSETSELECTED,lv
	SENDMESSAGE win,0x1000+19,lv,0,100 'LVM_ENSUREVISIBLE
	conDrawOn(win,100)
ENDIF
ENDSUB

SUB DoMax() 'Get maximum number of records in database
	iStmt="SELECT MAX(recID)+1 FROM tablets"
	hStmt=dbExecSQL(pDB,iStmt)
	temp=dbGetErrorCode(hStmt)
IF LEN(temp)
IF temp<>"07002" '07002 = no records in table
	MESSAGEBOX win,"("+STR$(__LINE__)+") "+dbGetErrorText(hStmt)+"\n"+iStmt,temp
ENDIF
ELSE
WHILE dbGet(hStmt)
	dbGetData(hStmt,1,recID)
ENDWHILE
ENDIF
	dbFreeSQL(hStmt)
	hStmt=NULL
ENDSUB

SUB SetupDB() 'Load Name items into combobox
IF pDB<>NULL 'Load Listview
	conDrawOff(win,100)
	hStmt=dbExecSql(pDB,"SELECT * FROM tablets ORDER BY ISOdate")
	numCols=dbGetNumCols(hStmt)
	p=NEW(STRING,numCols)
FOR t=1 TO numCols
	dbBindVariable(hStmt,t,#<STRING>p[t-1,0])
NEXT t
	rowNum=0
WHILE dbGet(hStmt)
	CONTROLCMD win,100,@LVINSERTITEM,rowNum,RIGHT$(#<STRING>p[0,0],2)+"-"+MID$(#<STRING>p[0,0],6,2)+"-"+LEFT$(#<STRING>p[0,0],4)
FOR t=0 TO numCols
	CONTROLCMD win,100,@LVSETTEXT,rowNum,t-1,#<STRING>p[t-1,0]
NEXT t
	rowNum++
ENDWHILE
	dbFreeSQL(hStmt)
	hStmt=NULL
	conDrawOn(win,100)
ENDIF
	SETFOCUS win,100
ENDSUB

SUB DoAbout(),INT
	SELECT @MESSAGE
CASE @IDINITDIALOG
	CENTERWINDOW about
	SETICON about,LOADIMAGE(101,@IMGICON)
	SETCONTROLCOLOR about,2,RGB(0,0,255),GetSysColor(15)
	SETFONT about,"Tahoma",8,700,0,2
	SETCONTROLCOLOR about,7,0x0,RGB(201,228,222)
CASE @IDCONTROL
	SELECT @CONTROLID
CASE @IDCLOSEWINDOW
	CLOSEDIALOG about,@IDOK
CASE 7
	CLOSEDIALOG about,@IDOK
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB CreateShortcut() 'Set a Desktop shortcut for the program
	ISTRING desktopPath[260]
	ISTRING objectPath[260]
	ISTRING iconLocation[260]
	ISTRING description[260]
'Get the running exe name first, in case user has decided to alter it!
	ISTRING fName[260]
	GetModuleFileNameA(0,fName,260)
'Extract filename part from full path
	INT p=1
DO 
	UINT q=INSTR(fName,"\\",p)
IF q 
	p=q+1
ENDIF
UNTIL q=0
	fName=RIGHT$(fName,LEN(fName)-p+1)
'Make sure COM is active
	CoInitialize(NULL)
'Get the desktop folder path
	desktopPath=GetFolderLocation(0)
'The .lnk file - the Shortcut will always be called this, even if the filename is different
	desktopPath+="\\Tablets "+strUser+".lnk"
'What we are linking to - namely this executable, whatever it is called
	objectPath=GETSTARTPATH+fName
'The description
	description="Location: Tablets ("+GETSTARTPATH+")"
'Icon location - get icon from executable
	iconLocation=GETSTARTPATH+fName
'Create the link
IF CreateLink(objectPath,desktopPath,description,iconLocation)=0
	MESSAGEBOX(win,"Shortcut created on Desktop","Create Desktop Shortcut",@MB_OK|@MB_ICONINFORMATION)
ELSE
	MESSAGEBOX(win,"Shortcut not created","Create Desktop Shortcut",@MB_OK|@MB_ICONSTOP)
ENDIF
'Shut down COM
	CoUninitialize()
ENDSUB

SUB CreateLink(lpszPathObj:STRING,lpszPathLink:STRING,lpszDesc:STRING,lpszIcon:STRING),INT
	WORD wSz[260]
	INT hRes=0
	IShellLinkA psl
	IPersistFile ppf
'Get a pointer to the IShellLink interface
	hRes=CoCreateInstance(_CLSID_ShellLink,NULL,CLSCTX_INPROC_SERVER,_IID_IShellLinkA,&psl)
IF (hRes=0)
'Set the path to the shortcut target, and add the description and icon path
	psl->SetWorkingDirectory(GETSTARTPATH)
	psl->SetPath(lpszPathObj)
	psl->SetDescription(lpszDesc)
	psl->SetIconLocation(lpszIcon,0)
'Query IShellLink for the IPersistFile interface for saving the shortcut in persistent storage
	hRes=psl->QueryInterface(_IID_IPersistFile,&ppf)
IF (hRes=0)
'Ensure that the string is ANSI unicode
	MultiByteToWideChar(0,0,lpszPathLink,-1,&wSz,260)
'Save the link by calling IPersistFile->Save
	hRes=ppf->Save(wSz,TRUE)
	ppf->Release()
ENDIF
	psl->Release()
ENDIF
RETURN hRes
ENDSUB

SUB GetFolderLocation(nFolder:INT),STRING
	POINTER pIdl
	SHGetSpecialFolderLocation(NULL,nFolder,&pIdl)
	SHGetPathFromIDList(pIdl,&path)
	CoTaskMemFree(pIdl)
RETURN path
ENDSUB

SUB BackupMDB()
	SETCAPTION win,"Tablets  -  Backing up Database..."
	SETCURSOR win,@CSWAIT
IF hStmt THEN dbFreeSQL(hStmt)
	dbDisconnect(pDB)
	Sleep(500)
	answer=COPYFILE(GETSTARTPATH+"Tablets.mdb",GETSTARTPATH+"backup\\Tablets "+DATE$("dd-MM-yyyy")+" "+LEFT$(TIME$,2)+MID$(TIME$,4,2)+".mdb",0)
IF answer=0
	MESSAGEBOX(win,"Backup failed","Error",@MB_ICONEXCLAMATION)
ELSE
	Sleep(500)
	MESSAGEBOX(win,"Backup successful!","Success",@MB_ICONINFORMATION)
ENDIF
'Reopen DB
	SETCURSOR win,@CSARROW
	SETCAPTION win,"Tablets Database"
	pDB=OpenDatabase(win)
ENDSUB

SUB PrefsSub(),INT
	SELECT @MESSAGE
CASE @IDINITDIALOG
	CENTERWINDOW prefs
	SETICON prefs,LOADIMAGE(101,@IMGICON)
FOR loop=1 TO 4
	SETFONT prefs,"Tahoma",8,700,0,loop
NEXT loop
	SETCONTROLCOLOR prefs,1,0x0,RGB(121,150,222)
	SETCONTROLCOLOR prefs,2,0x0,RGB(255,255,255)
	SETCONTROLCOLOR prefs,3,0x0,RGB(255,255,255)
	SETCONTROLCOLOR prefs,4,0x0,RGB(255,255,255)
	SETCONTROLTEXT prefs,2,LTRIM$(STR$(OrderBy))
'Colour the dialog window
CASE WM_CTLCOLORDLG
   RETURN CreateSolidBrush(RGB(121,150,222))
CASE @IDCLOSEWINDOW
	CLOSEDIALOG prefs,@IDOK
CASE @IDCONTROL
	SELECT @CONTROLID
CASE 3 'OK
	OPENFILE(iniFile,GETSTARTPATH+"Tablets.ini","W")
	OrderBy=VAL(GETCONTROLTEXT prefs,2)
	WRITE iniFile,OrderBy
	CLOSEFILE iniFile
	SETCONTROLTEXT win,215,"Days to remind:"+STR$(OrderBy)
	CLOSEDIALOG prefs,@IDOK
CASE 4 'Cancel
	CLOSEDIALOG prefs,@IDCANCEL
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB Elapsed(sDate:string,eDate:string)
'Make sure that eDate > sDate
IF eDate>sDate
	tDate=""
else
	tDate=sDate
	sDate=eDate
	eDate=tDate
endif
'First get the system time so that all the other structure members are filled
	GetSystemTime(st)
'Set up the SYSTEMTIME structure with the original date like so:
	st.wDay=val(RIGHT$(sDate,2))
	st.wMonth=val(mid$(sDate,6,2))
	st.wYear=val(LEFT$(sDate,4))
'Convert the system time to filetime
	rtn=SystemTimeToFileTime(st,ft)
'Move the FILETIME info into a UINT64 variable and add days using the Quad variable (this is how M$ recommends doing it)
	s.dtVar.LowDW=ft.dwLowDateTime
	s.dtVar.HighDW=ft.dwHighDateTime
'First get the system time so that all the other structure members are filled
	GetSystemTime(st)
'Set up the SYSTEMTIME structure with the original date like so:
	st.wDay=val(RIGHT$(eDate,2))
	st.wMonth=val(mid$(eDate,6,2))
	st.wYear=val(LEFT$(eDate,4))
'Convert the system time to filetime
	rtn=SystemTimeToFileTime(st,ft)
'Move the FILETIME info into a UINT64 variable and add days using the Quad variable (this is how M$ recommends doing it)
	e.dtVar.LowDW=ft.dwLowDateTime
	e.dtVar.HighDW=ft.dwHighDateTime
	d.qVar=e.qVar-s.qVar
	iVar=d.qVar/(24*60*60*10000000)
return iVar
endsub

'Dosage edit control sub-classing stuff
SUB NumEditSubclass(parent:WINDOW,id:INT)
'Sub-class stuff
	hEdit=GETCONTROLHANDLE(parent,id)
	lpFn=SetWindowLongA(hEdit,-4,&NumEditHandler)
'Save the old handler as a property in the edit control, this way we don't need any global variables
	SetPropA(hEdit,"edit_handler",lpFn)
ENDSUB

SUB NumEditHandler(hWnd:INT,uMsg:INT,wParam:INT,lParam:POINTER),INT 'Allow numbers and full point
	SELECT uMsg
CASE @IDCHAR
IF ((wParam<0x30) OR (wParam>0x39)) AND (wParam<>ASC(".")) AND (wParam<>0x08) THEN RETURN 1
ENDSELECT
RETURN CallWindowProcA(GetPropA(hWnd,"edit_handler"),hWnd,uMsg,wParam,lParam)
ENDSUB

SUB NumEditUnSubclass(parent:WINDOW,id:INT)
'Restore the old handler and remove the property
	hEdit=GETCONTROLHANDLE(parent,id)
	SetWindowLongA(hEdit,-4,GetPropA(hEdit,"edit_handler"))
	RemovePropA(hEdit,"edit_handler")
ENDSUB

SUB PrintAll()
	lvCount=CONTROLCMD(win,100,@LVGETCOUNT)
'Open a DDoc page
	hFile=dpStartDoc(0,"Tablets Listing","",DDOC_CM,DDOC_PAPER_A4,DDOC_PORTRAIT,DDOC_BIN_AUTO,DDOC_ZOOM100)
	lm=1.00 'Left margin
	ls=1.00 'Top margin down the page
	dpFont(hFile,DDOC_FONTNORMAL,18,vbBlue,"Verdana")
	dpText(hFile,lm,ls,DDOC_LEFT,"Prescription Report for "+strUser)
	ls+=1.00
FOR loop=0 TO lvCount-1
'Set the font
	dpFont(hFile,DDOC_FONTNORMAL,12,vbBlue,"Tahoma")
'Get the data
	CONTROLCMD(win,100,@LVGETTEXT,loop,2,lvStr,255)
	dpText(hFile,lm,ls,DDOC_LEFT,lvStr)
	ls+=0.40
	dpFont(hFile,DDOC_FONTNORMAL,12,vbBlack,"Tahoma")
	CONTROLCMD(win,100,@LVGETTEXT,loop,4,lvStr,255)
	temp="Dosage: "+lvStr
	CONTROLCMD(win,100,@LVGETTEXT,loop,3,lvStr,255)
	temp+=" mg. Started course: "+lvStr
	dpText(hFile,lm,ls,DDOC_LEFT,temp)
	ls+=0.40
	CONTROLCMD(win,100,@LVGETTEXT,loop,7,lvStr,255)
	temp="Runs out: "+lvStr
	CONTROLCMD(win,100,@LVGETTEXT,loop,8,lvStr,255)
	temp+=". Reorder on: "+lvStr
	CONTROLCMD(win,100,@LVGETTEXT,loop,6,lvStr,255)
	temp+=". Take "+lvStr+" per day"
	dpText(hFile,lm,ls,DDOC_LEFT,temp)
	ls+=00.80
IF ls>29.30
	dpNewPage(hFile,DDOC_PAPER_A4,DDOC_PORTRAIT,DDOC_BIN_AUTO)
	ls=1.00 'Reset top margin
ENDIF
NEXT loop
'End the page
	dpEndDoc(hFile,DDOC_END_VIEW+DDOC_END_DELETE)
ENDSUB

SUB PrintForm()
	lvCount=CONTROLCMD(win,100,@LVGETCOUNT)
	countClicked=CONTROLCMD(win,100,@LVGETSELCOUNT)
'Open a DDoc page
IF countClicked>0
	hFile=dpStartDoc(0,"Tablets Order Form","",DDOC_CM,DDOC_PAPER_A4,DDOC_PORTRAIT,DDOC_BIN_AUTO,DDOC_ZOOM100)
ENDIF
'First text line
	lm=5.00
	ls=2.50
	dpFont(hFile,DDOC_FONTBOLD,24,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_CENTER,"ORDER FORM")
	ls+=1.00
	dpFont(hFile,DDOC_FONTBOLD,14,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_CENTER,"REPEAT MEDICATION")
'Name
	lm=2.70 'Left margin
	ls=5.00 'Start depth of line
	fws3=9.60 'Width of line
	fws4=5.00 'End depth of line
	dpLine(hFile,lm,ls,fws3,fws4,3,vbBlack)
	lm=1.00 'Left margin
	ls=4.52
	dpFont(hFile,DDOC_FONTNORMAL,14,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_LEFT,"NAME:")
	lm=2.70 'Left margin
	ls=4.40
	dpFont(hFile,DDOC_FONTNORMAL,20,penBlack,"Nanum Pen")
	dpText(hFile,lm,ls,DDOC_LEFT,"Your Name")
'Address
	lm=3.60 'Left margin
	ls=6.30 'Start depth of line
	fws4=6.30 'End depth of line
	dpLine(hFile,lm,ls,fws3,fws4,3,vbBlack)
	lm=1.00 'Left margin
	ls=5.84
	dpFont(hFile,DDOC_FONTNORMAL,14,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_LEFT,"ADDRESS:")
	lm=3.60 'Left margin
	ls=5.60
	dpFont(hFile,DDOC_FONTNORMAL,20,penBlack,"Nanum Pen")
	dpText(hFile,lm,ls,DDOC_LEFT,"Address 1")
	lm=1.00 'Left margin
	ls=6.40
	dpText(hFile,lm,ls,DDOC_LEFT,"Address 2")
	ls=7.22
	dpText(hFile,lm,ls,DDOC_LEFT,"Address 3")
'Two lines
	ls=7.10 'Start depth of line
	fws4=7.10 'End depth of line
FOR loop=1 TO 2
	dpLine(hFile,lm,ls,fws3,fws4,3,vbBlack)
	ls+=0.80
	fws4+=0.80
NEXT loop
'DoB
	lm=2.40 'Left margin
	ls=8.97 'Start depth of line
	fws4=8.97
'End depth of line
	dpLine(hFile,lm,ls,fws3,fws4,3,vbBlack)
	lm=1.00 'Left margin
	ls=8.49
	dpFont(hFile,DDOC_FONTNORMAL,14,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_LEFT,"DoB:")
	lm=2.40 'Left margin
	ls=8.28
	dpFont(hFile,DDOC_FONTNORMAL,20,penBlack,"Nanum Pen")
	dpText(hFile,lm,ls,DDOC_LEFT,"00/00/0000")
'Text in middle
	lm=1.00
	ls=10.00
	dpFont(hFile,DDOC_FONTBOLD,14,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_LEFT,"MEDICATION REQUIRED:")
	ls=10.80
	dpFont(hFile,DDOC_FONTNORMAL,12,vbBlack,"Tahoma")
	dpText(hFile,lm,ls,DDOC_LEFT,"(Please put name of Medication,")
	ls=11.30
	dpText(hFile,lm,ls,DDOC_LEFT,"Quantity & Strength)")
'Last 10 lines
	ls=12.70 'Start depth of line
	fws4=12.70 'End depth of line
FOR loop=1 TO 10
	dpLine(hFile,lm,ls,fws3,fws4,3,vbBlack)
	ls+=0.90
	fws4+=0.90
NEXT loop
'Signature
	dpGraphic(hFile,6.00,21.00,8.44,26.08,GETSTARTPATH+"Signature.bmp")
'Now print the Prescriptions required
	ls=12.00
FOR loop=0 TO lvCount-1
	selected=CONTROLCMD(win,100,@LVGETSELECTED,loop)
IF selected=2
'Set the font
	dpFont(hFile,DDOC_FONTNORMAL,20,penBlack,"Nanum Pen")
'Get the data
	CONTROLCMD(win,100,@LVGETTEXT,loop,2,lvStr,255)
	temp=lvStr
	CONTROLCMD(win,100,@LVGETTEXT,loop,6,lvStr,255)
	amount=VAL(lvStr)*28
	temp+=" -"+STR$(amount)
	CONTROLCMD(win,100,@LVGETTEXT,loop,4,lvStr,255)
	temp+=" - "+lvStr+"mg"
	dpText(hFile,lm,ls,DDOC_LEFT,temp)
	ls+=0.9
ENDIF
NEXT loop
'Vertical cut line
	dpLine(hFile,10.60,00.00,10.60,25.00,0,vbBlack)
'End the page
	dpEndDoc(hFile,DDOC_END_VIEW+DDOC_END_DELETE)
ENDSUB