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

Pascal/Delphi Source File | 1993-02-09 | 9KB | 338 lines

{

                                                      ╔══════════════════╗
                                                      ║  PGUI Graphic    ║
                                                      ║  Button Include  ║
                                                      ║    Rev.  1.00    ║
                                                      ╚══════════════════╝

}

Procedure ButtonChain.Init;
Begin
  Root     :=NIL;
  Total    :=0;
  Buttons  :=NIL;
End;

Function ButtonChain.Position:Word;

Var
  B     :Pointer;
  X     :Word;

Begin
  X:=1;
  B:=Buttons;
  Buttons:=Root;

  While (Buttons<>NIL) And (Buttons^.Next<>NIL) And (B<>Buttons) do
  Begin
    Inc(X);
    Buttons:=Buttons^.Next;
  End;

  If (B<>Buttons) Or (B=NIL) Then Position:=0;
  Buttons:=B;
End;

Function ButtonChain.Number:Word;
Begin
  If Buttons=NIL Then
    Number:=0
  Else
    Number:=Buttons^.Number;
End;

Procedure ButtonChain.GotoPosition(Here:Word);

Var
  X     :Word;

Begin
  If Here=0 Then
  Begin
    Buttons:=NIL;
    Exit;
  End;

  X:=1;
  Buttons:=Root;
  While (Buttons<>NIL) And (Buttons^.Next<>NIL) And (X<Here) do
  Begin
    Buttons:=Buttons^.Next;
    Inc(X);
  End;
End;

Procedure ButtonChain.GotoNumber(ButtonNumber:Word);    {NIL if not found}
Begin
  Buttons:=Root;
  While (Buttons<>NIL) And (ButtonNumber<>Buttons^.Number) do
    Buttons:=Buttons^.Next;
End;

Function ButtonChain.NewButtonNumber:Word;

Var
  Highest:Word;

Begin
  Buttons:=Root;
  Highest:=0;
  While Buttons<>NIL do
  Begin
    Highest:=Buttons^.Number;
    Buttons:=Buttons^.Next;
  End;
  If Highest>65500 Then
  Begin
    Repeat
      Highest:=Random(65499)+1;
      Buttons:=Root;
      While (Buttons<>NIL) And (Highest<>0) do
      Begin
        If Highest=Buttons^.Number Then Highest:=0;
        Buttons:=Buttons^.Next;
      End;
    Until Highest<>0;
    NewButtonNumber:=Highest;
  End
  Else
    NewButtonNumber:=Highest+1;
End;

Procedure ButtonChain.Add(X1, Y1, X2, Y2:Word;
                          Special:Boolean; Key:Char);

{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║                                                                        ║ }
{ ║   The button is added to the list.  Button coordinates are at X1,Y1    ║ }
{ ║   to X2,Y2.  The equivalent key press is in Key.  Special is True      ║ }
{ ║   if the key returned if preceeded by a character 0.                   ║ }
{ ║                                                                        ║ }
{ ║   Background is the background colour, Picture is a possible           ║ }
{ ║   Button picture and it returns a the button's number.                 ║ }
{ ║                                                                        ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }

Var
  P   :ButtonListPtr;   {New Button}

Begin
  New(P);
  P^.X1         :=X1;
  P^.Y1         :=Y1;
  P^.X2         :=X2;
  P^.Y2         :=Y2;
  P^.Number     :=NewButtonNumber;
  P^.Special    :=Special;
  P^.Key        :=Key;
  P^.Next       :=NIL;

  GotoPosition(65535);

  If Root=NIL Then
  Begin
    Root:=P;
    Buttons:=P;
  End
  Else
  Begin
    Buttons^.Next:=P;
    Buttons:=P;
  End;
  Inc(Total);
End;

Procedure ButtonChain.WaitForClick(Var X, Y:Word;Var MouseButtons:Byte;
                                   Var Held,Doubled,Special:Boolean; Var Key:Char);

{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║                                                                        ║ }
{ ║  This procedure will return which of the currently active buttons      ║ }
{ ║  has been selected.  If a user presses the key equivalent of a         ║ }
{ ║  button or moves the mouse onto a button and clicks, the procedure     ║ }
{ ║  returns that button's key press.  It also checks for a double click.  ║ }
{ ║                                                                        ║ }
{ ║  If Key=#255 then no valid key was received.                           ║ }
{ ║                                                                        ║ }
{ ║  It will return the co-ordinates if no button was clicked on.          ║ }
{ ║                                                                        ║ }
{ ║  If a double click was selected, Double is set to True, else False.    ║ }
{ ║                                                                        ║ }
{ ║  Special is set to True if and only if a "Special" key was pressed.    ║ }
{ ║  A "Special" key is a key pressed that is preceeded by a NUL or        ║ }
{ ║  character 0.  Example, the cursor keys.                               ║ }
{ ║                                                                        ║ }
{ ║  Which mouse buttons are being pressed is also returned.               ║ }
{ ║                                                                        ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }

Var
  Z,W            :Word;
  FoundAgain,
  Found          :Boolean;      {Has the user pressed a button}
  CheckDouble    :Pointer;
  C              :Char;         {Key Pressed}

Begin
  C      :=Chr(255);
  Found  :=False;
  Buttons:=Root;

  Begin
    Special:=False;

    If Mouse.Active Then
    Begin
      Mouse.GetClick(X,Y,Z,W,MouseButtons,Held,Doubled);
      X:=(X Div MouseGranularity) + 1;
      Y:=(Y Div MouseGranularity) + 1;
      While (Not Found) And (Buttons<>NIL) And (Not KeyPressed) do
      Begin
        If (X>=Buttons^.X1) And (X<=Buttons^.X2) And
           (Y>=Buttons^.Y1) And (Y<=Buttons^.Y2) Then Found:=True;
        If Not Found Then Buttons:=Buttons^.Next;
      End;
      If KeyPressed Then C:=UpCase(ReadKey);

      FoundAgain:=False;
      CheckDouble:=Buttons;
      If Doubled Then
      Begin
        Buttons:=Root;
        While Not FoundAgain And (Buttons<>NIL) do
        Begin
          If (Z>=Buttons^.X1) And (Z<=Buttons^.X2) And
             (W>=Buttons^.Y1) And (W<=Buttons^.Y2) Then FoundAgain:=True;
          If Not FoundAgain Then Buttons:=Buttons^.Next;
        End;
        If CheckDouble<>Buttons Then
        Begin
          Doubled:=False;
          If Buttons=NIL Then Buttons:=CheckDouble;
        End;
      End;
    End;     {Now, for Mouse and No Mouse}

    If Not Found Then Buttons:=Root;
    If Not Mouse.Active Then C:=UpCase(ReadKey);
    If C=Chr(0) Then If KeyPressed Then
    Begin
      C:=ReadKey;
      Special:=True;
    End;
    If C=Chr(0) Then C:=Chr(255);

    While Not Found And (Buttons<>NIL) do
    Begin
      If (C=Buttons^.Key) And (Special=Buttons^.Special) Then Found:=True;
      If Not Found Then Buttons:=Buttons^.Next;
    End;
  End;

  If Found Then
  Begin
    Special:=Buttons^.Special;
    Key    :=Buttons^.Key;
  End
  Else
  Begin
    Key    :=#255;
    Buttons:=NIL;
  End;
End;

Procedure ButtonChain.Move(X,Y:Integer;ButtonNumber:Word);
Begin
  GotoNumber(ButtonNumber);
  If Buttons=NIL Then Exit;
  Inc(Buttons^.X1,X);
  Inc(Buttons^.X2,X);
  Inc(Buttons^.Y1,Y);
  Inc(Buttons^.Y2,Y);
End;

Procedure ButtonChain.MoveAll(X,Y:Integer);

Var
  OldBut  :Pointer;

Begin
  OldBut :=Buttons;
  Buttons:=Root;
  While Buttons<>NIL do
  Begin
    Inc(Buttons^.X1,X);
    Inc(Buttons^.X2,X);
    Inc(Buttons^.Y1,Y);
    Inc(Buttons^.Y2,Y);
    Buttons:=Buttons^.Next;
  End;
  Buttons:=OldBut;
End;

Procedure ButtonChain.KillFrom;

{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║  Removes *some* buttons from memory.                                   ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }

Var
  Q     :Pointer;

Begin
  While Buttons<>NIL do
  Begin
    Q:=Buttons^.Next;
    Dispose(Buttons);
    Buttons:=Q;
    Dec(Total);
  End;
  If Total=0 Then Root:=NIL;
End;

Procedure ButtonChain.KillAll;

{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║  Removes all buttons from memory.                                      ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }

Begin
  Buttons:=Root;
  KillFrom;
End;

Procedure ButtonChain.KillOne;

{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║  Removes *one* button from memory, if it exists.                       ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }

Var
  Q     :ButtonListPtr;
  Here  :Word;

Begin
  Here:=Position;
  If Here>Total Then Exit;
  If Here=1 Then
  Begin
    Root:=Buttons^.Next;
    Dispose(Buttons);
    Buttons:=Root;
    Dec(Total);
  End
  Else
  Begin
    GotoPosition(Here-1);
    Q:=Buttons^.Next;
    Buttons^.Next:=Buttons^.Next^.Next;
    Dispose(Q);
    Dec(Total);
  End;
End;

{ Copyright 1993, Michael Gallias }