events.inc

将bmf在DOS下显示出来

{$IFNDEF events}
{$DEFINE events}
{$I SYST.INC}
const
  mbLEFT           =1 shl 0;
  mbRIGHT          =1 shl 1;
  mbCENTER         =1 shl 2;
  mbLEFTRIGHT      =mbLEFT or mbRIGHT;
  evMOUSEMOVE      =1 shl 0;
  evLEFTPRESSED    =1 shl 1;
  evLEFTRELEASED   =1 shl 2;
  evRIGHTPRESSED   =1 shl 3;
  evRIGHTRELEASED  =1 shl 4;
  evCENTERPRESSED  =1 shl 5;
  evCENTERRELEASED =1 shl 6;
  evMOUSEDOUBLE    =1 shl 7;
  evMOUSEAUTO      =1 shl 8;
  evMOUSEBUTTON    =$1FE;
  MouseButtons:word=0;
  MouseDivX:word   =2;
  ReversedMouseButtons:boolean=false;
  msgNEXTFOCUS     =9;
  msgPREVFOCUS     =10;
  msgOK            =13;
  msgCANCEL        =27;
  msgHELP          =59;
  msgINFO          =63;
  msgQUIT          =255;
  evDOUBLELIMIT    :dword=4; {in ticks}
  evAUTOLIMIT      :dword=8;
type
  TEventType=(evNOTHING,evKEYBOARD,evMOUSE,evMESSAGE);
  PEvent=^TEvent;
  TEvent=record
    keyflags:byte;
    case typ:TEventType of
    evNOTHING:();
    evKEYBOARD:(
      key,keyext:char;
      keyscan:byte);
    evMOUSE:(
      action:word;
      x,y:longint;
      buttons:byte);
    evMESSAGE:(
      msgcode:word;
      attr:byte;
      sender:pointer;
      info:string[3]);
  end;  {TEvent}

procedure initMouse;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.ax:=0;
  RealModeInt($33,r);
  MouseButtons:=r.bx;
  r.ax:=2; {hide mouse cursor}
  RealModeInt($33,r);
end;  {initMouse}

function getEvent(var e:TEvent):boolean;
const
  lastX:word=0;
  lastY:word=0;
  lastZ:word=0;
  lastA:dword=0;
  lastD:dword=0;
var
  r:TRmRegs;
begin
  e.typ:=evNOTHING;
  e.action:=0;
  e.keyflags:=mem[ROM_KEYFLAGS];
  ClearRmRegs(r);
  r.ah:=1;
  RealModeInt($16,r);
  if r.flags and FLAGS_ZERO=0 then begin
    e.typ:=evKEYBOARD;
    r.ah:=1;
    RealModeInt($16,r);
    if r.al=0 then begin
      r.ah:=$10;
      RealModeInt($16,r);
      e.key:=#0;
      e.keyext:=chr(r.ah);
      e.keyscan:=r.al;
    end else begin
      r.ah:=0;
      RealModeInt($16,r);
      e.key:=chr(r.al);
      e.keyext:=#0;
      e.keyscan:=r.ah;
    end;
  end else
  if MouseButtons>0 then begin
    r.ax:=3;
    RealModeInt($33,r);
    if ReversedMouseButtons then r.bx:=r.bx xor mbLEFTRIGHT;
    if (r.cx<>lastX) or (r.dx<>lastY) then e.action:=e.action or evMOUSEMOVE;
    if (lastZ and mbLEFT=0) and (r.bx and mbLEFT<>0) then begin
      e.action:=e.action or evLEFTPRESSED;
      if memd[ROM_TICKS]<=lastD+evDOUBLELIMIT then
        e.action:=e.action or evMOUSEDOUBLE;
    end;
    if (lastZ and mbLEFT<>0) and (r.bx and mbLEFT=0) then begin
      e.action:=e.action or evLEFTRELEASED;
      lastD:=memd[ROM_TICKS];
    end;
    if (lastZ and mbRIGHT=0) and (r.bx and mbRIGHT<>0) then e.action:=e.action or evRIGHTPRESSED;
    if (lastZ and mbRIGHT<>0) and (r.bx and mbRIGHT=0) then e.action:=e.action or evRIGHTRELEASED;
    if (lastZ and mbCENTER=0) and (r.bx and mbCENTER<>0) then e.action:=e.action or evCENTERPRESSED;
    if (lastZ and mbCENTER<>0) and (r.bx and mbCENTER=0) then e.action:=e.action or evCENTERRELEASED;
    lastX:=r.cx;
    lastY:=r.dx;
    lastZ:=r.bx;
    if (lastZ and mbLEFT<>0) and (memd[ROM_TICKS]>lastA+evAUTOLIMIT) then begin
      e.action:=e.action or evMOUSEAUTO;
      lastA:=memd[ROM_TICKS];
    end;
    if e.action<>0 then begin
      e.typ:=evMOUSE;
      e.x:=r.cx div MouseDivX;
      e.y:=r.dx;
      e.buttons:=r.bx;
    end;
  end;
  result:=e.typ<>evNOTHING;
end;  {getEvent}

function  messageCode(e:TEvent):integer;
begin
  result:=0;
  if e.typ=evMESSAGE then result:=e.msgcode;
end;  {messageCode}

procedure placeMouseCursor(x,y:integer);
var r:TRmRegs;
begin
  ClearRmRegs(r);
  with r do begin
    ax:=$0004;
    cx:=x*MouseDivX;
    dx:=y;
  end;
  RealModeInt($33,r);
end;  {placeMouseCursor}

function  strokeKey(e:TEvent):char;
begin
  result:=#0;
  if e.typ=evKEYBOARD then result:=e.key;
end;  {strokeKey}
{$ENDIF}