TURBO PASCAL

Новости

Программы   

Turbo Pascal 

Игры

Документация   

Странности

FAQ

Ссылки

Форум

Гостевая книга

Рассылка

Благодарности

Об авторе

 

 

П6. МОДУЛЬ F EMS ДЛЯ РАБОТЫ С ОТОБРАЖАЕМОЙ ПАМЯТЬЮ

Описание модуля см. п.5.3.

(»=========»===-; Unit F_EMS; f-—==—=-»-«-===/

^—————————————————————————————+

I Этот модуль содержит объекты и подпрограммы f I для работы с EMS-паыятью 1 +——————.———_——————————————————+/

{$X+,N1-,E+)

INTERFACE

^———————————————————————————————;

type

/——----— Базовый объект иерархии -—-————} PEMSArea =ATEMSArea,• TEMSArea " Object

Handle: Word; {Дескриптор}

MaxPag: Word; (Количество страниц}

Size: LongInt; (Длина используемой памяти}

Constructor Init(ASize: LongInt);

Constructor Load(var F: File);

Destructor Done; Virtual;

Peocedure EMSError(NError: Byte); Virtual;

Procedure Store(var F: File); Virtual;

Procedure WriteEMS(var Source; Dest,Sz: LongInt); Virtual;

Procedure ReadEMS(Source: LongInt; var Dest; Sz: LongInt); Virtual;

/———————; private (——————)

Function ReadFilefvar F: File; var Dest; Sz: Word): Boolean; Virtual;

Function WriteFile(var F: file; var Source; Sz: Word): Boolean; Virtual;

end;

{—————— Одномерный массив a EMS ——————}

PEMSVector -"TEMSVector;

TEMSVector - object (TEMSArea)

ItemS : LongInt; {Длина элемента массива)

Minind; LongInt; {Минимальный индекс}

Maxind: LongInt; {Максимальный индекс}

Constructor Init(ASize,Min,Max: LongInt);

Constructor Load(var F: File);

Procedure Store(var F: File); Virtual;

Procedure Setltem(var Source; Index: Longint);

Procedure GetItemtvar Dest; Index: Longint);

Function SingleItem(Index: Longint): Single;

Function Doubleltem(Index: Longint): Double;

Function Realltem(Index: Longint): Real;

Function ExtendedItem(Index: Longint): Extended;

Function IntegerItemdndex: Longint) : Integer;

Function LongIntItem(Index: Longint): Longint;

Function Byte I tern(Index: Longint): Byte;

end;

{---------- Двумерный пассив в EMS ----------}

PEMSMatrix =^TEMSMatrix;

TEMSMatrix = object (TEMSVector)

Minlndl: Longint; {Минимальный индекс!

MaxIndl: Longint; (Максимальный индекс}

MinInd2: Longint; {Минимальный индекс}

Maxlnd2: Longint; {Максимальный индекс}

Constructor Init(ASize,Minl,Maxl,Min2,Max2: Longint);

Constructor Load(var F: File);

Procedure Store(var F: File); Virtual;

Function GetVedndex(Indl,Ind2: Longint): Longint;

Procedure SetItem(var Source;Indl,Ind2: Longint);

Procedure GetItemfvar Dest;Indl,Ind2: Longint);

Function SingleItemdndl, Ind2: Longint): Single;

Function DoubleItemdndl, Ind2: Longint): Double;

Function Real Item(Indl,Ind2: Longint): Real;

Function ExtendedItemtIndl,Ind2: Longint): Extended;

Function IntegerltemlIndl,Ind2: LengInt): Integer;

Function LongIntItem(Indl,Ind2: Longint): Longinc;

Function BytPltem(Indl,Ind2: Longint): Byte;

end;

{---------- Многомерный массив в ЕМЗ —-—--—}

TIndexList - array [l-.MaxInt div 2] of Longint;

TIndex = array [l-.MaxInt div 6,1..3] o? Longint;

PIndex ="TIndex;

TIndexBond = array [l..Max!nt div 4,1..2] of Longint, PEMSArray -"TEMSArray;

TEMSArray = object (TEMSVector)

Nindex: Word; {Колячество измерений)

Index : PIndex:

Constructor Init(ASize: Longint; NInd: Word,- var Ind)?

Constructor Load(var F: File);

Destructor Done; Virtual;

Procedure Store(var F: File); Virtual;

Function GetVeclndex(var Ind): Longint;

Procedure Setltemfvar Source,Ind);

Procedure GetItem(var Dest,Ind);

end;

{—-- Имитатор файла последовательного доступа ----} PEMSType ="TEMSType;

TEMSType » object (TEMSArea)

Pos: Longint; {Текущая позиция от начала памяти,"

Constructor Init(ASize: Longint;;

Constructor Load(vac F: Pile);

Procedure Store(var F: File); Virtual;

Procedure SetItem(var Source; Sz: LotigInt) ;

Procedure GetItemtvar Dest; Sz: Longint);

end;

{-------- Имитатор текстового файла ---------^

PEMSText ^TEMSText;

TEMSText ° object (TEMSType)

Procedure SetItem(S: String);

Function Getltem: String;

end;

{-————— копия экрана в EMS-памяти ————-} PEMSScreen =^TEMSScreen;

TEMSScreen = object (TEMSArea)

Mode: Byte; {Код режиыа)

Constructor Init;

Constructor Load(var P: File) ;

Procedure Store(var F: File); Virtual;

Procedure PutScreen;

Procedure GetScreen;

end;

var

EMSStatus: Byte; {Статус последней операции}

Function IsEMS: Boolean;

{Возвращает TRUE, если в ПК имеется EMS-память}

function GetEMMVersion: String;

{Возвращает номер версии EMM в формате 'Х.Х'}

Function EMSSeg: Word;

{Возвращает сегментную часть адреса окна EMS-памяти}

Procedure GetEMSInfo(var AllPage, Pages: Word);

{Возвращает полное количество (AllPages) и количество незанятых (Pages) страниц}

Procedure MewEMSHandle(var Handle: Word;Pages: Word);

{Открывает новый дескриптор Handle и связывает с ним Pages страниц EMS}

Procedure DisposeEMSHandle(var Handle: Word);

{Удаляет дескриптор Handle и освобождает связанную с ниш память}

Procedure MapEMSPage(Handle,Physic,Logic: Word);

{Картирует окно, связывая его Physic физическую страницу с

Logic логической страницей дискриптора Handle! const

EMSErrorFlag : Boolean =' False;

RegHeadIEMSArea : String [14]='F_EMS TEMSArea'

RegHeadTEMSVector: String [14]='F_EMS TEMSVect'

RegHeadTEMSMatrix: String [14]='F_EMS TEMSMatr'

RegHeadTEMSArray : String [14]='F_EMS TEMSArra

RegHeadTEMSType : String [14]-•F_EMS TEMSType'

RegHeadTEMSScreen: String [14]='F_EMS TEMSScre' /——-_———————_——————————————„————;

IMPLEMENTATION ,———————————————————————————————/

Uses DOS,Graph,F Text;

var

Reg: registers;

const

EMSVer : riord =0; {Версия iSMM; используется как флаг проверки наличия EMS) EMSS : Word =0; {Сегмент окна}

LPage=16*1024; {Длина страницы} I --------- Базовый объект иерархии ----------}

Constructor TEMSArea.Init(ASize: Longint);

{Создает объект TEMSArea. ASize - размер требуемой ЕМЗ-памяти в байтах} vaa:

All,Pag: Word;

begin

if not IsEMS then

EMSError($A5) {Нет EMS} else begin

EKSErrorFlag := False;

Size := ASize;

MaxPag := (Size+LPage-1) shr 14;

GetEMSInfo(All,Pag) ;

if MaxPag>Pag then

EMSError($88) (Нет требуемых страниц) else begin

NewEMSHandle(Handle,MaxPag) ;

EMSError(EMSStatus) end end

end; {TEMSArea.Init} ' (— ————————— ——;

Function TEMSArea.ReadFile(var F: File; var Dest; Sz: Word): Boolean;

{Читает Зг байт из файла F в переменную Dest и контролирует результат} var

К: Word;

begin

BlockRead(F,Desc,Sz,K) ;

if KOSz then begin

EMSError($A7) ;

ReadFile := False (Ошибка при чтении} end else

ReadFile := True {Нет ошибок} end; {ReadFilo} ^—————————————

Constructor TEMSArea.Load(var F: File);

{Создает объект TEMSArea, считывая его изфайла F. Файл должен быть открыт на чтение с длиной блоков в 1 байт и позиционирован на место, где ранее был сохранен объект TEMSArea процедурой. Store.} var

SRead,Rest: Longint;

S: Strings-All,k: Word;

Stop: Boolean;

P: Pointer;

begin

if not IsEMS then

EMSError($A5) {Нет EMSf else begin

{Читаем заголовок объекта - строку RegHeadTEMSArea EMSErrorFlag :=• Fals&;

Stop := False; {Флаг нормального чтени^ч if not ReadFile(F,S,SizeOf(RegHeadTEMSAreaU or (SORegHeadTEMSArea) then

EMSError($A6) {Ошибка чтения или несовпадение заголовка} else {Читаем поля МахРад и Size} begin

if not (ReadFile(F,MaxPag,2) and ReadFile(F,Size,4)) then

Exit; {Была ошибка при чтении полей} (Проверяем доступную память} GetEMSInfo(All,k);

if k<MaxPag then

EMSError($88) {Нет нужной памяти} else begin

{Пытаемся создать дескриптор) NewEMSHandle(Handle,MaxPag) ;

if EMSStatusoO then

EMSError(EMSStatus) else

begin {Читаем содержимое памяти} Rest :=• Size; {Непрочитанный остаток} Р := Ptr(EMSSeg,0);{Адрес начала физической страницы окна} АН := 0; (Начинаем с 0-й логической страницы} Stop := False;

while (RestoO) and not Stop do begin

MapEMSPage (Handle, 0,AU);

EMSError(EMSStatus);

if EMSStatusoO then

Exit; (Ошибка картирования} if Rest>LPage then

SRead := Lpage else

SRead :=• Rest;

Stop :- not ReadFile(F,P",SRead);

Dec(Rest,SRead) ;

Inc(All) end end end end end

end; {TEMSArea.Load} /———————————;

function TEMSArea.WriteFile(var F: Pile; var Source; Sz: Word): Boolean;

{Записывает Sz байт из переменной Source в файл F и контролирует результат) var

К: Word;

begin

BlockWrite(P,Source,Sz,К) ;

if KoSz then begin

EMSError($A8) ;

WriteFile := False {Ошибка при записи) end else

WriteFile := True (Нет ошибок} end; {TEMSArea.WriteFile) ^-————————————;

Procedure TEMSArea.Storetvar F: Pile);

{Записывает объект TEMSArea в файл F. Файл должен быть открыт на валясь с длиной блоков в 1 байт и позиционирован на нужное место (обычно ~ а конец файла) } var

SRead,Rest: LongInt;

S: String;

All,k: Word;

Stop: Boolean;

P: Pointer;

begin

if not IsEMS then

EMSError(?A5) {Нет EMS} else begin

{Записываем заголовок объекта - строку RegHeadTEMSArea} EMSErrorFlag := False;

S := RegHeadTEMSArea;

if WriteFile(F,S,SizeOf(RegHeadTEMSArea))

then begin {Записываем поля MaxPag и Size} if WriteFile(F,MaxPag,2) and

WriteFile(F,Size,4) then

begin /Записываем содержимое памяти} Rest := Size; {Незаписанный остаток} Р := Ptr(EMSSeg,0); {Адрес начала физической страницы окна} All := 0; {Начинаем с 0-й логической страницы) Stop :=• False; {Признак ошибки} while (RestoO) and not Stop do begin

MapEMSPage(Handle,0,All);

EMSError(EMSStatus) ;

if EMSStatusOO then

Exit; {Ошибка картирования} if Rest>LPage then

SRead := LPage else

SRead := Rest;

Stop:= not WriteFile (F.V, SRead);

Dec(Rest,SRead);

Inc(All) end end end end end; {TEMSArea.Store} {——— ——————_——;

Destructor TEMSArea.Done ;

{Уничтожает объект TEMSArea и освобождает связанную с ним память} begin

if not IsEMS then

EMSError($A5) {Нет EMS} else begin

DisposeEMSHandle(Handle) ;

EMSError(EMSStatus) end

end; {TEMSArea.Done} ;———————————;

Procedure TEMSArea.WtiteEMS(var Source; Dest,Sz: Longint);

{Записывает Sz байт из переменной Source в EMS,

начиная с позиции Dest байт от ее начала) var

Rest,Pos,k: Longint;

Рад: Word;

PD,PS: Pointer;

PW: record

S,0: Word end absolute PS;

Stop: Boolean;

begin {$IFSDEF NOTCHECK}

if (Sz<0) or (Dest+Sz>Size) then

EMSError($AA) {Запись за границей памяти} else {?endIF} begin

Рад := Dest div LPage; {Логическая страница} Pos := Dest mod LPage; {Смещение в ней) PS := @Source; {Указатель в источнике} PD :- ptr(EMSS,Pos); {Указатель в EMS} Stop :» False; (Флаг ошибки картирования) Rest :== Sz; {Остаток записи} repeat {Цикл по страницам EMS} MapEMSPage(Handle,0,Рад); {Картируем окно} EMSError(EMSStatus) ;

Stop := EMSStatusOO; {Признак ошибки} if not Stop then begin

{Определяем размер Sz очередного блока:} if Rest>LPage-Pos then

Sz := LPage-Pos else

Sz := Rest;

MovefPS^PD^Sz) ; ' {Переносим блок} Dec(Rest,Sz); (Уменьшаем остаток} Inc(Рад); {Следующая логическая страница} PD := ptr(EMSS,0); (Указатель - а ее начало} Pos := 0;

Inc(PW.O,Sz); (Смещение в источнике} {Нормализуем указатель PS источника:} PW.S :» PW.S+(PW.O Shr 4);

PW.O := PW.O mod 16 end

until Stop or <Rest=0) end

end; {TEMSArea.WriteEMS} /———_————————/

Procedure TEMSArea.ReadEMS(Source: Longint; var Dest; Sz: Longint)-{Читает Sz байт из EMS-памяти, начиная с байта Source от ее начала, в переменную Dest} var

Rest,Pos,k: Longint;

Рад: Word;

PD,PS: Pointer;

PW: record S,0: Word end absolute PD;

Stop: Boolean;

begin (fIFNDEF NOTCHECK}

±f (Sz<0) or (Source+Sz>Size) then

EMSError($A9) {Чтение за границей памяти}

else

{$endIF} begin

Pag :• Source div LPage; {Логическая страница} Pos := Source mod LPage; {Смещение в ней) PD := @Dest; {Указатель в приемнике} PS := ptr(EMSS,Pos); {Указатель в источнике} Stop := False; {Флаг ошибки картирования} Rest :=' Sz; ^Остаток чтения} repeat {Цикл по страницам EMS} MapEMSPage(Handle,0,Pag); {Картируем окно} EMSError(EMSStatus) ;

Stop :- EMSStatusOO; {Признак ошибки} if not Stop then begin

{Определяем размер Sz очередного блока:} if Rest>LPage-Pos then

Sz :-= LPage-Pos else

Sz := Rest;

Move(PS",PD^,Sz); {Переносим блок} Dec(Rest,Sz); {Уменьшаем остаток} Inc(Pag); {Следующая логическая стр.} PS :-= ptr(EMSS,0) ;

Pos 0;

Inc(PW.O,Sz); {Смещение в приемнике} {Нормализуем, указатель PD приемника:} PW.S :» PW.S+(PW.O shr 4);

PW.O ;= PW.O mod 16 end

until Stop oe (Rest-0) end

end; (TEMSArea.ReadEMS} /—.——_-_———__-_-,

Procedure TEMSArea.EMSError(NError: Byte);

{Получает управление при ошибках EMM илипри выполнении методов объекта. По умолчанию выводит сообщение с номером NError.! const

Msg: array [$80..$AD] of String »( 'Внутренняя ошибка EMM', 'Сбой EMS-платы",

'EMM занят обработкой предыдущего запроса', 'Неверный дескриптор окна',

'Запрошена неопределенная в данной версии EMM функция', "Нет доступных дескрипторов окон', 'Ошибка при сохранении или восстановлении окна', 'Запрос распределения превышает общую EMS-память', 'Запрос распределения превышает число доступных страниц', 'Попытка создать дескриптор с нулевым количеством страниц', 'Дескриптор не располагает таким числом страниц', 'попытка картировать больше 4 страниц", ,

•Переполнение области сохранения картирующего контекста .

'Попытка повторного сохранения картирующего контекста',

"Попытка восстановления несохраненного контекста",

'Не определен параметр подфункции',

1 Неизвестный тип атрибутов',

'Нет аппаратной поддержки сохраняемых страниц ,

•Источник и приемник информации одновременно находятся в ЕМЗ-памяти',

'Размер приемника информации слишком мал',

'Стандартная память частично перекрывает расширенную память",

'Слишком большое смещение в перемещаемом блоке',

'Размер перемещаемого блока больше 1 Мбайт',

'Источник и приемник связаны с одним дескриптором и частично перекрываювся',

'Недопустимый тип памяти источника или приемника',

'Неопознанная ошибка',

'Нет аппаратной поддержки альтернативной установки страниц',

•Исчерпаны все допустимые установки альтернативных регистров',

'Не поддерживается установка альтернативных регистров",

'Неправильная установка альтернативных регистров',

'Назначенные каналы прямого доступа к памяти (КПДП) не поддерживаются',

'Указанный КПДП не поддерживается',

'Дескриптор не поименован',

'Указанное имя дескриптора уже существует',

•Источник выходит за границу 1 Мбайт',

'Содержимое указанное области данных разрушено',

'Нет доступа к указанной функции',

"Нет ЕМЗ-памяти или не установлен драйвер EMM.SXS',

'Неверный формат файла',

'Ошибка при чтении объекта из файла',

'Ошибка при записи объекта в файл',

"Попытка чтения за границей доступной ЕМЗ-памяти"^

'Попытка записи за границей доступной ЕМЗ-памяти"у

'Неверные границы индексов',

'Размер элемента вектора не соответствует длине переменной',

'Изменен режим работы дисплея (объект TEMSScreen)>

);

begin

if NError»0 then begin

EMSErrorFlag :» False;

Exit end;

EMSErrorFlag := True;

if NError in [?80..$AD] then

WriteLn(Msg[NError)) else

WriteLn('Ошибка номер ',NError) end; {TEMSArea.EMSError} {---—---— Одномерный массив s JEMS -———----;

Constructor TEMSVector.Init(ASize,Min,Max: LongInt);

{Создает объект TEMSVector:

ASize - размер элементов пассива в байтах;

Min,Max - границы индекса.} var

Sz: LongInt;

begin

if Min>Max then begin

EMSError($AB); {Неправильные границы} Exit end;

Sz := ASize*(Max-Min+1); {Определяем размер} TEMSArea.Init(Sz); {Создаем TEMSArea} if not EMSErrorFlag then begin

ItemS := ASize;

Minind := Min;

Maxind := Max end end; {TEMSVector,lait}

^_— ————__—}

Constructor TEMSVector.Load(var F: File);

{Создает объект TEMSVector - читает из файла базовый объект TEMSArea, затем заголовок и поля ItemS, Minind, Maxind.} var

S: String;

begin

TEMSArea.Load(F); {Загружаем из файла базовый объект} if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSVector))

and (S=RegHeadTEMSVector) then begin

if ReadFile(F,Items,4) then if ReadFile(F,MinInd,4) then ReadFile(F,Maxind,4) ;

if EMSErrorFlag then

Done end else

EMSError($A6) end; {TEMSVector.Load} ^————————————;

Procedure TEMSVector.Store(var F: File);

{Сохраняет вектор в файле - сначала сохраняет базовый объект, потом заголовок и поля ItemS, Minind, Maxind.}

begin

TEMSArea.Store(F) ;

if not EMSErrorFlag then begin

if WriteFile(F,RegHeadTEMSVector, SizeOf(RegHeadTEMSVector)) then if WriteFile(F,ItemS,4) then if WriteFile(F,Minind,4) then

WriteFile(F,Maxind,4) end end; {TEMSVector.} ^__—___——.__————;

Procedure TEMSVector.Setltem(var Source; Index: LongInt);

{Помещает в EMS элемент с индексом Index из переменной Source) begin HIFNDEF NOTCHECK}

if (Index>MaxInd) or (Index<MinInd) then

EMSError($AB) {Неправильный индекс} else {$endIFf

WriteEMS(Source,(Index-MinInd)*ItemS,ItemS) end; {TEMSVector.Setltem} ^__-.__—— _——_———;

Procedure TEMSVector.GetItem(var Dest; Index: LongInt);

{Читает из EMS элемент массива с индексом Index} begin {$IFNDEF NOTCHECK} if (Index>MaxInd) or (Index<MinInd) then

EMSError($AB) (Неправильный индекс} else {$endIF}

ReadEMS((Index-MinInd)*ItemS,Dest,ItemS) end; {TEMSVector.GetItem (•—————_————

Function TEMSVector.SingleItemfIndex: LongInt): Single;

var

X: Single;

begin {$IFNDEF NOTCHECK}

if ItemSoSizeOf (Single) then

EMSError($AC) (Ошибка в длине элемента} else {$endIF} begin

GetItem(X,Index) ;

Singleltem :- X end

end; {TEMSVector.SingleItem} {—. _______——_____-;

Function TEMSVector.DoubleItem(Index: LongInt): Double;

var

X: Double;

begin ($IFNDEF NOTCHECK}

if ItemSoSizeOf (Double) then

EMSError($AC) {Ошибка в длине элемента} else {$endIF} begin

Getltem(X,Index) ;

DoubleItem := X end

end; {TEMSVector.DoubleItem} {-,..————————— —/

Function TEMSVector.RealItemfIndex: LongInt): Real;

var

X: Real;

begin ($IFNDEF NOTCHECK} if ItemSoSizeOf (Real) then

EMSError($AC) {Ошибка в длине элемента} else ffendIF} begin

GetItem(X,Index) ;

Realltem := X end

end; {TEMSVector.Realltem} ^————————————;

Function TEMSVector.ExtendedItemtIndex: LongInt): Extended;

var

X: Extended;

begin !$IFNDEF NOTCHECK}

if ItemSoSizeOf (Extended) then

EMSError($AC) {Ошибка в длине элемента} else l$endIF} begin

Getltem(X,Index) ;

Extendedltem := X end

end; ITEMSVector.Extendedltem} ^————————————;

Function TEMSVector.IntegerItem(Index: Longint): Integer;

var

X: Integer;

begin ($IFNDEF KOTCHECK} if ItemSoSizeOf (Integer) then

EMSError($AC) (Ошибка в длине элемента} else ($endIFI begin

GetItem(X,Index);

IntegerItem := X end

end; {TEMSVector.IntegecItem) (———.———————/

Function TEMSVector.LongIntItemlIndex; Longint): Longint;

var

X: Longint;

begin {$IFNDEF NOTCHECK}

if ItemSOSizeOftLongInt) then

EMSError($AC) (Ошибка в длине элемента) else {$endIF} begin

GetItem(X,Index) ;

LongIntItem := X end

•nd; {TEMSVector.LongIntItem} ^————————————;

Function TEMSVector.ByteItemfIndex: Longint): Byte;

var

X: Byte;

begin {$IFNDEF NOTCHECK]

if ItemSoSizeOf(Byte) then

EMSError($AC) (Ошибка в длине элемента} else {$endIF} begin

GetItem(X,Index) ;

ByteItem := X end end; /r.EMSVector.ByteIteni;

{---------- Двумерный массив в EMS -—--—---}

Constructor TEMSMatrix.Init(ASize,Minl,Maxl,Min2,Max2: Longint);

(Создает объект TEMSMatrix:

ASize - размер элементов массива а байтаи;

Mm,Max - границы индекса.) var

Sz: Longint;

begin

if (Minl>Maxl) or (Min2>Max2) then begin

SMSError($AB); (Неправильные границы} Exit end;

(Преобразуем к одномерному массиву от 0} Sz := (Maxl-Minl+l)*(Max2-Min2+l)-l;

TEMSVector.Init(Asize,0,Sz);

if not EMSErrorFlag then begin

MinIndl Mini;

Maxindl :» Maxi;

MinInd2 :° Min2;

Maxlnd2 := Max2 end

end; f TEMSMatrix.Init} {— ——__———__——_;

Constructor TEMSMatrix.Load(var F: File);

{Создает объект TEMSMatrix - читает из файла объект TEMSVector, затем заголовок и поля MinIndl, Maxlnd.1, Minlnd2, Maxlnd2} var

S: String;

begin

TEMSVector.Load(F); {Загружаем из файла объект-родитель} if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSMatrix))

and (S-RegHeadTEMSMatrix) then begin

if ReadFile(F,MinIndl,4) and ReadFile(F,MaxIndl,4) and ReadFile(F,Minlnd2,4) then ReadFile(F,Maxlnd2,4) ;

if EMSErrorFlag then

Done end else

EMSError($A6) end; {TEMSMatrix.Load} _•————————————/

Procedure TEMSMatrix.Store(var F: File);

{Сохраняет вектор в файле - сначала сохраняет родительский объект TEMSVector, потом заголовок и поля MinIndl, Maxindl, Minlnd2, Maxlnd2} begin

TEMSVector.Store(F) ;

if not EMSErrorFlag then begin

if WriteFile(F,RegHeadTEMSMatrix,SizeOf(RegHeadTEMSMatrix)) then if WriteFile(F,MinIndl,4) then if WriteFilefF,Maxindl,4) than if WriteFile(F,Minlnd2,4) then

WriteFile(F,MaxInd2,4) end

end; {TEMSMatrix.Store) ^————————————;

Function TEMSMatrix.GetVecIndex(Indl,Ind2: Longint): Longint;

{Преобразует индексы двумерного пассива к индексу одномерного от 0} begin

EMSErrorFlag := False;

{$IFNDEF KOTCHECK}

if <Indl>MaxIndl) or (IndKMinIndl) or (Ind2>MaxInd2) or (Ind2<MinInd2) then

EMSError($AB) {Неправильный индекс} else {$endIF}

GetVecIndex := (Indl-MinIndl)*(MaxInd2-MinInd2)+Ind2-MinInd2 end; {TEMSMatrix.GetVecIndex} ^————————————;

Procedure TEMSMatrix.SetItem(var Source; Indl,Ind2: LongInt);

{Помещает в EMS элемент с индексами Indl, Ind2 из переменной Source} var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2);

($IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIFj

TEMSVector.SetItem(Source,Item) end; {TEMSMatrix. Setltem} ^___—____-_____-. ___^

Procedure TEMSMatrix.Getltem(var Dest; Indl,Ind2: LongInt);

(Читает из EMS элемент ыассивас индексами Indl,Ind2} var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$end.IFf

TEMSVector.Getltem(Dest,Item) end; {TEMSMatrix.Getltem} ^—————————————;

Function TEMSMatrix.SingleItemtIndl,Ind2: LongInt): Single;

var

Item: LongInt; , begin

Item := GetVedndex (Indl, Ind2 );

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

SingleItem := TEMSVector.SingleItem(Item) end; {TEMSMatrix.SingleItem} ^_—————————.——;

Function TEMSMatrix.DoubleItem(Indl,Ind2: LongInt): Double;

var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

DoubleItem := TEMSVector.DoubleItem(Item) end; {TEMSMatrix.Doubleltem} ^————————————^

Function TEMSMatrix.Real Item(Indl,Ind2: LongInt): Real;

var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then ($endIF)

RealItem := TEMSVector.RealItem(Item) end; {TEMSMatrix.RealItem} ^——-——————————;

Function TEMSMatrix.Extendedltem(Indl,Ind2: LongInt): Extended;

var

item: Longint;

begin

Item := GetVecIndex(Indl,Ind2);

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

ExtendedItem := TEMSVector.ExtendedItem(Item) end; {TEMSMatrix.ExtendedItem} ^———————————;

Function TEMSMatrix.IntegerItem(Indl,Ind2: Longint): Integer;

var

Item: Longint;

begin

Item := GetVecIndexdndl, Ind2) ;

f$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

Integerltem := TEMSVector.Integerltem(Item) end; {TEMSMatrix.Integerltem} {—— ————————— —}

Function TEMSMatrix.LongIntItemfIndl,Ind2: Longint): Longint;

var

Item: Longint;

begin

Item := GetVecIndexdndl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

LongIntItem := TEMSVector.LongIntItem(Item) end; {TEMSMatrix.LongIntItem} ^————————————;

Function TEMSMatrix.Byteltem(Indl,Ind2: Longint): Byte;

var

Item: Longint;

begin

Item := GetVedndex (Indl, Ind2) ;

{?IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

Byteltem := TEMSVector.Byteltem(Item) end; {TEMSMatrix.Byteltem} (--------- Многомерный массив в EMS ----------}

Constructor TEMSArray.Init(ASize: Longint; Hind: Word; var Ind);

{Создает объект TEMSArray: сначала создаетбазовый объект TEMSVector с индексом от 0, затем заполняет поле NInd, резервирует память для поля Index и заполняет его границами индексов} var

Indx: TIndexBond absolute Ind;

Sz: Longint;

k,j: Word;

begin

(Определяем общее количество Sz элементов массива:}

Sz := 0;

EMSErrorFlag := False;

for k := 1 to NInd do

if Indx[k,l]>Indx[k,2] then

EMSError($AB) else

Sz := Sz+Indx[k,2]-Indx[k,l]+l;

if not EMSErrorFlag then begin

/Создаем базовый объект TEMSVector} TEMSVector.InittASize,0,Sz-1) ;

if not EMSErrorFlag then begin

GetMem(Index,NInd*12);

(Вычисляем множители каждого измерения и формируем список границ Index*}

Index*[NInd,З] :- I; (Младший индекс} Index^INInd,!] :- Indx[NInd,1];

Index^NInd^] := Indx[NInd,2];

for k := NInd-1 downto 1 do begin

Index* [k,l] :=• Indx[k,l];

Index^k^] :» Indx[k,2];

Sz :- 0;

for j :" k+1 to NInd do

Sz :- Зг+^аех^з^-Хг^ех'''^,!!*!)*!"^*!:]^];

Index* [k,3] :- Sz •nd;

MIndex :- NXnd end •nd

•nd; (TEMSArray.lnit) (,....-, -———————;

Destructor TEMSArray.Done;

(Уничтожает объект TEMSArray - уничтожает базовый объект TEMSVector и освобождает память Index"} begin

TEMSVector.Done;

FreeMem(Index,NIndex*12)

•nd; {TEMSArray.Done} ^—-—.—.——————;

Constructor TEMSArray.Load(var F: file);

{Загружает объект TEMSArray из файла S' - сначала загружает базовый объект TEMSVector, затем читает заголовок RegHeadTEMSArray, noneHIndex и список границ индексов} vac

S: String;

k,j: Integer;

begin

TEMSVector.Load(F);

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSArray)) and

(S=RegHeadTEMSArray) and ReadFile(F,NIndex,2) then begin

GetMem(Index,NIndex*12);

for k :- 1 to NIndex do begin

ReadFile(F,Index*[k,1],4);

ReadFile (F, Index* [1с, 2], 4) ;

ReadFile(F.Index*[k,3],4) •nd;

it EMSErrorFlag then

Done end else begin

EMSError($A6);

TEMSVector. Done and

end; {TEMSArray.Load} /————————————;

Procedure TEMSArray.Store(var F: File);

{Сохраняет объект TEMSArray в файле - сохраняет базовый объект TEMSVector, затем пишет заголовок, поле NIndex и список границ индексов} var

It: Word;

begin

TEMSVector.Store(F);

if not EMSErrorFlag then

if WriteFile(F,RegHeadTEMSArray,SizeOf(RegHeadTEMSArray)) and WriteFile(F,NIndex,4) then for k := 1 to NIndex do begin

WriteFile(F,bndex^[k,1],4) ;

WriteFile(F,Index"[k,2],4) ;

WriteFile(F,Index*[k,3],4) • end

end; {TEMSArray.Store} /-—————————— ——}

Function TEMSArray.GetVecIndex(var Ind): Longint;

{По текущим значениям списка индексов Ind вычисляет индекс для объекта TEMSVector} var

Indx: TIndexList absolute Ind;

N: Longint;

k: Word;

begin

EMSErrorFlag •.•=• False;

N := О;

for k :- 1 to NIndex do l$IFNDEF NOTCHECKf

if (Indx[k]<Index"[k,ll) or (Indx[k]>Index^[k,2]) then

EMSErrorFlag :•= True else {$end.IF}

N :» N+dndxtkl-Index^tk^jrindax^Ik.S];

i? EMSErrorFlag then

EMSError($AB) else

GetVecIndex :« N-1 end; {TEMSArray.GetVecIndex} ^_-_——————————;

Procedure TEMSArray.SetItem(var Source,Ind);

{Помещает значение Source в элемент многомерного массива} var

N: Longint;

begin

N := GetVecIndex(Ind) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then ($endIF}

TEMSVector.SetItem(Source,N) end; {TEMSArray.SetItem) ^-_————__——————_

Procedure TEMSArray.GetItem(var Dest,Ind);

(Возвращает в переменной Dest элемент многомерного массива} var

М: Longint;

begin

N := GetVecIndex(Ind) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

TEMSVector.GetItem(Dest,N) end; ITEMSArray.Get Item}

{---- Имитатор файла последовательного доступа ----} Constructor TEMSType.Init(ASize: Longint);

{Создает объект TEMSType: сначала создает базовый объект TEMSArea, затем обнуляет поле Роз}

begin

TEMSArea.Init (ASize) ;

Pos := О

end; {TEMSType.Init} ^______-____-____-__;

Constructor TEMSType.Load(var F: File) ;

(Считывает объект TEMSType из файла F} var

S: String;

begin

TEMSArea.Load(F) ;

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSType)) and

(S=RegHeadTEMSType) then ReadFile(F,Pos,4) else

Done

end; {TEMSType.Load} ^______——————___;

Procedure TEMSType.Store(var F: File);

{Записывает объект в файл} begin

TEMSArea.Store(F) ;

if not EMSErrorFlag and

WriteFile(F,RegHeadTEMSType,SizeOC(RegHeadTEMSType)) then

WriteFile(F,Pos,4) end; /TEMSType.Store} ^_-____________-__-./

Procedure TEMSType.Setltem(var Source; Sz: Longint) ;

{Записывает в ТЕМСТуре очередной элемент} begin

WriteEMS(Source,Pos,Sz) ;

if not EMSErrorFlag than

inc(Pos,Sz) end; {TEMSType.} ^_____——————_____;

Procedure TEMSType.Getlten(var Dcst; Sz: Lon^Int);

{Читает из TEMSType очс^гднгй элем"лт} begin

ReadEMS(Pos,Dest,Sz) ;

if not EMSErrorrlag then inc(Pos,Sz)

end; {TEMSType.}

{------- Имитатор текстового файла --------}

Procedure TEMSText.SetItemfS: String);

{Помещает в EMS-память (начиная с позиции Pos от ее начала) строку S) begin

TEMSType.SetItem(S,Length(S)+1) end; {TEMSText.SetItem} {— ——____-_———__/

Function TEMSText.GetItem: String;

{Читает из EMS-памяти очередную строку} var

L: Byte;

S: String;

begin

TEMSType.GetItem(L,l) ;

if not EMSErrorFlag then begin

s[0] := chr(L) ;

TEMSType.GetItem(S[l],L) ;

GetItem := S end else

GetItem := #26 end; {TEMSText.GetItem) {-------- Копия экрана в EMS-памяти --------}

Constructor TEMSScreen.Init;

{Создает объект - определяет текущий режим работы видеоадаптера и в зависимости от этого резервирует память нужного размера} var

Sz: Longint;

begin

{С помощью функции $F прерывания $10 определяем текущий режим работы экрана} with Reg do begin

ah :-= $F;

Ini:r($lO,Reg) ;

Mode := al end;

{Выбираем нужный размер памяти

1..7 - текстовые режимы или графика CGA,16 Кбай'г=1с

13,14 - имитация на EGA/VGA графики ССА,1б Кбайт^1с

15 - моно EGA 640х350, 28 Кбайт = 2 стр.

16 - цвет " " " ", 112 Кбайт = 7 стр.

17 - моно VGA 640х480, 38.4 Кбайт = 3 стр.

18 - цвет " " " ", 153.6 Кбайт - 10 стр.} case Mode of

1..7,13..14 : Sz := LPage;

15: Sz := 2*LPage;

16: Sz := 7*LPage;

17: Sz :- 3*LPage;

18: Sz := 10*LPage else

Sz := 24*LPage {Для SVGA} end;

TEMSArea.Init(Sz) end; {TEMSScreen.Initf /——_—————————;

Constructor TEMSScreen.Load(var F: File);

(Читает объект из файла}

var

S: String;

begin

TEMSArea.Load(F) ;

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSScreen))

and (S=RegHeadTEMSScreen) then ReadFile(F,Mode,1) else

Done

end; {TEMSScreen.Load} (•-.-.———————————}

Procedure TEMSScreen.Store(var F: File) ;

{Сохраняет объект в файле} begin

TEMSArea.Store(F) ;

if not EMSErrorFlag then

if WriteFile(F,RegHeadTEMSScreen,SizeOf(TEMSScreen)) then WriteFile(F,Mode,1)

end; {TEMSScreen.Store} _•—————————_——__

Procedure TEMSScreen.PutScreen;

{Записывает в EMS-лаиять копию экрана} var

x,y,xx,yy,dy: Integer;

Pag: Byte;

EMS,Video: Pointer;

begin

{Проверяем текущий видеорежим} with R-eg do begin

ah := $F;

Intr($lO,Reg) ;

if aloMode then {Режим соответствует Mode?} begin (Нет - сообщаем и выходим} EMSError($AD) ;

Exit «id end;

(Копируем видеопамять в зависимости от режима} EMS :» ptr(EMSS,0); {Начало EMS} case Mode of

1..6,13..14: {Текстовые режимы всех адаптеров,

кроме MDA, графика CGA или ее имитация:

начало видеопамяти в $В800, длина до 16 Кбайт} begin

Video := Ptr($B8OO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveFromScreen (Video^EMS^yLPage) end;

7: {Текстовый режим MDA: начало видеопамяти в $ВООО, длина 4 Кбайт) begin

Video := Ptr($BOOO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveFromScreen(Video,EMS,Lpage div 4) end;

else {Остальные: дисплеи: предполагается, что

это EGA, VGA или SVGA в графическом режиме) begin

х := 0; (Левый верхний...} хх := GetMaxX; {угол экрана} у ;= 0; (Правый нижний угол} УУ := 0;

Рад := 0; (Номер началььой страницы EMS}

(Определяем количество dy полных строк экрана, которые еще умещаются в памяти одной страницы EMS}

while (ImageSize(х,у,хх,yy)<LPage) and (yy<=GetMaxY) do inc(yy);

dy := yy-1;

/Основной цикл сохранения копии блоками по 16 К) repeat

(Картируем страницу окна} MapEMSPage(Handle,0,Рад) ;

(Получаем копию части жрана} if y+dy<-GetMaxY then

GetImage(x,y,xx,y+dy,EMS^) else

GetImage(x/y,xx,GetMaxY,EMS");

inc(Рад) ;

inc (y,dy) until y>=GetMaxY end end {case Mode} end; {TEMSScreen.PutScreen} ^————-.————————;

Procedure TEMSScreen.GetScreen;

(Получает из EMS-памяти копию экрана} var

х,у,хх,yy,dy: Integer;

Рад: Byte;

EMS,Video: Pointer;

begin

(Проверяем текущий видеорежим} with Reg do begin

ah := $F;

Intr($lO,Reg) ;

if aloMode then (Режим соответствует Mote'?} begin (Нет - сообщаем и выходим} EMSError($AD);

Exit end end;

(Переносим копию а видеопамять в зависимости от режима} EMS := ptr(EMSS,O); (Начало EMS} case Mode of

1..6,13..14: (Текстовые режимы всех адаптеров,

кроме MDh, графика CGA или ее имитация:

начало видеопамяти в $В800, длина до 16 Кбайт} begin

Video := Ptr($B800,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveToScreenfEMS^Vidao^LPage) end;

7: (Текстовый режим MDA: начало видеопамяти в $ВООО, длина 4 Кбайт) begin

Video := Ptr ($BOOO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveToScreen(EMS,Video,LPage div 4) end;

else {Остальные дисплеи: предполагается,

что это EGA, VGA или SVGA. в графическом режиме} begin

х :° 0; {Левый верхний...} хх := GetMaxX; {угол экрана) у :=• 0; {Правый нижний угол} уу := 0;

Рад := 0; {Номер начальной страницы EMS} (Определяем количество dy полных строк экрана, которые еще умещаются в памяти одной страницы EMS} while (ImageSize(х,у,хх,уу)<LPage) and (yy<=GetMaxY) do inc(yy);

dy := yy-1;

{Основной цикл восстановления экрана блоками по 16 К} repeat

{Картируем окно} MapEMSPage(Handle,0,Рад) ;

(Переносим копию части экрана} PutIniagetXfyiEMS^NornialPut) ;

inc(Рад) ;

inc (y,dy) until y>=GetMaxY end

end (case Mode} end; {TEMSScreen.GetScreen} {----—--—-- Интерфейс с EMM ------------)

Procedure Intr67;

{Реализует прерывание $67 и устанавливает флаг EMSStatus} begin

Intr($67,Reg) ;

EMSStatus := Reg.ah end;

^———————————;

Function IsEMS: Boolean;

{Возвращает TRUE, если в ПК имеется EMS-память} const

Name: array [1..9] of Char = 'EMMXXXXO'#0;

label Exit;

begin

if EMSVer=0 then with Reg do {Была проверка раньше?}

begin {Нет - проверяем установку EMM} ah :° $3D; {Создаем дескриптор файла} а1 :^ 0; {Для чтения} dx := Ofs(Name); {С именем "EMMXXXXO"} ds := Seg(Name) ;

MSDOS(Reg) ;

{Если файла нет - EMM не установлен} if (Flags and FCarry)<>0 then Goto Exit;

(Проверяем статус файла}

bx :== ax; {Дескриптор файла}

ah := $44; {Запрос IOCTL}

al :== 7; (Дать статус файла)

MSDOS(Reg) ;

if ((Flags and FCarry)<>Q) or (al=0) then Goto Exit;

ah := $46; {Получаем номер версии EMM} Intr67;

if EMSStatus~0 then {Если ошибка - нет EMM} begin

EMSVer :« al; {Сохраняем номер версии} ah := $41; {Получаем сегмент окна} Intr67;

EMSS := Ьх (Сохраняем сегмент} end end;

Exit:

IsEMS := EMSVerOO end; {IsEMS} (— —____—_____——}

Function GetEMMVersion: String;

{Возвращает номер версии EMM в формате 'Х.Х'} var

s,ss: Strings-begin

if EMSVer=0 then if IsEMS then;

Str (EMSVer shr 4,s);

Str(EMSVer and $F,ss);

GetEMMVersion := s+'.'+ss end;

^———————————;

Function EMSSeg: Word;

{Возвращает сегментную часть адреса "окна" EMS-памяти} begin

if EMSS=0 then if IsEMS then;

EMSSeg := EMSS end; {EMSSeg! {,—, —————————}

Procedure GetEMSInfo(var AllPage, Pages: Word);

/'Возвращает полное количество (AllPages) и количество незанятых (Pages) страниц} begin

if IsEMS then with Reg do begin

ah :=$42;

Intr67;

AllPage := dx;

Pages := bx end else begin

AllPage := 0;

Pages := 0 end end; {GetEMSInfo} ^————————————;

Procedure NewEMSHandle(var Handle: Word;Pages: Word) ;

{Открывает новый дескриптор Handle и связывает с ним Pages страниц EMS} begin

it IsEMS then with Reg do

begin

ah :- $43;

bx := Pages;

Intr67;

Handle :== dx end end; {NewEMSHandle} _— ———————— ——)

Procedure DisposeEMSHandle(var Handle: Word);

{Удаляет дескриптор Handle и освобождаетсвяэаннугэ с ним память} begin

it IsEMS then with Reg do begin

ah := $45;

dx :=• Handle;

Intr67 end

end; {DisposeEMSHandle} /————————————;

Procedure MapEMSPage(Handle,Physic,Logic: Word);

{Картирует окно, связывая его Physic физическую страницу с Logic логической страницейдескриптора Handle} coast

OIdH: Word-$FPFP; {Параметры...}

OldL: Word-$FFFF; {предыдущего...}

OldP: Word=$FFFF; {обращения к процедуре) begin asm

{Проверяем параметры обращения: если они не менялись, значит контекст страниц сохранился и можно не картироватъ)

mov ax,Physic {AX := Physic}

mov bx,Logic BX := Logic}

mov dx,Handle {DX := Handle}

cmp ax,OldP {Physic=01dP ?}

jne @do {Нет - изменилась физ.стр.}

cmp bx,01dL {Logic-OldL ?}

3ne @do {Нет - изменилась логич.стр.}

cmp dx,01dH (Handle^OIdH ?}

js @Exit {Да - параметры не менялись,

не нужно картироватъ, еще раз} @do: {Параметры изменились - картируем:}

mov 01dP,ax {Сохраняем...}

mov 01dL,bx {новые...}

mov 01dH,dx {параметры}

mov ah,$44 {Код функции для картирования}

int $67 {Картируеы}

mov EMSStatus,ah {Новый статус EMS} @Exit: end;

end; {MapEMSPage} ^==^==»-,=====/ end. /Unit F_EMS} /e======».=====;

 

 Оглавление

На первую страницу

Rambler's Top100 Rambler's Top100
PROext: Top 1000

(с)Все права защищены

По всем интересующим вопросам прошу писать на электронный адрес

Hosted by uCoz