Графические возможности TurboPascal 7.0 — страница 9

  • Просмотров 6219
  • Скачиваний 578
  • Размер файла 3666
    Кб

Для выхода из программы нажмите Enter. Uses CRT,Graph; var xl,yl,x2,y2,Err: Integer; begin {Инициируем графический режим} xl := Detect; InitGraph(xl,x2,''); Err := GraphResult; if Err<>grOk then WriteLn(GraphErrorMsg(Err)) else begin {Определяем координаты окна с учетом разрешения экрана} xl := GetMaxX div 4; yl := GetMaxY div 4; x2 := 3*xl; y2 := 3*yl; {Создаем окно} Rectangle(xl,yl,x2,y2); SetViewPort(xl+l,yl+l,x2-l,y2-l,ClipOn); {Заполняем окно случайными окружностями} repeat Circle(Random(GetMaxX),Random(GetMaxX), Random(GetMaxX div 5)) until KeyPressed; {Очищаем окно и ждем нажатия Enter} ClearViewPort;

OutTextXY(0,0,'Press Enter...'); ReadLn; CloseGraph end end. 4. Линии и точки Процедура PutPixel. Выводит заданным цветом точку по указанным координа­там. Заголовок: Procedure PutPixel(X,Y: Integer; Color: Word); Здесь X, Y - координаты точки; Color - цвет точки. Координаты задаются относительно левого верхнего угла окнаили, если окно не установлено, относительно левого верхнего угла экрана. Следующая программа периодически выводит на экран «звездное небо» и затем гасит его. Для

выхода из программы нажмите любую клавишу. Uses CRT, Graph; type PixelType = record x, у : Integer; end ; const N = 5000; (Количество "звезд"} var d,r,e,k: Integer; xl,yl,x2,y2: Integer; a: array [l..N] of PixelType; {Координаты} begin {Инициируем графику} d := Detect; InitGraph(d, r, ''); e := GraphResult; if e<>grOk then WriteLn(GraphErrorMsg(e)) else begin {Создаем окно в центре экрана} xl := GetMaxX div 4; yl := GetMaxY div 4; x2 := 3*xl; y2 := 3*yl; Rectangle(xl,yl,x2,y2); SetViewPort(xl+l,yl+l,x2-l,y2-l,ClipOn); {Создаем и запоминаем координаты всех "звезд"} for k := 1 to N do with a[k] do begin x :=

Random(x2-xl); у := Random(y2-yl) end; {Цикл вывода} repeat for k := 1 to N do with a[k] do {Зажигаем "звезду"} PutPixel(x,y,white); if not KeyPressed then for k := N downto 1 do with a[k] do {Гасим "звезду"} PutPixel(x,y,black) until KeyPressed; while KeyPressed do k := ord(ReadKey); CloseGraph end ; end. Функция GetPixel. Возвращает значение типа Word, содержащее цвет пикселя с указанными координатами. Заголовок: Function GetPixel(X,Y: Integer): Word; Здесь Х, Y - координаты пикселя. Процедура Line. Вычерчивает линию с указанными координатами начала и

кон­ца. Заголовок: Procedure Line(Xl,Yl,X2,Y2: Integer); ЗдесьХ1...Y1 - координаты начала (X1, Yl) и конца(Xi2, Y2) линии. Линия вычерчивается текущим стилем и текущим цветом. В следующей программе в центре экрана создается окно, которое затем расчерчивается случайными линиями. Для выхода из программы нажмите любую клавишу. Uses CRT, Graph; Var d,r,e : Integer,-xl,yl,x2,y2: Integer; begin {Инициируем графику} d := Detect; InitGraph(d, r, ''); e := GraphResult; if e <> grOk then WriteLn(GraphErrorMsg(e)) else begin {Создаем окно

в центре экрана} xl := GetMaxX div 4; yl := GetMaxY div 4; x2 := 3*xl; y2 := 3*yl; Rectangle(xl,yl,x2,y2); SetViewPort(xl+l,yl+l,x2-l,y2-l,ClipOn); {Цикл вывода случайных линий} Repeat SetColor(succ(Random(16))); {Случайный цвет} Line(Random(x2-xl), Random(y2-yl), Random(x2-xl), Random(y2-yl)) until KeyPressed; if ReadKey=#0 then d := ord(ReadKey); CloseGraph end end. Процедура LineTo. Вычерчивает линию от текущего положения указателя до по-дожения, заданного его новыми координатами. Заголовок: Procedure LineTo(X,Y: Integer); Здесь X, Y - координаты нового положения указателя, они же -