'MMEDIT!!! Basic Version = Micromite_X_V5.3 'MMEDIT!!! Port = COM3:38400:30,150 'MMEDIT!!! Device = Micromite_X_V5.3 'MMEDIT!!! Config = 100111101121010001101001010001 Option Explicit Option Default Integer Option autorun On 'Timing Box Library ' 'WiFi File transfer (MXWifi) '******* the following code is self contained and should be stored as a library file ****** '********************* Library Code ************************** '**************** sub routines ********************* 'http://www.codenquilts.com.au 'Michael Ogden July 2016 'WiFi File transfer 'ver 0.8 additions for use on other platforms running MMBasic ver 5.2 'add uMite plus platform detection. '0.086 add Sub Other, add individual resets 'UserProcess routine ' process network data and commands. 'ver 1.1 add handshake in listfiles routines 'ver 1.5 change to extCmd (external commands) 'ver 1.6 add error check for long lines on debug prints Raw and From 'Power up system check 'test for Normal or Restart 'v1.9 optimise for UserprocessFlag 'v2.3 add Read and write on MX170 for System file access eg, INI/dat files 'v2.4 add mins to SDT function, DST fixes 'v2.4 compatible with uMite commander 1.1.48 and above, ESP8266-Mcu5.7 and above 'v2.5 add Close files (for uMite Plus) 'v2.6 add Read and Write array functions, Err routine changes 'v2.8 replace previous array functions with direct save for config.dat file to cfgdata() array 'v2.9 cleaned up exits from Do-Loops 'v3.0 remove PUSC sub declare 'v3.1 Err skip fix 'v3.2 Remove SD files support for MX170 , added RTC support 'v3.3 added seconds to SDC routine 'v3.5 added baud rate selection, added PrintLine function (acts like a scrolling terminal) 'v3.6 add RTC setclock via wifi 'v3.61 add single variable DAT file located in root folder 'v3.62 no change, ver only 'v3.63 expanded Printline sub to allow numer of lines available 'v3.64 checks if system has display, Skipwifi function by pin or program line, debug.print 'v3.65 add ability to skip wifi init by touching display at power up, not checked when no display. 'v3.66 add watchdog function and also wifi status 'v3.67 add support for receiving and processing "msg.rec" ESPMM (ESP micromite messaging) 'v3.68 MX170 Changes-disable wdat, add rdat wifiname,password and node variables, '***********Core functions for MXWifi - DO NOT REMOVE ********** dim ver$="3.68" dim Q$=chr$(34) dim integer maxWait=2000 'ESP handshake minimum wait dim integer CTRL_Z = 26 'Used in example as EOF marker dim integer CS_PIN=4 'Chip select pin conected to the SD card Dim res As Integer Dim cr$=chr$(13) + chr$(10) dim integer sdfilepos,err,minWait Dim Integer cfgNum=10 'set size of config array Dim String cfgdata(cfgnum) length 80 'general configuration array 80 char Dim lastline$,newline$,temp$,from$,cfg$,cmd$,strin$ dim Integer userprocessflag,ReadyFlag,stopflag,sdOpenFlag,starttime,debug Dim Integer md(12) = (0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334) 'used by dst cal dim integer dl.count,dl.print,Nodisp,chgwifi dim dl.txt$(15)length 40 dim esp.start,esp.ip$,esp.ver$,esp.alive,esp.link$ if isPlus()=1 then minWait=85 else minWait=85 end If 'setup pin for Nowifi , usefull when developing 'setpin 33,din 'will error if used on MX170 chip 'if pin(33)=0 then Nowifi=1 'check pin 33 first on MX470, if low ignore wifi setup, 'Nowifi=1 'use 1 for no wifi check or if pin33 not available '***** mxWiFi communications setup **** 'Pusc 'Power up system check-Not required with ver 3.xx library initWiFifile 1 , "19200" 'call initialise WiFi file transfer library, set comm port and baud rate to use '***** End mxWiFi communications setup **** pause 1000 'allow some time to touch display 'Clears display if there is one, if it fails sets NoDisp flag clearlines if Nodisp=0 then 'skip this check if NoDisp=1 if Touch(x) <> -1 then if touch(x)<250 and touch(y)>50 then Nowifi=1 'set nowifi flag else if touch(x)>250 and touch(y)<50 then chgwifi=1 end if end if end if '*************************************** Dim integer flag(20) 'Flag List (Examples) '0=err '1=timeout '*************************************** 'request Esp8266 firmware version res=0 do xbsend "ver:" Pause 100 userprocess res=res+1 Loop Until esp.ver$<>"" or res>5 'bail after 5 trys initialise: dl.print=1 'allows text printing during initialisation etc Print "WiFi "; esp.ver$ printline "WiFi "+ esp.ver$ If MM.Watchdog=1 Then Print "MXWifi v"; ver$ ; " System start from reboot" printline "MXWifi v" + ver$ + " System start from reboot" Else Print "MXWiFi v"; ver$ ; " System start from power up" printline "MXWiFi v"+ ver$ + " System start from power up" End If if Nowifi=1 then Print "Skipping Wifi Initialise" printline "Skipping Wifi Initialise" pause 2000 'wait to show message goto skipwifi end if 'check ESP8266 has started in Station mode and connected to access point 'if not write SSID and Password and restart temp$="Wait for ESP8266" res=0 Do dl.print=1 temp$=temp$+"." printline temp$,1 dl.print=0 Pause 2000 xbsend "ip:" Pause 100 userprocess res=res+1 Loop Until esp.ip$<>"" or res>30 'bail after 30+ secs print "IP address :" + esp.ip$ if res>30 then print "Error: waiting to long for ESP8266" printline "Error: waiting to long for ESP8266" printline "Stopping.........." pause 1000 End end if if chgwifi=1 then dl.print=1:printline "Force New Wifi Setup":dl.print=0 end if temp$=rdat$("reset") print temp$ 'If Instr(esp.ip$,"192.168.4.1")>0 or temp$="YES" Then 'force to read new SSID and Password If chgwifi=1 or temp$="YES" Then 'force to read new SSID and Password dl.print=1:printline "ESP8266 setup " printline "Assign new network details " temp$=rdat$("wifiname") printline "New SSID: " + temp$ xbsend "write:WIFIname:" + temp$ 'edit with required SSID pause 5000 temp$=rdat$("wifipass") printline "New Password: " + temp$ xbsend "write:WIFIpass:" + temp$ 'edit with required password pause 5000 temp$=rdat$("espnode") printline "New node name: " + temp$ xbsend "write:espnode:" + temp$ 'edit with required Node name Pause 5000 on error skip kill "\reset.dat" printline "" printline "Please now switch off power" printline "wait 5 secs and then switch on again" End EndIf dl.print=1 if Instr(esp.ip$,"192.168.4.1")>0 then printline "IP:192.168.4.1 in AP-Mode.." else printline "WiFi connected to IP:" + esp.ip$ end if skipwifi: printline "" printline "Starting main program ..........." 'put a delay in the main code to show above message 'then turn off printline messages with dl.print=0 '*************************************************** Test user code '*************************************************** End Test user code Sub UserProcess local temp$ if instr(newline$,"debug:")>0 then ' print newline$ 'debug end if 'Parse fields 'print 'Print "New Run" if debug=1 Then print "Raw:" + newline$ 'debug prints any complete lines from ESP8266 from$=parse$(newline$,2,"|") cmd$=parse$(newline$,3,"|") cfg$=parse$(newline$,4,"|") strin$=parse$(newline$,5,"|") print "From:";from$;" Cmd:";cmd$;" Config:";cfg$;" Data:";strin$ if instr(newline$,"udp.rec:")>0 or instr(newline$,"msg.rec:")>0 then 'add support for ESPMM (ESP micromite messaging) select case cmd$ case "close" if isplus()=1 then on error skip close #1 If ChkErr()>0 then exit Sub xbsend "udp.send:|"+from$+"|File-Closed" WaitforReady end if case "date" xbsend "udp.send:|"+from$+"|Date-read|"+date$ WaitforReady case "time" if cfg$="set" then time$=parse$(strin$,1,"-")+":"+parse$(strin$,2,"-")+":"+parse$(strin$,3,"-") elseif cfg$="read" then xbsend "udp.send:|"+from$+"|Time-read|"+time$ WaitforReady end if case "reload" if isplus()=1 then load cfg$,R else bootload cfg$ end if case "resetall" xbsend "reboot:" 'restart ESP8266 watchdog 100 'set the uMite to time out pause 200 'pause to wait for time out case "resetesp" xbsend "reboot:" 'restart ESP8266 case "resetmite" watchdog 100 'set the uMite to time out pause 200 'pause to wait for time out case "write" If InStr(ucase$(cfg$),"CONFIG.DAT")>0 Then writecfg strin$,cfgnum Else if isplus()=1 then writefile from$,cfg$,strin$ End If case "rmdir" if isplus()=1 then on error skip rmdir cfg$ res=ChkErr() if err>0 then exit sub end if xbsend "udp.send:|"+from$+"|Dir-deleted|"+cfg$ case "delete" if isplus()=1 then on error skip kill cfg$ res=ChkErr() if err>0 then exit sub xbsend "udp.send:|"+from$+"|File-deleted|"+cfg$ end if case "read" 'read file if isplus()=1 then readfile cfg$,from$ case "readb" 'read file Random access ' readfileB cfg$,from$ case "list" 'list folders/files if isplus()=1 then listfiles from$,cfg$ case "chdir" 'change dir if isplus()=1 then on error skip chdir ucase$(cfg$) res=ChkErr() if err>0 then exit sub end if case "mkdir" 'change dir if isplus()=1 then on error skip mkdir cfg$ res=ChkErr() if err>0 then exit sub end if case "crdir" 'current dir on error skip xbsend "udp.send:|"+from$+"|curr-dir|"+cwd$ res=ChkErr() if err>0 then exit sub 'commands preceeded by x are Non uMite Plus commands 'removed in v3.2 'other commands case else on error skip extCmd res=ChkErr() end select elseif instr(newline$,"ESP:")>0 then 'feedback from ESP module 'print "Ext command from ESP only" if cmd$="start" then esp.start=1 if cmd$="ver" then esp.ver$=strin$ if cmd$="ip" then esp.ip$=strin$ if cmd$="watchdog" then esp.alive=30000 'watchdog from ESP module, esp alive can be counted down 'and detected by main program to use function esp.link$=cfg$ 'contains wifi status end if 'printline newline$ on error skip extCmd res=ChkErr() EndIf End Sub function isPlus() as integer isplus=0 if mm.device$="Micromite Plus" then isplus=1 end function 'write a file to current folder 'v2.6 add write array sub writefile(dest$,fname$,d$) on error skip OPEN fname$ FOR append AS #1 if ChkErr()>0 then exit sub on error skip print #1,d$ if ChkErr()>0 then exit sub 'print "Write data:";d$ CLOSE #1 xbsend "udp.send:|"+dest$+"|"+chr$(4)+"|" end Sub 'write a single variable dat file sub wdat(fname$,d$) if isplus()=0 then exit sub 'not used in mx170 on error skip OPEN "\"+fname$+".dat" FOR output AS #1 if ChkErr()>0 then exit sub on error skip print #1,d$ if ChkErr()>0 then exit sub print "Done Write dat ";d$ CLOSE #1 end Sub 'read a single variable dat file function rdat$(fname$) if isplus()<>1 then ' if mx170 load variables if fname$="wifiname" then rdat$=w170name$ if fname$="wifipass" then rdat$=w170pass$ if fname$="espnode" then rdat$=w170node$ else rdat$="" on error skip OPEN "\"+fname$+".dat" FOR input AS #1 if ChkErr()>0 then exit function on error skip line input #1,rdat$ if ChkErr()>0 then exit function print "Done Read dat ";rdat$ CLOSE #1 end if end function 'open requested file and return data sub readfile(fname$,Dest$) local a$,b$ on error skip OPEN fname$ FOR input AS #1 if ChkErr()>0 Then goto exitread print "Start of Doc Send" do while not eof(#1) Watchdog 8000 if stopFlag=1 then exit do on error skip line input #1,b$ if ChkErr()>0 then Exit Do 'check for reading from array xbsend "udp.send:|"+dest$+"|Line|"+fname$+"|"+b$ WaitforReady 'reset flag loop 'print "udp.send:|"+dest$+"|Doc-Close|"+fname$ xbsend "udp.send:|"+dest$+"|Doc-Close|"+fname$ WaitforReady 'reset flag xbsend "flush:" 'clear ESP8266 serial buffer exitread: on error skip Close #1 stopFlag=0 print "End of Doc Send" End Sub 'write to config array variable sub writecfg(d$,sys) Local p As Integer p=Val(Parse$(d$,1)) If p=0 Then Exit Sub If p>sys Then Exit sub on error skip print "Save Config array :";Mid$(d$,InStr(d$,",")+1) printline "Save Config array :"+Mid$(d$,InStr(d$,",")+1) cfgdata(p)=Mid$(d$,InStr(d$,",")+1) res=ChkErr() End Sub 'Check Error routine call is placed after the line that is being Skipped 'The routine will report the errors out to console and via UDP Function ChkErr() As Integer ChkErr=0 if mm.errno<>0 then print "Error# ";mm.errno; " "; mm.errmsg$ printline "Error# "+str$(mm.errno)+ " "+ mm.errmsg$ xbsend "udp.send:|"+from$+"|Error#|"+ str$(mm.errno) + " " + mm.errmsg$ +"|" WaitforReady 'reset flag ChkErr=1 end if end function 'list files sub Listfiles(Dest$,type$) local f$ if type$="file" then on error skip f$ = DIR$("*", FILE) if ChkErr()>0 then GoTo exitlistfiles ElseIf type$="dir" then on error skip f$ = DIR$("*", DIR) if ChkErr()>0 Then GoTo exitlistfiles endif print "mode is:";type$ print "Start of UDP Directory Send" 'print "f:";f$ DO WHILE f$ <> "" Watchdog 8000 print "f:";f$ printline "f:"+f$ print "udp.send:|"+dest$+"|"+type$+"|"+f$ xbsend "udp.send:|"+dest$+"|"+type$+"|"+f$ WaitforReady 'reset flag on error skip f$ = DIR$() if ChkErr()>0 Then Exit Do LOOP ExitListfiles: print "udp.send:|"+dest$+"|"+type$+"-Close|" xbsend "udp.send:|"+dest$+"|"+type$+chr$(4)+"|" WaitforReady 'reset flag 'xbsend "flush:" 'clear ESP8266 serial buffer print "End of UDP Send" end sub sub WaitforReady local timeout, period timeout = Timer do while ReadyFlag=0 if Timer-timeout>MaxWait then exit do 'wait max 1000 mSec loop 'wait for ready from ESP8266 period=Timer-timeout if period<=1 then pause MinWait 'make sure there is a min period 'print "Wait:";period ReadyFlag=0 'reset flag end sub Function Parse$(s$,FieldNumber,d$) Local String stringArg$ Local Integer intOldY,intY,intX 'print s$;" ";fieldnumber;" ";d$ if d$="" then d$="," endif StringArg$ = S$ + d$ intOldY = 1:intX=0:intY=0 Parse$ = "" do While intY < Len(StringArg$) And intX < FieldNumber intY = Instr(intOldY, StringArg$, d$) intX = intX + 1 If intX = FieldNumber Then parse$ = Mid$(StringArg$, intOldY, intY - intOldY) Endif intOldY = intY + 1 loop 'print s$; intx; inty; intoldy 'print fieldnumber;" ";parse$ End Function Function Ltrim(sString As String)As String ltrim=Str$(Val(sString)) End Function 'replaceString$(string$, replaceWhat$, replaceWith$) FUNCTION replace$(R$, a$, b$) local integer i,j,c,d d=1 replace$=R$ i = LEN(a$) : j = LEN(b$) do while INSTR(d,replace$, a$) > 0 c = INSTR(d,replace$, a$) replace$ = LEFT$(replace$, c-1) + b$ + MID$(replace$, c+i) d = c+j loop END FUNCTION 'Comms for ESP8266 'initialise routines Sub iniTWiFifile (c as integer,baud as string) Open "com" + str$(c) + ":" + baud + ",1024,Xbreceive" As #5 'initialise commS End Sub Sub xbreceive 'reads bytes from comms buffer , data terminated bt CR will output a NewLine$ and set the UserFlag 'also checks for block data transmissions , start with SOH (Dec 1) local a$ local bl as integer 'print "Buffer:";loc(5) a$=Input$(1,#5) 'user supplied processing routine If debug=1 Then Print a$; 'debug prints any CHR from ESP8266 if a$=chr$(4) then ReadyFlag=1:exit sub end if if a$=chr$(26) then stopflag=1 if a$=chr$(10) then exit sub 'ignore Line feed 'print "Line length:";len(lastline$) if len(lastline$)=>254 then lastline$=lastline$ + a$ a$=chr$(13) 'terminate line to force processing else lastline$=lastline$ + a$ 'add to data packet endif packet: if a$=chr$(13)and len(lastline$)>1 or a$=chr$(02) or a$=chr$(26) then if a$=chr$(13) then a$="" 'don't want CR added if a$=chr$(02) then 'get rest of Block print "Block";191;len(lastline$) print "Buffer";loc(5) print "Lastlins$:";lastline$ on error skip a$=Input$(loc(5),#5) res=ChkErr() end if Newline$=Lastline$ + a$ lastline$="" if instr(newline$,"udp.send:")>0 then 'filter out sent strings being returned exit sub else UserProcessFlag=1 'set process data flag end if endif End Sub Sub xbsend (msgframe$) on error skip Print #5,msgframe$ End Sub 'End of ESP8266 Comms 'End of Library code '*********** End of Core functions for MXWifi - DO NOT REMOVE above code********** 'Optional Library Items may be selectively removed if required ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Display routines ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Printline function, prints a line of text scrolling down screen like a terminal sub printline(t$,l,fl,ll) print "Debug: "+t$ if Nodisp=1 then exit sub if dl.print=0 then exit sub if fl=0 then fl=1 if ll=0 then ll=15 t$=left$(t$,40) 'trim if req if l=1 then 'just print on same line dl.txt$(dl.count)=t$+space$(40-len(t$)) text 1,dl.count*15,dl.txt$(dl.count) exit sub end if local x if dl.count>ll then for x= fl to ll dl.txt$(x-1)=dl.txt$(x) 'move line up next x for x= fl-1 to ll-1 text 1,x*15,dl.txt$(x) next x dl.count=ll end if dl.txt$(dl.count)=t$+space$(40-len(t$)) text 1,dl.count*15,dl.txt$(dl.count) dl.count=dl.count +1 end sub 'clears screen and resets line count for Printline function sub clearlines on error skip cls if ChkErr()>0 then Nodisp=1 dl.count=0 end sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Draw options and get button presses ' These two subs draw the option title, value and a button labeled "CHANGE" ' The function CheckButtonPress() will check if a button has been touched. ' ' These routines use the arrays key_coord() and key_caption() to track the ' coordinates and size of each button and save its caption. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' draw a single option Sub DrawOption n As Integer, colour As Integer, caption As String, vert As Integer, var As Float, units As String Const btn_width = 120 Const fonth = MM.FontHeight * 2 Const space = 4 Text MM.HRes/2, vert, caption, CT, 1, 2, colour If var <> -1 Then Text MM.HRes/2 - 20, vert + fonth + space, Str$(var) + " " + units, RT, 1, 2, colour key_coord(n,0) = MM.HRes/2 + 20 : key_coord(n,1) = vert + fonth + space/2 key_coord(n,2) = btn_width : key_coord(n,3) = fonth + space key_coord(n,4) = RGB(cyan) key_caption(n) = "CHANGE" DrawButton n, 0 End Sub ' draw a button Sub DrawButton n As Integer, pressed As Integer If pressed Then ' draw in reverse video if it is being touched RBox key_coord(n,0), key_coord(n,1), key_coord(n,2), key_coord(n,3), , key_coord(n,4), key_coord(n,4) Text key_coord(n,0) + key_coord(n,2)/2, key_coord(n,1) + key_coord(n,3)/2, key_caption(n), CM,1,2, 0, key_coord(n,4) Else ' otherwise draw a normal button RBox key_coord(n,0), key_coord(n,1), key_coord(n,2), key_coord(n,3), , key_coord(n,4), 0 Text key_coord(n,0) + key_coord(n,2)/2, key_coord(n,1) + key_coord(n,3)/2, key_caption(n), CM,1,2, key_coord(n,4), 0 EndIf End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' the next two subroutines are responsible for drawing the keypad, ' animating the key presses and returning the entered value as a float. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Get a number ' when the user touches ENT (enter) the value is saved into the variable var ' which is parsed as reference as the second argument ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub GetFloat caption As String, var As Float Const bw = MM.HRes\4, bh = MM.VRes\5 ' these are the captions on each key Local String cap(15) = ("7","8","9","","4","5","6","","1","2","3","Can",".","0","Del","ENT") Local Integer key, keydwn Local Integer x, y, xt, yellowt, btn Local String s CLS 0 ' draw the title Text 0, 8, caption + ": ", , 1, 2, RGB(yellow), 0 ' draw the entire keypad (99 means draw them all) DrawKeypad 99 Do If Touch(x) <> -1 And Not keydwn Then ' if the panel is touched keydwn = 1 xt = Touch(x) yellowt = Touch(y) btn = 1 For y = bh To MM.VRes - bh Step bh For x = 0 To MM.HRes - bw Step bw If cap(btn-1) <> "" And xt > x And xt < x+bw And yellowt > y And yellowt < y+bh Then x = 1000 : y = 1000 ' exit both loops Else btn = btn + 1 EndIf Next x Next y ' continue looping if the touch was not on a key If btn > 16 Then Continue do ' special handling for the +, - and . keys If (btn = 4 Or btn = 8) And s <> "" Then Continue do If btn = 13 And Instr(s, ".") > 0 Then Continue do ' draw the key as pressed DrawKeypad btn ' special processing for Can (cancel), Del and Ent (enter) If btn = 12 Or btn = 16 Then Continue do If btn = 15 Then If s <> "" Then s = Left$(s, Len(s) - 1) Else s = s + cap(btn - 1) ' add the key to our entered string EndIf Text Len(caption + ": ") * 16, 8, s + " ", , 1, 2, RGB(yellow), 0 EndIf ' if a key is currently down check if it has been released If Touch(x) = -1 And keydwn Then ' yes, the key has been released ' draw the key as normal (ie, not pressed) keydwn = 0 DrawKeypad -btn ' if ENT return the value If btn = 16 And s <> "" Then var = Val(s) ' if Can just return If btn = 12 Or btn = 16 Then Exit Do EndIf Loop End Sub ' this draws the keypad ' if the argument is 99 all keys will be drawn ' if it is negative the particular key will be drawn as normal ' if it is positive the key will be drawn as depressed Sub DrawKeypad btndwn As Integer Const bw = MM.HRes\4, bh = MM.VRes\5 Local String cap(15) = ("7","8","9","","4","5","6","","1","2","3","Can",".","0","Del","ENT") Local Integer x, y, btn btn = 1 For y = bh To MM.VRes - bh Step bh For x = 0 To MM.HRes - bw Step bw If cap(btn - 1) <> "" Then If btn = btndwn Then ' draw the key as touched (ie, reverse video) RBox x + 5, y + 5, bw - 5, bh - 5, , RGB(cyan), RGB(cyan) Text x + bw/2 + 4, y + bh/2 + 6, cap(btn - 1), CM,1,2, 0, RGB(cyan) ElseIf -btn = btndwn Or btndwn = 99 Then ' draw the key as normal RBox x + 5, y + 5, bw - 5, bh - 5, , RGB(cyan), 0 Text x + bw/2, y + bh/2 + 2, cap(btn - 1), CM,1,2, RGB(cyan), 0 EndIf EndIf btn = btn + 1 Next x Next y End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' routines to draw the option pages and get any changes ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' draw a menu item option Sub DrawMenuOption n As Integer, colour As Integer, caption As String, vert As Integer Const btn_width = 120 Const fonth = MM.FontHeight * 2 Const space = 4 key_coord(n,1) = vert + fonth + space/2 Text 2, key_coord(n,1), caption,, 1, 2, colour key_coord(n,0) = MM.HRes/2 + 20 key_coord(n,2) = btn_width : key_coord(n,3) = fonth + space key_coord(n,4) = RGB(cyan) key_caption(n) = "SELECT" 'print "Drawmenuoption";n DrawButton n, 0 End Sub Sub DrawButtonOnly n As Integer, caption As String,hpos as integer, vert As Integer,hwidth as integer Const btn_width = hwidth Const fonth = MM.FontHeight * 2 Const space = 4 key_coord(n,1) = vert + fonth + space/2 'Text 2, key_coord(n,1), caption,, 2, 1, colour key_coord(n,0) = hpos key_coord(n,2) = btn_width : key_coord(n,3) = fonth + space key_coord(n,4) = RGB(cyan) key_caption(n) = Caption 'print "DrawbuttonOnly";n DrawButton n, 0 End Sub ' *************** General Subs/Functions ********** ' *************** Time & Date functions Sub IncTime Local iHr As Integer 'Print Time$ ihr=Val(parse$(Time$,1,":")) iHr=ihr+1 If ihr=24 Then ihr=0 Time$=Str$(ihr,2,0,"0")+":"+parse$(Time$,2,":")+":"+parse$(Time$,3,":") 'Print Time$ End Sub 'convert month to number function moy(mon$)As Integer For moy=1 To 12 if UCase$(mon$)=parse$(numofmonth$,moy) Then Exit For Next end function Function IsDST() As Integer Local S$,E$ Local integer mon,startYr,sun1,sun2,d0,day 'get the serial of the date to test d0=sdt(date$,"","d") 'of the date only 'get the current month and the current year for DST ie Oct to Apr mon=Val(parse$(date$,2,"-")) startyr=Val(parse$(date$,3,"-")) If mon=>1 And mon=<4 Then startyr=startyr-1 s$=("1-10-"+str$(startyr)) e$=("1-4-"+str$(startyr+1)) else s$=("1-10-"+str$(startyr)) e$=("1-4-"+str$(startyr+1)) end If 'print d0 'print s$;" ";e$ 'find start sunday and end sunday day=GetDOW(SDT(s$)) sun1=sdt(s$,"","d") sun2=sdt(e$,"","d") if day>0 then sun1=((7-day)*86400)+sun1 end if day=GetDOW(SDT(e$)) if day>0 then sun2=((7-day)*86400)+sun2 end if 'print "sun1&2:";sun1;" ";sun2 If d0 >=sun1 And d0 2000 Then yr=yr-2000 if yr>0 then GetSec = (yr - 14) * (365 * 24 * 60) GetSec = GetSec + ((yr - 13) \ 4) * (24 * 60) GetSec = GetSec + (md(mth) * (24 * 60)) GetSec = GetSec + ((day - 1) * (24 * 60)) end if GetSec = GetSec + (hr * 60) GetSec = ((GetSec + min) * 60) + sec if yr>0 then If (yr - 16) Mod 4 = 0 And mth > 2 Then GetSec = GetSec + (24 * 3600) end if End Function