FORMAT(32x,'КОД КЛАВИШИ - ',I3)

1 FORMAT(32x,'КОД КЛАВИШИ - ',I3)

print*,' НАЖМИТЕ ЛЮБУЮ КЛАВИШУ'

10 print*

SCOD=getch() ! Отслеживание кода нажатой клавиши

print1,scod ! Печать кода

print*

print*,' ( Для выхода в VC - нажмите ^BREAK )' ! Прерывание выполнения программы

print*,' ( Для продолжения - любую клавишу ) '

go to 10 ! Бесконечный цикл

end

Дополнительные возможности вывода текста.

Текст стандартным шрифтом в любую позицию экрана можно вывести процедурой OutText. Процедура outtext не производит форматирование текста и работает во всех видео режимах. Текст выводится стандартным шрифтом.

Пример:

 RECORD /record/ rc

 ……………………..

 dum = SetTextColor (9) ! восстановление цвета текста

 call SetTextPosition (20,20,rc)

 text = ‘программа демонстрации’

 call outtext (text)

Вывод текста (сверху вниз) можно осуществить только в пределах заданной области экрана (текстового окна), которое устанавливается процедурой SetTextWindow. При заполнении окна происходит прокрутка.

Синтаксис call SetTextWindow (r1,c1,r2,c2)

Где: r1,c1- текстовые координаты (строка и столбец) левого верхнего угла прямоугольного окна, r2,c2 – то же правого.

Пример работы с текстовым окном:

! File: textwin.for

! Программа установки текстового окна и ввода элементов массива

! Программа устойчива при некорректном вводе. Выход из программы осуществляется нажатием Esc

$DEBUG ! Производит дополнительные проверки при компиляции

$STORAGE:2 ! Переменные и константы целого типа:2-х байтовые (integer*2)

$DECLARE ! Генерация предупреждающих сообщений для необъявленных переменных

include 'fgraph.fi' ! Включение интерфейсов графических функций в начале каждого файла

interface to function getch() ! Объявление ф-ции getch, ее

integer getch [C, alias:'_getch'] ! атрибутов, типов формальных параметров

end

program Demonstr_Text_Window ! Объявление головной программы

implicit NONE ! Запретить неявное объявление типов

integer *2 i2 ! Фиктивная переменная

include 'fgraph.fd' ! Объявление типов графических функций, объявление и задание параметров, определение структур (STRUCTURE) в каждой графической п/п

i2=SetVideoMode($MAXRESMODE) ! Установить видеорежим с max разрешением

call SetTextWin() ! Вызов п/п

i2=SetVideoMode($DEFAULTMODE) ! Установить предыдущий видеорежим

end

subroutine SetTextWin()

include 'fgraph.fd'

integer getch [EXTERN] ! Функция возврата кода нажатой клавиши

integer*2 i2

integer*2 i, j, k, m

integer*2 nr, nc ! Max кол-во строк и столбцов

integer*2 nx, ny ! Max кол-во пиксел по X и Y

real A(3,3) ! Вспомогательный массив

real kr,kc

character*12 ValElem

character*6 vl

character*1 one

record /videoconfig/ vc ! Подключ. структуры videoconfig

record /rcCOORD/ rc ! и rccoord, определенных в файле fgraph.fd

call ClearScreen($GCLEARSCREEN)! Очистка экрана

call GetVideoConfig(vc) ! Определение видеоконфигурации

nx=vc.NumXPixels ! см. файл fgraph.fd

ny=vc.NumYPixels ! см. файл fgraph.fd

nr=vc.NumTextRows ! см. файл fgraph.fd

nc=vc.NumTextCols ! см. файл fgraph.fd

i2=SetBkColor($GRAY) ! Установка цвета фона

i2=SetColor(2) ! Цвет рисования зеленый

i2=SetTextColor(6) ! Цвет текста красный

kr=0.8

kc=0.75

call SetTextWindow(Int(kr*nr)+2,2,nr-1,Int(kc*nc)) ! Текстовое окно

i2=rectangle($GBORDER,1,Int(kr*ny),Int(kc*nx),ny-1)! Рамка области ввода

do i=1,3

do j=1,3

call SetTextPosition(1,2,rc) ! Установка начальной позиции

write(vl,11) i, j ! Помещение индексов массива в буфер (внутренний файл) (по формату 11)

call OutText(' Ведите элемент массива А'//vl)

ValElem=' ' ! Символьное обнуление

m=0 ! Числовое обнуление

do k=1,24 ! Количество вводимых цифр

i2=getch() ! Возврат кода нажатой клавиши

if (i2.eq.13) exit ! Нажат ввод

if (i2.eq.27) return ! Нажата Esc (выход из программы)

call GetTextPosition(rc) ! Возврат текущей позиции

call SetTextPosition(rc.row,rc.col,rc) ! и ее установка

write(one,'(a)') char(i2) ! Печать в буфер введенного символа

if (i2.eq.8) then ! Нажата клавиша Backspace

call SetTextPosition(rc.row,rc.col-1,rc)

write(one,'(a)') ' ' ! При нажатии BackSpace удаляется

end if ! последний введенный символ (запись в буфер пробела)

call OutText(one) ! Печать введенного символа

if (i2.eq.8) call SetTextPosition(rc.row,rc.col-1,rc) ! При печати пробела смещаемся влево, поэтому возврат

if (i2.ge.48.and.i2.le.57.or.i2.eq.43.or.i2.eq.45.or.i2.eq.46.or.i2.eq.69.or.i2.eq.101) then

! Перечислены коды следующих символов:0,1,2,3,4,5,6,7,8,9,+,-,.,E,e

m=m+1 ! Отсчет количества введенных символов

if (m.eq.12) exit ! Максимум 12 символов

write(ValElem,'(a,a)') ValElem(1:m),char(i2) ! В буфер помещается первые m символов и введенный

else

if (i2.ne.8) call SetTextPosition(2,2,rc)

if (i2.ne.8) call OutText(' Ошибка ввода! ')

if (i2.eq.8) write(ValElem,'(a,a)') ValElem(1:m),' ' ! При нажатии Backspace

if (i2.eq.8) m=m-1 ! Удаление последнего символа

end if

end do

call SetTextPosition(3,2,rc)

read(ValElem,'(f12.0)') A(i,j) ! Преобразование символа в число (через буфер)

write(5,*)'Элемент массива ',A(i,j)

i2=getch() ! Задержка до нажатия клавиши

call ClearScreen($GWINDOW) ! Очистка текстового окна

i2=SetColor(8) ! Цвет зеленый

i2=rectangle($GFILLINTERIOR,0,0,nx,ny)

i2=SetColor(2) ! Цвет зеленый

i2=rectangle($GBORDER,1,Int(kr*ny),Int(kc*nx),ny-1)

end do

end do