как на паскале написать кнопку - Pascal - Ответ 329792

Unit EgaMouse;
 
{*******************************************************************}
{*                                                                 *}
{*                   EgaMouse - EGA Mouse Unit                     *}
{*                                                                 *}
{*                    version 1.0, 02/02/88                        *}
{*                by Eduardo Martins 73300,267                     *}
{*                                                                 *}
{*                        based on Mouse4                          *}
{*                     version .9, 11/20/87                        *}
{*                by Richard Sadowsky 74017,1670                   *}
{*                                                                 *}
{*             thanks to John Sierasky for helping me out          *}
{*            with function CursorShape (mouse function 9)         *}
{*                                                                 *}
{*                 released to the public domain                   *}
{*                                                                 *}
{*******************************************************************}
{*                                                                 *}
{* Version 2.0, 3/14/88                                            *}
{* Modifications by Lew Paper                                      *}
{*                                                                 *}
{*                                                                 *}
{* 1.     The original five cursor types came from the Microsoft   *}
{* Mouse manual.  I changed the unit so that each one has its      *}
{* own hot spot, as located in the Microsoft Mouse manual.         *}
{*                                                                 *}
{* 2.     I added the extra error checking which the Microsoft     *}
{* Mouse manual recommends in Procedure InitMouse.  If the         *}
{* mouse interrupt ($33) does not point to a valid location,       *}
{* InitMouse sets Mouse_Error to 1 and Mouse_Installed to FALSE.   *}
{*                                                                 *}
{* 3.     I moved a lot of variables from the INTERFACE to the     *}
{* IMPLEMENTLATION because they are none of the calling program's  *}
{* business.                                                       *}
{*                                                                 *}
{*******************************************************************}
 
Interface
 
Uses DOS;
 
const
  LEFTPRESS        = 2;
  LEFTREL          = 4;
  RIGHTPRESS       = 8;
  RIGHTREL         = 16;
 
  Standard         = 1;
  PointingHand     = 2;
  HourGlass        = 3;
  DiagCross        = 4;
  CheckMark        = 5;
 
 
 
var
  Mouse_Installed  : Boolean;
  Mouse_Error      : Word;
 
function InitMouse : Word;
{ Function 0 - Initialize mouse software and hardware }
 
procedure ShowMouse;
{ function 1 - show mouse cursor }
 
procedure HideMouse;
{ function 2 - hide mouse cursor }
 
function MousePosition(var MouseX,MouseY : Word) : Word;
{ function 3 - return mouse position and button status }
{ X and Y values scaled for 640 x 350 EGA mode }
 
procedure SetMousePosition(mousex, mousey: Word);
{ function 4 - sets mouse position  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
function MousePress(button: Word;
                     var count, lastx, lasty: Word): Word;
{ function 5 - gets button press information  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
function MouseRelease(button: Word;
                       var count, lastx, lasty: Word): Word;
{ function 6 - gets button release information  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
procedure SetMouseXY(x1,y1,x2,y2: Word);
{ functions 7 and 8 - sets min/max values for horizontal/vertical  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
procedure RestoreMouseXY;
{ functions 7 and 8 - restores min/max values for CGA screen }
 
procedure CursorShape(Shape: integer);
{ function 9 - sets the graphics cursor shape }
 
procedure SetPixeltoMickey(Horiz,Verti : Word);
{ function 15 - sets the mickey to pixel ratio }
 
 
implementation
 
VAR
  Mouse_Reg        : Registers;
 
function InitMouse : Word;
{ Function 0 - Initialize mouse software and hardware }
 
CONST
  IRET = $CF;
 
VAR
  MouseInterrupt: ^Byte ABSOLUTE 0:$CC;     {4 * $33 = $CC}
 
begin
  IF MouseInterrupt = NIL
  THEN
    InitMouse := 1
  ELSE IF MouseInterrupt^ = IRET
  THEN
    InitMouse := 1
  ELSE
  BEGIN
    with Mouse_Reg do
      Ax := 0;
    Intr($33,Mouse_Reg);
    InitMouse := Mouse_Reg.Ax
  END;
end;
 
procedure ShowMouse;
{ function 1 - show mouse cursor }
 
begin
  Mouse_Reg.Ax := 1;
  Intr($33,Mouse_Reg);
end;
 
procedure HideMouse;
{ function 2 - hide mouse cursor }
 
begin
  Mouse_Reg.AX := 2;
  Intr($33,Mouse_Reg);
end;
 
function MousePosition(var MouseX,MouseY : Word) : Word;
{ function 3 - return mouse position and button status }
{ X and Y values scaled for 640 x 350 EGA mode }
 
begin
  Mouse_Reg.Ax := 3;
  Intr($33,Mouse_Reg);
  with Mouse_Reg do begin
    MouseX := Succ(Cx);
    MouseY := Succ(Dx);
    MousePosition := Bx;
  end;
end;
 
procedure SetMousePosition(mousex, mousey: Word);
{ function 4 - sets mouse position  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
begin
  Mouse_Reg.ax:=4;
  Mouse_Reg.cx:=Pred(mousex);
  Mouse_Reg.dx:=Pred(mousey);
  intr($33,Mouse_Reg);
end;
 
function MousePress(button: Word;
                     var count, lastx, lasty: Word): Word;
{ function 5 - gets button press information  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
begin
  Mouse_Reg.ax:=5;
  Mouse_Reg.bx:=button;
  intr($33,Mouse_Reg);;
  mousepress:=Mouse_Reg.ax;
  count:=Mouse_Reg.bx;
  lastx:=Succ(Mouse_Reg.cx );
  lasty:=Succ(Mouse_Reg.dx );
end;
 
function MouseRelease(button: Word;
                       var count, lastx, lasty: Word): Word;
{ function 6 - gets button release information  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
begin
  Mouse_Reg.ax:=6;
  Mouse_Reg.bx:=button;
  intr($33,Mouse_Reg);;
  mouserelease:=Mouse_Reg.ax;
  count:=Mouse_Reg.bx;
  lastx := Succ(Mouse_Reg.cx );
  lasty := Succ(Mouse_Reg.dx );
end;
 
procedure SetMouseXY(x1,y1,x2,y2: Word);
{ functions 7 and 8 - sets min/max values for horizontal/vertical  }
{ X and Y values scaled for 640 x 350 EGA mode }
 
begin
  Mouse_Reg.ax:=7;
  Mouse_Reg.cx:=Pred(x1);
  Mouse_Reg.dx:=Pred(x2);
  intr($33,Mouse_Reg);
  Mouse_Reg.ax:=8;
  Mouse_Reg.cx:=Pred(y1);
  Mouse_Reg.dx:=Pred(y2);
  intr($33,Mouse_Reg);
end;
 
procedure RestoreMouseXY;
{ functions 7 and 8 - restores min/max values for EGA screen }
 
begin
  Mouse_Reg.ax:=7;
  Mouse_Reg.cx:=0;
  Mouse_Reg.dx:=639;
  intr($33,Mouse_Reg);
  Mouse_Reg.ax:=8;
  Mouse_Reg.cx:=0;
  Mouse_Reg.dx:=349;
  intr($33,Mouse_Reg);
end;
 
 
procedure CursorShape(Shape:integer);
{ function 9 - sets the graphics cursor shape }
 
 
TYPE
  CursorType = RECORD
    Mask             : ARRAY[0..1, 0..15] OF WORD;
    HorizontalHotSpot: WORD;
    VerticalHotSpot  : WORD;
  END;
 
CONST
 
  Hand: CursorType =
    (
      Mask: (($E1FF,$E1FF,$E1FF,$E1FF,$E000,$E000,$E000,$0000,
              $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
 
             ($1E00,$1200,$1200,$1200,$13FF,$1249,$1249,$F249,
              $9001,$9001,$9001,$8001,$8001,$8001,$8001,$FFFF));
 
      HorizontalHotSpot: 9;
      VerticalHotSpot:   0
    );
 
  Hour: CursorType =
    (
      Mask: (($0000,$0000,$0000,$0000,$8001,$C003,$E007,$F00F,
              $E007,$C003,$8001,$0000,$0000,$0000,$0000,$FFFF),
 
             ($0000,$7FFE,$6006,$300C,$1818,$0C30,$0660,$03C0,
              $0660,$0C30,$1998,$33CC,$67E6,$7FFE,$0000,$0000));
 
      HorizontalHotSpot: 7;
      VerticalHotSpot  : 7
    );
 
   Stand: CursorType =
    (
      Mask: (($3FFF,$1FFF,$0FFF,$07FF,$03FF,$01FF,$00FF,$007F,
              $003F,$001F,$01FF,$10FF,$30FF,$F87F,$F87F,$FC7F),
 
             ($0000,$4000,$6000,$7000,$7800,$7C00,$7E00,$7F00,
              $7F80,$7C00,$6C00,$4600,$0600,$0300,$0300,$0000));
 
      HorizontalHotSpot: $FFFF;              {WORD(-1)}
      VerticalHotSpot  : $FFFF
    );
 
   DiagC: CursorType =
    (
      Mask: (($07E0,$0180,$0000,$C003,$F00F,$C003,$0000,$0180,
              $07E0,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
 
             ($0000,$700E,$1C38,$0660,$03C0,$0660,$1C38,$700E,
              $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
 
      HorizontalHotSpot: 7;
      VerticalHotSpot  : 4
    );
 
   Check: CursorType =
    (
      Mask: (($FFF0,$FFE0,$FFC0,$FF81,$FF03,$0607,$000F,$001F,
              $C03F,$F07F,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
 
              ($0000,$0006,$000C,$0018,$0030,$0060,$70C0,$1D80,
               $0700,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
 
      HorizontalHotSpot: 6;
      VerticalHotSpot  : 7
    );
 
begin
 
   case Shape of
      1: BEGIN
           Mouse_Reg.BX := Stand.HorizontalHotSpot;
           Mouse_Reg.CX := Stand.VerticalHotSpot;
           Mouse_Reg.ES := Seg(Stand.Mask);
           Mouse_Reg.DX := Ofs(Stand.Mask);
         END;
      2: BEGIN
           Mouse_Reg.BX := Hand.HorizontalHotSpot;
           Mouse_Reg.CX := Hand.VerticalHotSpot;
           Mouse_Reg.ES := Seg(Hand.Mask);
           Mouse_Reg.DX := Ofs(Hand.Mask);
         END;
      3: BEGIN
           Mouse_Reg.BX := Hour.HorizontalHotSpot;
           Mouse_Reg.CX := Hour.VerticalHotSpot;
           Mouse_Reg.ES := Seg(Hour.Mask);
           Mouse_Reg.DX := Ofs(Hour.Mask);
         END;
      4: BEGIN
           Mouse_Reg.BX := DiagC.HorizontalHotSpot;
           Mouse_Reg.CX := DiagC.VerticalHotSpot;
           Mouse_Reg.ES := Seg(DiagC.Mask);
           Mouse_Reg.DX := Ofs(DiagC.Mask);
         END;
      5: BEGIN
           Mouse_Reg.BX := Check.HorizontalHotSpot;
           Mouse_Reg.CX := Check.VerticalHotSpot;
           Mouse_Reg.ES := Seg(Check.Mask);
           Mouse_Reg.DX := Ofs(Check.Mask);
         END;
   end;
 
  Mouse_Reg.AX := 9;
  Intr($33, Mouse_Reg);
end;
 
 
procedure SetPixeltoMickey(Horiz,Verti : Word);
{ function 15 - sets the mickey to pixel ratio }
 
begin
  with Mouse_Reg do begin
    Ax := 15;
    Cx := Horiz;
    Dx := Verti;
  end;
  Intr($33,Mouse_Reg)
end;
 
begin
  Mouse_Error := InitMouse;
  Mouse_Installed := Mouse_Error = 65535;
end.