Подпрограмма IMAG_IDM_1. Изображение ИДМ

Назначение пп IMAG_IDM_1 - изобразить ИДМ по рассчитанным размерам. Для расчётов и поиска оптимального варианта эта программа не нужна. Её, и связанные с ней подпрограммы, пользователь может не включать в проект. В этом случае в файле MAIN_OPTIMIZ.F90 (см. п. 2.6.2.) следует удалить строку 6 снизу, содержащую вызов пп IMAG_IDM_1.

Если раскрыть точку у подпрограммы, обозначенной 4 IMAG_IDM_1 на рис.2.3, то структура вызовов пп IMAG_IDM_1 будет иметь вид как на рис.2.4. Три вызываемых подпрограммы - RAZMERN, STRELA, IMAGERZM написаны автором пособия, остальные - из графической библиотеки ФОРТРАНА.

Рис.2.4

Ниже приводится текст пп IMAG_IDM_1.

Вызов: CALL IMAG_IDM_1

SUBROUTINE IMAGJDMJL

USE MSFLIB; USE DESCRIBE; USE IFQWIN; IMPLICIT NONE INTEGER bkcolor

INTEGER(2) maxx, maxy/i22,newx,newy/dummy

REAL*8 rmx/my^xmax^yl^lV/Sd-B/& ldlV-длина выносной линии

,xmin,hv/0.3d-3/,IArr/1.2d-3/,xx lhv-пол высоты основ-я стрелки,lArr- её длина

LOGICAL:: modestatus

TYPE (xycoord) xy; TYPE (fontinfo) fi; TYPE (windowconfig)myscreen TYPE(VERSH) V(4)

NEWX(xx)=INT2(xx*rmx+5d-l); NEWY(yl)=INT2(yl*rmy+5d-l) modestatus=GETWINOOWCONFIG(myscreen)

maxx=(myscreen.numxpixels-l)/delenx; maxy=(myscreen.numypixels-l)/deleny xmax=MAX(rKatNar*3,rDnar*3,twKz+sO+hDisk); if(xmax<0.06d0) xmax=0.06d0 rmx=maxx/xmax; rmy=maxy/xmax;

!oldcolor=SETCOLORRGB(Z’OOOOFF')!red; oldcolor=SETBKCOLORRGB(Z'OOFFOO’)!green bkcolor = SETBKCOLORRGB(#FFFFFF) ! white !ii = SETBKCOLORRGB(#909090) ! gray CALL CLEARSCREEN($GCLEARSCREEN); i= SETCOLORRGB(#000000) IBIack i = INITIALIZEFONTSO

IF(getfontinfo(fi).NE.O)THEN; CALL outtext('Error: cannot get font info'); stop ENDIF

IF(setfont("t'Courier New Cyr'hl6w8").lt.O) STOP'IMAG_IDM: cannot get font info'

CALL setvieworg( maxx/2_2,INT2(maxy/1.5), xy )

xmax=MAX(rKatNar*3,rDnar*3) !Нахожу наиб, радиус и там будет порт !Верхнее сечение катушки - прямоугольник:

dummy=RECTANGLE($GBORDER,0_2,-NEWY(rKatNar),NEWX(twKz),-NEWY(rKatvn)) !Нижнее сечение катушки- прямоугольник:

dummy=RECTANGLE($GBORDER,0_2,NEWY(rKatvn),NEWX(twKz),NEWY(rKatNar)) dummy=RECTANGLE($GBORDER,0_2,-NEWY(rKatvn),NEWX(twKz),NEWY(rKatvn)) i22= SETCOLOR(12_2)i Установлен, цвета заливки: светлокрасный i=FLOODFILLRGB(5_2,-NEWY(rKatNar)+S_2, 0_2)!3алив верх.прямоуг.Цвет гран.чёрный i=FLOODFILLRGB(l_2,NEWY(rKatvn)+l_2, 0_2)!Залив.нижн.прямоуг.Цвет гран.чёрный !Верхнее и нижнее сечения диска

i22= SETCOLOR(0_2)i Устанавл. цвет для рисования прямоугольника dummy=RECTANGLE($GBORDER,NEWX(twKz+sO),-NEWY(rDnar),NEWX(twKz+sO+hDisk) & ,-NEWY(rDvn))!Bepx.npaMoyr.

dummy=RECTANGLE($GBORDER,NEWX(twKz+sO),NEWY(rDnar),NEWX(twKz+sO+hDisk) & ,ЫЕЛ/У(Юуп))!Нижний

dummy=RECTANGLE($GBORDER,NEWX(twKz+sO),-NEWY(rDvn),NEWX(twKz+sO+hDisk) & ,ЫЕЛ/У(гОуп))!Нижний

i22= SETCOLOR(10_2)i Устанавл. цвет заливки: светлозелёный !3аливка верхнего прямоугольника. Ганицы чёрным цветом: i=FLOODFILLRGB(NEWX(twKz+sO)+l_2,-NEWY(rDnar)+l_2, 0_2)

!3аливка нижнего прямоугольника. Ганицы чёрным цветом: i=FLOODFILLRGB(NEWX(twKz+sO)+3_2,NEWY(rDnar)-3_2, 0_2)

Юсевые

i22= SETCOLOR(0_2)i Устанавлив. цвет для рисования осей

CALL MOVETO(0_2,0_2, xy); i=LINETO(NEWX(4*(twKz+sO+hDisk)),0_2) !Горизонтальная CALL outgtext('Z'); CALL MOVETO(0_2,0_2, xy) ! Вертикальная i=LINETO(0_2,-NEWY(xmax/2_2)); CALL outgtextf R')

!Выносные и размерные для толщины кат-ки:

V(l)%x=0_8; V(l)%y=rKatNar; V(2)°xSx=0_8; V(2)%y=rKatvn V(3)%x=twKz; V(3)%y=rKatNar; V(4)%x=twKz; V(4)%y=rKatvn CALL RAZMERN(V,4,dlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z

!Выносные и размерные для толщины диска:

V(l)%x=twKz+sO; V(l)%y=rDnar; V(2)%x=twKz+sO; V(2)%y=rDvn V(3)%x=twKz+sO+hDisk; V(3)%y=rDnar; V(4)%x=twKz+sO+hDisk; V(4)%y=rDvn CALL RAZMERN(VAdlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Zread(*,*)i !Выносные и размерные для зазора между кат. и диском: xmin=MIN(rKatvn,rDvn); dlV=3d-3 !Длина выносной линии для зазора

V(l)%x=twKz; V(l)%y=xmin/5; V(2)%x=twKz; V(2)%y=0d0 V(3)%x=twKz+sO; V(3)%y=xmin/5; V(4)%x=twKz+sO; V(4)%y=0d0 CALL RAZMERN(VAdlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z !Выносные и размерные для внутр.диаметра кат-ки: dlV=5d-3 !Длина выносной линии

V(l)%x=0d0; V(l)%y=-rKatvn; V(2)%x=twKz; V(2)%y=-rKatvn V(3)%x=0d0; V(3)%y=rKatvn; V(4)%x=twKz; V(4)^y=rKatvn CALL RAZMERN(V,4,dlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z !Выносные и размерные для внутр.диаметра диска:

V(l)%x=twKz+sO+hDisk; V(l)%y=-rDvn; V(2)%x=twKz+sO; V(2)%y=-rDvn V(3)%x=twKz+sO+hDisk; V(3)%y=rDvn; V(4)%x=twKz+sO; V(4)%y=rDvn CALL RAZMERN(VAdlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z !Выносные и размерные для наружн.диаметра кат-ки: dlV=15d-3 !Длина выносной линии для зазора V(l)%x=0d0; V(l)%y=-rKatNar; V(2)%x=twKz; V(2)%y=-rKatNar V(3)%x=0d0; V(3)%y=rKatNar; V(4)%x=twKz; V(4)°^y=rKatNar CALL RAZMERN(V,4,dlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z !Выносные и размерные для наружн.диаметра диска:

V(l)%x=twKz+sO+hDisk; V(l)%y=-rDnar; V(2)%x=twKz+sO; V(2)%y=-rDnar V(3)%x=twKz+sO+hDisk; V(3)%y=rDnar; V(4)%x=twKz; V(4)%y=rDnar CALL RAZMERN(VAdlV,IArr,hv,rmx,rmy) ! Размер кат-ки в напр.оси Z CALL setvieworgf 1_2Д_2, xy )!Смещ.порт в лев.верх.угол для написания текста CALL MOVETO(10_2,5_2, xy);

CALL ОиТСТЕХТ('Рассчитываемая конструкция. Размеры в мм.')

CALL MOVETO(10_2,5_2+12_2, ху)

CALL ОиТСТЕХТСДля продолжения счёта нажмите 1 и Enter')

CALL MOVETO(10_2,5_2+24_2, xy)

CALL ОиТСТЕХТ('Для прекращения счёта нажмите 0 и Enter')

read(*,*)i;

if(i==l) then;

CALL setvieworgf 1_2Д_2, xy ) !Смещ.порт в лев.верх.угол для запомин.экрана j=SAVEIMAGE(path(l:LenPath)//'imageJDM.bmp',l,l,INT(myscreen.numxpixels) & ,INT(myscreen.numypixels))

CALL CLEARSCREEN($GCLEARSCREEN); bkcolor=SETBKCOLOR (0_2) endif

if (j==0) STOP END

 
Посмотреть оригинал
< Пред   СОДЕРЖАНИЕ   ОРИГИНАЛ     След >