Модератор: Модераторы
Напрямую в программу попадает обработка очень не многих прерываний (если не пользоваться специальными директивами), да и попадая она отделяется от их штатного вызова, обретая программное воплощение в виде так понравившейся вам SEH.
Procedure i9; INTERRUPT;
var R:registers;
n, m :byte;
Label NoCall;
begin
GateOut;
Port[$20]:=$20;
n:=Port[$60];
If WasExt then m:=1 else m:=0;
if n in[1..83,87] then begin
if not(KP[n,m]) then begin
KP[n,m]:=True;
KC[n,m]:=True;
end
Else GoTo NoCall;
end;
if n in[129..211,215] then begin
KP[n-128,m]:=False;
end;
IF n=225 then KC[KeyPause,m]:=True;
IF KP[KeyCtrl,0] or KP[KeyCtrl,1] or(n=225) or (n=224) or (n=197) or (n=69)
or (n=58) or (n=69) or (n=70) then GoTo NoCall;
IF (Head-Tail=2) Or ((Head<=34) and (Tail>=56)) Then GoTo NoCall;
Intr($63,R);
NoCall:
IF (KP[29,0]or KP[29,1]) and (KP[42,1]or KP[42,0]or KP[KeyAlt,0]
or KP[KeyAlt,1]) and (KP[83,0]or KP[83,1]) Then {Ctrl-Alt-Del}
ExitReqested:=Yes;
if n=224 then WasExt:=True else WasExt:=False;
GateIn;
End
unit g_mouse; { Ржешевский А.В. 1992, 1995, 1999 }
interface
uses dos;
VAR
MouseX,MouseY, MSens :integer;
Mouse1,Mouse2,
MouseDetected, InvertMouse: boolean; {Состояние кнопок}
MouseRClicks: WORD;
MDrot,
MUpDown : integer;
Procedure GetMouseInfo;
{Обращается к драйверу, результат помещает в вышеописанные переменные. }
Function ResetMouse:word;
{Сбрасывает драйвер. Возврат: 0- если нет мыши, иначе-число кнопок (2 или 3}
Procedure _DefineMouseSensitivity (HorizSens,VerticalSens:WORD);
procedure MouseSensitivity(s: integer);
{Задает чувствительность}
var GMInf:registers;
MSV, MSH: Word;
var
RMX, RMY: Longint;
DMX, DMY: Integer;
MLDown, MMDown, MRDown: BOOLEAN;
MLClick, MMClick: BOOLEAN;
MRClickS: Word;
MouseButtons: Word;
MouseH, MouseV, MH, MV: Integer;
implementation
uses g_mat;
const MST: array[0..10] of Word =(1,1,2,3,4,5,7,9,13,19,25);
Function ResetMouse;
var p:pointer;
begin
MDrot:=0;
Mupdown:=0;
GMInf.AX:=0;
GetIntVec(51,p);
if p<>NIL then begin
Intr(51,GMInf);
If GMInf.AX=0 then ResetMouse:=0 else ResetMouse:=GMInf.BX;
end
else ResetMouse:=0;
MouseButtons:=GMInf.BX;
end;
Procedure _DefineMouseSensitivity;
begin
MSH:=HorizSens;
MSV:=VerticalSens;
end;
procedure MouseSensitivity(s: integer);
begin
MSens:=s;
_DefineMouseSensitivity(MST[s], max(1,MST[s] div 2));
end;
Procedure _GetMouseInfo; ASSEMBLER;
ASM
MOV AX, 3
INT 33h
MOV [MLDown], False
TEST BX, 0001h
JZ @m1
MOV [MLDown], True
@m1:
MOV [MRDown], False
TEST BX, 0002h
JZ @m1a
MOV [MRDown], True
@m1a:
CMP [MouseButtons], 3
JB @m2
MOV [MMDown], False
TEST BX, 0004h
JZ @m2
MOV [MMDown], True
@m2:
MOV AX, 5
MOV BX, 1
INT 33h
MOV [MRClickS], BX
MOV [MLClick], False
MOV AX, 5
MOV BX, 0
INT 33h
CMP BX, 0
JE @m3
MOV [MLClick], True
@m3:
CMP [MouseButtons], 3
JB @m4
MOV [MMClick], False
MOV AX, 5
MOV BX, 2
INT 33h
CMP BX, 0
JE @m4
MOV [MMClick], True
@m4:
MOV AX, 0Bh
INT 33h
ADD [MouseH], CX
MOV [MH], CX
ADD [MouseV], DX
MOV [MV], DX
@me:
END;
Procedure GetMouseInfo;
var yre, xre, pr: Integer;
begin
_GetMouseInfo;
Inc(RMX, MH {div MSH});
If InvertMouse then MV:=-MV;
Dec(RMY, MV {div MSV});
If RMY div MSV<-200 then RMY:=-200*MSV;
If RMY div MSV>200 then RMY:=200*MSV;
{ Yre:=RMY;
If Yre<-50 then yre:=-50;
If Yre>50 then yre:=50;}
MUpDown:=(RMY*30) div MSV - 1500;
MouseY:= -(RMY div (2*MSV)) + 100;
Mouse1:=MLDown or MLClick;
MouseRClicks:=MRClicks;
xre:=0;
If (RMX div MSH)<>0 then begin
xre:=(rmx div msh);
Dec(rmx, Xre*MSH);
end;
MouseX:=100;
MDrot:=64*xre;
(*If Mouse3 then begin
Mdrot:=RMX*30;
{xRe:=Rmx
RMX:=0}
end;*)
{НЕ ДОДЕЛАНО.}
end;
BEGIN
If ResetMouse=0 then begin
WriteLn('В эту игру нельзя играть без мыши,');
WriteLn('драйвер коей не обнаружен.');
WriteLn('Нажми Enter для выхода.');
ReadLn;
Halt(0);
end;
InvertMouse:=False;
MouseDetected:=True;
MDrot:=0;
MouseH:=0;
MouseV:=0;
RMX:=0;
RMY:=0;
DMX:=0;
DMY:=0;
MLDown:=False;
MMDown:=False;
MH:=0;
MV:=0;
MouseH:=0;
MouseV:=0;
MLDown:=False;
MMDown:=False;
MRDown:=False;
MSens:=5;
{ DefineMouseRange(200,200);}
END.
Cheb писал(а):Дааа, это ж надо так сказануть. Давно так не смеялся.
Прерывания... В прикладное приложение...
Cheb писал(а):P.S. Когда-то давно, на турбо паскале под досом, я баловался с прерываниями. Но путать их с исключениями... Прерывание мыши... Ржунимагу!
Исключение это событие, а прерывание это реакция на него.
excep^.ContextRecord^.Eip := ptruint (@JumpToDllRaiseFunction);
excep^.ExceptionRecord^.ExceptionCode := 0;
Result := EXCEPTION_CONTINUE_EXECUTION;
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 32