Simtel MSDOS - Coast to Coast/simteldosarchivecoasttocoast2.iso/turbopas/pstui100.zip/PTUIVMSE.PAS

Pascal/Delphi Source File | 1993-03-12 | 5KB | 206 lines

{

                                                      ╔══════════════════╗
                                                      ║   PTUI Virtual   ║
                                                      ║   Screen Mouse   ║
                                                      ║    Rev.  1.00    ║
                                                      ╚══════════════════╝

}

{$F+} {$O-} {$A+} {$G+}
{$V-} {$B-} {$X-} {$N+} {$E+}

{$I FINAL.PAS}

{$IFDEF FINAL}
  {$I-} {$R-}
  {$D-} {$L-} {$S-}
{$ENDIF}

Unit PTUIVMSE;

Interface

Uses PTUIVCRT;

Const
  MouseGranularity =    8;

Var
  OldMouseChar,
  MouseX,
  MouseY                :Word;
  Busy                  :Boolean;
  MouseHideCount        :Byte;

Procedure ControlVScreenMouse;
Procedure Show;
Procedure Hide;
Procedure SetXY          (X,Y:Word);
Procedure SetBounds      (X1,Y1,X2,Y2:Word);

Implementation

{$S-}
Procedure ControlVScreenMouse;

Var
  P        :^Word;

Begin
  Asm
    pusha
    push     ds
    push     es
    mov      ax, SEG @Data
    mov      ds, ax
  End;

  If Not Busy Then
  Begin
    Busy:=True;
    If MouseHideCount=255 Then
    Begin
      P:=VideoWriteAddress((MouseX Div MouseGranularity) + 1,(MouseY Div MouseGranularity) + 1);
      P^:=OldMouseChar;
      Asm
        mov   ax, 3
        int   33h
        mov   MouseX, cx
        mov   MouseY, dx
      End;
      P:=VideoWriteAddress((MouseX Div MouseGranularity) + 1,(MouseY Div MouseGranularity) + 1);
      OldMouseChar:=P^;
      If Card=ColorCard Then
        P^:=P^ XOR 6144
      Else
        If (Hi(P^) in [$70,$78,$F0,$F8]) Then
          P^:=(P^ And $FF) + (Word($1) Shl 9)
        Else
          P^:=(P^ And $FF) + (Word($70) Shl 8);

      While  (((MouseX Div MouseGranularity) + 1)>=VideoCard[Card].SX2) And
              (VideoCard[Card].SX2<VideoCard[Card].XSize) do
      Begin
        ScreenOrigin((VideoCard[Card].SX1) * VideoCard[Card].CharacterLength,
                     (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
      End;

      While (((MouseY Div MouseGranularity) + 1)>=VideoCard[Card].SY2) And
             (VideoCard[Card].SY2<VideoCard[Card].YSize) do
      Begin
        ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength,
                     (VideoCard[Card].SY1) * VideoCard[Card].CharacterHeight);
      End;

      While  (((MouseX Div MouseGranularity) + 1)<=VideoCard[Card].SX1) And
              (VideoCard[Card].SX1>1) do
      Begin
        ScreenOrigin((VideoCard[Card].SX1 - 2) * VideoCard[Card].CharacterLength,
                     (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
      End;

      While  (((MouseY Div MouseGranularity) + 1)<=VideoCard[Card].SY1) And
              (VideoCard[Card].SY1>1) do
      Begin
        ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength,
                     (VideoCard[Card].SY1 - 2) * VideoCard[Card].CharacterHeight);
      End;
      Busy:=False;
    End
    Else
    Asm
      mov   ax, 3
      int   33h
      mov   MouseX, cx
      mov   MouseY, dx
    End;
  End;

  Asm
    pop      es
    pop      ds
    popa
  End;
End;
{$IFNDEF FINAL} {$S+} {$ENDIF}

Procedure Show;

Var
  P     :^Word;

Begin
  Busy:=True;
  If MouseHideCount<255 Then
  Begin
    Inc(MouseHideCount);
    If MouseHideCount=255 Then
    Begin
      P:=VideoWriteAddress((MouseX Div MouseGranularity) + 1,(MouseY Div MouseGranularity) + 1);
      OldMouseChar:=P^;
      If Card=ColorCard Then
        P^:=P^ XOR 6144
      Else
        If (Hi(P^)=$70) Or (Hi(P^)=$78) Then
          P^:=(P^ And $FF) + (Word($1) Shl 8)
        Else
          P^:=(P^ And $FF) + (Word($70) Shl 8);
    End;
  End;
  Busy:=False;
End;

Procedure Hide;

Var
  P     :^Word;

Begin
  Busy:=True;
  If MouseHideCount=255 Then
  Begin
    P:=VideoWriteAddress((MouseX Div MouseGranularity) + 1,(MouseY Div MouseGranularity) + 1);
    P^:=OldMouseChar;
  End;
  If MouseHideCount>0 Then Dec(MouseHideCount);
  Busy:=False;
End;

Procedure SetXY(X,Y:Word);
Begin
  Hide;
  Asm
    mov  ax,4
    mov  cx,X
    mov  dx,Y
    int  33h
  End;
  MouseX:=X;
  MouseY:=Y;
  Show;
End;

Procedure SetBounds(X1,Y1,X2,Y2:Word);
Begin
  Hide;
  Asm
    mov  ax,7
    mov  cx,X1
    mov  dx,X2
    int  33h
    mov  ax,8
    mov  cx,Y1
    mov  dx,Y2
    int  33h
  End;
  Show;
End;

Begin
  Busy  :=False;
End.

{ Copyright 1993, Michael Gallias }