[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]

    Unit mouse;

    Interface

    Procedure RESET_MOUSE (var errore : boolean;
                           var num : word);
    Procedure OPEN_MOUSE;
    Procedure CLOSE_MOUSE;
    Function LEFT_BUTTON : boolean;
    Function RIGHT_BUTTON : boolean;
    Function MIDDLE_BUTTON : boolean;
    Function X_MOUSE (w : boolean) : word; (* w=True se in Graphic Mode *)
    Function Y_MOUSE (w : boolean) : word;
    Procedure POS_MOUSE (x,y : word);
    Procedure WINDOW_MOUSE (x,y,x1,y1 : word);
    Procedure GRAPHIC_CURSOR (nome : string;
                              var errore : boolean;
                              hotx,hoty : word);
    Procedure TEXT_CURSOR1 (inizio, fine : word);
    Procedure TEXT_CURSOR2 (sfondo, colore : byte);
    Function X_REL : word;
    Function Y_REL : word;
    Procedure RAPPORTO_MOUSE (oriz,vert : word);
    Procedure NOWINDOW_MOUSE (x,y,x1,y1 : word);

    Implementation

     Uses dos;
     Var r : registers;

     Procedure GEST_MOUSE (inf : word);
     begin
       r.ax:=inf;
       Intr ($33,r)
     end;

     Procedure RESET_MOUSE (var errore : boolean;
                            var num : word);
     begin
       GEST_MOUSE (0);
       errore:=r.ax = -1;
       num:=r.bx
     end;

     Procedure OPEN_MOUSE;
     begin
       GEST_MOUSE (1)
     end;

     Procedure CLOSE_MOUSE;
     begin
       GEST_MOUSE (2)
     end;

     Function LEFT_BUTTON : boolean;
     begin
        GEST_MOUSE (3);
        left_button:= (r.bx = 1) or (r.bx = 3) or (r.bx = 5)
                      or (r.bx = 7)
     end;

     Function RIGHT_BUTTON : boolean;
     begin
        GEST_MOUSE (3);
        right_button:= (r.bx = 2) or (r.bx = 3) or (r.bx = 6)
                       or (r.bx = 7)
     end;

     Function MIDDLE_BUTTON : boolean;
     begin
        GEST_MOUSE (3);
        middle_button:= (r.bx = 4) or (r.bx = 5) or (r.bx = 6)
                        or (r.bx = 7)
     end;

     Function X_MOUSE (w : boolean) : word;
     begin
        GEST_MOUSE (3);
        If w
         then
          x_mouse:=r.cx
         else
          x_mouse:=r.cx div 8
     end;

     Function Y_MOUSE (w : boolean) : word;
     begin
        GEST_MOUSE (3);
        If w
         then
          y_mouse:=r.dx
         else
          y_mouse:=r.dx div 8
     end;

     Procedure POS_MOUSE (x,y : word);
     begin
        r.cx:=x;
        r.dx:=y;
        GEST_MOUSE (4)
     end;

     Procedure WINDOW_MOUSE (x,y,x1,y1 : word);
     begin
        r.cx:=x;
        r.dx:=x1;
        GEST_MOUSE (7);
        r.cx:=y;
        r.dx:=y1;
        GEST_MOUSE (8)
     end;

     Procedure GRAPHIC_CURSOR (nome : string;
                               var errore : boolean;
                               hotx,hoty : word);
      Const n = 16;
      Type vettore  = array[1..n]of word;
           vettore2 = array[1..n*2]of word;
      Var cursore : file of vettore;
          buffer  : vettore;
          mappa   : vettore2;
          i       : byte;
     begin
        Assign (cursore,nome);
        {$I-}
        Reset (cursore);
        {$I+}
        errore:=Ioresult<>0;
        If not(errore)
         then
          begin
            Read (cursore,buffer);
            Close (cursore);
            For i:=1 to 16 do
             mappa[i]:=not(buffer[i]);
            For i:=17 to 32 do
             mappa[i]:=buffer[i-16];
            r.bx:=hotx;
            r.cx:=hoty;
            r.es:=Seg(mappa);
            r.dx:=Ofs(mappa);
            GEST_MOUSE (9)
          end
     end;

     Procedure TEXT_CURSOR1 (inizio, fine : word);
     begin
        r.bx:=1;
        r.cx:=inizio;
        r.dx:=fine;
        GEST_MOUSE(10)
     end;

     Procedure TEXT_CURSOR2 (sfondo, colore : byte);
     begin
        if (sfondo<16)and(colore<16)
         then
          begin
           r.bx:=0;
           r.cx:=$00ff;
           r.dx:=(colore*256)+(sfondo*4096);
           GEST_MOUSE(10)
          end
     end;

     Function X_REL : word;
     begin
        GEST_MOUSE (11);
        X_REL:=r.cx
     end;

     Function Y_REL : word;
     begin
        GEST_MOUSE (11);
        Y_REL:=r.dx
     end;

     Procedure RAPPORTO_MOUSE (oriz,vert : word);
     begin
        r.cx:=oriz;
        r.dx:=vert;
        GEST_MOUSE (15)
     end;

     Procedure NOWINDOW_MOUSE (x,y,x1,y1 : word);
     begin
        r.cx:=x;
        r.dx:=y;
        r.si:=x1;
        r.di:=y1;
        GEST_MOUSE (16)
     end;

     end.

    (*---------------------------------------------------*)
    (* PUT THE FOLLOWING CODE IN THE FILE TEST.PAS *)
    program Test;
    uses CRT, Mouse;
    var e: Boolean;
        n: Word;
    begin
      ClrScr;
      Reset_Mouse (e, n);
      if e then
        WriteLn ('Mouse Initialization Failed!')
      else begin
        Open_Mouse;
        repeat
          GotoXY (20, 25);
          Write ('Mouse: X = ', X_Mouse(False),
            '  Y = ', Y_Mouse(False), '  ');
          if Left_Button or Right_Button then begin
            Close_Mouse;    (* YOU MUST HIDE THE MOUSE BEFORE WRITING
                               SOMETHING TO VIDEO *)
            GotoXY (X_Mouse(False), Y_Mouse(False));
            if Left_Button then Write (#178) else Write (' ');
            Open_Mouse;     (* AND THEN MAKE IT VISIBLE AGAIN *)
          end;
        until Middle_Button or KeyPressed;
        Close_Mouse;
      end;
    end.

[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]