П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======».=====;
