POINT Software Programming/PPROG1.ISO/pascal/visionix/vpointu.pas

Pascal/Delphi Source File | 1993-12-28 | 18.3 KB | 1,185 lines

{
 ════════════════════════════════════════════════════════════════════════════

 Visionix Pointer Device Unit (VPOINT)
   Version 0.1
 Copyright 1991,92,93 Visionix
 ALL RIGHTS RESERVED

 ────────────────────────────────────────────────────────────────────────────

 Revision history in reverse chronological order:

 Initials  Date      Comment
 ────────  ────────  ────────────────────────────────────────────────────────

 jrt       11/23/93  Filled in the code--calls INTR $33 for everything
                     but OS/2; uses VMOU when compiled for OS/2.

 jrt       09/01/92  First logged revision.

 ────────────────────────────────────────────────────────────────────────────

 C A V E A T S    /    K N O W N   B U G S

 Mouse buttons "stick" when running os/2

 Mouse cursor sometimes dissapears when running os/2--probably a
 problem with the MyOffCount logic.

}

(*-

[TEXT]

<Overview>

VPointu implements a comprehensive, easy to use "mouse" function library
that works under DOS, protected mode, and OS/2.

This overview will be enhanced in the next BETA release.

<Interface>


-*)


Unit VPointU;

Interface

Uses

  DOS,
{$IFDEF OS2}
  VMouI,
{$ENDIF}
  VTypesu;

Const

  mbLEFT        = 1;
  mbCENTER      = 8;
  mbRIGHT       = 2;
  mbLEFTRIGHT   = 1+2;
  mbLEFTCENTER  = 1+8;
  mbRIGHTCENTER = 2+8;
  mbALL         = 1+2+8;



  cmfReadCells  = 0;
  cmfReadPixels = 1;

Type

  TMouseCaps = RECORD

    NumButtons : BYTE;

  END;

  PMouseCaps = ^TMouseCaps;

{────────────────────────────────────────────────────────────────────────────}

Procedure VMouseGetCaps(              Caps        : PMouseCaps );

Function  VMouseInstalled : BOOLEAN;

Function  VMouseOpen(                 Flags       : WORD;
                                      MouType     : BYTE       ):WORD;

Procedure VMouseClose;

Procedure VMouseOn;

Procedure VMouseOff;

Procedure VMouseTypeSet(          PointerID   : BYTE       );

Procedure VMouseVertLimitSet(     MaxRow      : WORD       );

Procedure VMouseRead(             Var Button      : BYTE;
                                  Var X           : WORD;
                                  Var Y           : WORD       );


Function  VMouseReadButtons : BYTE;

Function  VMouseReadX : WORD;

Function  VMouseReadY : WORD;

Procedure VMouseWaitRelease(    Buttons     : BYTE       );

Procedure VMouseWaitPress(      Buttons     : BYTE       );




(*
Procedure VMouseProcNew(                BPressed    : BYTE;
                                      BReleased   : BYTE;
                                      X1          : WORD;
                                      Y1          : WORD;
                                      X2          : WORD;
                                      Y2          : WORD;
                                      Proc        : POINTER;
                                      Id          : POINTER;
                                      Name        : TProcName;
                                  Var Err         : WORD       );

Procedure VMouseProcOn(                 Name        : TProcName  );

Procedure VMouseProcOff(                Name        : TProcName  );

Procedure VMouseProcDispose(            Name        : TProcName  );

Procedure VMouseSubmitButtonKey(        Button      : BYTE;
                                      Key1        : CHAR;
                                      Key2        : CHAR       );

*)


{────────────────────────────────────────────────────────────────────────────}

Implementation

Var

  MyHandle       : WORD;
  MyMouseType    : WORD;
  MyMouseFlags   : WORD;

{$IFDEF OS2}

  MyOffCount     : LONGINT;

  MyLastMEI      : TMouEventInfo;

  {---------------------------------------}

  Function GetNumQMEI : WORD;

  Var
    MQI : TMouQueInfo;

  BEGIN

    MouGetNumQueEl( @MQI, MyHandle );

    GetNumQMEI := MQI.Events;

  END;

  {---------------------------------------}

  Function GetMEI : BOOLEAN;

  Var

    F       : WORD;
    NumQMEI : WORD;

  BEGIN

    { get num of mouse events in the queue }

    NumQMEI := GetNumQMEI;

    { are their any mouse events in the queue? }

    If NumQMEI>0 Then
    BEGIN

      { yep, read the next mouse event }

      F := 1;
      MouReadEventQue( @MyLastMEI, F, MyHandle );

      { are their still some in the queue? }

      GetMEI := (NumQMEI) > 1;

    END
    ELSE
      GetMEI := FALSE;

  END;

  {---------------------------------------}

  Function GetCurrentLastMEI : BOOLEAN;

  Var

    F       : WORD;
    Loop    : WORD;
    NumQMEI : WORD;

  BEGIN

    NumQMEI := GetNumQMEI;
    F       := 0;

    { get all the currently enqueued mouse events }

    While NumQMEI>0 Do
    BEGIN
      MouReadEventQue( @MyLastMEI, F, MyHandle );
      Dec( NumQMEI );
    END;

    { did any knew mouse events show up? }

    GetCurrentLastMEI := (GetNumQMEI<>0);

  END;

  {---------------------------------------}

  Function ButtonTranslate( MEI : PMouEventInfo ) : BYTE;

  BEGIN

    Case MEI^.FS of

       $01 : ButtonTranslate := 0;               { motion }

       $02 : ButtonTranslate := mbLEFT;          { button1+motion    }
       $04 : ButtonTranslate := mbLEFT;          { button1           }

       $08 : ButtonTranslate := mbRIGHT;         { button2+motion    }
       $10 : ButtonTranslate := mbRIGHT;         { button2           }

       $14 : ButtonTranslate := mbLEFT+mbRIGHT;  { both buttons      }
       $0A : ButtonTranslate := mbLEFT+mbRIGHT;  { both + motion     }

    ELSE
      ButtonTranslate := 0;
    END;

  END;


  {---------------------------------------}

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseGetCaps(              Caps        : PMouseCaps );

[PARAMETERS]

Caps        pointer to a mouse capabilities structure

[RETURNS]

caps        filled in

[DESCRIPTION]

This function gets the mouse capabilities structure for the current
environment.  IT IS NOT YET IMPLEMENTED.

[SEE-ALSO]

[EXAMPLE]



-*)

Procedure VMouseGetCaps(              Caps        : PMouseCaps );

BEGIN
END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VMouseInstalled : BOOLEAN;

[PARAMETERS]

None.

[RETURNS]

TRUE if a mouse and appropriate mouse driver are installed,
FALSE it they are not.

[DESCRIPTION]

This function determines if a mouse and its appropriate mouse driver
are installed.  If so, this function returns TRUE and the other
VMousexxx functions can be used (after VMouseOpen is called).

This function returns FALSE if either a mouse or mouse driver is
not present.

[SEE-ALSO]

[EXAMPLE]

  IF VMouseInstalled Then
    WriteLN('A Mouse and driver are present.')
  Else
    WriteLN('A Mouse and/or driver are not present.');


-*)


Function  VMouseInstalled : BOOLEAN;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  R.AX  := $0;
  R.ES  := $0;
  R.DS  := $0;

  Intr( $33, R );

  VMouseInstalled := (R.AX=$FFFF);

END;

{$ELSE}

Var

  MHandle : WORD;

BEGIN

  If MouOpen( NIL, MHandle )=0 Then
  BEGIN
    MouClose( MHandle );
    VMouseInstalled := TRUE;
  END
  ELSE
    VMouseInstalled := FALSE;

END;

{$ENDIF} { not os2 / else }

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Function  VMouseOpen(             Flags       : WORD;
                                  MouType     : BYTE       ):WORD;

[PARAMETERS]

flags           mouse open flags (currently unused)
moutype         mouse pointer type (currently unused)

[RETURNS]

0 if the open was successfull,
non 0 if it failed.

[DESCRIPTION]

This function opens and initializes the mouse.  After calling this
function, the other VMousexxx functions can be used.

[SEE-ALSO]

[EXAMPLE]

  IF VMouseInstalled Then
    WriteLN('A Mouse and driver are present.')
  Else
    WriteLN('A Mouse and/or driver are not present.');


-*)

Function  VMouseOpen(             Flags       : WORD;
                                  MouType     : BYTE       ):WORD;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  MyMouseType := MouType;

  R.AX  := $0;
  R.ES  := $0;
  R.DS  := $0;

  Intr( $33, R );

  If R.AX=$FFFF Then
    VMouseOpen := 0
  ELSE
    VMouseOpen := $FFFF;

END;

{$ELSE}

Var

  F : WORD;

BEGIN

  MyMouseType := MouType;

  VMouseOpen := MouOpen( NIL, MyHandle );

  { prime the LastMEI record }

  F := 0;

  MouReadEventQue( @MyLastMEI, F, MyHandle );

  MyOffCount := 1;

END;

{$ENDIF} { notdef os2 / else }

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseClose;


[PARAMETERS]

None.

[RETURNS]

Nothing.

[DESCRIPTION]

This function closes and deinitializes the mouse.  This function should
be called when you are finished with the mouse.

[SEE-ALSO]

[EXAMPLE]

-*)


Procedure VMouseClose;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  VMouseOff;

END;

{$ELSE}

BEGIN

  MouClose( MyHandle );

END;

{$ENDIF} { notdef os2 / else }

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseOn;


[PARAMETERS]

None.

[RETURNS]

Nothing.

[DESCRIPTION]

This function turns the mouse pointer on and makes the mouse pointer
visible.

[SEE-ALSO]

[EXAMPLE]

-*)



Procedure VMouseOn;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  Case MyMouseType of

    1:
    BEGIN

      R.AX := $01;
      R.ES := $00;
      R.DS := $00;

      Intr( $33, R );

    END

  END;

END;

{$ELSE}

BEGIN


  If MyOffCount>0 Then
    Dec( MyOffCount );

  If MyOffCount=0 Then
    MouDrawPtr( MyHandle );


END;

{$ENDIF} { notdef os2 / else }


{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseOff;


[PARAMETERS]

None.

[RETURNS]

Nothing.

[DESCRIPTION]

This function turns the mouse pointer off and makes the mouse pointer
invisible.

[SEE-ALSO]

[EXAMPLE]

-*)



Procedure VMouseOff;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  Case MyMouseType of

    1:
    BEGIN

      R.AX := $02;
      R.ES := $00;
      R.DS := $00;

      Intr( $33, R );

    END

  END;

END;

{$ELSE}

Var

  exrect : TNoPtrRect;

BEGIN

  { set the exclusion rectangle to cover the whole screen }

  exrect.TopRow    := 0;
  exrect.TopCol    := 0;
  exrect.BottomRow := 24;
  exrect.bottomCol := 79;

  MouRemovePtr( @exrect, MyHandle );

  Inc( MyOffCount );

END;

{$ENDIF} { notdef os2 / else }

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseTypeSet(     PointerID   : BYTE       );

[PARAMETERS]

pointerid   mouse pointer type

[RETURNS]

Nothing.

[DESCRIPTION]

This function is not yet implemented.

[SEE-ALSO]

[EXAMPLE]

-*)



Procedure VMouseTypeSet(     PointerID   : BYTE       );

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

END;

{$ELSE}

BEGIN

END;

{$ENDIF} { notdef os2 / else }

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseVertLimitSet(     MaxRow      : WORD       );

[PARAMETERS]

maxrow      maximum row for the mouse

[RETURNS]

Nothing.

[DESCRIPTION]

This function sets the maximum vertical limit of the mouse pointer.


[SEE-ALSO]

[EXAMPLE]

-*)


Procedure VMouseVertLimitSet(     MaxRow      : WORD       );

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  R.AX := $08;
  R.CX := 0;
  R.DX := (MaxRow-1) * 8;
  R.ES := $0;
  R.DS := $0;

  Intr( $33, R );

END;

{$ELSE}

BEGIN

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}


(*-

[FUNCTION]

Procedure VMouseRead(       Var Button      : BYTE;
                            Var X           : WORD;
                            Var Y           : WORD       );

[PARAMETERS]

buttons     (returned> currently pressed buttons
x           (returned) current mouse x location
y           (returned) current mouse y location

[RETURNS]

buttons     (returned> currently pressed buttons
x           (returned) current mouse x location
y           (returned) current mouse y location

[DESCRIPTION]

This function reads the current button settings and x and y location of the
mouse.

The buttons variable will contain one of the following values:

  mbLEFT        = 1;
  mbCENTER      = 8;
  mbRIGHT       = 2;
  mbLEFTRIGHT   = 1+2;
  mbLEFTCENTER  = 1+8;
  mbRIGHTCENTER = 2+8;
  mbALL         = 1+2+8;



[SEE-ALSO]

[EXAMPLE]

-*)



Procedure VMouseRead(       Var Button      : BYTE;
                            Var X           : WORD;
                            Var Y           : WORD       );

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  Case MyMouseType of

    1:
    BEGIN

      R.AX := 03;
      R.ES := $0;
      R.DS := $0;

      Intr( $33, R );

      Button := R.BX;

      {-----------------------------------}
      { should we report pixels or cells? }
      {-----------------------------------}

      If (MyMouseFlags and cmfReadPixels)>0 Then
      BEGIN
        X := R.CX;
        Y := R.DX;
      END
      ELSE
      BEGIN
        X := ( R.CX + 8 ) DIV 8;
        Y := ( R.DX + 8 ) DIV 8;
      END;

    END

  END;

END;

{$ELSE}

Var

 PL : TPtrLoc;

BEGIN

  GetCurrentLastMEI;

  Button := ButtonTranslate( @MyLastMEI );

  X := Succ(MyLastMEI.Col);
  Y := Succ(MyLastMEI.Row);

END;

{$ENDIF} { notdef os2 / else }


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VMouseReadButtons : BYTE;


[PARAMETERS]

None.

[RETURNS]

buttons      currently pressed buttons

[DESCRIPTION]

This function reads the current mouse button settings.

The buttons variable will contain one of the following values:

  mbLEFT        = 1;
  mbCENTER      = 8;
  mbRIGHT       = 2;
  mbLEFTRIGHT   = 1+2;
  mbLEFTCENTER  = 1+8;
  mbRIGHTCENTER = 2+8;
  mbALL         = 1+2+8;



[SEE-ALSO]

[EXAMPLE]

-*)


Function  VMouseReadButtons : BYTE;

Var

  X,Y : WORD;
  B   : BYTE;

BEGIN

  VMouseRead( B, X, Y );

  VMouseReadButtons := B;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VMouseReadX       : WORD;

[PARAMETERS]

None.

[RETURNS]

buttons      currently pressed buttons

[DESCRIPTION]

This function reads the current x location of the mouse.

[SEE-ALSO]

[EXAMPLE]

-*)


Function  VMouseReadX       : WORD;

Var

  X,Y : WORD;
  B   : BYTE;

BEGIN

  VMouseRead( B, X, Y );

  VMouseReadX := X;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VMouseReadY       : WORD;

[PARAMETERS]

None.

[RETURNS]

buttons      currently pressed buttons

[DESCRIPTION]

This function reads the current y location of the mouse.

[SEE-ALSO]

[EXAMPLE]

-*)


Function  VMouseReadY       : WORD;

Var

  X,Y : WORD;
  B   : BYTE;

BEGIN

  VMouseRead( B, X, Y );

  VMouseReadY := Y;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VMouseWaitRelease(        Buttons     : BYTE       );

[PARAMETERS]

None.

[RETURNS]

None.

[DESCRIPTION]

This function waits until all mouse buttons are released.

[SEE-ALSO]

[EXAMPLE]

-*)


Procedure VMouseWaitRelease(        Buttons     : BYTE       );

Var

  X,Y : WORD;
  B   : BYTE;

BEGIN

  Repeat
    VMouseRead( B, X, Y );
  Until B=0;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VMouseWaitPress(          Buttons     : BYTE       );

[PARAMETERS]

None.

[RETURNS]

None.

[DESCRIPTION]

This function waits until a mouse button is pressed.

[SEE-ALSO]

[EXAMPLE]

-*)



Procedure VMouseWaitPress(          Buttons     : BYTE       );

Var

  X,Y : WORD;
  B   : BYTE;

BEGIN

  Repeat
    VMouseRead( B, X, Y );
  Until B<>0;

END;


{────────────────────────────────────────────────────────────────────────────}

(*

Procedure VMouseProcNew(              BPressed    : BYTE;
                                      BReleased   : BYTE;
                                      X1          : WORD;
                                      Y1          : WORD;
                                      X2          : WORD;
                                      Y2          : WORD;
                                      Proc        : POINTER;
                                      Id          : POINTER;
                                      Name        : TProcName;
                                  Var Err         : WORD       );

BEGIN
END;

{────────────────────────────────────────────────────────────────────────────}

Procedure VMouseProcOn(               Name        : TProcName  );

BEGIN
END;

{────────────────────────────────────────────────────────────────────────────}

Procedure VMouseProcOff(              Name        : TProcName  );

BEGIN
END;

{────────────────────────────────────────────────────────────────────────────}

Procedure VMouseProcDispose(          Name        : TProcName  );

BEGIN
END;

{────────────────────────────────────────────────────────────────────────────}

Procedure VMouseSubmitButtonKey(      Button      : BYTE;
                                      Key1        : CHAR;
                                      Key2        : CHAR       );

BEGIN
END;

*)

{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}

BEGIN
END.