Loading ...
Sorry, an error occurred while loading the content.

47133MiniDiary76

Expand Messages
  • green8819
    Oct 28, 2013
    • 0 Attachment
      Hello All,

      As promised yesterday......

      Any comments, questions, questionable codelines, etc, welcome.

      '----start code
      'kill DefaultDir$ + "\md65.txt":end 'for testing purpose
      nomainwin
      CrLf$=chr$(13)+chr$(10)
      dim yr$(101),mn$(12),dy$(31)
      monthName$="Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
      dayName$="Wed Thu Fri Sat Sun Mon Tue"
      for x=1 to 101 :yr$(x)=str$(1919+x):next :sort yr$(),101,1
      for x=1 to 12 :mn$(x)=word$(monthName$,x):next
      for x=1 to 31 :dx$=str$(x) :if x<10 then dx$="0"+dx$
      dy$(x)=dx$:next
      '---------------
      'to create md65.txt if it doesn't exist
      [start]
      if wopen$="open" then close #w
      sessionRec=0
      open DefaultDir$ + "\md65.txt" for append as #rec
      close #rec
      '----
      rec=0
      open "md65.txt" for input as #rec
      while eof(#rec) = 0
      line input #rec, line$
      rec=rec+1
      wend
      totRec=rec/3
      close #rec
      '
      Limit=totRec+9 :dim List$(Limit) :dim rec$(Limit,3)
      gosub [readDB]
      gosub [formList]
      '----------------------------------------------------
      'Listbox display
      WindowWidth = 560: WindowHeight = 490
      UpperLeftX=10 :UpperLeftY=10
      stylebits #w.List,_WS_VSCROLL,_WS_HSCROLL,0,0 'noReadOnly forLBX
      Stylebits #w, 0,_WS_MAXIMIZEBOX,0,0
      'top half display
      button #w.1,"Date",[sortDte], UL, 10,5
      button #w.3,"Event",[sortEvnt], UL, 175,5
      statictext #w.when, "When",370,15,100,20
      ListboxColor$="buttonface"
      Listbox #w.List, List$(),[LstSelected], 5, 35, 540, 200
      '----------------------------------------------------
      'bottom half display
      Stylebits #w.mn,0,_WS_VSCROLL or _WS_HSCROLL,0,0 'no scolls for mnth
      stylebits #w.dte, _ES_CENTER,_WS_BORDER,0,0
      'evnt textbox no Hscolling
      stylebits #w.evnt, _WS_VSCROLL, _ES_AUTOHSCROLL, _ES_MULTILINE, 0
      stylebits #w.clear, _BS_MULTILINE,0,0,0
      stylebits #w.del, _BS_MULTILINE,0,0,0
      '
      Listbox #w.dy, dy$(),[daySelected], 10,245,50,210
      Listbox #w.mn, mn$(),[mnthSelected],65,245,40,210
      Listbox #w.yr, yr$(),[yrSelected], 110,245,70,210
      '
      textbox #w.dte, 185, 245, 245, 23
      TextboxColor$="yellow"
      textbox #w.evnt, 185, 275, 245, 145
      '
      button #w.today,"Today",[today],UL,440,245,105,25
      button #w.nSave,"Save as New",[nSave],UL,440,278
      button #w.eSave,"Save Changes",[eSave],UL,440,313,110,25
      button #w.del,"Delete Selected"+CrLf$+"Record",[dSave],UL,435,345,115,40
      button #w.clear,"Clear Date Box and"+CrLf$+"Event Box",_
      [clear],UL,440,395,105,60
      button #w.srch,"Search in All",[Srch], UL,185,430,100,25
      button #w.fnd,"Find in Selected",[Find], UL,295,430,120,25
      '
      stylebits #w.btn, _BS_DEFPUSHBUTTON, 0, 0, 0
      button #w.btn, "", DefaultButton, UL, -10, -10
      '----
      Open "MiniDiary by Mike Lavin" for window_nf as #w
      #w "font arial 9 ":#w "trapclose [quit]" :wopen$="open"
      #w.dte "!font Tahoma 8"
      #w.List "font courier_new 8"
      order$="ascend" 'initial sorting order
      'update Listing, and to make scrollbars active at start
      #w.yr, "singleclickselect [yrSelected]"
      #w.mn, "singleclickselect [mnthSelected]"
      #w.dy, "singleclickselect [daySelected]"
      #w.List, "singleclickselect [LstSelected]"
      '
      #w.evnt "!disable"
      sort rec$(),1,totRec,3 :gosub [formList]
      gosub [clearing]
      wait
      '====================================================================
      [LstSelected]
      #w.yr,"selectindex ";0 :#w.mn,"selectindex ";0 :#w.dy,"selectindex ";0
      #w.evnt,"" :#w.dte,""
      #w.List, "selectionindex? sel"
      #w.evnt "!enable"
      #w.dte,rec$(sel,1) :xEvnt$=rec$(sel,2) :gosub [removeCrLfSymb]
      #w.evnt, yEvnt$
      calldll #kernel32,"Sleep",100 as ulong,r as void
      wait
      '
      [yrSelected]
      #w.List,"selectindex ";0 :#w.List,"reload"
      #w.yr, "selection? yr$"
      goto [addYMD]
      [mnthSelected]
      #w.List,"selectindex ";0 :#w.List,"reload"
      #w.mn, "selection? mnth$"
      goto [addYMD]
      [daySelected]
      #w.List,"selectindex ";0 :#w.List,"reload"
      #w.dy, "selection? dy$"
      [addYMD]
      calldll #kernel32,"Sleep",100 as ulong,r as void
      dt$=dy$+" "+mnth$+" "+yr$ :#w.dte,dt$
      dV=val(dy$) :yV=val(yr$)
      DtErr$=""
      if mnth$="Feb" and dV>29 then DtErr$="Month or Day Error!"
      if mnth$="Feb" and dV>28 and (yV mod 4) then DtErr$="Leap Year error!"
      if (mnth$="Apr" or mnth$="Jun" or mnth$="Sep" or _
      mnth$="Nov") and dV>30 then DtErr$="Month or Day Error!"
      if len(DtErr$) then notice ""+chr$(13)+DtErr$ :wait
      if len(dt$)=11 then
          #w.dte "!disable" :#w.evnt "!enable" :#w.evnt "!setfocus"
          end if
      wait
      '
      [today]
      'get today date
      todayNr = date$("days") :evntDtNr=todayNr :gosub [GetWkDay]
      today$=date$(todayNr)
      d$=word$(today$,2,"/") :m$=word$(today$,1,"/") :y$=word$(today$,3,"/")
      for x=1 to 12
      if val(m$)=x then m$=word$(monthName$,x) :exit for
      next
      today$=d$+" "+m$+" "+y$+WkDay$
      #w.dte,today$+", Today"
      #w.evnt "!enable" :#w.evnt "!setfocus"
      wait

      'btn3=DtNr, btn2=Evnt
      [sortDte]
      btn=3 :goto [doSort]
      [sortEvnt]
      btn=2
      [doSort]
      if totRec=0 then wait
      select case order$
      case "ascend"
          sort rec$(),1,totRec,btn:order$="descend"
      case "descend"
          sort rec$(),totRec,1,btn:order$="ascend"
      end select
      gosub [formList] :#w.List,"reload"
      calldll #kernel32,"Sleep",100 as ulong,r as void
      wait
      '
      [eSave]
      editFlag=1
      rec$(sel,1)="" :rec$(sel,2)="" :rec$(sel,3)="" :goto [nSave]
      [dSave]
      if sel=0 then notice ""+chr$(13)+"Nothing selected" :wait
      deleteFlag=1
      confirm "Are you sure ?";ans$
      if lower$(ans$)="no" then deleteFlag=0 :gosub [clearing] :wait
      rec$(sel,1)="" :rec$(sel,2)="" :rec$(sel,3)=""
      sessionRec=sessionRec - 1 :goto [compile]
      [nSave]
      sessionRec=sessionRec+1
      newFlag=1
      dte$="":evnt$=""
      #w.dte, "!contents? inpDte$"
      #w.evnt, "!contents? inpEvnt$"
      if inpDte$="" or inpEvnt$="" or len(inpDte$)<11 then
          notice "Input incomplete or incorrect" :wait
          end if
      if editFlag=1 then
          confirm "Overwrite previous Entry ?";ans$
          if  lower$(ans$)="no" then editFlag=0 :wait
          end if
      [compile]
      dt$=left$(inpDte$,11) :gosub [calcWhen]
      evnt$=inpEvnt$ :evnt$=trim$(evnt$)
      xEvnt$=inpEvnt$ :gosub [insertCrLfSymb] :evnt$=yEvnt$
      gosub [upDate]
      editFlag=0 :deleteFlag=0 :newFlag=0
      gosub [clearing]
      if sessionRec=8 then [start]
      wait
      '
      [Srch]
      if totRec=0 then wait
      gosub [clearing] :srch$=""
      found=0
      prompt"Search what?";srch$ :srch$=lower$(srch$)
      if srch$="" then wait
      for x=1 to totRec :content$=List$(x):content$=lower$(content$)
      if instr(content$,srch$)>0 then
          List$(x)=chr$(149)+trim$(List$(x)):found=1
          end if
      next
      if found=0 then notice ""+chr$(13)+"Not Found"
      #w.List,"reload"
      wait
      '
      [Find]
      if srch$="" then notice ""+chr$(13)+"Please do Search first" :wait
      count=0
      #w.evnt, "!setfocus" :#w.evnt, "!contents? orig$"
      fLen=len(srch$)
      sPos = instr(lower$(orig$), srch$, fPos)
      if sPos = 0 then notice chr$(13)+"No match found!"
      #w.evnt "!setfocus"
      dummy=SendMessage(hwnd(#w.evnt),_EM_SETSEL,sPos-1,sPos+fLen-1)
      fPos=sPos+fLen
      count=count+1
      wait
      '
      [clear]
      gosub [clearing]
      wait
      '
      [quit]
      gosub [backup]
      CLOSE #w
      END
      '--------------------------------------------------------------------
      [readDB]
      open "md65.txt" for input as #rec
      for x=1 to totRec :line input #rec, dt$,evnt$,evntDtNr
      rec$(x,1)=dt$ :rec$(x,2)=evnt$ :rec$(x,3)=str$(evntDtNr)
      List$(x)=rec$(x,1)
      next
      close #rec
      sort rec$(),1,totRec,3
      return
      '
      [calcWhen]
      when$="" :WkDay$="" :alert$="":evntDt$="":sign$=""
      days=0 :months=0 :years=0
      d$=word$(dt$,1) :m$=word$(dt$,2) :y$=word$(dt$,3)
      for x=1 to 12
      if m$=word$(monthName$,x) then mNr$=str$(x) :exit for
      next
      evntDt$=mNr$+"/"+d$+"/"+y$
      evntDtNr=date$(evntDt$)
      todayNr=date$("days")
      totDays=evntDtNr - todayNr
      gosub [GetWkDay] 'calc day of the week
      'calc when
      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.5)
          end if
      if months>11 then
          years=int(months/12)
          months=int(((months/12)-years)*12)
          end if
      'yr, mnth, days to or from event; and ago/later
      if years>0 then when$=str$(years)+"y "
      if months>0 then when$=when$+str$(months)+"m "
      if days>1 or days<-1 then when$=when$+str$(days)+"d"
      if totDays<-1 then sign$="Ago"
      if totDays>1 then sign$="Later"
      if totDays=0 then when$="Today"
      if totDays=-1 then when$="Yesterday"
      if totDays=1 then when$="Tomorrow"
      if totDays=7 then when$="Next Week" :sign$=""
      if len(sign$) then when$=when$+" "+sign$
      return
      '
      [upDate]
      d$=word$(dt$,1) :m$=word$(dt$,2) :y$=word$(dt$,3)
      if len(d$)=1 then d$="0"+d$
      dt$=d$+" "+m$+" "+y$ :evntDtNr$=str$(evntDtNr)
      totRec=totRec+1
      if deleteFlag=1 then dt$=""
      rec$(totRec,1)=dt$:rec$(totRec,2)=evnt$
      rec$(totRec,3)=str$(evntDtNr)
      if newFlag=1 then
          rec$(totRec,1)=dt$:rec$(totRec,2)=evnt$
          rec$(totRec,3)=evntDtNr$
          end if
      if editFlag=1 then
          totRec=totRec-1
          rec$(sel,1)=dt$ :rec$(sel,2)=evnt$ :rec$(sel,3)=evntDtNr$
          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 3:rec$(new,y)=rec$(x,y):next
          end if
      next
      totRec=new
      sort rec$(),1,totRec,3
      open "md65.txt" for output as #rec
      for x=1 to totRec
          for y=1 to 3:#rec,rec$(x,y):next
      next
      close #rec
      gosub [readDB] 'sort included
      gosub [formList]
      #w.List,"reload"
      return
      '
      [todayDate]
      evntDteNr=date$("days")
      todayW$=today$+WkDay$ :todayW$=left$(todayW$,12)
      todayW$=space$(40)+"Today is "+todayW$
      return
      '
      [clearing]
      #w.yr,"reload" :#w.mn,"reload" :#w.dy,"reload"
      #w.List, "selectindex ";0 :#w.List "reload" 'clear prv sel and reload
      inpDte$="":inpEvnt$="":dte$="":evnt$=""
      dateSel$="":yr$="" :mnth$="" :dy$=""
      #w.evnt,"" :#w.dte,"" :#w.evnt, "!disable"
      gosub [formList]
      #w.List,"reload"
      return
      '
      [insertCrLfSymb]
      yEvnt$=""
      for xs=1 to len(xEvnt$)
      charac$=mid$(xEvnt$,xs,1)
      if asc(charac$)=13 then charac$="~"
      if asc(charac$)=10 then charac$="|"
      yEvnt$=yEvnt$+charac$
      next
      return
      '
      [removeCrLfSymb]
      yEvnt$=""
      for xs=1 to len(xEvnt$)
      charac$=mid$(xEvnt$,xs,1)
      if asc(charac$)=126 then charac$=chr$(13)
      if asc(charac$)=124 then charac$=chr$(10)
      yEvnt$=yEvnt$+charac$
      next
      return
      '
      [GetWkDay]
      WkDay$=""
      remainder=evntDtNr mod 7
      WkDay$=word$(dayName$,remainder)
      if remainder=0 then WkDay$="Tue"
      WkDay$=" "+"("+WkDay$+")"
      return
      '
      [formList]
      for fm=1 to totRec
      dt$=rec$(fm,1) :if dt$="" then [nextfm]
      dtLen=len(dt$) :dtOnly$=left$(dt$,11)
      evnt$=(rec$(fm,2)) :evntLen=len(evnt$)
      evntDtNr=val((rec$(fm,3))) :gosub [calcWhen] 'find when$, WkDay$
      evSpc=23 - evntLen
      if evntLen>20 then evnt$=left$(evnt$,20)+".. "
          a$="" :for x=1 to evntLen
          c$=mid$(evnt$,x,1) :if c$="~" or c$="|" then c$="."
          a$=a$+c$ :next :evnt$=a$
      List$(fm)=dtOnly$+WkDay$+"   "+evnt$+space$(evSpc)+" "+when$
      List$(fm)=trim$(List$(fm)) :List$(fm)=" "+List$(fm)
      [nextfm]
      next
      return
      '
      [evntDtNr]
      d$=word$(dt$,1) :m$=word$(dt$,2) :y$=word$(dt$,3)
      for x=1 to 12
      if m$=word$(monthName$,x) then mNr$=str$(x) :exit for
      next
      evntDt$=mNr$+"/"+d$+"/"+y$
      evntDtNr=date$(evntDt$)
      return
      '
      sub DefaultButton handle$
      if hWnd(#w.evnt) then notice ""+chr$(13)+_
      "Please press [Ctrl+Enter]"
      end sub
      '
      function wordCount(someText$)
      in=1
      while word$(someText$,in)<>"" :in=in+1 :wend
      wordCount=in-1
      end function
      '
      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
      '
      [backup]
      open "md65.txt" for input as #original
      open "mdBkup.txt" for output as #copy
      #copy, input$(#original, lof(#original))
      close #original
      close #copy
      return

      [IfValidDate]
      DtErr$=""
      if wordCount(dt$)<>3 then DtErr$="Invalid Date!"
      d$=word$(dt$,1) :m$=word$(dt$,2) :y$=word$(dt$,3)
      if len(d$)=1 then d$="0"+d$
      '#w.dte d$+" "+m$+" "+y$
      mL=len(m$) :yL=len(y$) :dV=val(d$) :yV=val(y$) :mV=val(m$)
      if dV>31 or dV<1 then DtErr$="Invalid day!"
      if mL<>3 then DtErr$="Invalid month!"
      if instr(monthName$,m$)=0 then DtErr$="Invalid month name!"
      if yL<>4 then DtErr$="Invalid Year!"
      if yV<1920 or yV>2020 then DtErr$="1920 to 2020 only"
      if dV=28 and m$<>"Feb" and (yV mod 4) then DtErr$="Leap Year error!"
      return
      '-----end code
    • Show all 2 messages in this topic