home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / COLRMENU.ZIP / COLORS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-09-25  |  10.8 KB  |  435 lines
  1. {*****************************************************************************}
  2. {* Author : Andrew Phillips                                                  *}
  3. {* Date   : 9-25-1989                                                        *}
  4. {*                                                                           *}
  5. {* Program: COLORS.PAS   A unit designed to build a color selection menu.    *}
  6. {*****************************************************************************}
  7.  
  8. UNIT Colors;
  9.  
  10. INTERFACE
  11.  
  12. USES TpMOUSE,TpWINDOW,TpCRT;
  13.  
  14.     PROCEDURE ColorMenu (X, Y: byte;
  15.                          UseExplode,UseSound,UseShadow : boolean;
  16.                      VAR Color : Byte;
  17.                      VAR ChangeColor : boolean);
  18.  
  19. IMPLEMENTATION
  20.  
  21. PROCEDURE GotoMouse;
  22.  
  23.     BEGIN
  24.  
  25.          GotoXY(MouseWhereX,MouseWhereY);
  26.  
  27.     END;
  28.  
  29. PROCEDURE Display_Error(error : word);
  30.  
  31.     BEGIN
  32.  
  33.          CASE Error OF
  34.  
  35.               1 : writeln ('Menu cannot be made.');
  36.               2 : writeln ('Menu cannot be displayed.');
  37.  
  38.               END;
  39.  
  40.          Exit
  41.  
  42.     END;
  43.  
  44.  
  45. PROCEDURE Get_Color(VAR Color : byte);
  46.  
  47.     BEGIN
  48.  
  49.          Color := ReadAttrAtCursor
  50.  
  51.     END;
  52.  
  53. PROCEDURE Left_Arrow;
  54.  
  55.     BEGIN
  56.  
  57.          GotoMouse;
  58.          GotoXY(WhereX-1,WhereY);
  59.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  60.  
  61.     END;
  62.  
  63. PROCEDURE Right_Arrow;
  64.  
  65.     BEGIN
  66.  
  67.          GotoMouse;
  68.          GotoXY(WhereX+1,WhereY);
  69.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  70.  
  71.     END;
  72.  
  73. PROCEDURE Up_Arrow;
  74.  
  75.     BEGIN
  76.  
  77.          GotoMouse;
  78.          GotoXY(WhereX,WhereY-1);
  79.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  80.  
  81.     END;
  82.  
  83. PROCEDURE Down_Arrow;
  84.  
  85.     BEGIN
  86.  
  87.          GotoMouse;
  88.          GotoXY(WhereX, WhereY+1);
  89.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  90.  
  91.     END;
  92.  
  93. PROCEDURE Home_Key;
  94.  
  95.     BEGIN
  96.  
  97.          GotoMouse;
  98.          GotoXY(WhereX-1,WhereY-1);
  99.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  100.  
  101.     END;
  102.  
  103. PROCEDURE Pg_Up;
  104.  
  105.     BEGIN
  106.  
  107.          GotoMouse;
  108.          GotoXY(WhereX+1,WhereY-1);
  109.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  110.  
  111.     END;
  112.  
  113. PROCEDURE End_Key;
  114.  
  115.     BEGIN
  116.  
  117.          GotoMouse;
  118.          GotoXY(WhereX-1,WhereY+1);
  119.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  120.  
  121.     END;
  122.  
  123. PROCEDURE Pg_Dn;
  124.  
  125.     BEGIN
  126.  
  127.          GotoMouse;
  128.          GotoXY(WhereX+1,WhereY+1);
  129.          IF MouseInstalled THEN MouseGotoXY(WhereX,WhereY)
  130.  
  131.     END;
  132.  
  133. PROCEDURE ColorMenu (
  134.          X, Y: byte;
  135.                  UseExplode,UseSound,UseShadow : boolean;
  136.          VAR Color : Byte; VAR ChangeColor : boolean);
  137.  
  138.     LABEL
  139.          Here, There;
  140.  
  141.     CONST
  142.          MouseLeft    = 239;
  143.          MouseRight   = 238;
  144.          UpArrow      = 72;
  145.          DownArrow    = 80;
  146.          LeftArrow    = 75;
  147.          RightArrow   = 77;
  148.          CR           = 13;
  149.          SPC          = 32;
  150.          ESC          = 27;
  151.          HOME         = 71;
  152.          ENDKEY       = 79;
  153.          PgUP         = 73;
  154.          PgDN         = 81;
  155.  
  156.     VAR
  157.          xy,scan : word;
  158.          Colors  : WindowPtr;
  159.          i, j    : byte;
  160.          backg   : byte;
  161.          FOReg   : Byte;
  162.          Attr    : Byte;
  163.          Code    : Word;
  164.          HiCode  : Byte;
  165.          LoCode  : Byte;
  166.  
  167.     BEGIN
  168.  
  169.          GetCursorState(XY,scan);
  170.          IF MouseInstalled THEN
  171.          EnableEventHandling;          {Activate Mouse               }
  172.          HiddenCursor;                 {Turn off Hardware Cursor     }
  173.  
  174.  
  175.    {Make the Window}
  176.  
  177.          IF (X+16 > 80) or (Y+8>25) or (X < 1) or (X < 1) THEN
  178.  
  179.               BEGIN
  180.  
  181.                    X := 1;
  182.                    Y := 1;
  183.  
  184.               END;
  185.  
  186.          Explode    := UseExplode;
  187.          Shadow     := UseShadow;
  188.          SoundFlagW := UseSound;
  189.          ShadowAttr := $07;
  190.  
  191.          IF not MakeWindow(
  192.               Colors,
  193.               X,Y,X+17,Y+9,
  194.               True,True,False,
  195.               $0E,$0E,$0E,
  196.               '╡Colors╞'   )           THEN Display_Error(1); {Cannot Make   }
  197.  
  198.          IF not DisplayWindow(Colors)  THEN Display_Error(2); {Cannot Display}
  199.  
  200.          FOR backg := 0 to 7 DO
  201.          FOR Foreg := 0 to 15 DO
  202.  
  203.               BEGIN
  204.  
  205.                    Attr := ((backg*16)+Foreg);
  206.                    FastWriteWindow(#4,backg+1,Foreg+1,attr)
  207.  
  208.               END;
  209.  
  210.          IF MouseInstalled THEN
  211.  
  212.               BEGIN
  213.  
  214.                    SetMickeyToPixelRatio(16,32) ;
  215.                    MouseWindow(x+1,y+1,x+16,y+8);
  216.                    SoftMouseCursor($FF00,$0008) ;     {Set Mouse Cursor}
  217.                    ShowMouse;
  218.  
  219.               {Scan Mouse and Keyboard for Input}
  220.  
  221.               There:
  222.                    GotoXY(MouseWhereX,MouseWhereY);
  223.  
  224.                    Code   := ReadKeyOrButton;
  225.                    LoCode := Lo(Code);
  226.                    HiCode := Hi(Code);
  227.  
  228.                    IF LoCode = 0 THEN
  229.  
  230.                         CASE HiCode OF
  231.  
  232.                              CR      : ChangeColor := True;
  233.                              ESC     : ChangeColor := False;
  234.                              SPC     : ChangeColor := True;
  235.  
  236.                              UpArrow : BEGIN
  237.  
  238.                                             Up_Arrow;
  239.                                             GOTO There
  240.  
  241.                                        END;
  242.  
  243.                            LeftArrow : BEGIN
  244.  
  245.                                             Left_Arrow;
  246.                                             GOTO There
  247.  
  248.                                        END;
  249.  
  250.                           RightArrow : BEGIN
  251.  
  252.                                             Right_Arrow;
  253.                                             GOTO There
  254.                                        END;
  255.  
  256.                            DownArrow : BEGIN
  257.  
  258.                                             Down_Arrow;
  259.                                             GOTO There
  260.  
  261.                                        END;
  262.                                 Home : BEGIN
  263.  
  264.                                             Home_Key;
  265.                                             GOTO There
  266.                                        END;
  267.  
  268.                               ENDKEY : BEGIN
  269.  
  270.                                             End_Key;
  271.                                             GOTO There
  272.  
  273.                                        END;
  274.  
  275.                                 PgUp : BEGIN
  276.  
  277.                                             Pg_Up;
  278.                                             GOTO There
  279.  
  280.                                        END;
  281.  
  282.                                 PgDn : BEGIN
  283.  
  284.                                             Pg_Dn;
  285.                                             GOTO There
  286.  
  287.                                        END;
  288.  
  289.                            MouseLeft : BEGIN
  290.  
  291.                                             GotoXY(MouseWhereX,MouseWhereY);
  292.                                             ChangeColor := True;
  293.  
  294.                                        END;
  295.  
  296.                           MouseRight : ChangeColor := False
  297.  
  298.                    ELSE
  299.  
  300.                          CASE LoCode OF
  301.  
  302.                                   CR : ChangeColor := True;
  303.                                  ESC : ChangeColor := False;
  304.                                  SPC : ChangeColor := True;
  305.                               0..255 : GOTO There
  306.                          END
  307.                    END
  308.  
  309.          ELSE
  310.  
  311.               CASE LoCode OF
  312.  
  313.                        CR : ChangeColor := True;
  314.                       ESC : ChangeColor := False;
  315.                       SPC : ChangeColor := True;
  316.                    1..255 : GOTO There
  317.               END;
  318.  
  319.          GotoMouse;
  320.          Color := ReadAttrAtCursor;
  321.     END
  322.  
  323.         {No Mouse, so just scan keyboard}
  324.  
  325.     ELSE
  326.          BEGIN
  327.               Here:
  328.                    Code := ReadKeyWord;
  329.                    LoCode := Lo(Code);
  330.                    HiCode := Hi(Code);
  331.  
  332.                    IF LoCode = 0 THEN
  333.  
  334.                         CASE HiCode OF
  335.  
  336.                                  CR : ChangeColor := True;
  337.                                 ESC : ChangeColor := False;
  338.                                 SPC : ChangeColor := True;
  339.  
  340.                             UpArrow : BEGIN
  341.  
  342.                                            Up_Arrow;
  343.                                            GOTO There
  344.  
  345.                                       END;
  346.  
  347.                           LeftArrow : BEGIN
  348.  
  349.                                            Left_Arrow;
  350.                                            GOTO There
  351.  
  352.                                       END;
  353.  
  354.                          RightArrow : BEGIN
  355.  
  356.                                            Right_Arrow;
  357.                                            GOTO There
  358.  
  359.                                       END;
  360.  
  361.                           DownArrow : BEGIN
  362.  
  363.                                            Down_Arrow;
  364.                                            GOTO There
  365.  
  366.                                       END;
  367.  
  368.                                Home : BEGIN
  369.  
  370.                                            Home_Key;
  371.                                            GOTO There
  372.  
  373.                                       END;
  374.  
  375.                              EndKey : BEGIN
  376.  
  377.                                            End_Key;
  378.                                            GOTO There
  379.  
  380.                                       END;
  381.  
  382.                                PgUp : BEGIN
  383.  
  384.                                            Pg_Up;
  385.                                            GOTO There
  386.  
  387.                                       END;
  388.  
  389.                                PgDn : BEGIN
  390.  
  391.                                            Pg_Dn;
  392.                                            GOTO There
  393.  
  394.                                       END
  395.  
  396.                    ELSE
  397.                         CASE LoCode OF
  398.  
  399.                                  CR : ChangeColor := True;
  400.                                 ESC : ChangeColor := False;
  401.                                 SPC : ChangeColor := True;
  402.                              1..255 : GOTO Here;
  403.  
  404.                         END
  405.  
  406.                    END
  407.  
  408.               ELSE
  409.                    CASE LoCode OF
  410.  
  411.                             CR : ChangeColor := True;
  412.                            ESC : ChangeColor := False;
  413.                            SPC : ChangeColor := True;
  414.                         1..255 : GOTO There
  415.  
  416.                    END;
  417.  
  418.               GotoMouse;
  419.               Color := ReadAttrAtCursor;
  420.  
  421.          END;
  422.  
  423.      {Finish Up Program}
  424.  
  425.          HideMouse;
  426.          DisableEventHandling;    {De-Activate Mouse to avoid "Mouse Droppings"}
  427.          DisposeWindow(
  428.               EraseTopWindow);    {Get rid of window}
  429.          RestoreCursorState(
  430.               XY,scan);           {Reset Hardware Cursor}
  431.  
  432.     END;
  433.  
  434. END.
  435.