Support Forum / Форум поддержки

Mr.Kibernetik software support
https://nitisara.ru/forum/

Программа учета жидкости в организме

https://nitisara.ru/forum/viewtopic.php?f=21&t=1033

Page 1 of 1

Программа учета жидкости в организме

Posted: Wed Apr 29, 2015 7:18 am
by Igor

Code: Select all

' Программа учета введенной и выведенной жидкости Water Counter
SET TOOLBAR OFF
SET ORIENTATION TOP
graphics
graphics clear .8,.8,1
draw color 0,0,0
fill color .8,.8,1
maxx=SCREEN_WIDTH ()
maxy=SCREEN_HEIGHT ()
dx=int(maxx/25.6)
dy=int(maxy/40)
dim infuse$(7) 'имена файлов включенных инфузий
numberInfuse=0 ' количество включенных инфузий
dim inf(24) ' инфузия за сутки
dim pil(24) ' выпил за сутки
dim pis(24) ' выделил за сутки
dim ves(24) 
dim infPrn(24)
dim pilPrn(24)
dim pisPrn(24)
dim vesPrn(24)
dim dnm(12)
dim month$(12)
dim monthEng$(12)
dim weekDay$(7)
dim modeInf(7)
dim volumeInf(7)
dim speedInf(7)
dim balanceInf(7)
folderName$="datawater/"
txtFont$="AmericanTypewriter-CondensedBold"
fldName$="field"
yearLd=0!monthLd=0!dayLd=0!hourLd=0!minLd=0!secLd=0
data "января","Jan",31,"февраля","Feb",28,"марта","Mar",31,"апреля","Apr",30
data "мая","May",31,"июня","Jun",30,"июля","Jul",31,"августа","Aug",31
data "сентября","Sep",30,"октября","Oct",31,"ноября","Nov",30,"декабря","Dec",31
data "воскресенье","понедельник","вторник","среда","четверг","пятница","суббота"

def NowDate() ' Определяет текущее время и дату
y=CURRENT_YEAR ()
m=CURRENT_MONTH ()-1
d=CURRENT_DATE ()
dn=CURRENT_DAY ()
hour=CURRENT_HOUR ()
min=CURRENT_MINUTE ()
sec=CURRENT_SECOND ()
end def

def FindWeekDay(year,month,day) ' Вычисляет день недели
month+=1
a=integ((14-month)/12)
y=year-a
m=month+12*a-2
FindWeekDay=(7000+(day+y+integ(y/4)-integ(y/100)+integ(y/400)+integ((31*m)/12)))%7
end def

def PrntDate(cy,cm,cd) 'печатает дату и время
cdn=FindWeekDay(cy,cm,cd)
ch=CURRENT_HOUR ()
cmi=CURRENT_MINUTE ()
cs=CURRENT_SECOND ()
chs$=ch
cms$=cmi
css$=cs
if ch<10 then chs$="0"&chs$
if cmi<10 then cms$="0"&cms$
if cs<10 then css$="0"&css$
a$=chs$&":"&cms$&":"&css$
draw font size .dy*7/8
fill rect 0,.dy/2 size .maxx,.dy
draw TEXT a$ AT .maxx-5*.dx,.dy/2
a$=cd&" "&.month$(cm)&" "&cy&" г. "&.weekDay$(cdn)
draw text a$ at .dx/2,.dy/2
end def

def SaveData() ' Сохранение всех данных
NowDate()
year=NowDate.y
month=NowDate.m
day=NowDate.d
hour=NowDate.hour
min=NowDate.min
fn$=.folderName$&"timeInfo"
if file_exists(fn$)=0 then dir .folderName$ create
file fn$ print
file fn$ trim
file fn$ print year;month;day;hour;min
.yearLd=year!.monthLd=month!.dayLd=day!.hourLd=hour!.minLd=min
tekFoldName$=.folderName$&year&"/"&.monthEng$(month)&"/"
if File_Exists(tekFoldName$)=0 then DIR tekFoldName$ CREATE
fn$=tekFoldName$&day
file fn$ print
file fn$ trim
for i=0 to 23
 FILE fn$ print .inf(i);.pil(i);.pis(i);.ves(i)
next i
if .numberInfuse>0 then
 fn$=.folderName$&"infuses/inf"
 for i=0 to .numberInfuse-1
  if file_exists(fn$&i) then file fn$&i trim
  if .modeInf(i)>0 then
   FILE fn$&i print .modeInf(i);.volumeInf(i);.speedInf(i);.balanceInf(i)
  else
   FILE fn$&i delete
  end if
 next i
end if
end def

def LoadDataStart() ' Первоначальная загрузка данных
fn$=.folderName$&"timeInfo"
NowDate()
.yearLd=NowDate.y!.monthLd=NowDate.m!.dayLd=NowDate.d!.hourLd=NowDate.hour!.minLd=NowDate.min
if file_exists(fn$)=0 then
 dir .folderName$ create
 file fn$ print .yearLd;.monthLd;.dayLd;.hourLd;.minLd
end if
file fn$ reset
if DATA_EXIST(fn$) then FILE fn$ input .yearLd,.monthLd,.dayLd,.hourLd,.minLd
tekFoldName$=.folderName$&.yearLd&"/"&.monthEng$(.monthLd)&"/"
if File_Exists(tekFoldName$)=0 then DIR tekFoldName$ CREATE
fn$=tekFoldName$&.dayLd
file fn$ print
file fn$ reset
for i=0 to 23
.inf(i)=0!.pil(i)=0!.pis(i)=0!.ves(i)=0
if DATA_EXIST(fn$) then FILE fn$ input .inf(i),.pil(i),.pis(i),.ves(i)
next i
if .numberInfuse>0 then
 fn$=.folderName$&"infuses/inf"
 for i=0 to .numberInfuse-1
  .modeInf(i)=0!.volumeInf(i)=0!.speedInf(i)=0!.balanceInf(i)=0
  if file_exists(fn$&i) then file fn$&i reset
  if data_exist(fn$&i) then 
   FILE fn$&i input .modeInf(i),.volumeInf(i),.speedInf(i),.balanceInf(i)
  end if
 next i
end if
end def

def LoadData(year,month,day) ' Загрузка данных на сутки
tekFoldName$=.folderName$&year&"/"&.monthEng$(month)&"/"
if File_Exists(tekFoldName$)=0 then DIR tekFoldName$ CREATE
fn$=tekFoldName$&day
file fn$ print
file fn$ reset
for i=0 to 23
.infPrn(i)=0!.pilPrn(i)=0!.pisPrn(i)=0!.vesPrn(i)=0
if DATA_EXIST(fn$) then FILE fn$ input .infPrn(i),.pilPrn(i),.pisPrn(i),.vesPrn(i)
next i
file fn$ trim
for i=0 to 23
 FILE fn$ print .infPrn(i);.pilPrn(i);.pisPrn(i);.vesPrn(i)
next i
end def

def ScreenDraw() 'рисует таблицу
dx=integ(.maxx/12)
draw size 2
draw line 1,2*.dy to 6*dx,2*.dy
draw line to 6*dx,33*.dy
draw line to 1,33*.dy
draw line to 1,2*.dy
draw line 5*dx,2*.dy to 5*dx,33*.dy
for i=0 to 29
draw line 1,.dy*(4+i) to 6*dx,.dy*(4+i)
next i
draw line dx,.dy*2 to dx,.dy*33
draw line 3*dx,.dy*2 to 3*dx,.dy*33
draw line 4*dx,.dy*2 to 4*dx,.dy*33
draw size 1
draw line 2*dx,.dy*3 to 2*dx,.dy*33
draw line dx,.dy*3 to 3*dx,.dy*3
draw line .maxx/2+10,2*.dy to .maxx,2*.dy
draw line .maxx/2+10,4*.dy to .maxx,4*.dy
draw font size 3*.dy/6
draw text " Время" at 6,2.5*.dy+8
draw text "Получил :" at 1.5*dx,2*.dy+7
draw text "Выделил" at 3*dx+3,2.5*.dy+8
draw text "Разность" at 4*dx+3,2.5*.dy+8
draw text "  Вес" at 5*dx+3,2.5*.dy+8
draw text "инфузии" at dx+5,3*.dy+7
draw text " выпил" at 2*dx+5,3*.dy+7
draw font size 3*.dy/4
t=7
for hy=0 to 23
ts$=""
if t<10 then ts$="0"
ts$=ts$&t&"-"
t+=1
if t=24 then t=0
if t<10 then ts$&="0"
ts$&=t
gr=integ(hy/6)
draw text ts$ at 4,(4+hy+gr)*.dy+3
next hy
draw color 1,0,0
draw text "07-13" at 4,10*.dy+3
draw text "13-19" at 4,17*.dy+3
draw text "19-01" at 4,24*.dy+3
draw text "01-07" at 4,31*.dy+3
draw text "Итого" at 4,32*.dy+3
draw color 0,0,0
draw font size .dy
end def

def MenuItems()
dy=.dy
x0=.maxx/2+5
y0=2.5*dy
xsize=.maxx/8-10
draw color 0,0,0
fill color 1,0,1
SET BUTTONS CUSTOM
SET BUTTONS FONT SIZE 16
BUTTON "but21" TEXT "Инфузии" AT x0,y0 SIZE xsize,dy
button "but22" text "Выпил" at x0+xsize+10,y0 size xsize,dy
button "but23" text "Выделил" at x0+2*(xsize+10),y0 size xsize,dy
button "but24" text "Вес" at x0+3*(xsize+10),y0 size xsize,dy
SET BUTTONS FONT DEFAULT
draw color 0,0,0
fill color .8,.8,1
SET BUTTONS DEFAULT
end def

def CheckInfuse()
EraseNilInfuses()
InitInfuseFolder()
for i=0 to 6
EraseInfuseTable(i)
next i
dy=.dy
x0=.maxx/2+10
fn$=.folderName$&"infuses/inf"
for i=0 to .numberInfuse-1
 y0=dy*(2.5+4.5*i)+3
 file fn$&i reset
 file fn$&i input .modeInf(i),.volumeInf(i),.speedInf(i),.balanceInf(i)
 volint=int(.volumeInf(i)*10)/10
 spint=int(.speedInf(i)*10)/10
 balint=int(.balanceInf(i)*10)/10
 DRAW FONT SIZE 20
 draw text volint at x0+200-TEXT_WIDTH (str$(volint)),y0+3*dy
 draw text spint at x0+200-TEXT_WIDTH (str$(spint)),y0+4*dy
 draw text balint at x0+200-TEXT_WIDTH (str$(balint)),y0+5*dy
 PrntInfuseTable(i)
 bn=3*i+1
 BUTTON "but"&bn show '  кнопка stop
 if .modeInf(i)=1 then
  bn=3*i
  BUTTON "but"&bn show '  кнопка pause
  bn=3*i+2
  BUTTON "but"&bn hide ' кнопка start
  ost=balint/spint
  if ost>1 then
   timeint$=str$(int(10*ost)/10)&" час"
  else
   timeint$=str$(int(60*ost))&" мин"
  end if
  DRAW FONT SIZE 20
  draw text timeint$ at .maxx-TEXT_WIDTH (timeint$)-5,y0+5*dy
  end if
 if .modeInf(i)=2 then
  bn=3*i
  BUTTON "but"&bn hide '  кнопка pause
  bn=3*i+2
  BUTTON "but"&bn show ' кнопка start
 end if
next i
DRAW FONT SIZE dy
end def

def DrawButtons()
dy=.dy
x0=.maxx/2+10
DRAW FONT SIZE 20
DRAW FONT NAME .txtFont$
SET BUTTONS FONT NAME .txtFont$
for number=0 to 6
y0=dy*(4.5+4.5*number)
draw color 0,0,1
fill color 1,1,0
SET BUTTONS CUSTOM
bn=3*number
BUTTON "but"&bn TEXT "pause" AT x0+120,y0 SIZE 100,dy
BUTTON "but"&bn hide
bn=3*number+1
draw color 1,1,1
fill color 1,.3,.3
SET BUTTONS CUSTOM
BUTTON "but"&bn TEXT "stop" AT x0+260,y0 SIZE 100,dy
BUTTON "but"&bn hide
bn=3*number+2
draw color 0,0,0
fill color .6,1,.6
SET BUTTONS CUSTOM
BUTTON "but"&bn TEXT "start" AT x0+260,y0+1.5*dy SIZE 100,2.3*dy
BUTTON "but"&bn hide
next number
DRAW FONT NAME "Courier-Bold"
DRAW FONT SIZE dy
SET BUTTONS FONT DEFAULT
draw color 0,0,0
fill color .8,.8,1
SET BUTTONS DEFAULT
end def

def PrntInfuseTable(number) ' Рисует поля инфузии
dy=.dy
x0=.maxx/2+10
y0=dy*(4.5+4.5*number)
DRAW FONT SIZE 20
DRAW FONT NAME .txtFont$
draw line .maxx/2+10,y0+4*dy to .maxx,y0+4*dy
draw text "Инфузия "&(number+1) AT x0,y0
draw text "Объем :" at x0,y0+dy
draw text "Скорость :" at x0,y0+2*dy
draw text "Остаток :" at x0,y0+3*dy
draw text "мл" at x0+210,y0+dy
draw text "мл/ч" at x0+210,y0+2*dy
draw text "мл" at x0+210,y0+3*dy
draw line .maxx/2+10,(4+4.5*number)*dy to .maxx,(4+4.5*number)*dy
DRAW FONT NAME "Courier-Bold"
DRAW FONT SIZE dy
end def

def EraseInfuseTable(number) 'Удаляет с экрана инфузию номер number
dy=.dy
x0=.maxx/2+10
y0=dy*(4.5+4.5*number)
fill rect x0,y0 to .maxx,y0+4*dy
bn=3*number
BUTTON "but"&bn hide
bn=3*number+1
BUTTON "but"&bn hide
bn=3*number+2
BUTTON "but"&bn hide
end def

def EraseNilInfuses() ' Удаляет файлы пустых инфузий
fn$=.folderName$&"infuses/inf"
for i=0 to 6
if file_exists(fn$&i) then
 file fn$&i reset
 if data_exist(fn$&i) then 
  FILE fn$&i input .modeInf(i),.volumeInf(i),.speedInf(i),.balanceInf(i)
  if .modeInf(i)=0 then FILE fn$&i delete
 else
  FILE fn$&i delete
 end if
end if
next i
end def

def PrntPilTable() ' Рисует поле Выпил
p$="newpil"
x0=.maxx/5!y0=200!width=3*.maxx/5!height=300
BUTTON "but21" HIDE
BUTTON "but23" HIDE
BUTTON "but24" HIDE
PAGE p$ SET
PAGE p$ COLOR .6,.6,.8,.9
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BUTTON "pilbutOK" TEXT "OK" AT width/4,4*height/5 SIZE width/2,.dy*2
FIELD "volpil" TEXT "" AT 10,4*.dy RO
FIELD "volpil" FONT SIZE 1.5*.dy
FIELD "volpil" TEXT " Выпил :" AT 10,4*.dy RO
FIELD "volpil" BACK ALPHA 0
FIELD "volpil" BACK COLOR .6,.6,.8
FIELD "involpil" TEXT "" AT 2*width/5+5,4*.dy
FIELD "involpil" FONT SIZE 1.5*.dy
FIELD "involpil" TEXT "" AT 2*width/5+5,4*.dy size width/3,2*.dy
FIELD "involpil" BACK ALPHA 1
FIELD "involpil" BACK COLOR .9,.9,.9
FIELD "pilml" TEXT "" AT 11*width/15+15,4*.dy RO
FIELD "pilml" FONT SIZE 1.5*.dy
FIELD "pilml" TEXT " мл" AT 11*width/15+15,4*.dy RO
FIELD "pilml" BACK ALPHA 0
FIELD "pilml" BACK COLOR .6,.6,.8
x1=0!y1=0
butPres=0
while (x1+y1)<1 and butPres=0
 x=TOUCH_X(0)
 y=TOUCH_Y(0)
 x1=0!y1=0
 if (x>0 and x<x0) or x>(x0+width) then x1=1
 if (y>0 and y<y0) or y>(y0+height) then y1=1
 butPres=button_pressed("pilbutOK")
 CheckTime()
end while
PAGE p$ HIDE
BUTTON "but21" show
BUTTON "but23" show
BUTTON "but24" show
if butPres=0 then return
vol=val(FIELD_TEXT$ ("involpil"))
if vol<0 or vol>1999 then return
NowDate()
h=NowDate.hour
.pil(h)+=vol
SaveData()
PrntTable(.prnYear,.prnMonth,.prnDay)
end def

def PrntPisTable() ' Рисует поле выделил
p$="newpis"
x0=.maxx/5!y0=200!width=3*.maxx/5!height=300
BUTTON "but21" HIDE
BUTTON "but22" HIDE
BUTTON "but24" HIDE
PAGE p$ SET
PAGE p$ COLOR .6,.6,.8,.9
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BUTTON "pisbutOK" TEXT "OK" AT width/4,4*height/5 SIZE width/2,.dy*2
FIELD "volpis" TEXT "" AT 10,4*.dy RO
FIELD "volpis" FONT SIZE 1.5*.dy
FIELD "volpis" TEXT "Выделил:" AT 10,4*.dy RO
FIELD "volpis" BACK ALPHA 0
FIELD "volpis" BACK COLOR .6,.6,.8
FIELD "involpis" TEXT "" AT 2*width/5+5,4*.dy
FIELD "involpis" FONT SIZE 1.5*.dy
FIELD "involpis" TEXT "" AT 2*width/5+5,4*.dy size width/3,2*.dy
FIELD "involpis" BACK ALPHA 1
FIELD "involpis" BACK COLOR .9,.9,.9
FIELD "pisml" TEXT "" AT 11*width/15+15,4*.dy RO
FIELD "pisml" FONT SIZE 1.5*.dy
FIELD "pisml" TEXT " мл" AT 11*width/15+15,4*.dy RO
FIELD "pisml" BACK ALPHA 1
FIELD "pisml" BACK COLOR .6,.6,.8
x1=0!y1=0
butPres=0
while (x1+y1)<1 and butPres=0
 x=TOUCH_X(0)
 y=TOUCH_Y(0)
 x1=0!y1=0
 if (x>0 and x<x0) or x>(x0+width) then x1=1
 if (y>0 and y<y0) or y>(y0+height) then y1=1
 butPres=button_pressed("pisbutOK")
 CheckTime()
end while
PAGE p$ HIDE
BUTTON "but21" show
BUTTON "but22" show
BUTTON "but24" show
if butPres=0 then return
vol=val(FIELD_TEXT$ ("involpis"))
if vol<0 or vol>1999 then return
NowDate()
h=NowDate.hour
.pis(h)+=vol
SaveData()
PrntTable(.prnYear,.prnMonth,.prnDay)
end def

def PrntVesTable() ' Рисует поле вес
p$="newves"
x0=.maxx/5!y0=200!width=3*.maxx/5!height=300
BUTTON "but21" HIDE
BUTTON "but22" HIDE
BUTTON "but23" HIDE
PAGE p$ SET
PAGE p$ COLOR .6,.6,.8,.9
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BUTTON "vesbutOK" TEXT "OK" AT width/4,4*height/5 SIZE width/2,.dy*2
FIELD "volves" TEXT "" AT 10,4*.dy RO
FIELD "volves" FONT SIZE 1.5*.dy
FIELD "volves" TEXT "     Вес  :" AT 10,4*.dy RO
FIELD "volves" BACK ALPHA 0
FIELD "volves" BACK COLOR .6,.6,.8
FIELD "involves" TEXT "" AT 2*width/5+5,4*.dy
FIELD "involves" FONT SIZE 1.5*.dy
FIELD "involves" TEXT "" AT 2*width/5+5,4*.dy size width/3,2*.dy
FIELD "involves" BACK ALPHA 1
FIELD "involves" BACK COLOR .9,.9,.9
FIELD "volkg" TEXT "" AT 11*width/15+15,4*.dy RO
FIELD "volkg" FONT SIZE 1.5*.dy
FIELD "volkg" TEXT " кг" AT 11*width/15+15,4*.dy RO
FIELD "volkg" BACK ALPHA 0
FIELD "volkg" BACK COLOR .6,.6,.8
x1=0!y1=0
butPres=0
while (x1+y1)<1 and butPres=0
 x=TOUCH_X(0)
 y=TOUCH_Y(0)
 x1=0!y1=0
 if (x>0 and x<x0) or x>(x0+width) then x1=1
 if (y>0 and y<y0) or y>(y0+height) then y1=1
 butPres=button_pressed("vesbutOK")
 CheckTime()
end while
PAGE p$ HIDE
BUTTON "but21" show
BUTTON "but22" show
BUTTON "but23" show
if butPres=0 then return
vol=val(FIELD_TEXT$ ("involves"))
if vol<0 or vol>1999 then return
NowDate()
h=NowDate.hour
.ves(h)+=vol
SaveData()
PrntTable(.prnYear,.prnMonth,.prnDay)
end def

def PrntAbout()
DRAW FONT NAME .txtFont$
SET BUTTONS FONT NAME .txtFont$
x0=50
y0=.maxy-3*.dy
BUTTON "but25" TEXT "?" AT x0,y0 SIZE 2*.dy,2*.dy
DRAW FONT NAME "Courier-Bold"
DRAW FONT SIZE .dy
SET BUTTONS FONT DEFAULT
end def

def ClearTable() ' Очищает таблицу данных
dx=integ(.maxx/12)
dy=.dy
for y=0 to 29
fill rect dx+2,dy*(4+y)+2 to dx*2-2,dy*(5+y)-2
fill rect dx*2+2,dy*(4+y)+2 to dx*3-2,dy*(5+y)-2
fill rect dx*3+2,dy*(4+y)+2 to dx*4-2,dy*(5+y)-2
fill rect dx*4+2,dy*(4+y)+2 to dx*5-2,dy*(5+y)-2
fill rect dx*5+2,dy*(4+y)+2 to dx*6-2,dy*(5+y)-2
next y
end def

def PrntTable(year,month,day) ' Выводит таблицу данных на сутки
PrntDate(year,month,day)
dim pinf(24)
dim ppil(24)
dim ppis(24)
dim pves(24)
LoadData(year,month,day)
for i=0 to 16
 pinf(i)=.infPrn(i+7)
 ppil(i)=.pilPrn(i+7)
 ppis(i)=.pisPrn(i+7)
 pves(i)=.vesPrn(i+7)
next i
CheckFeb(year)
day+=1
if day>.dnm(month) then
 month+=1
 if month=12 then
  year+=1
  month=0
 end if
 day=1
end if
LoadData(year,month,day)
for i=17 to 23
 pinf(i)=.infPrn(i-17)
 ppil(i)=.pilPrn(i-17)
 ppis(i)=.pisPrn(i-17)
 pves(i)=.vesPrn(i-17)
next i
ClearTable()
dx=integ(.maxx/12)
dy=.dy
draw font size 16
itog1=0
itog2=0
itog3=0
sum1=0
sum2=0
sum3=0
h=0
for hy=1 to 28
if hy%7=0 then 
 draw color 1,0,0
 sumint=int(sum1*10)/10
 draw text sumint at 2*dx-TEXT_WIDTH(str$(sumint))-2,dy*(3+hy)+4
 itog1+=sum1
 sumint=int(sum2*10)/10
 draw text sumint at 3*dx-TEXT_WIDTH(str$(sumint))-2,dy*(3+hy)+4
 itog2+=sum2
 sumint=int(sum3*10)/10
 draw text sumint at 4*dx-TEXT_WIDTH(str$(sumint))-2,dy*(3+hy)+4
 itog3+=sum3
 sumint=int(sum1+sum2-sum3)
 draw text sumint at 5*dx-TEXT_WIDTH(str$(sumint))-2,dy*(3+hy)+4
 sum1=0
 sum2=0
 sum3=0
 sum4=0
 draw color 0,0,0
else
 pint=int(pinf(h)*10)/10
 draw text pint at 2*dx-TEXT_WIDTH(str$(pint))-2,dy*(3+hy)+4
 sum1+=pinf(h)
 pint=int(ppil(h)*10)/10
 draw text pint at 3*dx-TEXT_WIDTH(str$(pint))-2,dy*(3+hy)+4
 sum2+=ppil(h)
 pint=int(ppis(h)*10)/10
 draw text pint at 4*dx-TEXT_WIDTH(str$(pint))-2,dy*(3+hy)+4
 sum3+=ppis(h)
 if pves(h)>0 then
  pint$=pves(h)
  if pves(h)=int(pves(h)) then
   pint$&=".000"
  else
   pint$&="00"
  end if
  draw text pint$ at 6*dx-TEXT_WIDTH(pint$)-2,dy*(3+hy)+4
 end if
 h+=1
end if
next hy
draw color 1,0,0
itog=int(itog1*10)/10
draw text itog at 2*dx-TEXT_WIDTH(str$(itog))-2,.dy*32+4
itog=int(itog2*10)/10
draw text itog at 3*dx-TEXT_WIDTH(str$(itog))-2,.dy*32+4
itog=int(itog3*10)/10
draw text itog at 4*dx-TEXT_WIDTH(str$(itog))-2,.dy*32+4
itog=int(itog1+itog2-itog3)
draw text itog at 5*dx-TEXT_WIDTH(str$(itog))-2,.dy*32+4
draw color 0,0,0
end def

def CountData() 'Подсчет данных с момента последн. сохран. или ежеминут.
InitInfuseFolder()
NowDate()
yNw=NowDate.y
mNw=NowDate.m
dNw=NowDate.d
hNw=NowDate.hour
minNw=NowDate.min
yLd=.yearLd!mLd=.monthLd!dLd=.dayLd!hLd=.hourLd!minLd=.minLd
if yLd=yNw and mLd=mNw and dLd=dNw and hLd=hNw and minLd=minNw then return
for y=yLd to yNw
CheckFeb(y)
for m=mLd to 11
for d=dLd to .dnm(m)
tekFoldName$=.folderName$&y&"/"&.monthEng$(m)&"/"
fn$=tekFoldName$&d
if File_Exists(tekFoldName$)=0 then DIR tekFoldName$ CREATE
file fn$ print
FILE fn$ reset
for i=0 to 23
 if data_exist(fn$) then
  FILE fn$ input .inf(i),.pil(i),.pis(i),.ves(i)
 else
  .inf(i)=0!.pil(i)=0!.pis(i)=0!.ves(i)=0
  FILE fn$ print .inf(i);.pil(i);.pis(i);.ves(i)
 end if
next i
for h=hLd to 23
for min=minLd to 59
 if y=yNw and m=mNw and d=dNw and h=hNw and min=minNw then
  file fn$ trim
  for i=0 to 23
   file fn$ print .inf(i);.pil(i);.pis(i);.ves(i)
  next i
  return
 end if
 for numInf=0 to .numberInfuse-1
  if .modeInf(numInf)=1 then
   spMin=.speedInf(numInf)/60
   if .balanceInf(numInf)>spMin then
    .balanceInf(numInf)-=spMin
    .inf(h)+=spMin
   else
    .inf(h)+=.balanceInf(numInf)
    .balanceInf(numInf)=0
    .modeInf(numInf)=0
    .speedInf(numInf)=0
    .volumeInf(numInf)=0
   end if
  end if
 next numInf
next min
minLd=0
next h
file fn$ trim
for i=0 to 23
 file fn$ print .inf(i);.pil(i);.pis(i);.ves(i)
next i
hLd=0
next d
dLd=1
next m
mLd=0
next y
end def

def NewInfuse() ' Новая инфузия
InitInfuseFolder()
numOfInf=.numberInfuse
if numOfInf>6 then return
p$="newinf"
x0=.maxx/5!y0=200!width=3*.maxx/5!height=300
BUTTON "but22" HIDE
BUTTON "but23" HIDE
BUTTON "but24" HIDE
PAGE p$ SET
PAGE p$ COLOR .6,.6,.8,.9
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BUTTON "butOK" TEXT "OK" AT width/4,4*height/5 SIZE width/2,.dy*2
FIELD "volinf" TEXT "" AT 10,2*.dy RO
FIELD "volinf" FONT SIZE 1.5*.dy
FIELD "volinf" TEXT "Объем  :" AT 10,2*.dy RO
FIELD "volinf" BACK ALPHA 0
FIELD "volinf" BACK COLOR .6,.6,.8
FIELD "spinf" TEXT "" AT 10,6*.dy RO
FIELD "spinf" FONT SIZE 1.5*.dy
FIELD "spinf" TEXT "Скорость:" AT 10,6*.dy RO
FIELD "spinf" BACK ALPHA 0
FIELD "spinf" BACK COLOR .6,.6,.8
FIELD "involinf" TEXT "" AT 2*width/5+5,2*.dy
FIELD "involinf" FONT SIZE 1.5*.dy
FIELD "involinf" TEXT "" AT 2*width/5+5,2*.dy size width/3,2*.dy
FIELD "involinf" BACK ALPHA 1
FIELD "involinf" BACK COLOR .9,.9,.9
FIELD "inspinf" text "" AT 2*width/5+5,6*.dy
FIELD "inspinf" FONT SIZE 1.5*.dy
FIELD "inspinf" TEXT "" AT 2*width/5+5,6*.dy size width/3,2*.dy
FIELD "inspinf" BACK ALPHA 1
FIELD "inspinf" BACK COLOR .9,.9,.9
FIELD "volml" TEXT "" AT 11*width/15,2*.dy RO
FIELD "volml" FONT SIZE 1.5*.dy
FIELD "volml" TEXT " мл" AT 11*width/15,2*.dy RO
FIELD "volml" BACK ALPHA 0
FIELD "volml" BACK COLOR .6,.6,.8
FIELD "spmlh" TEXT "" AT 11*width/15,6*.dy RO
FIELD "spmlh" FONT SIZE 1.5*.dy
FIELD "spmlh" TEXT " мл/ч" AT 11*width/15,6*.dy RO
FIELD "spmlh" BACK ALPHA 0
FIELD "spmlh" BACK COLOR .6,.6,.8
x1=0!y1=0
butPres=0
while (x1+y1)<1 and butPres=0
 x=TOUCH_X(0)
 y=TOUCH_Y(0)
 x1=0!y1=0
 if (x>0 and x<x0) or x>(x0+width) then x1=1
 if (y>0 and y<y0) or y>(y0+height) then y1=1
 butPres=button_pressed("butOK")
CheckTime()
end while
PAGE p$ HIDE
BUTTON "but22" show
BUTTON "but23" show
BUTTON "but24" show
if butPres=0 then return
vol=VAL(FIELD_TEXT$ ("involinf"))
sp=VAL(FIELD_TEXT$ ("inspinf"))
if vol<=0 or vol>2000 or sp<=0 or sp>2000 then return
.modeInf(numOfInf)=1
.volumeInf(numOfInf)=vol
.speedInf(numOfInf)=sp
.balanceInf(numOfInf)=vol
.numberInfuse+=1
SaveData()
CheckInfuse()
end def

def StartInf(num) ' Запуск инфузии
numInf=integ(num/3)
.modeInf(numInf)=1
SaveData()
CheckInfuse()
end def

def PauseInf(num) ' Пауза инфузии
numInf=int(num/3)
.modeInf(numInf)=2
SaveData()
CheckInfuse()
end def

def StopInf(num) ' Остановка и выкл инфузии
numInf=int(num/3)
p$="delete"
x0=.maxx/5!y0=200!width=3*.maxx/5!height=300
PAGE p$ SET
PAGE p$ COLOR .6,.6,.8,.9
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BUTTON "delbutOK" TEXT "Да" AT width/8,4*height/5 SIZE width/4,.dy*2
BUTTON "delbutNO" TEXT "Нет" AT 5*width/8,4*height/5 SIZE width/4,.dy*2
FIELD "del" TEXT "" AT 10,4*.dy RO
FIELD "del" FONT SIZE 1.5*.dy
FIELD "del" TEXT " Удалить инфузию # "&(numInf+1)&"?" AT 25,4*.dy RO
FIELD "del" BACK ALPHA 0
FIELD "del" BACK COLOR .6,.6,.8
butPresY=0
butPresN=0
while butPresY=0 and butPresN=0
 butPresN=button_pressed("delbutNO")
 butPresY=button_pressed("delbutOK")
 CheckTime()
end while
PAGE p$ HIDE
BUTTON "but21" show
BUTTON "but22" show
BUTTON "but23" show
if butPresN=1 then return
.modeInf(numInf)=0
SaveData()
CheckInfuse()
end def

def About()
p$="about"
b$="brows"
x0=100!y0=200!width=.maxx-200!height=400
BUTTON "but25" HIDE
PAGE p$ SET
PAGE p$ SHOW
PAGE p$ COLOR .6,.8,.6,.8
PAGE p$ FRAME x0,y0,width,height
PAGE p$ SHOW
BROWSER b$ AT 0,0 SIZE width,height
'--- write something in panel
top$="<center><h3>Water Counter v3.0</h3></center>"
msg1$="   Данная программа предназначена для помощи при подсчете количества потребляемой "
msg2$="и выделяемой жидкости во время проведения медицинских процедур.<br><br>"
msg3$="   Учет ведется по-суточно. Сутки начинаются в 7-00. Контрольный подсчет ведется каждые 6 часов<br><br>"
msg4$="    Программа написана на языке программирования <b>SmartBasic </b>и распространяется абсолютно бесплатно.<br><br>"
msg5$="   По всем вопросам, ошибкам, недоработкам, внесении изменений, дополнений и т.д., а также получении текста программы просьба обращаться на E-mail.<br>"
msg6$="   <br><br>"
msg$=""
msg10$="<center><b>С уважением Хажеев Игорь. E-mail: hazheevim@rambler.ru</b></center>"
BROWSER b$ SET TEXT top$&msg1$&msg2$&msg3$&msg4$&msg5$&msg6$&msg10$
x=TOUCH_X(0)
while x<0
 x=TOUCH_X(0)
 CheckTime()
end while
BROWSER b$ DELETE
PAGE p$ HIDE
BUTTON "but25" show
end def

def ButLeft() 'Кнопка влево (вчера)
CheckFeb(.prnYear)
.prnDay-=1
if .prnDay=0 then
 .prnMonth-=1
 if .prnMonth=-1 then
  .prnYear-=1
  .prnMonth=11
 end if
 .prnDay=.dnm(.prnMonth)
end if
PrntTable(.prnYear,.prnMonth,.prnDay)
end def

def ButRight() ' кнопка вправо (завтра)
CheckFeb(.prnYear)
.prnDay+=1
if .prnDay>.dnm(.prnMonth) then
 .prnMonth+=1
 if .prnMonth=12 then
  .prnYear+=1
  .prnMonth=0
 end if
 .prnDay=1
end if
PrntTable(.prnYear,.prnMonth,.prnDay)
end def

def CheckFeb(year) ' Проверка високосного года
if year%4=0 then
 .dnm(1)=29
else
 .dnm(1)=28
end if
end def

def InitInfuseFolder() ' Инициализация и упорядочивание папки инфузий
fn$=.folderName$&"infuses/"
if FILE_EXISTS(fn$)=0 then DIR fn$ CREATE
DIR fn$ LIST FILES .infuse$,.numberInfuse
if .numberInfuse>0 then
 fn$&="inf"
 for i=0 to .numberInfuse-1
  for k=i to 6
   if file_exists(fn$&k) and file_exists(fn$&i)=0 then FILE fn$&k RENAME fn$&i
  next k
 next i
end if
end def

def CheckTime()
NowDate()
if .contrSec<>NowDate.sec then
 .contrSec=NowDate.sec
 PrntDate(.prnYear,.prnMonth,.prnDay)
end if
if .contrMin<>NowDate.min then
 CountData()
 SaveData()
 CheckInfuse()
 .contrMin=NowDate.min
 PrntTable(.prnYear,.prnMonth,.prnDay)
end if
end def


'   Начало программы

RESTORE
for i=0 to 11
read month$(i)
read monthEng$(i)
read dnm(i)
next i
for i=0 to 6
read weekDay$(i)
next i
NowDate()
prnYear=NowDate.y
prnMonth=NowDate.m
prnDay=NowDate.d
prnHour=NowDate.hour
if prnHour<7 then
 prnDay-=1
 if prnDay=0 then
  prnMonth-=1
  if prnMonth=-1 then
   prnYear-=1
   prnMonth=11
  end if
  prnDay=dnm(prnMonth)
 end if
end if

InitInfuseFolder()

' интерфейс
ScreenDraw()
MenuItems()
DrawButtons()
PrntAbout()
LoadDataStart()
CountData()
SaveData()
PrntTable(prnYear,prnMonth,prnDay)
PrntDate(prnYear,prnMonth,prnDay)
CheckInfuse()
butPress=-1
NowDate()
contrSec=NowDate.sec
contrMin=NowDate.min
while butPress<0
CheckTime()
for i=0 to 25
bn$="but"&i
if BUTTON_PRESSED (bn$) then butPress=i
next i
y=100
x1=-1
GET TOUCH 0 AS x1,y
while y>-1
GET TOUCH 0 AS x2,y
if x2>x1 then  butPress=26
if x2<x1 and x2>-1 then butPress=27
end while
if butPress>=0 and butpress<21 then
 if FRACT(butPress/3)=0 then PauseInf(butPress)
 if int((butPress-1)/3)=(butPress-1)/3 then StopInf(butPress)
 if int((butPress-2)/3)=(butPress-2)/3 then StartInf(butPress)
end if
if butPress=21 then NewInfuse()
if butPress=22 then PrntPilTable()
if butPress=23 then PrntPisTable()
if butPress=24 then PrntVesTable()
if butPress=25 then About()
if butPress=26 then ButLeft()
if butPress=27 then ButRight()
butPress=-1
end while
Уважаемый mr Kibernetik. Получится разместить в AppStore? Программа написана коряво(на коленках в больнице) и не адаптирована под iphone. Был бы очень признателен, если найдете время для модернизации кода.

Re: Программа учета жидкости в организме

Posted: Wed Apr 29, 2015 10:56 pm
by Mr. Kibernetik
Программа, несомненно, полезная.
Но до публикации в Апсторе ее дизайн не дотягивает. Apple такое вряд ли примут.

Re: Программа учета жидкости в организме

Posted: Thu Apr 30, 2015 2:30 am
by Igor
Так как у меня дизайнерских способностей никогда не было, остается надеятся, что кто-нибудь доведет идею до конца.
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited