Графическое программирование на Ms Fortran (стр. 3 из 4)

Dum = SetFont (“t‘Roman’h18”)

После выполнения функции setfont установленный шрифт становится текущим, т.е. он действует до тех пор, пока не будет установлен другой шрифт (либо не отменен видеорежим, либо не окончена программа). Текущим может быть только один шрифт. Параметры функции setfont задаются строкой символов, которые определяют желаемые характеристики выбранного шрифта. Порядок параметров не имеет значения.

Параметр	Значение
t’fontname’ hy wx f p v r b	Имя шрифта. В апострофах указывается одно из следующих: courier, helv, tms rmn, modern, script, roman, helv Cyrillic Высота символов пикселях (у) Ширина символов пикселях (х) Выбор фиксированного шрифта Выбор пропорционального шрифта Выбор векторного шрифта Выбор битового шрифта Выбор наиболее подходящего шрифта

Функция setfont при успешном выполнении возвращает 0, иначе – 1.

Приоритет параметров при выборе шрифта

высота

начертание (f/p)

ширина

разрядка (v/r).

Отображение текста.

Для написания текста текущим шрифтом необходимо:

установить координату вывода текста п/п move to – см. выше

передать текст на экран с помощью процедуры OutGText.

Пример:

Call MoveTo (50,60,xy)

Call OutGText (‘Minsk, 2001’)

После выполнения п/п outgtext текущая графическая позиция изменяется. Отметим, что данная п/п не обеспечивает возможность форматирования текста, то есть для вывода целых или вещественных значений сначала необходимо их преобразование в строку (символьную константу или т. н. внутренний файл) с помощью оператора write.

Character *12 val

……………………

call moveto (xdin + 5, posy, xy)

call outgtext (‘E=’)

write (val,’(f12.2\)’)E

call outgtext (val) ! вывод значения

call outgtext (' MPa')

Определение параметров установленного шрифта можно осуществить функцией GetFontInfo, которая возвращает характеристики шрифта в виде структуры fontinfo, определенной в файле fgraph.fd.

Пример:

RECORD /fontinfo/fi

………………………

dum = GetFontInfo (fi)

write (5,*)’ Путь к файлу шрифта –‘,fi.filename

Элементы структуры fontinfo:

type – тип шрифта: 1-векторный, 0-битовый

ascent – размещение от верхней базовой линии пиксела

Integer*2 pixwidth –ширина символов в пикселях (0-пропорциональный шрифт)

pixheight - высота символов в пикселях (0-пропорциональный шрифт)

avgvidth – средняя ширина символов в пикселях

filename – имя файла с путем доступа

Character facename – имя шрифта.

Выгрузка шрифта.

Выгрузка зарегистрированных шрифтов из памяти осуществляется п/п UnRegisterFonts ()

Пример программы деления экрана на 4 области.

! File: geomshar.for

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

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

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

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

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

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

end ! параметров

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

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

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

integer getch [EXTERN]

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

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

call devide_graph_area()

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

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

end

! п/п деления экрана на 4 области

subroutine devide_graph_area()

include 'fgraph.fd'

integer*2 i2

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

integer*2 xdin,ydin ! Координаты общей точки областей

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

real kx,ky

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

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

record /xyCOORD/ xy ! xy - образец типа xycoord

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

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

kx=75.0 ! Коэф-ты в %, определяющие положе-

ky=80.0 ! ние общей точки областей

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

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

xdin=int2(kx*nx/100)

ydin=int2(ky*ny/100)

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

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

i2=rectangle($GBORDER,1,1,nx-1,ny-1) ! Рамка всей области экрана

i2=rectangle($GBORDER,2,2,xdin,ydin) ! Рамка области чертежа

i2=rectangle($GBORDER,2,ydin+1,xdin,ny-2)! Рамка области ввода

i2=rectangle($GBORDER,xdin+1,2,nx-2,ydin)!Рамка информац. области

i2=rectangle($GBORDER,xdin+1,ydin+1,nx-2,ny-2)! Область автора

i2=setcolor(12) ! Цвет светлокрасный

! Оформление области автора

if (registerfonts('D:\MSLIB\*.fon').LT.0) then ! инициализация

i2=registerfonts('C:\MSLIB\*.fon') ! шрифтов

end if ! библиотеки

i2=setfont("t'Helv Cyrillic'h18w8b"C) !Установка шрифта

! i2=settextcolor(2) ! Установка цвета текста

! nr=vc.numtextrows

! nc=vc.numtextcols

call moveto(xdin+40,ydin+10, xy)

call outgtext (' ¦ ¦ + +') ! Вывод текста в текущ. позицию

call moveto(xdin+30,ydin+30, xy)

call outgtext ('+ГЕбМГ +.+.')

call moveto(xdin+50,ydin+50, xy)

call outgtext (' 1998')

end

Пример использования функции Getch, возвращающей код нажатой клавиши.

! Программа печати кода нажатой клавиши

$debug

interface to function getch()

integer*2 getch [C, alias:'_getch'] ! Интерфейс Си функции

end

integer *2 getch [EXTERN]

integer *2 scod

integer i

do i=1,26 ! Отступ в 26 строк

print*

enddo

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) ! Цвет зеленый