Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/CMPLTPAS.ZIP/PULLDOWN.PAS

Pascal/Delphi Source File | 1988-07-24 | 19.8 KB | 491 lines

{--------------------------------------------------------------}
{                         PULLDOWN                             }
{                                                              }
{              Graphics pull-down menuing system               }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V5.0                }
{                             Last update 7/24/88              }
{                                                              }
{                                                              }
{     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
{    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
{--------------------------------------------------------------}

UNIT PullDown;

INTERFACE

USES DOS,Graph,Crt,Mouse;  { Mouse is described in Section 17 }

TYPE
  String15  = String[15];

  ItemRec   = RECORD
                Item       : String15;  { Title of item }
                ItemCode   : Byte;      { Code number of item }
                ItemActive : Boolean    { True if item is active }
              END;

  MenuRec   = RECORD
                XStart,XEnd : Word;     { Pixel offset along menu bar }
                Title       : String15; { Menu title }
                MenuSize    : Word;     { Size of menu image on heap }
                Imageptr    : Pointer;  { Points to menu image on heap }
                Active      : Boolean;  { True if menu is active }
                Choices     : Byte;     { Number of items in menu }
                ItemList    : ARRAY[0..18] OF ItemRec  { The items }
              END;

  MenuDesc  = ARRAY[0..12] OF MenuRec;  { Up to 13 items along menu bar }


{->>>>ActivateMenu<<<<-----------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This routine makes the menu specified by MenuNumber active,  }
{ regardless of whether it was active or inactive at           }
{ invocation.  ImagePtr is set to NIL so that the menu will be }
{ redrawn the next time it is pulled down.                     }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
                       MenuNumber      : Byte);


{->>>>DeactivateMenu<<<<---------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This routine makes the menu specified by MenuNumber          }
{ inactive, regardless of whether it was active or inactive at }
{ invocation.  ImagePtr is set to NIL so that the menu will be }
{ redrawn the next time it is pulled down.                     }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
                         MenuNumber      : Byte);


{->>>>ActivateItem<<<<-----------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This routine sets the item whose code is given in Code to    }
{ active, regardless of the state of the item at invocation.   }
{ ImagePtr is set to NIL so that the menu will be redrawn      }
{ the next time it is pulled down.                             }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
                       Code            : Byte);


{->>>>DeactivateItem<<<<---------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This routine sets the item whose code is given in Code to    }
{ inactive, regardless of the state of the item at invocation. }
{ ImagePtr is set to NIL so that the menu will be redrawn      }
{ the next time it is pulled down.                             }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
                         Code            : Byte);


{->>>>InvalidMenu<<<<------------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This function checks for duplicate item codes within the     }
{ menu array passed in CurrentMenu.  The menuing system always }
{ assumes that every menu item has a unique code.  Run this    }
{ function on any menu array you intend to use and abort if a  }
{ duplicate code is detected.                                  }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
                     VAR BadCode : Byte) : Boolean;



{->>>>SetupMenu<<<<--------------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This routine does the initial display of the menu bar, menu  }
{ titles, and the menu bar amulet.                             }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE SetupMenu(CurrentMenu : MenuDesc);



{->>>>Menu<<<<-------------------------------------------------}
{                                                              }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
{                                                              }
{ This is the main menuing routine.  It requires that both     }
{ InvalidMenu and SetupMenu be run before it.  It directly     }
{ samples the mouse pointer position and decides which menu    }
{ within the menu bar has been selected.  It then allows the   }
{ user to bounce the menu bar up and down within the menu      }
{ until an item is chosen or the right button is pressed or    }
{ the pointer is moved out of the pulled-down menu.  The code  }
{ of the chosen item is returned in ReturnCode.  If no item is }
{ chosen, ReturnCode comes returns a 0.  The returned code is  }
{ within the range 0-255.                                      }
{                                                              }
{ Menu is responsible for drawing pull-down menus and storing  }
{ them on the heap so that once drawn a menu does not need to  }
{ be drawn again until it is changed somehow, typically by     }
{ deactivating or reactivating an item.                        }
{                                                              }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
{   predefined.                                                }
{--------------------------------------------------------------}

PROCEDURE Menu(CurrentMenu    : MenuDesc;
               VAR ReturnCode : Word;
               VAR Amulet     : Boolean);



IMPLEMENTATION


PROCEDURE ChangeItemStatus(VAR CurrentMenu : MenuDesc;
                           Code            : Byte;
                           ToActive        : Boolean);

VAR
  I          : Byte;
  MenuNumber : Byte;
  ItemFound  : Boolean;

BEGIN
  MenuNumber := 0; ItemFound := False;
  REPEAT
    WITH CurrentMenu[MenuNumber] DO
      BEGIN
        I := 0;
        REPEAT     { Here we scan menu items to find the right one }
          IF ItemList[I].ItemCode = Code THEN  { We found it ! }
            BEGIN
              ItemList[I].ItemActive := ToActive;  { Mark item }
              ItemFound := True;
              { Since we've changed the information in a menu, we must       }
              {  remove any menu image from storage on the heap, and force   }
              {  the code to redraw the menu the next time it's pulled down: }
              IF ImagePtr <> NIL THEN    { If there's an image on the heap }
                BEGIN
                  FreeMem(ImagePtr,MenuSize);  { Deallocate the heap image }
                  ImagePtr := NIL              { Make pointer NIL again }
                END;
            END
          ELSE
            Inc(I)
        UNTIL ItemFound OR (I > Choices)
      END;
    Inc(MenuNumber)
  UNTIL ItemFound OR (MenuNumber > 12);
END;


{---------------------------------------------------------------------}
{  IMPLEMENTATION Definitions above this bar are PRIVATE to the unit. }
{---------------------------------------------------------------------}


PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
                       MenuNumber      : Byte);

BEGIN
  WITH CurrentMenu[MenuNumber] DO
    BEGIN
      ImagePtr := NIL;
      Active   := True
    END
END;


PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
                         MenuNumber      : Byte);

BEGIN
  WITH CurrentMenu[MenuNumber] DO
    BEGIN
      ImagePtr := NIL;
      Active   := False
    END
END;




PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
                       Code            : Byte);

BEGIN
  ChangeItemStatus(CurrentMenu,Code,True)
END;


PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
                         Code            : Byte);

BEGIN
  ChangeItemStatus(CurrentMenu,Code,False)
END;




FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
                     VAR BadCode : Byte) : Boolean;

VAR
  I,J            : Word;
  CmdSet         : SET OF Byte;
  DuplicateFound : Boolean;

BEGIN
  DuplicateFound := False;
  CmdSet := [];  { Start out with the empty set }
  FOR I := 0 TO 12 DO      { Check each menu }
    WITH CurrentMenu[I] DO
      BEGIN
        J := 0;  { Reset item counter to 0 for each new menu }
        REPEAT   { Here we scan menu items to check each one }
          IF ItemList[J].ItemCode > 0 THEN
            IF ItemList[J].ItemCode IN CmdSet THEN
              BEGIN
                DuplicateFound := True;         { Flag duplicate }
                BadCode := ItemList[J].ItemCode { Return dupe in BADCODE }
              END
            ELSE
              BEGIN
                { Add item's command code to the set: }
                CmdSet := CmdSet + [ItemList[J].ItemCode];
                Inc(J)
              END
          ELSE Inc(J)
        UNTIL (J > Choices) OR DuplicateFound
      END;
  InvalidMenu := DuplicateFound
END;



PROCEDURE SetupMenu(CurrentMenu : MenuDesc);

VAR
  I,DrawX,DrawY : Word;

BEGIN
  { Show bar and amulet: }
  SetFillStyle(SolidFill,White); Bar(0,0,GetMaxX,11);
  SetColor(0); Rectangle(2,1,12,9);
  FOR I := 3 TO 8 DO IF Odd(I) THEN Line(4,I,10,I);

  { Display menu titles in bar: }
  DrawX := CurrentMenu[0].XStart; DrawY := 2; I := 0;
  REPEAT
    OutTextXY(DrawX,DrawY,CurrentMenu[I].Title);
    Inc(I);
    DrawX := CurrentMenu[I].XStart;
  UNTIL (Length(CurrentMenu[I].Title) = 0) OR (I > 13);
END;


PROCEDURE Menu(CurrentMenu    : MenuDesc;
               VAR ReturnCode : Word;
               VAR Amulet     : Boolean);

VAR
  PointerX,PointerY : Word;       { Current position of mouse pointer }
  Left,Center,Right : Boolean;    { Current state of mouse buttons }
  I,J               : Integer;
  MenuWidth         : Integer;    { Width in pixels of target menu }
  M1X,M1Y,M2X,M2Y   : Integer;    { Coordinates of menu box }
  FoundMenu         : Boolean;
  SaveColor         : Integer;    { Holds caller's draw color }
  UnderMenu         : Pointer;    { Points to saved screen area }
  BounceBar         : Pointer;    { Points to bounce bar pattern }
  Pick              : Word;       { Number of item under bounce bar }
  UpperBound,
    LowerBound      : Integer;    { Current Y-limits of bounce bar }


PROCEDURE RestoreUnderMenuBox;

BEGIN
  PointerOff;
  PutImage(M1X,M1Y,UnderMenu^,NormalPut);
  PointerOn
END;


BEGIN
  Amulet := False;
  SaveColor := GetColor; SetColor(White);
  PollMouse(PointerX,PointerY,Left,Right,Center);
  { Check to see if the amulet is under mouse pointer: }
  IF (PointerX > 1) AND (PointerX < 13) AND
     (PointerY > 0) AND (PointerY < 10)
  THEN
    BEGIN
      Amulet := True;   { We've clicked on the amulet }
      SetColor(SaveColor);
      Exit              { THIS IS AN EXIT TO MENU! }
    END;
  { Now we find out which menu to pull down: }
  I := -1;
  REPEAT
    I := I + 1;
    IF (PointerX >= CurrentMenu[I].XStart) AND  { If pointer is in }
       (PointerX <= CurrentMenu[I].XEnd)   AND  { menu's range }
       CurrentMenu[I].Active                    { and menu is active }
    THEN FoundMenu := True ELSE FoundMenu := False;
  UNTIL FoundMenu OR                           { We hit an active menu }
        (Length(CurrentMenu[I].Title) = 0) OR  { We hit a null menu }
        (I > 13);                              { Only 13 menus max! }
  IF FoundMenu THEN  { Pull it down and pick! }
    BEGIN
      PointerOff;
      WITH CurrentMenu[I] DO   { We're only working with current menu now }
        BEGIN
          { Calc coordinates of the found menu box: }
          MenuWidth := 0;       { First we have to calc menu width : }
          FOR J := 0 TO Choices-1 DO  { Find longest item string }
            IF Length(ItemList[J].Item) > MenuWidth
              THEN MenuWidth := Length(ItemList[J].Item);
          MenuWidth := MenuWidth * 8; { We're using the 8 X 8 font }
          M1X := XStart; M1Y := 11;
          M2X := XStart+MenuWidth+6;
          M2Y := (Choices+1) * 12;
          MenuSize := ImageSize(M1X,M1Y,M2X,M2Y);

          { We must save the screen area beneath the menu box: }
          GetMem(UnderMenu,MenuSize);            { Allocate space on heap }
          GetImage(M1X,M1Y,M2X,M2Y,UnderMenu^);  { Save area out to heap  }

          { First we clear the menu box: }
          SetFillStyle(SolidFill,Black);
          Bar(M1X,M1Y,M2X,M2Y);

          { Here we create the bounce bar pattern on the heap: }
          SetFillStyle(SolidFill,White);
          GetMem(BounceBar,ImageSize(M1X+1,M1Y+1,M2X-1,M1Y+12));
          Bar(M1X+1,M1Y+1,M2X-1,M1Y+12);
          GetImage(M1X+1,M1Y+1,M2X-1,M1Y+12,BounceBar^);

          { If the menu has not yet been shown for the first time, or if    }
          {   the active/inactive status of any menu item has changed since }
          {   we last pulled it down, the image pointer is NIL and we must  }
          {   draw it and then store it on the heap.  Any time AFTER the    }
          {   first time it comes in from the heap with lightning speed...  }
          IF ImagePtr = NIL THEN    { We must draw the menu }
            BEGIN
              Rectangle(M1X,M1Y,M2X,M2Y);  { Draw the menu box }
              { The first item must be drawn in black on the white bar: }
              SetColor(Black);
              IF ItemList[0].ItemActive THEN
                OutTextXY(XStart+3,14,ItemList[0].Item);
              SetColor(White);
              { Items after the first are drawn in white on black: }
              FOR J := 1 TO Choices-1 DO IF ItemList[J].ItemActive THEN
                OutTextXY(XStart+3,14+(J*12),ItemList[J].Item);
              { Now we allocate heap space and move image to heap }
              GetMem(ImagePtr,MenuSize);
              GetImage(M1X,M1Y,M2X,M2Y,ImagePtr^);
            END;

          { Bring the menu box image in from the heap: }
          PutImage(M1X,M1Y,ImagePtr^,NormalPut);
          PointerOn;  { We need the pointer on to bounce the bar }

          { Now we enter the "bounce loop" that moves the bounce bar  }
          {  up and down the menu box, attached to the mouse pointer: }
          UpperBound := 12; LowerBound := 24; Pick := 0;
          REPEAT
            PollMouse(PointerX,PointerY,Left,Center,Right);
            { If the pointer leaves the menu box, it's an "escape" }
            {   identical in effect to pressing the right button:  }
            IF (PointerX < M1X) OR (PointerX > M2X) OR
               (PointerY > M2Y) THEN Right := True
            ELSE
              BEGIN
              IF PointerY < UpperBound THEN   { We bounce the bar UPWARD: }
                IF PointerY > 12 THEN   { If we're not above the top line }
                  BEGIN
                    PointerOff;
                    { Erase bar at current position if item is active: }
                    IF ItemList[Pick].ItemActive THEN
                      PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
                    { Decrement bounds and pick number: }
                    UpperBound := UpperBound - 12;
                    LowerBound := LowerBound - 12;
                    Pick := Pick - 1;
                    { Show bar at new position if item is active: }
                    IF ItemList[Pick].ItemActive THEN
                      PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
                    PointerOn;
                  END;
              IF PointerY > LowerBound THEN
                BEGIN
                  PointerOff;
                  { Erase bar at current position if item is active: }
                  IF ItemList[Pick].ItemActive THEN
                    PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
                  { Increment bounds and pick number: }
                  UpperBound := UpperBound + 12;
                  LowerBound := LowerBound + 12;
                  Pick := Pick + 1;
                  { Show bar at new position if item is active: }
                  IF ItemList[Pick].ItemActive THEN
                    PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
                  PointerOn;
                END;
              END;
          UNTIL (NOT Left) OR Right;
          RestoreUnderMenuBox;
          { Now we set up the function return code.  The right button  }
          { always indicates "escape;" i.e., 0; Take No Action.        }
          { Picking an inactive menu item also returns a 0.  An active }
          { item returns its item code as the function result. }
          IF Right THEN ReturnCode := 0
            ELSE IF ItemList[Pick].ItemActive THEN
                    ReturnCode := ItemList[Pick].ItemCode
                 ELSE ReturnCode := 0
        END;  { WITH statement }
      PointerOn;
    END;
  SetColor(SaveColor);   { Restore caller's drawing color }
END;

{ No initialization section...}

END.