ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/QP_PAINT.ZIP/CMOUSE.PAS

Pascal/Delphi Source File | 1989-05-22 | 16.3 KB | 359 lines

{$B-,F-,I+,R+}

unit CMouse;

{ Define TMouse - a class for accessing the mouse }

{ Copyright 1989
  Scott Bussinger
  110 South 131st Street
  Tacoma, WA  98444
  [phone]
  Compuserve 72247,2671 }

interface

uses CObject,MSGraph;

type MouseButton = (Left,Right,Middle);
     MouseCursor = (DefaultCursor,PenCursor,BucketCursor,HandCursor);
     MouseStatus = (Idle,Pressed,Released,Held);

type TMouse = object(TObject)
       fCurrentCursor: MouseCursor;              { Current style of mouse cursor }
       fLastButtonStatus: word;                  { Button status at last call to Update }
       fLastLocationX: integer;                  { Horizontal cursor location at last call to Update }
       fLastLocationY: integer;                  { Vertical cursor location at last call to Update }
       fMouseFactor: integer;                    { Horizontal scaling factor for current video mode }
       fPreviousButtonStatus: word;              { Button status at second to last call to Update }
       fTextCursorEnabled: boolean;              { True if the text cursor is enabled }
       fTextCursorHeight: integer;               { Height of text cursor in pixels }
       fVisible: boolean;                        { True if the mouse cursor is currently visible }

       function Init: boolean;                   { Initialize the mouse and return true if mouse present }
       procedure DisableTextCursor;              { Disable the text cursor }
       procedure EnableTextCursor;               { Enable the text cursor display }
       function GetLocationX: integer;           { Returns last horizontal location }
       function GetLocationY: integer;           { Returns last vertical location }
       function GetButton(Button: MouseButton): MouseStatus; { Returns last status of a mouse button }
       procedure Hide;                           { Turn mouse cursor off }
       procedure SetCursor(NewCursor: MouseCursor); { Change to a new cursor shape }
       procedure SetTextCursor(Height: integer); { Turn on the text cursor }
       procedure Show;                           { Turn mouse cursor on }
       procedure Update;                         { Update the currect mouse status }
       end;

var Mouse: TMouse;

implementation

uses Dos,CWindow;

const Cursor: array[MouseCursor] of record
        HotSpot: record
          X: integer;
          Y: integer
          end;
        ScreenMask: array[0..15] of word;
        CursorMask: array[0..15] of word
        end =
         ((HotSpot:(X:0; Y:0);                   { Hot spot is tip of arrow }
           ScreenMask:($3FFF,                    { 0011111111111111 } { DefaultCursor }
                       $1FFF,                    { 0001111111111111 }
                       $0FFF,                    { 0000111111111111 }
                       $07FF,                    { 0000011111111111 }
                       $03FF,                    { 0000001111111111 }
                       $01FF,                    { 0000000111111111 }
                       $00FF,                    { 0000000011111111 }
                       $007F,                    { 0000000001111111 }
                       $003F,                    { 0000000000111111 }
                       $001F,                    { 0000000000011111 }
                       $01FF,                    { 0000000111111111 }
                       $10FF,                    { 0001000011111111 }
                       $30FF,                    { 0011000011111111 }
                       $F87F,                    { 1111100001111111 }
                       $F87F,                    { 1111100001111111 }
                       $FC3F);                   { 1111110000111111 }
           CursorMask:($0000,                    { 0000000000000000 }
                       $4000,                    { 0100000000000000 }
                       $6000,                    { 0110000000000000 }
                       $7000,                    { 0111000000000000 }
                       $7800,                    { 0111100000000000 }
                       $7C00,                    { 0111110000000000 }
                       $7E00,                    { 0111111000000000 }
                       $7F00,                    { 0111111100000000 }
                       $7F80,                    { 0111111110000000 }
                       $78C0,                    { 0111111111000000 }
                       $7C00,                    { 0111110000000000 }
                       $4600,                    { 0100011000000000 }
                       $0600,                    { 0000011000000000 }
                       $0300,                    { 0000001100000000 }
                       $0300,                    { 0000001100000000 }
                       $0180)),                  { 0000000110000000 }
          (HotSpot:(X:1; Y:15);                  { Hot spot is just beyond tip of pen }
           ScreenMask:($FFCF,                    { 1111111111001111 } { PenCursor}
                       $FF87,                    { 1111111110000111 }
                       $FF03,                    { 1111111100000011 }
                       $FE01,                    { 1111111000000001 }
                       $FC03,                    { 1111110000000011 }
                       $F807,                    { 1111100000000111 }
                       $F00F,                    { 1111000000001111 }
                       $E01F,                    { 1110000000011111 }
                       $C03F,                    { 1100000000111111 }
                       $807F,                    { 1000000001111111 }
                       $00FF,                    { 0000000011111111 }
                       $01FF,                    { 0000000111111111 }
                       $03FF,                    { 0000001111111111 }
                       $07FF,                    { 0000011111111111 }
                       $0FFF,                    { 0000111111111111 }
                       $9FFF);                   { 1001111111111111 }
           CursorMask:($0000,                    { 0000000000000000 }
                       $0030,                    { 0000000000110000 }
                       $0078,                    { 0000000001111000 }
                       $009C,                    { 0000000010011100 }
                       $01E8,                    { 0000000111101000 }
                       $03F0,                    { 0000001111110000 }
                       $07E0,                    { 0000011111100000 }
                       $0FC0,                    { 0000111111000000 }
                       $1F80,                    { 0001111110000000 }
                       $2700,                    { 0010011100000000 }
                       $7A00,                    { 0111101000000000 }
                       $5C00,                    { 0101110000000000 }
                       $4800,                    { 0100100000000000 }
                       $5000,                    { 0101000000000000 }
                       $6000,                    { 0110000000000000 }
                       $0000)),                  { 0000000000000000 }
          (HotSpot:(X:14; Y:14);                 { Hot spot is just beyond tip of pen }
           ScreenMask:($FFCF,                    { 1111111111001111 } { BucketCursor }
                       $FF87,                    { 1111111110000111 }
                       $FE03,                    { 1111111000000011 }
                       $F803,                    { 1111100000000011 }
                       $E001,                    { 1110000000000001 }
                       $C001,                    { 1100000000000001 }
                       $8000,                    { 1000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $8000,                    { 1000000000000000 }
                       $8008,                    { 1000000000001000 }
                       $8018,                    { 1000000000011000 }
                       $C078,                    { 1100000001111000 }
                       $C0F8,                    { 1100000011111000 }
                       $C3F8,                    { 1100001111111000 }
                       $E7F8);                   { 1110011111111000 }
           CursorMask:($0000,                    { 0000000000000000 }
                       $0030,                    { 0000000000110000 }
                       $0048,                    { 0000000001001000 }
                       $0188,                    { 0000000110001000 }
                       $0604,                    { 0000011000000100 }
                       $1804,                    { 0001100000000100 }
                       $2002,                    { 0010000000000010 }
                       $7FFE,                    { 0111111111111110 }
                       $7FFA,                    { 0111111111111010 }
                       $3FF2,                    { 0011111111110010 }
                       $3FE2,                    { 0011111111100010 }
                       $3F82,                    { 0011111110000010 }
                       $1F02,                    { 0001111100000010 }
                       $1C02,                    { 0001110000000010 }
                       $1802,                    { 0001100000000010 }
                       $0000)),                  { 0000000000000000 }
          (HotSpot:(X:4; Y:0);                   { Hot spot is just beyond tip of pen }
           ScreenMask:($F3FF,                    { 1111001111111111 } { HandCursor }
                       $E1FF,                    { 1110000111111111 }
                       $E1FF,                    { 1110000111111111 }
                       $E1FF,                    { 1110000111111111 }
                       $E001,                    { 1110000000000001 }
                       $E000,                    { 1110000000000000 }
                       $E000,                    { 1110000000000000 }
                       $E000,                    { 1110000000000000 }
                       $8000,                    { 1000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $0000,                    { 0000000000000000 }
                       $8001,                    { 1000000000000001 }
                       $C003);                   { 1100000000000011 }
           CursorMask:($0C00,                    { 0000110000000000 }
                       $1200,                    { 0001001000000000 }
                       $1200,                    { 0001001000000000 }
                       $1200,                    { 0001001000000000 }
                       $13FE,                    { 0001001111111110 }
                       $1249,                    { 0001001001001001 }
                       $1249,                    { 0001001001001001 }
                       $1249,                    { 0001001001001001 }
                       $7249,                    { 0111001001001001 }
                       $9001,                    { 1001000000000001 }
                       $9001,                    { 1001000000000001 }
                       $9001,                    { 1001000000000001 }
                       $8001,                    { 1000000000000001 }
                       $8001,                    { 1000000000000001 }
                       $4002,                    { 0100000000000010 }
                       $3FFC)));                 { 0011111111111100 }

const CurrentTextCursorLineStyle: word = $FFFF;  { Line style for drawing text cursor }

procedure MouseCall(    AX: word;
                    var MouseRegs: Registers);
  { Execute a call to the mouse driver }
  begin
  MouseRegs.AX := AX;
  Intr($33,MouseRegs)
  end;

procedure XorTextCursor(Height: integer);
  { Draw/Undraw the text cursor }
  var SaveStatus: GraphicsStatus;
  begin
  CurrentCanvas.Activate;                        { Make sure the text cursor stays in the drawing window }
  GetGraphicsStatus(SaveStatus);
  _SetLineStyle(CurrentTextCursorLineStyle);
  _SetWriteMode(_GXOR);
  _SetColor(SystemWhite);
  _LineTo(SaveStatus.Position.XCoord,SaveStatus.Position.YCoord+Height);
  SetGraphicsStatus(SaveStatus)
  end;

function TMouse.Init: boolean;
  { Initialize the mouse and return true if mouse present }
  var MouseRegs: Registers;
      MouseVector: pointer;
      VideoConfig: _VideoConfig;
  begin
  GetIntVec($33,MouseVector);
  if MouseVector <> nil
   then
    begin
    MouseCall(0,MouseRegs);
    if MouseRegs.AX = $FFFF
     then
      begin
      Init := true;

      _GetVideoConfig(VideoConfig);
      if VideoConfig.NumXPixels <= 320           { Watch out for these odd modes with the mouse }
       then
        self.fMouseFactor := 1
       else
        self.fMouseFactor := 0;

      self.fVisible := false;
      self.fCurrentCursor := PenCursor;          { So the next statement works correctly }
      self.SetCursor(DefaultCursor);
      self.fTextCursorHeight := 1;
      self.fTextCursorEnabled := false;          { Text cursor is off initially }
      self.Update
      end
     else
      Init := false
    end
   else
    Init := false
  end;

procedure TMouse.DisableTextCursor;
  { Turn off the text cursor }
  begin
  if self.fTextCursorEnabled then
    begin
    self.Hide;                                   { So the old cursor gets erased }
    self.fTextCursorEnabled := false             { Don't display cursor anymore }
    end
  end;

procedure TMouse.EnableTextCursor;
  { Turn on the text cursor }
  begin
  if not self.fTextCursorEnabled then
    begin
    self.Hide;
    self.fTextCursorEnabled := true
    end
  end;

procedure TMouse.Hide;
  { Turn mouse cursor off }
  var MouseRegs: Registers;
  begin
  if self.fVisible then
    begin
    self.fVisible := false;
    MouseCall(2,MouseRegs);
    if self.fTextCursorEnabled then              { Draw the text cursor }
      XorTextCursor(self.fTextCursorHeight)
    end
  end;

procedure TMouse.SetCursor(NewCursor: MouseCursor);
  { Change to a new cursor shape }
  var MouseRegs: Registers;
  begin
  if self.fCurrentCursor <> NewCursor then       { Don't flicker the screen if the cursor style didn't change }
    begin
    self.fCurrentCursor := NewCursor;
    with MouseRegs do
      begin
      BX := word(Cursor[NewCursor].HotSpot.X);
      CX := word(Cursor[NewCursor].HotSpot.Y);
      DX := ofs(Cursor[NewCursor].ScreenMask);
      ES := seg(Cursor[NewCursor].ScreenMask)
      end;
    MouseCall(9,MouseRegs)
    end
  end;

procedure TMouse.SetTextCursor(Height: integer);
  { Set the height of the text cursor }
  begin
  self.fTextCursorHeight := Height
  end;

procedure TMouse.Show;
  { Turn mouse cursor on }
  var MouseRegs: Registers;
  begin
  if not self.fVisible then
    begin
    self.fVisible := true;
    if self.fTextCursorEnabled then
      XorTextCursor(self.fTextCursorHeight);
    MouseCall(1,MouseRegs)
    end
  end;

procedure TMouse.Update;
  { Update the currect mouse status }
  var MouseRegs: Registers;
  begin
  MouseCall(3,MouseRegs);
  with MouseRegs do
    begin
    self.fPreviousButtonStatus := self.fLastButtonStatus;
    self.fLastButtonStatus := BX;
    self.fLastLocationX := CX shr self.fMouseFactor;
    self.fLastLocationY := DX
    end
  end;

function TMouse.GetLocationX: integer;
  { Returns last horizontal location }
  begin
  GetLocationX := self.fLastLocationX
  end;

function TMouse.GetLocationY: integer;
  { Returns last vertical location }
  begin
  GetLocationY := self.fLastLocationY
  end;

function TMouse.GetButton(Button: MouseButton): MouseStatus;
  { Returns last status of a button }
  var ButtonMask: word;
  begin
  ButtonMask := $0001 shl ord(Button);
  GetButton := MouseStatus(2 * byte((self.fPreviousButtonStatus and ButtonMask)<>0) +
                               byte((self.fLastButtonStatus and ButtonMask)<>0))
  end;

end.