Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/RODENT_3.ZIP/TPRODENT.PAS

Pascal/Delphi Source File | 1989-12-16 | 4.6 KB | 182 lines

PROGRAM tprodent;

{ Demo program to show how to define a mouse graphics cursor.

  Written in Borland Turbo Pascal version 5.0.

  Hardware req'ts : CGA, EGA, or VGA
                    Microsoft-compatible mouse}

USES Dos, Graph;

{ Define an hourglass-shaped mouse graphics cursor }
TYPE MCursorType = ARRAY[0..31] OF Word;
CONST MCursor : MCursorType =

  { Screen mask }

   ($0001,  { 0000000000000001 }
    $0001,  { 0000000000000001 }
    $8003,  { 1000000000000011 }
    $C7C7,  { 1100011111000111 }
    $E38F,  { 1110001110001111 }
    $F11F,  { 1111000100011111 }
    $F83F,  { 1111100000111111 }
    $FC7F,  { 1111110001111111 }
    $F83F,  { 1111100000111111 }
    $F11F,  { 1111000100011111 }
    $E38F,  { 1110001110001111 }
    $C7C7,  { 1100011111000111 }
    $8003,  { 1000000000000011 }
    $0001,  { 0000000000000001 }
    $0001,  { 0000000000000001 }
    $0000,  { 0000000000000000 }

  { Cursor mask }

    $0000,  { 0000000000000000 }
    $7FFC,  { 0111111111111100 }
    $2008,  { 0010000000001000 }
    $1010,  { 0001000000010000 }
    $0820,  { 0000100000100000 }
    $0440,  { 0000010001000000 }
    $0280,  { 0000001010000000 }
    $0100,  { 0000000100000000 }
    $0280,  { 0000001010000000 }
    $0440,  { 0000010001000000 }
    $0820,  { 0000100000100000 }
    $1010,  { 0001000000010000 }
    $2008,  { 0010000000001000 }
    $7FFC,  { 0111111111111100 }
    $0000,  { 0000000000000000 }
    $0000); { 0000000000000000 }

VAR
    Buttons,                     { Number of mouse buttons }
    MouseX, MouseY, MouseButton, { Mouse cursor loc and button info }
    rightbutton,                 { Where to print mouse right button }
    GrStat : Integer;            { Return status from _SetVideoMode }
    OldX, OldY,                  { Save old X and Y }
    GraphDriver, GraphMode : Integer;
    GotMouse : Boolean;
    Regs : Registers;
    StrBuf : String[5];

PROCEDURE ms_hide;
BEGIN
  Regs.AX := 2;
  Intr($33, Regs);
END;

PROCEDURE ms_init(VAR Exists:Boolean; VAR Button:Integer);
BEGIN
  Regs.AX := 0;
  Intr($33, Regs);
  Exists := TRUE;
  Button := Regs.BX;
  IF (Regs.AX = 0) THEN
    BEGIN
    Exists := FALSE;
    Button := 0;
  END;
END;

PROCEDURE ms_read(VAR x, y, b : Integer);
BEGIN
  Regs.AX := 3;
  Intr($33, Regs);
  x := Regs.CX;
  y := Regs.DX;
  b := Regs.BX;
END;

PROCEDURE ms_set_graphPointer(HotX, HotY: Integer; VAR Pattern:MCursorType);
BEGIN
  Regs.AX := 9;    { Function 9 }
  Regs.BX := HotX; { X-ordinate of hot spot }
  Regs.CX := HotY; { Y-ordinate of hot spot }
  Regs.DX := Ofs(Pattern);
  Regs.ES := Seg(Pattern);
  Intr($33, Regs);
END;

PROCEDURE ms_show;
BEGIN
  Regs.AX := 1;
  intr($33, Regs);
END;

PROCEDURE ShowButton(Loc, Condition : Integer);
BEGIN
  IF (Condition = 0) THEN
    SetFillStyle(EmptyFill, 1)
  ELSE
  SetFillStyle(SolidFill, 1);
  Bar(Loc * 8 + 3, 8, (Loc + 2) * 8 + 3, 15);
END;

BEGIN {main}
  GraphDriver := CGA;
  GraphMode := CGAHi;
  InitGraph(GraphDriver, GraphMode, '');
  GrStat := GraphResult;
  IF (GrStat <> 0) THEN
    BEGIN
    Writeln('This program requires a CGA or other color adapter.');
    Halt(1);
    END;
  ms_init(GotMouse, Buttons);
  IF NOT GotMouse THEN
    BEGIN
    CloseGraph;
    Writeln('No mouse detected.');
    Halt(1);
    END;

  IF (Buttons = 3) THEN
    RightButton := 42
  ELSE
    RightButton := 35;
  OutTextXY(0, 0, '╔════╗                     ┌───┐  ┌───┐');
  OutTextXY(0, 8, '║Quit║  x = xxx  y = yyy   │   │  │   │');
  OutTextXY(0,16, '╚════╝                     └───┘  └───┘');
  IF (Buttons = 3) THEN
    BEGIN
    OutTextXY(RightButton * 8 - 8,  0, '┌───┐');
    OutTextXY(RightButton * 8 - 8,  8, '│   │');
    OutTextXY(RightButton * 8 - 8, 16, '└───┘');
    END;

  ms_set_graphPointer(7, 7, MCursor);
  ms_show;

  { Main program loop }
  REPEAT
    ms_read(MouseX, MouseY, MouseButton);
    IF (MouseX <> OldX) THEN
      BEGIN
      OldX := MouseX;
      Str(MouseX:3, StrBuf);
      SetFillStyle(EmptyFill, 1);
      Bar(12*8, 8, 14*8 + 7, 15);
      OutTextXY(12*8, 8, StrBuf);
      END;
    IF (MouseY <> OldY) THEN
      BEGIN
      OldY := MouseY;
      Str(MouseY:3, StrBuf);
      SetFillStyle(EmptyFill, 1);
      Bar(21*8, 8, 23*8 + 7, 15);
      OutTextXY(21*8, 8, StrBuf);
      END;
    ShowButton(28, MouseButton AND 1);
    ShowButton(RightButton, MouseButton AND 2);
    IF (Buttons = 3) THEN
      ShowButton(35, MouseButton AND 4);
  UNTIL ((MouseButton = 1) AND (MouseX < 48) AND (MouseY < 24));

  ms_hide;
  CloseGraph;
END.