Newsgroup: it.comp.lang.pascal
Titolo: MOUSE in pascal

Vi interessa se volete ecco tre procedure pascal per sapere tutto sullo 
stato del mouse:
   Function MouseObj.X;
   Begin
     Regs.Ax:=3;
     Regs.Bx:=0;
     Intr($33,regs);
     X:=(Regs.Cx Shr 1) Div 3*Ord(NOT GraphStatus)+1;
   End;
   Function MouseObj.Y;
   Begin
     Regs.Bx:=3;
     Regs.Bx:=0;
     Intr($33,regs);
     Y:=regs.dx Div 7*Ord(NOT GraphStatus)+1
   End;
   Function MouseObj.Button;
   { Questa funzone ritorna 0 se LButton č premuto metre 1 se č RButton 
    ad essere premuto in quel istante, per il pusante centrale sto 
lavorando... }
   Begin
     Regs.ax:=3;
     Regs.bx:=0;
     Intr($33,Regs);
     Button:=Regs.Bx;
   End;
Bisogna settare la variabile Boolean GraphStatus...
Ops mi stavo dimenticando del cursore...
   Procedure MouseObj.Show;
   Begin
     Regs.Ax:=1;
     Intr($33,Regs);
   End;
   Procedure MouseObj.Hide;
   Begin
     Regs.Ax:=2;
     Intr($33,regs);
   End;
Quando avvro' finito la visual (pusanti tipo Delphi in pascal) ve la 
donero...

Ecco una completa unit per la gestione del mouse, compatibile con
la unit drivers del tp7 (a parte che invece di TEvent c'e' FEvent)
(quindi valgono tutti gli esempi dell'help del tp). Supporta risoluzioni
finche potete (anche 1280x1024... non sono sicuro pero' con il vesa256.bgi)
Da qualche parte avevo fatto anche la versione dove si puo' cambiare il
puntatore del mouse... ma mucho casino, interrupt etc etc...
{ -- inizio fMouse.pas -- }
unit fMouse;
{ -- fMouse (c) Dreadnaut 2000 - 
drea...@libero.it
 -- }
interface
 type
  Pnt    = record x,y:integer; end;
  FEvent = record
            Where   : Pnt;
            What    : byte;
            Buttons : byte;
           end;
 const
  moResetMouse   = $00;    moShowMouse    = $01;
  moHideMouse    = $02;    moGetPosition  = $03;
  moSetPosition  = $04;    moGetButPress  = $05;
  moGetButRel    = $06;    moSetHorzRange = $07;
  moSetVertRange = $08;    moSetGraphCur  = $09;
  moSetTextCur   = $0A;    moGetMouseRel  = $0B;
  moSetInterrupt = $0C;    moLightPen_ON  = $0D;
  moLightPen_OFF = $0E;    moSetMouseSpd  = $0F;
  mbLeftButton   = $01;    mbRightButton  = $02;
  mbCenterButton = $04;
  evNothing      = $00;    evMouseDown    = $01;
  evMouseUp      = $02;    evMouseMove    = $04;
  evMouseAuto    = $08;
 Function  InitEvents: boolean;
 Procedure ShowMouse;{ far; }
 Procedure HideMouse;
 Procedure GetMouseEvent(var e: FEvent);
 Procedure MousePos     (var x,y,buttons:integer);
 Procedure MouseRel     (var x,y        :integer);
 Procedure SetMouseSens (    x,y        :integer);
 procedure MousePressed (var x,y,buttons:integer);
 procedure MouseReleased(var x,y,buttons:integer);
 procedure SetMouseView (x1,y1,x2,y2: word);
 procedure SetMousePos  (x,y:word);
implementation
 var
  FmData : record
            NButton : byte;
            Init    : byte;
            b,p     : integer;
            Where   : Pnt;
           end;
 Procedure GetMouseEvent(var e: FEvent);
  var
   p : Pnt;
   b : integer;
  begin
   e.What := evNothing;
   MousePos(P.x,P.y,b);
   if (P.x <> e.Where.X) or (P.y <> e.Where.Y) then
    begin
     e.What       := 4; { evMouseMove}
     if FmData.p <> 0 then e.What := evMouseAuto;
     e.Where      := P;
     FmData.Where := P;
    end;
   if b <> FmData.p
    then if b = 0
          then begin
           e.What   := 2 ; {evMouseUp}
           FmData.p := 0;
           FmData.b := 0;
          end
          else if FmData.b = 0
                then begin
                      e.What    := 1; {evMouseDown}
                      e.Buttons := b;
                      FmData.p  := b;
                      FmData.b  := 1;
                     end
                else begin
                      e.What   := 8; {evMouseAuto}
                      FmData.b := 0;
                     end;
  end;
 Function InitEvents: boolean; assembler;
   asm
    MOV   AX, moResetMouse
    INT   33h
    MOV   byte ptr [FmData.NButton],BL
    MOV   byte ptr [FmData.Init],AL
    CMP   AX,0
    JE    @InitQuit
    PUSH  AX
    MOV   AX, moShowMouse
    INT   33h
    POP   AX
 @InitQuit:
   end;
 Procedure ShowMouse; assembler;
  asm
   MOV   AX, moShowMouse
   INT   33h
  end;
 Procedure HideMouse; assembler;
  asm
   MOV   AX, moHideMouse
   INT   33h
  end;
 Procedure MousePos(var x,y,buttons:integer); assembler;
  asm
   MOV    AX, moGetPosition
   INT    33h
   LES    DI,buttons
   MOV    AX,BX
   STOSW
   LES    DI,x
   MOV    AX,CX
   STOSW
   LES    DI,y
   MOV    AX,DX
   STOSW
  end;
 Procedure MouseRel(var x,y:integer); assembler;
  asm
   MOV    AX, moGetMouseRel
   INT    33h
   LES    DI,x
   MOV    AX,CX
   STOSW
   LES    DI,y
   MOV    AX,DX
   STOSW
  end;
 Procedure SetMouseSens(x,y:integer); assembler;
  asm
   MOV   AX, moSetMouseSpd
   MOV   BX, x
   MOV   CX, y
   INT   33h
  end;
 procedure SetMouseView(x1,y1,x2,y2: word); assembler;
  asm
   MOV   AX, moSetHorzRange
   MOV   CX, word ptr x1
   MOV   DX, word ptr x2
   INT   33h
   MOV   AX, moSetVertRange
   MOV   CX, word ptr y1
   MOV   DX, word ptr y2
   INT   33h
  end;
 procedure SetMousePos(x,y:word); assembler;
  asm
   MOV   AX, moSetPosition
   MOV   CX, word ptr x
   MOV   DX, word ptr y
   INT   33h
  end;
 procedure MousePressed(var x,y,buttons: integer); assembler;
  asm
   MOV   AX, moGetButPress
   INT   33h
   LES   DI,buttons
   MOV   AX,BX
   STOSW
   LES   DI,x
   MOV   AX,CX
   STOSW
   LES   DI,y
   MOV   AX,DX
   STOSW
  end;
 procedure MouseReleased(var x,y,buttons: integer); assembler;
  asm
   MOV   AX, moGetButRel
   INT   33h
   LES   DI,buttons
   MOV   AX,BX
   STOSW
   LES   DI,x
   MOV   AX,CX
   STOSW
   LES   DI,y
   MOV   AX,DX
   STOSW
  end;
end.
{ -- fine fMouse.pas -- }
no problema se la usate, magari mettete una scrittina piccola piccola nel
vostro
programma con scritto che la usate :-)
Se fate modifiche magari ditemelo, perche' a volte faccio nuove versioni...
Se poi servono anche gli object per gestire pulsanti, checkbox, textbox,
finestre
[spostabili ma non ridimensionabili... :°( ] etc etc posso vedere se le
ritrovo
perche' da qualche parte le avevo fatte :-)
saluti :-D
--
Dreadnaut (dn)
drea...@liberoDALLASPAM.it

 saluti :-D
Ciao! :-)
--
Kripto

mmmh l'ng non accetta allegati....
per mail ?
--
Dreadnaut (dn)
drea...@liberoDALLASPAM.it

 per mail ?
Ehm...avevo dimenticato che posto con un falso indirizzo...
Eccolo: 
krip...@libero.it
--
Kripto

Presto ti arriva il tutto :-)
--
Dreadnaut (dn)
drea...@liberoDALLASPAM.it

le potresti mandare anche a me???
vorrei provarle! :-)))
la mia email č: 
iose...@infinito.it
grazie dreddy!

si pero' mi ci vuole un attimo perche li devo
recuperare dal vecchio pc....
scusate il ritardo :-)
ciao
--
Dreadnaut (dn)
drea...@liberoDALLASPAM.it

"Dreadnaut" <drea...@liberoDALLASPAM.it> ha scritto nel messaggio
news:XFa16.169262$hk4.6...@news.infostrada.it...

Già che ci sei se non ti dispiace puoi mandarle anche a me?
grazie!