Post by metro on Jul 29, 2019 3:30:02 GMT -5
This is not my code.
Looking at another thread there maybe some interest in another way to tackle a diary program.
'kill DefaultDir$ + "\minidiary.txt":end 'for testing purpose
nomainwin
'
dim yr$(101),mn$(12),dy$(31)
monthNames$="JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"
for x=1 to 101 :yr$(x)=str$(1919+x):next :sort yr$(),101,1
for x=1 to 12 :mn$(x)=word$(monthNames$,x):next
for x=1 to 31 :x$="0"+str$(x):x$=right$(x$,2):dy$(x)=x$:next
'----
'to create minidiary.txt if it doesn't exist
open DefaultDir$ + "\minidiary.txt" for append as #rec
close #rec
'----
rec=0
open "minidiary.txt" for input as #rec
while eof(#rec) = 0
line input #rec, line$
rec=rec+1
wend
totRec=rec/2
close #rec
Limit=totRec+9
dim disp$(Limit):dim rec$(Limit,3)
'
gosub [readDB]
for x=1 to totRec
dt$=left$(rec$(x,1),11):gosub [calcGap]
rec$(x,1)=dt$+wkday$+alert$
rec$(x,3)=gap$:dtlist$(x)=rec$(x,1)
next
sort rec$(),totRec,1,1
sort dtlist$(),totRec,1
gosub [formList]
'------------------------------------------------------------------------
WindowWidth = 600: WindowHeight = 280
UpperLeftX=50:UpperLeftY=50
'
stylebits #w.disp, _WS_VSCROLL,_WS_HSCROLL,0,0
stylebits #w.disp, _ES_READONLY,_WS_BORDER,0,0 'nowrite
stylebits #w.disp, _LBS_NOSEL,0,0,0 'no select
Stylebits #w, 0,_WS_MAXIMIZEBOX,0,0
button #w.1,"Date",[sortDate], UL, 10,10,45,20
statictext #w.2,"TimeGap",185,15,70,20
button #w.3,"Event",[sortEvnt], UL, 340,10,60,20
button #w.opt,"Options",[opt], UL, 525,10,60,20
listbox #w.disp, disp$(), [nothing], 5, 35, 580, 210
'----
Open "MiniDiary by Mike Lavin" for dialog as #w
#w "font arial 10":#w "trapclose [quit.w]"
#w.disp "font courier_new 10"
#w.disp, "reload" 'so that scrollbars are active at start
order$="ascend" 'initial sorting order
[nothing]
wait
'----
[opt]
goto [options]
[sortDate]
if totRec=0 then wait
select case order$
case "ascend"
sort rec$(),1,totRec,1:order$="descend"
sort dtlist$(),1,totRec:order$="descend"
case "descend"
sort rec$(),totRec,1,1:order$="ascend"
sort dtlist$(),totRec,1:order$="ascend"
end select
gosub [formList]:#w.disp,"reload"
if win2$="open" then #e.dtlist,"reload"
wait
'
[sortEvnt]
if totRec=0 then wait
select case order$
case "ascend"
sort rec$(),1,totRec,2:order$="descend"
sort dtlist$(),1,totRec:order$="descend"
case "descend"
sort rec$(),totRec,1,2:order$="ascend"
sort dtlist$(),totRec,1:order$="ascend"
end select
gosub [formList]:#w.disp,"reload"
if win2$="open" then #e.dtlist,"reload"
wait
'
[quit.w]
if win2$="open" then close #e
CLOSE #w
'
END
'============================================================================
[options]
#w.opt "!disable"
Stylebits #e, 0,_WS_MAXIMIZEBOX,0,0 'no maximize for this window
Stylebits #e.mn, 0,_WS_VSCROLL or _WS_HSCROLL, 0,0
stylebits #e.dte, _ES_READONLY,_WS_BORDER,0,0 'datebox readonly
stylebits #e.evnt, _WS_BORDER,0,0,0
'no Hscolling, will autoCrLf
stylebits #e.evnt, _WS_VSCROLL, _ES_AUTOHSCROLL, _ES_MULTILINE, 0
WindowWidth = 600: WindowHeight = 295
UpperLeftX=50 :UpperLeftY=320
'
statictext #e.st, "Event :", 335,65,45,15
'
listbox #e.yr, yr$(),[yrSelected], 10,25,60,200
listbox #e.mn, mn$(),[mnthSelected], 75,25,40,200
listbox #e.dy, dy$(),[daySelected], 120,25,45,200
Listbox #e.dtlist, dtlist$(), [dtSelected], 195,25,120,200
textbox #e.dte, 320,25,255,25
TextboxColor$="yellow"
textbox #e.evnt, 320,80,255,100
button #e.cancel,"Cancel",[quit.e],UL,520,227,60,25
button #e.del,"Delete",[delete],UL,450,227,60,25
button #e.nSave,"Save as New",[nSave],UL,320,185
button #e.eSave,"Save Changes",[eSave],UL,470,185
button #e.date,"Sort Date",[dateSort], UL, 195,227,80,25
button #e.today,"Today",[today],UL,60,227,107,25
button #e.srch,"Search",[srch], UL, 340,227,55,25
button #e.clear,"Clear",[clear],UL,10,227,40,25
button #e.contSrch,"Continue Search",[contSrch], UL, 315,227,110,25
gosub [currDate]
'
stylebits #e.btn, _BS_DEFPUSHBUTTON, 0, 0, 0
button #e.btn, "", DefaultButton, UL, -10, -10
'for window so that ENTER will work
open "MiniDiary by Mike."+today$ for window as #e
#e, "trapclose [quit.e]" :win2$="open"
#e, "font arial 10" :#e.dte,"font lucida_console 10"
#e.dtlist,"font lucida_console 10"
#e.yr, "singleclickselect [yrSelected]"
#e.mn, "singleclickselect [mnthSelected]"
#e.dy, "singleclickselect [daySelected]"
#e.yr, "reload" :#e.mn, "reload" :#e.dy, "reload"
gosub [clearEwin]
#e.dte,rec$(sel,1)
#e.evnt,rec$(sel,2)
#e.contSrch,"!hide"
order$="ascend"
wait
'
[dateSort]
if totRec=0 then wait
select case order$
case "ascend"
sort dtlist$(),1,totRec:order$="descend"
sort rec$(),1,totRec,1:order$="descend"
case "descend"
sort dtlist$(),totRec,1:order$="ascend"
sort rec$(),totRec,1,1:order$="ascend"
end select
#e.dtlist,"reload"
gosub [formList]:#w.disp,"reload"
wait
[yrSelected]
yr$=""
#e.yr, "selection? yr$"
dateSel$=yr$+" "+mnth$+" "+dy$
#e.dte,"":#e.dte,dateSel$
wait
[mnthSelected]
mnth$=""
#e.mn, "selection? mnth$"
dateSel$=yr$+" "+mnth$+" "+dy$
#e.dte,"":#e.dte,dateSel$
wait
[daySelected]
dy$=""
#e.dy, "selection? dy$"
dateSel$=yr$+" "+mnth$+" "+dy$
#e.dte,"":#e.dte,dateSel$
wait
[today]
#e.dte, "" :#e.evnt, ""
dateSel$=date$("yyyy/mm/dd")
yr$=left$(dateSel$,4):dy$=right$(dateSel$,2)
mnth=val(mid$(dateSel$,6,2))
mnth$=word$(monthNames$,mnth)
dateSel$=yr$+" "+mnth$+" "+dy$
#e.dte,dateSel$
wait
'
[dtSelected]
#e.dtlist, "SelectionIndex? selnr"
#e.dte, "" :#e.evnt, ""
pastDte$=rec$(selnr,1):pastEvnt$=rec$(selnr,2)
dt$=left$(rec$(selnr,1),11):gosub [calcGap]
xEvnt$=pastEvnt$ :gosub [removeSymb] :pastEvnt$=yEvnt$
#e.dte,pastDte$+gap$
#e.evnt,pastEvnt$
wait
'----
[clear]
gosub [clearEwin]
#e.evnt, "!setfocus"
wait
'
[eSave]
eFlag=1
rec$(selnr,1)="" :rec$(selnr,2)="" :goto [nSave]
[delete]
dFlag=1
rec$(selnr,1)="" :rec$(selnr,2)=""
if dFlag=1 then goto [compile]
[nSave]
dte$="":evnt$=""
dte$="":evnt$=""
#e.dte, "!contents? inpDte$"
#e.evnt, "!contents? inpEvnt$"
if inpDte$="" or inpEvnt$="" then 'or len(inpDte$)<>11 then
notice ""+chr$(13)+"Entries incomplete or incorrect":wait
end if
dte$=left$(inpDte$,11):evnt$=inpEvnt$
xEvnt$=inpEvnt$ :gosub [insertSymb] :evnt$=yEvnt$
if eFlag=1 then
confirm "Edited Entry."+chr$(13)+"Overwrite previous Entry ?";ans$
if lower$(ans$)="no" then wait
end if
dt$=left$(inpDte$,11):gosub [calcGap]:dte$=dt$
[compile]
gosub [upDate]
#w.disp,"reload"
#e.dtlist,"reload"
gosub [clearEwin]
wait
'
[srch]
if totRec=0 then wait
prompt"Search what?";srch$:srch$=lower$(srch$)
#e.srch,"!hide" :#e.contSrch,"!show"
for x=1 to totRec: content$=rec$(x,2)+""
if instr(content$,srch$)>0 then
#e.dtlist,"select ";dtlist$(x)
#e.dte,rec$(x,1) :text$=rec$(x,2):gosub [highlight]
#e.evnt,highlighted$
end if
wait
[contSrch]
next
#e.srch,"!show" :#e.contSrch,"!hide"
notice "No more found"
#e.dtlist, "select sel 0"
gosub [clearEwin]
wait
[quit.e]
win2$="close"
close #e
#w.opt "!enable"
#w.disp,"select sel 0" 'select nothing
wait
'-------------------------------------------------------------------------
[clearEwin]
selnr=0
inpDte$="":inpEvnt$="":dte$="":evnt$=""
dateSel$="":yr$="" :mnth$="" :dy$=""
#e.yr,"select selnr 0":#e.mn,"select selnr 0":#e.dy,"select selnr 0"
#e.dtlist, "select selnr 0"
#e.dte,"" :#e.evnt,""
return
'
[getContent]
#e.dte, "!contents? dte$"
#e.evnt, "!contents? unevnt$" ':print unevnt$;len(unevnt$)
evnt$=""
for x=1 to len(unevnt$)
charac$=mid$(unevnt$,x,1)
if asc(charac$)=13 then charac$=chr$(96)
if asc(charac$)=10 then charac$=chr$(180)
evnt$=evnt$+charac$
next
unevnt$=""
return
[insertSymb]
yEvnt$=""
for x=1 to len(xEvnt$)
charac$=mid$(xEvnt$,x,1)
if asc(charac$)=13 then charac$=chr$(96)
if asc(charac$)=10 then charac$=chr$(180)
yEvnt$=yEvnt$+charac$
next
return
[removeSymb]
yEvnt$=""
for x=1 to len(xEvnt$)
charac$=mid$(xEvnt$,x,1)
if asc(charac$)=96 then charac$=chr$(13)
if asc(charac$)=180 then charac$=chr$(10)
yEvnt$=yEvnt$+charac$
next
return
[highlight]
#e.evnt, "" :highlighted$=""
wordsTot=wordCount(text$)
for bgt=1 to wordsTot :wd$=word$(text$,bgt) 'bgt just a counter
if wd$=srch$ then wd$=chr$(149)+wd$+chr$(149)
wd$=wd$+" ":highlighted$=highlighted$+wd$:wd$=""
next
return
[upDate]
totRec=totRec+1
if deleteFlag=1 then dte$=""
rec$(totRec,1)=dte$:rec$(totRec,2)=evnt$
rec$(totRec,3)=gap$
'
if addFlag=1 then
rec$(totRec,1)=dte$:rec$(totRec,2)=evnt$
end if
if editFlag=1 then
totRec=totRec-1
rec$(sel,1)=dte$:rec$(sel,2)=evnt$
end if
if deleteFlag=1 then totRec=totRec-1:rec$(sel,1)=""
'
new=0
for x=1 to totRec
if rec$(x,1)<>"" then new=new+1:for y=1 to 2:rec$(new,y)=rec$(x,y):next
next
totRec=new
'
sort rec$(),1,totRec,1
open "minidiary.txt" for output as #rec
for x=1 to totRec
for y=1 to 2:#rec,rec$(x,y):next
next
close #rec
'
redim dtlist$(totRec)
gosub [readDB]
for x=1 to totRec
dt$=left$(rec$(x,1),11):gosub [calcGap]:dtlist$(x)=dt$
rec$(x,1)=dt$+wkday$+alert$
rec$(x,3)=gap$
next
gosub [formList]
return
'-----------------
[formList]
redim disp$(Limit) 'form display results
for fm=1 to totRec:dte$=rec$(fm,1)
if dte$="" then [nextfm]
ShortEvnt$="" :evnt$=(rec$(fm,2)) :evntlen=len(evnt$)
for x=1 to 23 :ShortEvnt$=ShortEvnt$+mid$(evnt$,x,1):next
if evntlen>23 then ShortEvnt$=ShortEvnt$+" ... "
dtelen=len(rec$(fm,1)):dtespc=20-dtelen
gaplen=len(rec$(fm,3)):gapspc=21-gaplen
disp$(fm)=""_
+rec$(fm,1)+space$(dtespc)+rec$(fm,3)+space$(gapspc)+ShortEvnt$+chr$(13)
disp$(fm)= trim$(disp$(fm))
[nextfm]
next
return
'
'limit textbox input length
function SendMessage(handle, message, wParam, lParam)
calldll #user32, "SendMessageA", handle as ulong,_
message as ulong, wParam as ulong, lParam as ulong,_
SendMessage as ulong
end function
'----------------------
[calcGap]
gap$="" :wkday$="" :alert$="": sign$="" :evntDte$=""
days=0 :months=0 :years=0
yr$=left$(dt$,4):mnth$=mid$(dt$,6,3):d$=right$(dt$,2)
evntDte$=mnth$+"/"+d$+"/"+yr$
evntDteNr=date$(evntDte$) :evntDte$=""
entryDteNr=date$("days")
totDays=evntDteNr - entryDteNr
'getWeekDay
DayNr=evntDteNr mod 7
if DayNr=1 then wkday$="(Wed)"
if DayNr=2 then wkday$="(Thu)"
if DayNr=3 then wkday$="(Fri)"
if DayNr=4 then wkday$="(Sat)"
if DayNr=5 then wkday$="(Sun)"
if DayNr=6 then wkday$="(Mon)"
if DayNr=7 or DayNr=0 then wkday$="(Tue)"
wkday$=" "+wkday$
'get alert exclamation marks
if totDays>=0 and totDays<=7 then alert$=" !!!"
if totDays>=8 and totDays<=31 then alert$=" !! "
if totDays>=32 and totDays<=60 then alert$=" ! "
if totDays>=61 or totDays<0 then alert$=" "
'totDays
absDays=abs(totDays)
if totDays<=31 then days=absDays
if absDays>31 then
months=int(absDays/30.4375)
days=int(((absDays/30.4375)-months)*30.4375+0.05)
end if
if months>11 then
years=int(months/12)
months=int(((months/12)-years)*12)
end if
'get gap$ and sign$
if years>0 then gap$=str$(years)+"y "
if months>0 then gap$=gap$+str$(months)+"m "
if days>0 then gap$=gap$+str$(days)+"d"
gap$=gap$+" "
if totDays=0 then sign$="Today"
if totDays<0 then sign$="Ago"
if totDays>0 then sign$="Later"
lengap=len(gap$):filler=12-lengap
for dot=1 to filler:gap$=gap$+".":next
gap$=" "+gap$+sign$
return
sub DefaultButton handle$
hIN = hWnd(#e.evnt)
#e.evnt, "!contents? out$" :out$ = out$+chr$(13)+chr$(10)
#e.evnt, out$ 'print back into textbox
pos = len(out$)
calldll #user32, "SendMessageA", hIN as Ulong, _
_EM_SETSEL as Long, _
pos as Long, _
pos as Long, _
result as Long
end sub
[readDB]
open "minidiary.txt" for input as #rec
for x=1 to totRec :line input #rec, rec$(x,1), rec$(x,2) :next
close #rec
return
[currDate]
today$=date$("yyyy/mm/dd"):dt$=today$:gosub [calcGap]
mnth=val(mid$(today$,6,2)):dy$=right$(today$,2)
mnth$=word$(monthNames$,mnth)
today$=mnth$+" "+dy$
evntDteNr=date$("days")
today$=today$+wkday$ :today$=left$(today$,12)
today$=space$(40)+"Today is "+today$
return
function wordCount(someText$)
in=1
while word$(someText$,in)<>"" :in=in+1 :wend
wordCount=in-1
end function
