Реализация алгоритма обработки данных
Информация - Компьютеры, программирование
Другие материалы по предмету Компьютеры, программирование
tinvnom:=dd->invnom
idpop:=dd->idzappp
lin:=" "+dd->invnom+" "
select bb
go top
do while .not. eof()
if(tinvnom=bb->invnom).and.(idpop=bb->idzap)
lin:=lin+aa->namest+" "+dtoc(bb->dateprof)+" "+bb->vidprof
endif
skip
enddo
select dd
idpop:=dd->idzapsp
select bb
go top
do while .not. eof()
if(tinvnom=bb->invnom).and.(idpop=bb->idzap)
lin:=lin+" "+dtoc(bb->dateprof)+" "+bb->vidprof+" "
endif
skip
enddo
select dd
lin:=lin+str(dd->fkdn-dd->norma,4)+" "
? lin
skip
enddo
lin:="+-----------------------------------------------------------------------------+"
? lin
set color to w+/b
lin:=" Всего просроченно дней -"+str(sitog,5)
? lin
set printer off
sound()
inkey(0)
return nil
6) п.п. подачи звукового сигнала для сигнализации успешного выполнения
поставленной задачи:
func sound
tone(300,1)
tone(100,1)
tone(300,1)
tone(100,1)
return nil
7) п.п. сохранения зкрана:
FUNC s_scr(t,l,b,r)
IF t = NIL
t := 0
ENDIF
IF l = NIL
l := 0
ENDIF
IF b = NIL
b := MAXROW()
ENDIF
IF r = NIL
r := MAXCOL()
ENDIF
AADD( wind[1], t )
AADD( wind[2], l )
AADD( wind[3], b )
AADD( wind[4], r )
AADD( wind[5], SAVESCREEN(t,l,b,r) )
AADD( pos[1], ROW() )
AADD( pos[2], COL() )
AADD( colr, SETCOLOR() )
AADD( curs, SETCURSOR() )
RETURN .T.
8) п.п. восстановления зкрана:
FUNC r_scr()
LOCAL ln
ln := LEN(wind[1])
IF ln == 0
@ 24,0 SAY Ошибка - стек для восстановления параметров пуст
INKEY(0)
@ 24,0
ENDIF
RESTSCREEN(wind[1,ln], wind[2,ln], wind[3,ln], wind[4,ln], wind[5,ln] )
ASIZE(wind[1],ln-1)
ASIZE(wind[2],ln-1)
ASIZE(wind[3],ln-1)
ASIZE(wind[4],ln-1)
ASIZE(wind[5],ln-1)
SETPOS( pos[1,ln], pos[2,ln] )
ASIZE(pos[1],ln-1)
ASIZE(pos[2],ln-1)
SETCOLOR(colr[ln])
ASIZE(colr,ln-1)
SETCURSOR(curs[ln])
ASIZE(curs,ln-1)
RETURN .T.
9) п.п. определения - нажата ли клавиша типового метода, если да - то возвращает блок кода с соответствующим методом, если нет - то возвращает NIL. Параметр функции - INKEY-код нажатой клавиши.
FUNC basemet(cod)
LOCAL ret , ei , i
LOCAL crsm:={ ;
{K_DOWN , {|o| o:down() } } ;
, {K_UP , {|o| o:up() } } ;
, {K_PGDN , {|o| o:pagedown() } } ;
, {K_PGUP , {|o| o:pageup() } } ;
, {K_CTRL_PGDN , {|o| o:gobottom() } } ;
, {K_CTRL_PGUP , {|o| o:gotop() } } ;
, {K_RIGHT , {|o| o:right() } } ;
, {K_LEFT , {|o| o:left() } } ;
, {K_CTRL_RIGHT , {|o| o:panright() } } ;
, {K_CTRL_LEFT , {|o| o:panleft() } } ;
, {K_END , {|o| o:end() } } ;
, {K_HOME , {|o| o:home() } } ;
, {K_CTRL_END , {|o| o:panend() } } ;
, {K_CTRL_HOME , {|o| o:panhome() } } }
i := ASCAN( crsm, {|ei| cod = ei[1] } )
IF i <> 0
ret := crsm[i,2]
ELSE
ret := NIL
ENDIF
RETURN ret
10) п.п. переключения режима вставка/замена и вида курсора:
PROCEDURE Repl_Ins()
IF READINSERT()
READINSERT(.F.)
SETCURSOR(SC_INSERT)
ELSE
READINSERT(.T.)
SETCURSOR(SC_NORMAL)
ENDIF
RETURN
11) п.п. перевода в верхний регистр латиницы и кириллицы:
FUNC UpperC(prm)
LOCAL n , i , smb , cs
n := LEN( prm )
FOR i = 1 TO n
smb := SUBSTR( prm , i , 1 )
cs := ASC( smb )
DO CASE
CASE cs >= 97 .AND. cs <= 122
cs := cs - 32
prm := STUFF( prm , i , 1 , CHR( cs ) )
CASE cs >= 160 .AND. cs <= 175
cs := cs - 32
prm := STUFF( prm , i , 1 , CHR( cs ) )
CASE cs >= 224 .AND. cs <= 239
cs := cs - 80
prm := STUFF( prm , i , 1 , CHR( cs ) )
ENDCASE
NEXT
RETURN prm
12) п.п. выхода из задачи с сохранением всей информации - реакция на клавишу F10:
PROCEDURE fquit()
LOCAL reply
reply := ALERT("Сохранить все внесенные изменения и продолжить;" ;
+ "работу с Базой данных - т.е. сделать промежуточный SAVE или;" ;
+ " Завершить работу с базой данных с сохранением всех изменений ;";
, {" Сохранить и продолжить " , " Завершить работу " } )
IF ( reply = 1 ) .OR. ( reply = 0 )
DBCOMMITALL()
ELSE
QUIT
ENDIF
RETURN
13) п.п. вывода сообщения на экран с заданными координатами и цветом:
PROCEDURE msgs(x,y,m,color)
LOCAL ml,c
IF m = NIL
RETURN
ENDIF
ml=LEN(m)
IF ml=0 && .OR. ml > 80
RETURN
ENDIF
IF x=NIL // Центр по X
x := (80-ml)/2
ENDIF
IF y=NIL // Центр по Y
y := 24/2 - 1
ENDIF
IF color <> NIL
c := SETCOLOR(color)
@ y,x SAY m
SETCOLOR(c)
ELSE
@ y,x SAY m
ENDIF
RETURN
14) п.п. создания TBrowse-объекта для просмотра-редактирования
файла aa.dbf в окне t,l,b,r :
FUNCTION aaCr(t,l,b,r)
LOCAL brws,coln,cblk,chdr
brws := TBrowseDb(t,l,b,r)
cblk := {|| " " + aa->idst }
chdr := "Идент. типа станка"
coln := TBColumnNew(chdr,cblk)
coln:width := 19
brws:AddColumn(coln)
cblk := {|| " " + aa->namest}
chdr := " Наименование типа станка"
coln := TBColumnNew(chdr,cblk)
coln:width := 35
brws:AddColumn(coln)
cblk := {|| STR( aa->norma,7) }
chdr := " Норма,дней"
coln := TBColumnNew(chdr,cblk)
coln:width := 12
brws:AddColumn(coln)
brws:colsep := CHR(186)
brws:headsep := CHR(205)
brws:colorspec := "w+/b,gr+/rb"
RETURN brws
15) п.п. просмотра файла aa.dbf с обработкой нажимаемых клавиш и вызовом соответствующих методов или пользовательских функций:
FUNCTION aaEd(brws)
LOCAL ret_fl,sel,otb , w
LOCAL cc,rr,nrc:=0,i
LOCAL ret:=NIL
LOCAL t := brws:nTop , l := brws:nLeft , b := brws:nBottom , r := brws:nRight
LOCAL t_ := 5 , l_ := 6 , b_ := 15 , r_ := 74
s_scr()
s_r_s()
SETCOLOR( "N/W" )
CLS
SETCOLOR( "gr+/b,w+/gr")
hlp("AAED")
SELECT aa
SET ORDER TO 2
@ t-2 , l-1 CLEAR TO b+2 , r+1
@ b+1, l TO b+1, r
ret_fl := .F.
DO WHILE .NOT. ret_fl
** оптимизированная с использованием буфера клавиатуры стабилизация
DO WHILE ( NEXTKEY() == 0 ) .AND. ( .NOT. brws:stabilize() )
ENDDO
IF ( NEXTKEY() == 0 ) .AND. ( RECNO() <> nrc)
nrc := RECNO()
rr := ROW()
cc := COL()
SETCOLOR("bg+/b")
@ t-2 , l+1 SAY " Нормативы профилактики оборудования:"
@ b+2 , l+1 SAY " Тип станка: "
@ b+2 , COL()+1 SAY aa->namest COLOR "w+/b"
SETPOS(rr,cc)
ENDIF
SETCOLOR("gr+/rb")
** ожидаем нажатия клавиши
nkey := Inkey(0)
// если нажата клавиша типового метода - вызовем его
blk := basemet( nKey )
IF blk <> NIL
EVAL( blk , brws )
ELSE
DO CASE
CASE ( bHotkey := SETKEY( nKey ) ) <> NIL
EVAL( bHotkey , PROCNAME() , PROCLINE() , READVAR() )
CASE ( nKey = K_F8 )
DELETE
// потрогаем файловый указатель, если
// возвращаетя EOF() - .T. после Down-Up,
// значит файл пуст
SKIP
SKIP -1
IF RECNO() = RECCOUNT()+1
r