@ 24,55 SAY 'F3' ENDIF IF callpnt="CCED" .OR. callpnt="DDED"
SET COLOR TO ("w/n")
@ 22,1 SAY chr(24) + " / " + chr(25) + " / " + CHR(26) + ' / ' ;
+ CHR(27) + ' / ^' + CHR(26) + " PgUp / PgDn " ;
+ ' / ^' + CHR(27) + '/ Home / End - Перемещение курсора'
@ 24,0 SAY 'Enter - Редактирование '
@ 23,23 TO 24,23 DOUBLE
@ 23,25 SAY 'Esc - Возврат на шаг назад ' COLOR "w/n"
@ 23,25 SAY 'Esc' COLOR "r+/n"
@ 24,25 SAY '^Enter - Выбор значения ' COLOR "w/n"
@ 24,25 SAY '^Enter' COLOR "r+/n"
@ 23,54 TO 24,54 DOUBLE
@ 23,55 SAY 'F8 - Удалить строку '
@ 24,55 SAY 'F3 - Вставить строку '
SET COLOR TO ("r+/n")
+ ' / ^' + CHR(27) + '/ Home / End '
@ 24,0 SAY 'Enter'
@ 23,55 SAY 'F8'
@ 24,55 SAY 'F3' ENDIF
SET COLOR TO (retcol)
SETPOS(crow,ccol) RETURN
5) п.п. выявления всех случаев превышения нормативных интервалов между профилактиками, вывода их в выводной файл “DD”, а также выдачи ведомости на принтер: func vedom local tinvnom,sitog,tdata,tidzap,tidst,idpop set printer on select dd zap lin:=space(17)+"Таблица нарушение норм техобслуживания:" ? lin select bb set relat to bb->invnom into cc set relat to cc->idst into aa additive go top sitog:=0 do while .not. eof() tinvnom:=bb->invnom tdata:=bb->dateprof tidzap:=bb->idzap tidst:=cc->idst skip if(bb->invnom=tinvnom).and.(bb->dateprof-tdata>aa->norma) select dd append blank replace dd->invnom with tinvnom replace dd->fkdn with bb->dateprof-tdata replace dd->norma with aa->norma replace dd->idzappp with tidzap replace dd->idzapsp with bb->idzap sitog:=sitog+(dd->fkdn-dd->norma) select bb endif enddo lin:="+--------------------------------------------------------------------- --------+" ? lin lin:="¦ Инв.¦ Наименование ¦ Дата ¦ Вид предвор. ¦ Дата ¦ вид след. ¦Просроч.¦" ? lin lin:="¦номер¦ типа станка ¦ ¦ профилактики ¦ ¦ профилактики ¦ дней ¦" ? lin lin:="¦-----+--------------+--------+--------------+--------+-------------- +--------¦" ? lin select dd set relat to dd->invnom into cc additive go top do while .not. eof() 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
IF b = NIL b := MAXROW()
IF r = NIL r := MAXCOL()
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
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)
9) п.п. определения - нажата ли клавиша типового метода, если да - то возвращает блок кода с соответствующим методом, если нет - то возвращает NIL. Параметр функции - INKEY-код нажатой клавиши. FUNC basemet(cod)
LOCAL ret , ei , i
LOCAL crsm:={ ;
{K_DOWN , o } ;
, {K_UP , o } ;
, {K_PGDN , o } ;
, {K_PGUP , o } ;
, {K_CTRL_PGDN , o } ;
, {K_CTRL_PGUP , o } ;
, {K_RIGHT , } ;
, {K_LEFT , o } ;
, {K_CTRL_RIGHT , o } ;
, {K_CTRL_LEFT , } ;
, {K_END , o } ;
, {K_HOME , } ;
, {K_CTRL_END , o:panend() } ;
, {K_CTRL_HOME , } } i := ASCAN( crsm, 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 = 160 .AND. cs = 224 .AND. cs 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 := chdr := "Идент. типа станка" coln := TBColumnNew(chdr,cblk) coln:width := 19 brws:AddColumn(coln) cblk := chdr := " Наименование типа станка" coln := TBColumnNew(chdr,cblk) coln:width := 35 brws:AddColumn(coln) cblk := 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 )
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 ret_fl := .T. // завершение просмотра
ENDIF brws:RefreshAll() nrc := 0
CASE nKey = K_ESC ret_fl := .T. // завершение просмотра
CASE ( nKey = K_ENTER )
// Редактирование текущего элемента данных aaGet(brws ;
, " Редактирование файла aa.dbf" ) nrc := 0 // обновить верхнюю строку
CASE nKey == K_F3
APPEND BLANK brws:RefreshAll()
ENDCASE ENDIF ENDDO SET RELAT TO s_r_s(.T.) r_scr() RETURN ret
16) п.п. выполнения GET в текущей колонке файла aa.dbf: PROCEDURE aaGet( brws , z0 )
LOCAL r , c , w , w2 , otb
LOCAL retcurs,retexit // форма курсора и режим выхода из READ
LOCAL retins, retcol // режим вставка-замена в READ
LOCAL indch := .F. // флаг изменений значений полей, входящих в
// индекснове выражение (тогда нужно REFRESHALL(),
// а не REFRESHCURRENT() )
LOCAL col r := ROW() c := COL()
// Проверка обновления экрана, корректности базы и т.д.
ForceStable(brws)
// Установка клавиш Up-Arrow и Down-Arrow как клавиш выхода из
// команды READ retexit := READEXIT(.T.)
// Установка клавиши INS для переключения
// режима вставка/замена
// и соответствующего изменения вида курсора retins := SetKey( K_INS, Repl_Ins() )
// эквивалентно Set Key K_INS To Procedure Repl_Ins
// Установка вида курсора по текущему состоянию режима retcurs := SetCursor( IF(ReadInsert(), SC_NORMAL, SC_INSERT ) ) s_scr() retcol := SETCOLOR("w+/g")
@ brws:nTop-3,0
@ brws:nTop-3,0 SAY z0 hlp("GET")
SETCOLOR("gr+/n,w+/g") indch := .F. DO CASE
CASE brws:colpos = 1 w := aa->idst
@ r,c+2 GET w
READ
IF .NOT.( LASTKEY() = K_ESC ).OR.( aa->idst == w )
REPLACE aa->idst WITH w indch := .T.
CASE brws:colpos = 2 n := aa->namest
@ r,c+2 GET n
IF .NOT.( LASTKEY() = K_ESC ).OR.( aa->namest == n )
REPLACE aa->namest WITH n
CASE brws:colpos = 3 w := aa->norma
@ r,c+1 GET w
IF .NOT.( ( LASTKEY() = K_ESC ) .OR. ( aa->norma = w ) )
REPLACE aa->norma WITH w
ENDIF ENDCASE SETCOLOR(retcol) r_scr() SETPOS(r,c) IF indch brws:RefreshAll() ELSE brws:RefreshCurrent() // Обеспечить перерисовку текущей строки, ENDIF // поскольку изменялся элемент данных
// Восстановление формы курсора и режима выхода из READ по стрелкам
// и процедуры по клавише K_INS
SetCursor(retcurs)
READEXIT(retexit)
SetKey(K_INS, retIns)
// Проверка требования ухода с текущей записи после GET nKey := LASTKEY()
IF nKey == K_UP .OR. nKey == K_DOWN .OR. ; nKey == K_PGUP .OR. nKey == K_PGDN
// управление курсором -- переход к другой записи
KEYBOARD( CHR(nKey) )
Примечание: В отчёте не описаны п.п.: а) для создания TBrowse-объекта для просмотра-редактирования файла bb.dbf в окне t,l,b,r ; б) для просмотра файла bb.dbf с обработкой нажимаемых клавиш и вызовом соответствующих методов или пользовательских функций; в) для выполнения GET в текущей колонке файла bb.dbf: Т.к. эти подпрограммы практически аналогичны подпрограммам для файла aa.dbf !!! ............................................................................ .....................................................
10. Результаты тестового примера:
а) Содержимое выводного файла dd.dbf:
INVNOM FKDN NORMA IDZAPPP IDZAPSP
2 62 20 9
15
231 51 20 10
16
24 74 15 12
18
323 77 25 8
14
4 50 15 11
17
626 58 25 7
13
б) Содержимое файла (print.prn), выводимого на принтер:
Таблица нарушение норм техобслуживания: ---------------------------------------------------------------------------- ------------------------------------- ¦ Инв. ¦ Наименование ¦ Дата ¦ Вид предвор. ¦ Дата ¦ вид след. ¦ Просроч.¦ ¦номер ¦ типа станка ¦ ¦ профилактики ¦ ¦ профилактики ¦ дней ¦ ¦--------------------------------------------------------------------------- -------------------------------------¦ ¦ 24 ¦ Сверлильный ¦01/18/98 ¦ Регулировка ¦04/02/98 ¦ Чистка
¦ 59 ¦ ¦ 323 ¦ Строгальный ¦01/28/98 ¦ Регулировка ¦04/15/98 ¦ Чистка
¦ 52 ¦ ¦ 2 ¦ Токарный ¦01/29/98 ¦ Регулировка ¦04/01/98 ¦ Чистка ¦ 42 ¦ ¦ 4 ¦ Сверлильный ¦01/19/98 ¦ Регулировка ¦03/10/98 ¦ Чистка
¦ 35 ¦ ¦ 626 ¦ Строгальный ¦02/01/98 ¦ Регулировка ¦03/31/98 ¦ Чистка
¦ 33 ¦ ¦ 231 ¦ Токарный ¦01/28/98 ¦ Регулировка ¦03/20/98 ¦ Чистка
¦ 31 ¦ ---------------------------------------------------------------------------- -------------------------------------
Всего просроченно дней - 252
Страницы: 1, 2, 3
