home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DISKVR20.ZIP / SCOLOR.200 < prev    next >
Encoding:
Text File  |  1986-02-07  |  7.1 KB  |  160 lines
  1. {**********************************************************************}
  2. {*          S C O L O R . I N C   :    Select Color from palette      *}
  3. {*                                                                    *}
  4. {*               Separate this file into SCOLOR.200                   *}
  5. {**********************************************************************}
  6. {----------------------------------------------------------------------}
  7. {      S e l e c t _ C o l o r  : Ask for Color and Return Attribute   }
  8. {----------------------------------------------------------------------}
  9. { Ask user to choose a color foreground and background and return the  }
  10. { attribute.                                                           }
  11. { Input:   Attribute at which to position the first Cursor             }
  12. { Output:  Atribute selection by the user or Zero                      }
  13. {**********************************************************************}
  14. Procedure Select_Color(Var Attr: byte) ;
  15.    Const
  16.        Arr_Up    = 72 ;
  17.        Arr_Dn    = 80 ;
  18.        Arr_Right = 77 ;
  19.        Arr_Left  = 75 ;
  20.        Return    = 13 ;
  21.        Esc       = 27 ;
  22.    Var
  23.        Fieldwidth,
  24.        ColorMatrixX,ColorMatrixY,
  25.        Background,
  26.        Foreground
  27.                            :integer;
  28.        ch                  :char;
  29.        Old_Attr,
  30.        Old_Text,
  31.        Old_background,
  32.        Chval               :byte;
  33. {----------------------------------------------------------------------}
  34. {   B l i n k  the Cursor Position On/Off                              }
  35. {----------------------------------------------------------------------}
  36.  Procedure Blink_Off;                  { Turn off blinking             }
  37.    Var
  38.       x,y :integer;
  39.    Begin
  40.    x := WhereX; y := WhereY;           { Save old cursor position      }
  41.    For I := x to x+FieldWidth-1 do
  42.       Begin
  43.       GotoXY(I,y);BlinkChar(Off);
  44.       end;
  45.    GotoXY(x,y);                        { Restore old cursor position   }
  46.    End;
  47.  
  48.  Procedure Blink_On;                   { Turn off blinking             }
  49.    Var
  50.       x,y :integer;
  51.    Begin
  52.    x := WhereX; y := WhereY;           { Save old cursor position      }
  53.    For I := x to x+FieldWidth-1 do
  54.       Begin
  55.       GotoXY(I,y);BlinkChar(On);
  56.       end;
  57.    GotoXY(x,y);                        { Restore old cursor position   }
  58.    End;
  59.  
  60. {----------------------------------------------------------------------}
  61. {      Move_Right_Left_Up_Dn : Cursor Move Routines                    }
  62. {----------------------------------------------------------------------}
  63. Procedure Move_Right;                  { Move Cursor right one position}
  64.    Begin                               { Restore unblinking attributes }
  65.    Blink_Off;                          { to old cursor postion         }
  66.    ColorMatrixX :=(ColorMatrixX + FieldWidth);
  67.    If ColorMatrixX > 16*Fieldwidth then ColorMatrixX := Fieldwidth;
  68.    GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
  69.    Blink_On;                          { set blinking attribute        }
  70.    End; {Move_Right}
  71.  
  72. Procedure Move_Left;                   { Move Cursor Left one position }
  73.    Begin                               { Restore unblinking attributes }
  74.    Blink_Off;                          { to old cursor postion         }
  75.    ColorMatrixX := ColorMatrixX - FieldWidth;
  76.    If (ColorMatrixX < FieldWidth) then
  77.        ColorMatrixX := FieldWidth*16;
  78.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  79.    Blink_On;                           { set blinking attribute        }
  80.    End; {Move_Left}
  81.  
  82. Procedure Move_Up;                     { Move up one Row               }
  83.   Begin                                { Restore unblinking attributes }
  84.    Blink_Off;                          { to old cursor postion         }
  85.    ColorMatrixY := ColorMatrixY - 1;
  86.    If ColorMatrixY < 4 then ColorMatrixY := 4+7;
  87.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  88.    Blink_On;                           { set blinking attribute        }
  89.   end; {Move_Up}
  90.  
  91. Procedure Move_Down;                   { Move Down one Row             }
  92.    Begin                               { Restore unblinking attributes }
  93.    Blink_Off;                          { to old cursor postion         }
  94.    ColorMatrixY := ColorMatrixY + 1;
  95.    If ColorMatrixY > 4+7 then colorMatrixY := 4;
  96.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  97.    Blink_On;                           { set blinking attribute        }
  98.    end; {Move_Down}
  99.  
  100. Procedure Selected;                    { Pass back selected attribute  }
  101.    Begin
  102.    Blink_Off;                          { Turn off any linking          }
  103.    Get_Abs_Cursor(x,y);
  104.    Attr :=                             { Get old Cursor attributes     }
  105.         Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  106.    End; {Procedure Selected }
  107. {-----------------------------------------------------------------------}
  108. {      M a i n  P r o c e d u r e  : Select Color and Return Attribute  }
  109. {-----------------------------------------------------------------------}
  110. Begin {Select_Color}
  111.  
  112.   Old_Attr := Attr;                           { Save old Attributes  }
  113.   Old_Text := Attr and $0F;
  114.   Old_background := Attr shr 4;
  115.   Get_Abs_Cursor(x,y);                        { Find Cursor and make }
  116.   MkWin(4,y,74,y+16,1,Old_Text,Old_Background);    { a window/Set Color   }
  117.  
  118.   Fieldwidth := 4;                            { Colors Display Width }
  119.   TextColor(Old_Text);
  120.   clrscr;
  121.   GotoXY(14,1);  write('* * *   Move Cursor to Select Colors   * * *');
  122.   GotoXY(14,2);  write('Enter ');
  123.   TextColor(Old_Text+Blink);Write('[Return]');
  124.   TextColor(Old_Text);Write(' to select -- ');
  125.   TextColor(Old_Text+Blink); Write('[Esc]');
  126.   TextColor(Old_Text); Writeln(' to Ignore');
  127.   ColorMatrixX := WhereX; ColorMatrixY := WhereY;
  128.   For Background:=0 to 7 do            { Background Color attributes   }
  129.     Begin
  130.     for Foreground:=0 to 15 do         { Foreground Color attributes   }
  131.       begin                            { Display the Color matrix      }
  132.       gotoxy(Fieldwidth*(Foreground+1),Background+4); { display posn }
  133.       textcolor(Foreground);
  134.       textbackground(Background);
  135.       write(Foreground:Fieldwidth-1);
  136.       end; { Forground}
  137.   Writeln;
  138.   end; { Background }
  139.                                           { Put Cursor at Old Attriute }
  140.   ColorMatrixX := Fieldwidth * (Old_Text)+Fieldwidth;
  141.   ColorMatrixY := 4 + (Old_background);
  142.   GotoXY(ColorMatrixX,ColorMatrixY);      { Position the Cursor        }
  143.   Chval := 0;
  144.  
  145.   Repeat {until Chval=Return|Esc key}     { Get an attribute selection }
  146.   Chval := Keyin;                         { Wait for user key          }
  147.   Case Chval of
  148.        Arr_Right   : Move_Right;
  149.        Arr_Left    : Move_Left;
  150.        Arr_Up      : Move_Up;
  151.        Arr_Dn      : Move_Down;
  152.        Return      : Selected;
  153.        Esc         :
  154.   else Beep;
  155.   end; {case Chval}
  156.   Until (Chval=Return) or (Chval=Esc);
  157.   RmWin;                                  { Remove the Color Window    }
  158. end; {Select_Color}
  159. {.......................................................................}
  160.