Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OOPMOU_B.ZIP/MOUSEUNI.PAS

Pascal/Delphi Source File | 1989-11-26 | 10.0 KB | 295 lines

{$I mouseuni.inc}

const
        MOUSE_DRIVER_INTERRUPT = $33;
var
        mouse_exists : boolean;
        mouse_visible : boolean;
        mouse_buttons : integer;
        Registers : DOS.Registers;

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

procedure CallMouse(MouseFunction : integer);
begin
        Registers.AX := MouseFunction;
        intr (MOUSE_DRIVER_INTERRUPT, Registers);
end; { CallMouse }

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

function mouse_object.Exists : boolean;
{ check if a mouse driver is currently loaded                           }
begin
        Exists := mouse_exists;
end;

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

function mouse_object.NumberOfButtons : integer;
{ returns the number of available buttons on the mouse                  }
begin
        NumberOfButtons := mouse_buttons;
end;

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

procedure mouse_object.Reset;
{ reset the mouse driver to its defaults                                }
begin
        CallMouse(0);
        Mouse_Exists := Registers.AX <> 0;
end; { Reset }

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

procedure mouse_object.Show;
{ Makes the mouse cursor visible.                                       }
begin
        if mouse_visible then exit;
        CallMouse(1);
        mouse_visible := true;
end;

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

procedure mouse_object.Hide;
{ Makes mouse cursor invisible. Movement and button activity are        }
{ still tracked.                                                        }
begin
        if not mouse_visible then exit;
        CallMouse(2);
        mouse_visible := false;
end;

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

procedure mouse_object.GetStatus(var status, row, column : integer);
{ Gets mouse cursor position and button status.                         }
begin
        CallMouse (3);
        with Registers do begin
                column := CX;
                row := DX;
                status := BX;
        end;
end; { GetPosition }

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

procedure mouse_object.MoveTo(new_row, new_column : integer);
{ Move mouse cursor to new position                                     }
begin
        with Registers do begin
                CX := new_column;
                DX := new_row;
        end;
        CallMouse(4);
end;

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

procedure mouse_object.Pressed(button : integer; var result : boolean; var count, row, column : integer);
{ Gets pressed info about named button: current status (up/down),       }
{ times pressed since last call, position at most recent press.         }
{ Resets count and position info. Button 0 is left, 1 is right on       }
{ Microsoft mouse.                                                      }
begin
        with Registers do begin
                BX := button - 1;
                CallMouse(5);
                case button of
                        1 : result := AX and $01 <> 0;
                        2 : result := AX and $02 <> 0;
                        3 : result := AX and $04 <> 0;
                end; { case }
                count := BX;
                column := CX;
                row := DX;
        end; { with }
end;

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

procedure mouse_object.Released(button : integer; var result : boolean; var count, row, column : integer);
{ Gets released info about named button: current status (up/down),      }
{ times released since last call, position at most recent press.        }
{ Resets count and position info. Button 0 is left, 1 is right on       }
{ Microsoft mouse.                                                      }
begin
        with Registers do begin
                BX := button - 1;
                CallMouse(6);
                case button of
                        1 : result := AX and $01 <> 0;
                        2 : result := AX and $02 <> 0;
                        3 : result := AX and $04 <> 0;
                end; { case }
                count := BX;
                column := CX;
                row := DX;
        end; { with }
end;

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

procedure mouse_object.ColRange(horizontal_min, horizontal_max : integer);
{ Sets min and max horizontal range for mouse cursor. Moves             }
{ cursor inside range if outside when called. Swaps values if           }
{ min and max are reversed.                                             }
begin
        with Registers do begin
                CX := horizontal_min;
                DX := horizontal_max;
        end; { with }
        CallMouse(7);
end;

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

procedure mouse_object.RowRange(vertical_min, vertical_max : integer);
{ Sets min and max vertical range for mouse cursor. Moves               }
{ cursor inside range if outside when called. Swaps values if           }
{ min and max are reversed.                                             }
begin
        with Registers do begin
                CX := vertical_min;
                DX := vertical_max;
        end; { with }
        CallMouse(8);
end;

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

procedure mouse_object.GraphCursor(hHot, vHot : integer; mask_segment, mask_offset : word);
{ Sets graphic cursor shape                                             }
begin
        with Registers do begin
                BX := hHot;
                CX := vHot;
                DX := mask_offset;
                ES := mask_segment;
        end;
        CallMouse(9);
end;

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

procedure mouse_object.TextCursor(cursor_type : integer; arg1, arg2 : word);
{ Sets text cursor type, where 0 = software and 1 = hardware)           }
{ For software cursor, arg1 and arg2 are the screen and cursor          }
{ masks.  For hardware cursor, arg1 and arg2 specify scan line          }
{ start/stop i.e. cursor shape.                                         }
begin
        with Registers do begin
                BX := cursor_type;
                CX := arg1;
                DX := arg2;
        end;
        CallMouse(10);
end;

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

procedure mouse_object.Motion(var horizontal_count, vertical_count : integer);
{ Reports net motion of cursor since last call to this function         }
begin
        CallMouse(11);
        with Registers do begin
                horizontal_count := CX;
                vertical_count := DX;
        end;
end;

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

procedure mouse_object.InstallTask(mask, task_segment, task_offset : word);
{ Installs a user-defined task to be executed upon one or more          }
{   mouse events specified by mask.                                     }
begin
        with Registers do begin
                CX := mask;
                DX := task_offset;
                ES := task_segment;
        end;
        CallMouse(12);
end;

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

procedure mouse_object.LightPenOn;
{ Turns on light pen emulation. This is the default condition.          }
begin
        CallMouse(13);
end;

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

procedure mouse_object.LightPenOff;
{ Turns off light pen emulation.                                        }
begin
        CallMouse(14);
end;

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

procedure mouse_object.Ratio(horizontal, vertical : integer);
{ Sets mickey-to-pixel ratio, where ratio is R/8. Default is 16         }
{   for vertical, 8 for horizontal                                      }
begin
        with Registers do begin
                CX := horizontal;
                DX := vertical;
        end;
        CallMouse(15);
end;

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

procedure mouse_object.ConditionOff(x1, y1, x2, y2 : integer);
{ This function hides the mouse if it is in the region when this        }
{ function is called.  Afterwards your program must call Show to show   }
{ the cursor again.                                                     }
begin
        if not mouse_visible then exit;
        with Registers do begin
                SI := x2;               { lower x screen coordinates    }
                DI := y2;               { lower y screen coordinates    }
                CX := x1;               { upper x screen coordinates    }
                DX := y1;               { upper y screen coordinates    }
        end;
        CallMouse(16);
        mouse_visible := false;
end;

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

procedure mouse_object.SetThreshold(x : integer);
{ Set the threshold speed for doubling the cursor's movements           }
begin
        Registers.DX := x;
        CallMouse(19);
end;


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

var     ExitSave: pointer;              { Previous exit procedure       }

{$F+} procedure ExitHandler; {$F-}
begin
        ExitProc := ExitSave;   { Chain to other exit procedures        }
        CallMouse(0);
end;

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

begin
        ExitSave := ExitProc;
        ExitProc := @ExitHandler;       { Install our exit procedure    }
        CallMouse(0);
        mouse_exists := Registers.AX <> 0;
        mouse_visible := false;
        mouse_buttons := Registers.BX;
end.