Новости

Модуль Graph

Работа добавлена:






Модуль Graph на http://mirrorref.ru

Балтийский государственный технический университет «ВОЕНМЕХ» им. Д. Ф. Устинова

Кафедра информационных систем и технологий

Курсовая работа по программированию

Тема: «ООП»

Преподаватель: Козлов В. Р.

Выполнил: Суходоев П. Ю.

Группа: И-351

Санкт-Петербург

2006 год.

Тема реферата.

Модуль Graph

Модуль Graph представляет собой мощную библиотеку графических подпрограмм универсального назначения, рассчитанную на работу с наиболее распространенными графическими адаптерами IBM-совместимых ПК. Подпрограммы модуля Graph обеспечивают различные режимы работы многорежимных адаптеров, полностью используют их цветовые возможности и разрешающую способность.

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

Графические драйверы поддерживают следующие графические адаптеры (и полностью совместимые с ними):

CGA

Hercules

MCGA

AT&T 400

EGA

3270 PC

VGA

IBM-8514

Для поддержки этих аппаратных средств используются следующие драйверы:

CGA.BGI

Драйвер для CGA, MCGA

EGAVGA.BGI

Драйвер для EGA, VGA

HERC . BGI

Драйвер для монохромного Hercules

ATT . BGI

Драйвер для AT&T 6300 (400 строк)

PC3270.BGI

Драйвер для IBM 3270 PC

IBM8514.BGI

Драйвер для IBM 8514

Во время выполнения программы процедура InitGraph автоматически распознает графический адаптер, установленный на ПК, загружает и инициализирует соответствующий графический драйвер, переводит адаптер в графический режим и возвращает управление вызывающей программе. Процедура CloseGraph выгружает драйвер из памяти и восстанавливает текстовый режим работы адаптера.

Подпрограммы модуля Graph позволяют адресоваться к любому элементу (пикселю) растрового графического экрана и управлять светимостью этого элемента. Для указания пикселя используется следующая система координат: верхний левый угол графического экрана имеет координаты 0,0; горизонтальная координата X увеличивается слева направо, вертикальная координата У увеличивается сверху вниз. Например, в режиме 640x480 (адаптер VGA) правый нижний угол экрана имеет координаты 639, 479, а центр экрана -координаты 319,239.

Некоторые графические подпрограммы используют понятие текущего указателя. Указатель содержит координаты того пикселя, начиная с которого будет строиться изображение подпрограммами LineTo, LineRel, OutText и др. В этом смысле указатель подобен текстовому курсору, но, в отличие от него, не имеет видимого изображения на экране.

Для вывода текстовых сообщений на графический экран модуль Graph предоставляет один матричный и 4 штриховых шрифтов. Каждый символ матричного шрифта на экране реализуется в виде матрицы из 8x8 пикселей. Штриховые шрифты для каждого символа определяют набор штрихов (векторов), с помощью которых на экране создается (вычерчивается) соответствующий символ. Штриховые шрифты позволяют изменять размеры текстовых надписей в широких пределах без существенного ухудшения качества изображения символов. Однако стандартные штриховые шрифты не содержат символы кириллицы.

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

Процедура SetViewPort создает на экране графическое окно. Если окно определено, весь дальнейший графический вывод осуществляется относительно координат этого окна и отсекается его границами.

В модуле имеются средства сохранения и выдачи изображений, работы с несколькими графическими страницами, установки необходимых цветов.

Константы

Константы задания драйверов и режимов работы

const

 

 

 

Detect =

0;

 

 

CGA =

1;

 

 

MCGA =

2;

 

 

EGA =

3;

 

 

EGA64 =

4;

 

 

EGAMono =

5;

 

 

IBM8514 =

6;

 

 

HercMono =

7;

 

 

ATT400 =

8;

 

 

VGA =

9;

 

 

PC3270 =

10;

 

 

CurrentDriver = -128 ;

{Передается в GetModeRange}

CGAC0 = 0;

{320x200;

палитра 0; 1

страница }

CGAC1 = 1;

{320x200;

палитра 1 ; 1

страница }

CGAC2 = 2;

{320x200;

палитра 2 ; 1

страница }

CGAC3 = 3;

{320x200;

палитра 3; 1

страница }

CGAHi = 4;

{640x200;

1 страница }

 

MCGAC0 = 0;

{320x200; палитра О; 1 страница}

MCGAC1 = 1;

{320x200; палитра 1; 1 страница}

MCGAC2 = 2;

{320x200; палитра 2; 1 страница}

MCGAC3 = 3;

{320x200; палитра 3; 1 страница}

MCGAMed = 4;

{640x200; 1 страница}

MCGAHi = 5;

{640x480; 1 страница}

EGALo = 0;

{640x200; 16 цветов; 4 страницы}

EGAHi = 1;

{640x350; 16 цветов; 2 страницы}

EGA64LO = 0;

{640x200; 16 цветов; 1 страница}

EGA64Hi = 1;

{640x350; 4 цвета; 1 страница}

EGAMonoHi= 3;

{640x350; 64К: 1 страница;256К:2 страницы}

HercMonoHi=0;

{720x348; 2 страницы}

ATT400CO = 0;

{320x200; палитра 0; 1 страница}

ATT400C1 = 1;

{320x200; палитра 1; 1 страница}

ATT400C2 = 2;

{320x200; палитра 2; 1 страница}

ATT400C3 = 3;

{320x200; палитра 3; 1 страница}

ATT400Med= 4;

{640x200; 1 страница}

ATT4QOHi = 5;

{640x400; 1 страница}

VGALo = 0;

{640x200; 16 цветов; 4 страницы}

VGAMed = 1;

{640x350; 16 цветов; 2 страницы}

VGAHi = 2;

{640x480; 16 цветов; 1 страница}

PC3270Hi = 0;

{720x350; 1 страница}

IBM8514LO= 0;

{640x480; 256 цветов}

IBM8514HI= 1;

{1024x768; 256 цветов}

Значения ошибок, возвращаемые GraphResult

const

grOk = 0;{Нет ошибок} 

grNoInitGraph = -1;{Графика не инициализирована} 

grNotDetected = -2;{Графическое устройство не обнаружено} 

grFileNotFound = -3;{Файл драйвера устройства не найден} 

grInvalidDriver= -4;{Неправильный файл драйвера устройства} 

grNoLoadMem = - 5;{Нет памяти для загрузки драйвера} 

grNoScanMem = - 6;{Нет памяти для просмотра областей}

grNoFloodMem = -7;{Нет памяти для закраски областей}

grFontNotFound = -8;{Файл шрифта не найден}

grNoFontMem = - 9;{Нет памяти для загрузки шрифта} 

grInvalidMode =-10;{Недопустимый графический режим} 

grError =-11;{Общая ошибка}

grIOerror =-12;{Ошибка графического ввода/вывода}

grInvalidFont =-13;{Неверный файл шрифта} 

grInvalidFontNum=-14;{Неверный номер шрифта}

Константы цвета

const

 

Black

= 0;{Черный}

Blue

= 1;{Синий}

Green

= 2;{Зеленый}

Cyan

= 3;{Голубой}

Red

= 4;{Красный}

Magenta

= 5;{Фиолетовый}

Brown

= 6;{Коричневый}

LightGray

= 7;{Светло-серый}

DarkGray

= 8;{Темно-серый}

LightBlue

= 9;{Ярко-синий}

LightGreen

= 10;{Ярко-зеленый}

LightCyan

= 11;{Ярко-голубой}

LightRed

= 12;{Розовый}

LightMagenta= 13;{Малиновый} 

Yellow      = 14;{Желтый}

White       = 15;{Белый}

Следующие константы цветов могут быть использованы с SetRGBPalette для выбора цветов на графическом адаптере IBM 8514:

const

EGABlack = 0;{Темныецвета}

EGABlue = 1;

EGAGreen = 2;

EGACyan = 3;

EGARed = 4;

EGAMagenta = 5;

EGALightGray = 7;

EGABrown = 20;

EGADarkGray = 56;{Светлыецвета}

EGALightBlue = 57;

EGALightGreen = 58;

EGALightCyan = 59;

EGALightRed = 60;

EGALightMagenta = 61;

EGAYellow = 62;

EGAWhite =63;

Константы типов и толщины линий

const

SolidLn=0;{Сплошная}

DottedLn=1;{Точечная}

CenterLn=2;{Штрихпунктирная}

DashedLn=3;{Пунктирная}

UserBitLn=4;{Тип определяется пользователем}

NormWidth=1;{Нормальная толщина}

ThickWidth= 3;{Тройная толщина}

Константы управления шрифтом

const

DefaultFont = 0;{Матричный шрифт 8x8}

TriplexFont = 1;{Шрифт триплекс; файл TRIP.CHR}

SmallFont = 2;{Мелкий шрифт; файл LITT.CHR}

SansSerifFont= 3;{Прямой шрифт; файл SANS.CHR}

GothicFont = 4;{Готический шрифт; файл GOTH.CHR}

HorizDir = 0;{Горизонтальное направление}

VertDir = 1;{Вертикальное направление}

UserCharSize = 0;{Размер символа, определяемый пользователем}

LeftText = 0;{Указатель слева от текста}

CenterText = 1;{Указатель по центру текста}

RightText = 2;{Указатель справа от текста}

BottomText = 0;{Указатель снизу от текста}

CenterText = 1;{Указатель по центру текста}

TopText = 2;{Указатель сверху от текста}

Константы отсечения

const

ClipOn = True;{Отсекать изображение} 

ClipOf£= False;{Игнорировать окно (не отсекать изображение)}

Константы для Bar3D

const

TopOn = True;{Рисовать вершину}

TopOff= False;{Не рисовать вершину}

Константы шаблона штриховки

const

EmptyFill=0;{Нет штриховки} 

SolidFill=1;{Сплошная штриховка} 

LineFill=2;{--- штриховка} 

LtSlashFill=3;{/// штриховка}

SlashFill=4;{/// штриховка (толстыми линиями)}

BkSlashFill=5;{\\\ штриховка (толстыми линиями)} 

LtBkSlashFill=6;{\\\ штриховка}

HatchFill=7;{+++ штриховка} 

XHatchFill=8;{ххх штриховка}

InterleaveFill=9;{Штриховка в клетку} 

WideDotFill =10;{Штриховка редкими точками}

CloseDotFill=11;{Штриховка частыми точками} 

UserFill =12;{Штриховка задается пользователем}

Битовые константы

const

CopyPut = 0;{MOV}

XORPut = 1;{XOR}

OrPut = 2;{OR}

AndPut = 3;{AND}

NotPut = 4;{NOT}

Константа палитры

const

MaxColors=15;{Максимальное количество цветов}

Типы

type

PaletteType = record{Используетсяв GetPallete}

Size : Byte;

Colors : array [0..MaxColors] of Shortlnt; 

end; 

LineSettingsType = record{Используетсяв GetLineSettings}

LineStyle Word;

Pattern Word;

Thickness Word; 

end; 

TextSettingsType = record{Используетсяв GetTextSettings}

Font :Word;

Direction : Word;

CharSize : Word;

Horiz : Word;

Vert : Word; 

end; 

FillSettingsType = record{Используетсяв GetFillSettings}

Pattern : Word;

Color : Word; 

end;

FillPatternType = array [1..8] of Byte; 

PointType = record{Длязаданиякоординатмногоугольников}

X,Y: Integer; 

end; 

ViemPortType = record{Используетсяв GetViewSettings}

X1, Y1, X2, Y2: Integer; 

Clip : Boolean; 

end;

ArcCoordsType = record{Используетсяв GetArcCoords} 

X,У : Integer; 

Xstart, Ystart: Integer; 

Xend, Yend : Integer;

end;

Переменные

var

GraphGetMemPrt : Pointer;{Распределениекучи

GraphFreeMemPrt: Pointer;{Освобождениекучи}

Эти переменные указывают на программы управления кучей модуля Graph. Если Ваша программа использует собственный алгоритм управления памятью, присвойте адреса Ваших программ распределения и освобождения памяти переменным GraphGetMemPrt и GraphFreeMemPrt.

 

Процедуры

Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word) Рисует дугу радиусом Radius от начального угла StAngle к конечному EndAngle, используя X, Y как координаты центра.

Procedure Bar (X1, Y1, X2, Y2 : Integer) Рисует полосу заданного размера, используя текущий стиль и цвет.

Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean) Рисует трехмерную полосу, используя текущий стиль и цвет.

Procedure Circle (X, Y: Integer; R: word) Рисует окружность радиуса R, используя X,Y как координаты центра.

Procedure ClearDeviceОчищаетэкран

Procedure ClearViewPortОчищаетокно

Procedure CloseGraph Закрывает графический режим.

Procedure DetectGraph (var Driver, Mode: Integer) Возвращает тип Driver установленного драйвера и текущий режим Mode его работы.

Procedure DrawPoly (NumPoints: Word; var PolyPoints) Рисует многоугольник из NumPoints вершин с координатами в PolyPoints текущим цветом и типом линии.

Procedure Ellipse (X, Y; Integer; StAngle, EndAngle, XR, YR: Word) Рисует эллиптическую дугу от начального угла StAngle к конечному углу EndAngle, используя X, Y как координаты центра и XR. YR - как горизонтальный и вертикальный радиусы.

Procedure FillEllipse(X, Y; Integer; XR, YR: Word) Рисует заштрихованный эллипс, используя X, Y как центр uXR, YR как горизонтальный и вертикальный радиусы.

Procedure FillPoly (NumPoints: word; var PolyPoints) Рисует и штрихует многоугольник, содержащий NPoints вершин с координатами в PolyPoints.

Procedure FloodFill (X, Y; Integer; Border; Word) Штрихует замкнутую область, содержащую внутреннюю точку с координатами X, Y и ограниченную линией с цветом Border. Используется текущий образец штриховки и цвет.

Procedure GetArcCoords (var ArcCoo: ArcCoordsType) Возвращает координаты центра, начала и конца дуги.

Procedure GetAspectRatio (var XAsp, YAsp: Word) Возвращает два числа, позволяющие оценить отношение сторон графического экрана (XAsp/YAsp).

Procedure GetDefaultPalette(var Palette; PaletteType) Возвращает текущую палитру в записи PaletteType.

Procedure GetFillPattern(var FillPatt: FillPatternType) Возвращает текущий образец штриховки.

Procedure GetFillSettings (var FillInfo: FillSettingsType) Возвращает текущий образец и цвет штриховки.

Procedure GetImage(X1, Y1, X2, Y2; Integer; var BitMap) Сохраняет в переменной BitMap битовый образ указанной части экрана.

Procedure GetLineSettings (var LineInfo; LineSettingsType) Возвращает текущий стиль, шаблон и толщину линии.

Procedure GetModeRange(GraphDriver: Integer; var LoMode, HiLode: Integer) Для графического драйвера GraphDriver возвращает диапазон возможных режимов работы.

Procedure GetPalette (var Palette: PaletteType) Возвращает текущую палитру и ее размер.

Procedure GetTextSettings (var TextInfo; TextSettingsType) Возвращает текущий шрифт, направление, размер и выравнивание текста, установленные процедурами SetTextStyle и SetTextJustify.

Procedure GetViewSettings (var viewport: NiewPortType) Возвращает координаты и признак отсечки текущего окна.

Procedure GraphDefaults Устанавливает стандартные параметры графического режима.

Procedure InitGraph(var Driver, Mode; Integer; Path: String)Инициализируетграфическийрежим.Переменные Driver и Mode должны содержать тип графического драйвера и его режим работы. Допускается указать Driver = 0 для автоматического определения этих параметров по результатам тестирования аппаратуры. Параметр Path определяет маршрут поиска файла графического драйвера.

Procedure Line (X1, Y1, Х2, Y2: Integer) Рисует линию от точки X1, Y1 до точки Х2, Y2.

Procedure LineRel(DX, DY: Integer) Рисует линию от текущего указателя к точке, заданной приращением координат.

Procedure LineTo(X, Y: Integer) Рисует линию от текущего указателя к точке X, Y.

Procedure MoveRel (DX, DY) Смещает текущий указатель к точке, заданной приращением координат.

Procedure MoveTo(X, Y: Integer) Смещает текущий указатель к точкеX,Y. 

Procedure OutText (TextString: String) Выводит текстовую строку на экран.

Procedure OutTextXY(X, Y: Integer; TextString: String) Выводит текст в заданное место экрана.

Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word) Рисует и штрихует сектор окружности радиусом Radius с центром в X.Y от начального угла StAngle к конечному углу EndAngle.

Procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word)Выводитбитовыйобразнаэкран.

Procedure PutPixel(X, Y; Integer; Color: Word)Выводитточкуцветом Colorскоординатами X. Y.

Procedure Rectangle (XI, Yl, X2, Y2: Integer)Рисуетпрямоугольник,используятекущийцветитиплинии.

Procedure RestoreCRTMode Восстанавливает текстовый режим работы экран.

Procedure Sector(X, Y: Integer; StAngle, EndAngle, XR, YR: Word) Рисует и штрихует сектор эллипса радиусами XR, YR с центром в X, Y от начального угла StAngle к конечному углу EndAngle.

Procedure SetActivePage(Page; Word) Устанавливает активную страницу для графического вывода.

Procedure SetAllPalette(var Palette) Изменяет все цвета палитры.

Procedure SetAspectRatio(XAsp, YAsp: Word) Изменяет масштабный коэффициент отношения сторон графического экрана.

Procedure SetBkColor (Color: Word)Устанавливаетцветфона.

Procedure SetColor (Color: Word) Устанавливает основной цвет, которым будет осуществляться рисование.

Procedure SetFillPattern (Pattern: FillPatternType; Color: Word) Устанавливает произвольный образец штриховки.

Procedure SetFillStyle (Pattern, Color: Word) Устанавливает образец штриховки и цвет.

Procedure SetGraphBuf Size (Size: Word) Позволяет изменить размер буфера для функций штриховки.

Procedure SetGraphMode(Mode: Integer) Устанавливает новый графический режим и очищает экран.

Procedure SetLineStyle(LineStyle, Pattern, Thickness: Word)Устанавливаеттолщинуистильлинии.

Procedure SetPalette(ColorNum, Color: Word)Заменяетцветпалитрысномером ColorNumнацвет Color.

Procedure SetRGBPallete(ColorNum, Red, Green, Blue: Integer)Позволяетмодифицироватьпалитрудля IBM 8514и VGA.

Procedure SetText Justify (Horiz, Vert: Word)Устанавливаетвыравниваниетекста,ис:пользуемоевпроцедурах OutTextи OutTextXY.

Procedure SetTextStyle (Font, Direction, CharSize; Word)Устанавливаеттекущийшрифт,стильиразмертекста.

Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word)Изменяетпропорциишрифта.

Procedure SetViewPort (X1, Y1, X2, Y2: Integer; ClipOn; Boolean)Устанавливаеттекущееокнодляграфическоговывода.

SetVisualPage(PageNo: Word) Устанавливает номер видимой графической страницы.

SetWriteMode(WriteMode; Integer) Устанавливает режим вывода (копирование или XOR) для линий, рисуемых процедурами DrawPoly, Line, LineRel, LineTo, Rectangle.

 

Функции

Procedure GetBkColor; Word Возвращает текущий фоновый цвет.

Procedure GetColor; WordВозвращаеттекущийцвет.

Procedure GetDriverName; String Возвращает строку с именем текущего драйвера.

Procedure GetGraphMode: Integer Возвращает текущий графический режим.

Procedure GetMaxColor; Word Возвращает максимальный цвет, который можно задать в SetColor.

Procedure GetMaxMode: Integer Возвращает номер максимального режима текущего загруженного драйвера.

Procedure GetMaxX: Integer Возвращает максимальную горизонтальную координату графического экрана.

Procedure GetMaxY; Integer Возвращает максимальную вертикальную координату графического экрана.

Procedure GetModeName(ModeNum; Word) ; String Возвращает строку с именем указанного графического режима.

Procedure GetPaletteSize: Integer Возвращает размер таблицы палитры. 

Procedure GetPixel (X, Y; Integer) : Word Возвращает цвет пикселя с координатами X,Y. 

Procedure GetX: Integer Возвращает координату X текущего указателя. 

Procedure GetY; Integer Возвращает координату У текущего указателя.

Procedure GraphErrorMsgtErrorCode: Integer): String Возвращает строку сообщения об ошибке для заданного кода ErrorCode.

Procedure GraphResult: Integer Возвращает код ошибки для последней графической операции.

Procedure ImageSize(X1, Y1, X2, Y2: Integer) Возвращает число байт, требуемое для сохранения прямоугольной области экрана.

Procedure InstallUserDriver(Name: String; AutoDetectPtr; Pointer): Integer Устанавливает пользовательский драйвер устройства в таблицу драйверов устройств.

Procedure InstallUserFont (FontFileName: String): Integer Устанавливает новый шрифт, который не встроен в BGI систему.

Procedure RegisterBGIdriver (Driver: Pointer); IntegerРегистрируетдрайвердляграфическойсистемы.

Procedure RegisterBGIfont (Font: Pointer): IntegerРегистрируетшрифтдляграфическойсистемы.

Procedure TextHeight (TextStr: String) : WordВозвращаетвысотустрокивпикселах

Procedure TextWidth(TextStr: String): WordВозвращаетширинустрокивпикселах.

 

Задание

Меню:

  1. Графическая заставка, где должны присутствовать ФИО и номер группы студента. Работать заставка должна на любых мониторах без привязки к конкретным координатам.
  2. Массив: найти минимальный элемент и поменять его с первым.
  3. Матрица: заменить элементы столбцов, где положительных элементов больше чем отрицательных, на 1
  4. Связанный список: поиск элементов в связанном списке по полю «табельный номер».
  5. Выход.

Блок схемы:

index.pas

program MyKurs;

uses

Crt,JobUnit,Grafika;

begin

q:=nil;

repeat

 clrscr;

 textmode(3);

 Write('В этой программе вы можете выполнять ');

 WriteLn('следующие действия:');

 WriteLn('1: Работа с массивом');

 WriteLn('2: Работа с матрицей');

 WriteLn('3: Работа со связанным списком');

 WriteLn('4: Просмотр заставки');

 WriteLn('5: Выход');

WriteLn;

 Write('Вашвыбор: ');

 ReadLn(answer);

 case answer of

  1: begin

st1:='Вывод исходного массива:';

    st2:='Вывод сформированного массива ';

    clrscr;

    write('Введите количество элементов массива: ');

readln(minit);

    q:=new(ptrmas,Init(minit))

end;

  2: begin

    st1:='Вывод исходной матрицы:';

    st2:='Вывод сформированноy матрицы:';

    clrscr;

    writeln('Введите размерность матрицы:');

write('m = ');

    readln(minit);

    write('n = ');

    readln(ninit);

    q:=new(ptrmatr,Init(minit,ninit))

end;

  3: begin

    st1:='Вывод исходноgo списка:';

    st2:='Вывод найденных элементов списка:';

    clrscr;

    write('Введите количество записей для ввода: ');

readln(minit);

    q:=new(ptrlist,Init(minit))

   end;

  4: begin

    zastavka;

    minit:=0;

   end;

  5: begin

    exit

   end;

 end;

 if minit<>0 then begin

  clrscr;

  writeln(st1);

  q^.OutData;

  q^.Job;

  writeln(st2);

  q^.OutData;

writeln;

  writeln('Для продолжения работы программы нажмите любую клавишу...');

readkey;

  dispose(q,Done);

  q:=nil;

 end;

 until false;

end.

JobUnit.PAS

unit JobUnit;

interface

uses

Crt;

const

mmax=50;

nmax=50;

type

{Описаниепростыхтипов...}

massiv=array [1..mmax] of integer;

matrix=array [1..mmax,1..nmax] of integer;

bazarec=record

 tabnum:word;

 mesac:string[3];

 vidNachisl:string[20];

 summ:real;

 nalogi:real;

 numOtdel:word;

end;

link=^elem;

elem=record

 data:bazarec;

 next:link;

pred:link;

end;

{Описание типов объектов...}

ptrquan=^Quantity;

Quantity=object

 m:integer;

 Constructor Init(minit:integer);

 Destructor Done;

 procedure OutData; virtual;

 procedure Job; virtual;

end;

ptrmas=^Mas;

Mas=object(quantity)

 a:massiv;

 Constructor Init(minit:integer);

 procedure OutData; virtual;

 procedure Job; virtual;

end;

ptrmatr=^Matr;

Matr=object(quantity)

 a:matrix;

 n:integer;

 Constructor Init(minit,ninit:integer);

 procedure OutData; virtual;

 procedure Job; virtual;

end;

ptrlist=^list;

List=object(quantity)

 first,last:link;

 Constructor Init(minit:integer);

 Destructor Done;

 procedure OutData; virtual;

 procedure Job; virtual;

end;

var

{Данныепеременныенужныдляменю...}

answer:integer;

st1,st2:string;

minit,ninit:integer;

{Данные переменные нужны для описания объектов...}

q:ptrquan;

implementation

{Описание соответствующих методов обработки объектов...}

Constructor Quantity.Init;

begin

m:=minit;

end;

Destructor Quantity.Done;

begin

end;

procedure Quantity.Job;

begin

end;

procedure Quantity.OutData;

begin

end;

Constructor Mas.Init; {Процедура инициализации массива}

var

i:integer;

begin

if minit<1 then begin

WriteLn('Неправильно введено количество елементов!');

readkey;

 exit

end;

m:=minit;

For i:=1 to m do begin

 textattr:=$07; Write(i,': ');

 textattr:=$0F; ReadLn(a[i])

end;

textattr:=07;

end;

procedure Mas.Job; {Процедураобработкимассива}

var

i,min,minpoz:integer;

begin

if m<1 then exit;

min:=a[1];

minpoz:=1;

For i:=2 to m do

 if min>a[i] then begin

  min:=a[i];

  minpoz:=i

 end;

a[minpoz]:=a[1];

a[1]:=min

end;

procedure Mas.OutData; {Процедура вывода массива на экран}

const

 colls=4;

var

i:integer;

begin

if m<1 then exit;

For i:=1 to m do begin

 textattr:=$07; Write(i:2,': ');

 textattr:=$0F; Write(a[i]:4,'; ');

 if i mod colls = 0 then WriteLn

end;

WriteLn;

textattr:=$07;

end;

Constructor Matr.Init;  {Процедураинициализацииматрицы}

var i,j:integer;

begin

if (minit<1)or(ninit<1) then begin

WriteLn('Недопустимая размерность матрицы!');

readkey;

 exit

end;

m:=minit;

n:=ninit;

For i:=1 to m do begin

 textattr:=$07;

 WriteLn('Ввод ',i,'-тойстроки:');

 For j:=1 to n do begin

Write('Введите ',j,'-тый елемент: ');

textattr:=$0F;

  Readln(a[i,j]);

  textattr:=$07;

 end;

end;

end;

procedure Matr.Job;  {Процедураобработкиматрицы}

var

i,j,plus,otric:integer;

begin

if m<1 then exit;

For j:=1 to n do begin

 plus:=0;

 otric:=0;

 For i:=1 to m do

  if a[i,j]>0 then inc(plus)

  else if a[i,j]<0 then inc(otric);

 if plus>otric then

  For i:=1 to m do a[i,j]:=1

end

end;

procedure Matr.OutData; {Процедуравыводаматрицынаэкран}

const colls=5;

var i,j:integer;

begin

if m<1 then exit;

textattr:=$0F;

For i:=1 to m do begin

 For j:=1 to n do

  Write(a[i,j]:6,' ');

 WriteLn

end;

textattr:=$07;

WriteLn;

end;

Constructor List.Init; {Процедура инициализации связанного списка}

var

 now:link;

 i:integer;

 c:char;

begin

if minit<1 then begin

WriteLn('Неправильно введено количество записей!');

readkey;

 exit

end;

clrscr;

m:=minit;

first:=nil;

last:=nil;

For i:=1 to m do begin

clrscr;

 WriteLn('Введите запись:');

new(now);

 if now=nil then begin

WriteLn('Не достаточно памяти!!!');

readkey;

  exit

 end;

 With now^.data do begin

Write('     введите табельный номер: ');

Readln(tabnum);

  Write('введитемесяц:           ');

Readln(mesac);

  Write('     введите вид начисления:  ');

Readln(vidNachisl);

  Write('введитесумму:           ');

  Readln(summ);

  Write('введитеналоги:          ');

  Readln(nalogi);

Write('     введите номер отдела:    ');

Readln(numOtdel);

 end;

 if first=nil then begin

  first:=now;

  now^.pred:=nil end

 else begin

  last^.next:=now;

  now^.pred:=last

 end;

 last:=now;

 now^.next:=nil

end;

end;

procedure List.OutData; {Процедура вывода связанного списка на экран}

var

now:link;

strNow,strMax,i:integer;

ans:char;

begin

readkey;

if m<1 then exit;

if first=nil then begin

 WriteLn('Нетданныхдлявывода!');

 readkey;

 exit

end;

now:=first;

strMax:=m div 11 +1;

strNow:=0;

i:=0;

Repeat

 inc(StrNow);

 inc(i);

 clrscr;

 WriteLn('г=====T===========T=======T============T===========T==========T========¬');

WriteLn('¦  №  ¦ Табельный ¦ Месяц ¦ Вид        ¦   Сумма   ¦  Налоги  ¦    №   ¦');

 WriteLn('¦     ¦     №     ¦       ¦ начисления ¦           ¦          ¦ Отдела ¦');

WriteLn('¦=====+===========+=======+============+===========+==========+========¦');

 while (now<>nil)and(WhereY<23) do begin

  with now^.data do

   WriteLn('¦ ',i:3,' ¦ ',tabnum:9,' ¦  ',mesac:3,'  ¦ ',vidNachisl:10,' ¦ ',summ:9:2,' ¦ ',nalogi:8:2,' ¦',numOtdel:7,' ¦');

  now:=now^.next;

  if (now<>nil)and(WhereY<23) then

   WriteLn('¦-----+-----------+-------+------------+-----------+----------+--------¦');

  inc(i);

  if (WhereY>=23)or(now=nil) then

   WriteLn('L-----¦-----------¦-------¦------------¦-----------¦----------¦---------');

 end;

 WriteLn('Страница ',strNow,'/',strMax);

 if now=nil then begin

  exit end

else begin

  Write('Вы хотите посмотреть следующую страницу?(y/n) ');

  ReadLn(ans);

  if upcase(ans)<>'Y' then exit;

  dec(i);

 end;

until false

end;

Destructor List.Done;  {Деструктор Doneобъекта List}

var                    { Процедура удаления списка из памяти}

now:link;

begin

if m<1 then exit;

now:=first;

while first <> nil do begin

 now:=first^.next;

 dispose(first);

 first:=now;

end;

end;

procedure List.Job;     {Метод Jobобработкиполейобъекта List }

var                     {   процедура поиска элементов в связ. списке}

now:link;

  answ:word;

  f:boolean;

begin

Write('Введите искомый табельный номер: ');

ReadLn(answ);

now:=first;

f:=true;

while now<>nil do begin

 if now^.data.tabnum=answ then begin

  if f then begin

   f:=false;

   first:=now;

   now^.pred:=nil;

   last:=now end

  else begin

   last^.next:=now;

   last:=now;

  end;

 end;

 now:=now^.next

end;

if f then first:=nil

else last^.next:=nil;

end;

end.

GRAFIKA.PAS

unit grafika;

interface

uses crt,graph;

procedure zastavka;

implementation

procedure zastavka;

const

detect=0;

{For ball}

r=3;

d=r*2;

{For speed}

pause=1000;

var

dr,m,error,maxx,maxy,SizeOfBall,

  x1,y1,dx1,dy1,x2,y2,dx2,dy2,x1P,x2P,x3P,y1P,y2P:integer;

choose:char;

f:boolean;

ball1,ball2:Pointer;

st1:string;

begin

{General}

dr:=detect;

InitGraph(dr,m,'');

error:=GraphResult;

if error<> grOk then begin

 WriteLn(GraphErrorMsg(error));

 readkey;

 exit

end;

maxX:=GetMaxX div 2;

maxY:=GetMaxY div 2;

Randomize;

{_General}

{Make Text}

SetTextStyle(1,HorizDir,3);

SetColor(10);

st1:='Kursovay''a rabota Suhodoeva Pavla I-351';

x1:=(GetMaxX div 2)-(textWidth(st1) div 2);

OutTextXY(x1,GetMaxY div 8,st1);

SetTextStyle(2,HorizDir,4);

SetColor(9);

st1:='For exit press ''Esc''';

x1:=(GetMaxX div 2)-(textWidth(st1) div 2);

OutTextXY(x1,(GetMaxY div 8)*7,st1);

SetColor(7);

{_Make Text}

{Make Game Zone}

x1:=maxx div 2;

y1:=maxy div 2;

Rectangle(x1,y1,MaxX+x1,MaxY+y1);

SetViewPort(x1+1,1+y1,x1+MaxX-1,y1+MaxY-1,ClipOn);

x2:=x1 div 3;

y2:=y1 div 3;

x1P:=x1-x2;

x2P:=x1;

x3P:=x1+x2;

y1P:=y1-y2;

y2P:=y1+y2;

Line(x1P,y1P,x1P,y2P);

Line(x2P,y1P,x2P,y2P);

Line(x3P,y1P,x3P,y2P);

{_Make Game Zone}

{Make table and balls and put them into heap}

{Ball1}

x1:=10; y1:=10;

SetColor(14);

SetFillStyle(1,14);

Circle(x1+r,y1+r,r);

dx1:=x1+d; dy1:=y1+d;

FloodFill(x1+r,y1+r,14);

SizeOfBall:=ImageSize(x1,y1,dx1,dy1);

GetMem(Ball1,SizeOfBall);

GetImage(x1,y1,dx1,dy1,Ball1^);

PutImage(x1,y1,Ball1^,XorPut);

{_Ball1}

{Ball2}

x1:=10; y1:=10;

SetColor(9);

SetFillStyle(1,9);

Circle(x1+r,y1+r,r);

dx1:=x1+d; dy1:=y1+d;

FloodFill(x1+r,y1+r,9);

GetMem(Ball2,SizeOfBall);

GetImage(x1,y1,dx1,dy1,Ball2^);

PutImage(x1,y1,Ball2^,XorPut);

{_Ball2}

{_Make table and balls and put them into heap}

{Set first coordinates of toys}

dx1:=(maxy div 2)-r;

x1:=(maxx div 4)-r;

y1:=dx1;

x2:=(maxx div 4)*3-r;

y2:=dx1;

dx1:=random(4)+1;

dy1:=random(3)+1;

dx2:=random(3)+1;

dy2:=random(3)+1;

{_Set first coordinates of toys}

{Main Repeating}

repeat

 PutImage(x1,y1,Ball1^,XorPut);

 PutImage(x2,y2,Ball2^,XorPut);

 Delay(pause);

 PutImage(x1,y1,Ball1^,XorPut);

 PutImage(x2,y2,Ball2^,XorPut);

 {New Coordinates}

 {Speed: 1..3}

 x1:=x1+dx1;

 y1:=y1+dy1;

 x1:=x1+dx1;

 y1:=y1+dy1;

 x2:=x2+dx2;

 y2:=y2+dy2;

 x2:=x2+dx2;

 y2:=y2+dy2;

 if KeyPressed then begin

  choose:=readkey;

  if choose=#0 then choose:=readkey;

  if choose=#27 then begin   {Esc}

   closeGraph;

   exit

  end;

 end;

 if (x1<=4)or((x1+d-4)>=maxx) then dx1:=-dx1;

 f:=(y1+d>=y1P)and(y1<=y2P);

 if f and (

  ((x1+d>=x1P) and (x1<=x1P))or

  ((x1+d>=x2P) and (x1<=x2P))or

  ((x1+d>=x3P) and (x1<=x3P))) then dx1:=-dx1;

 if (x2<=4)or((x2+d-4)>=maxx) then dx2:=-dx2;

 f:=(y2+d>=y1P)and(y2<=y2P);

 if f and (

  ((x2+d>=x1P) and (x2<=x1P))or

  ((x2+d>=x2P) and (x2<=x2P))or

  ((x2+d>=x3P) and (x2<=x3P))) then dx2:=-dx2;

 if (y1<=4)or((y1+d-4)>=maxy) then dy1:=-dy1;

 if (y2<=4)or((y2+d-4)>=maxy) then dy2:=-dy2;

 if ((y1+d>=y2)and(y1<=y2+d))and

  ((x1+d>=x2)and(x1<=x2+d)) then begin

   dx1:=random(4); dy1:=random(4);

   dx2:=random(4); dy2:=random(4);

   if (dx1=0)and(dx2=0) then dx1:=2;

   if (dy1=0)and(dy2=0) then dy1:=2;

   if random(2)=1 then begin

    dx2:=-dx2;

    dy1:=-dy1;

   end

 end;

until false;

end;

end.

Результаты.

Главное меню:

Результаты работы модуля «работа с массивом»:

Результаты работы модуля «работа с матрицей»:

Результаты работы модуля «работа со связанным списком»:

Зазтавка:

Модуль Graph на http://mirrorref.ru


Похожие рефераты, которые будут Вам интерестны.

1. Реферат Работа в графической среде Graph Edit

2. Реферат Основы программирования вTurboPascal Пример использования модуля Graph

3. Реферат Стандартные процедуры и функции Unit Graph. Методы создания анимации

4. Реферат Профессиональный модуль

5. Реферат МОДУЛЬ УПРУГОСТИ

6. Реферат Определить модуль упругости

7. Реферат КРУТИЛЬНЫЕ КОЛЕБАНИЯ И МОДУЛЬ КРУЧЕНИЯ

8. Реферат Модуль Таймера микроконтроллера MSP430F2013

9. Реферат Определить модуль упругости стержня

10. Реферат Опытным путем определить модуль упругости