Краски, палитры, заполнения
Процедура GetPalette
Возвращает размер и цвета текущей палитры. Заголовок:
Procedure GetPalette(var Palettelnfo: PaletteType);
Здесь Palettelnfo – переменная типа PaletteType, возвращающая размер и цвета палитры.
В модуле Graph определена константа:
const MaxColors =15;
И тип:
type
PaletteType = record
Size: Word; {Количество цветов в палитре}
Colors: array [0..MaxColors] of Shortlnt
{Номера входящих в палитру цветов}
end;
С помощью следующей программы можно вывести на экран номера всех возможных цветов из текущей палитры.
Uses Graph;
var
Palette: PaletteType;
d,r,e,k: Integer;
begin
{Инициируем графику}
d: = Detect; InitGraph(d, r, ' ');
e: = GraphResult; if e <> grOk then
WriteLn(GraphErrorMsg(e))
else
begin
GetPalette(Palette); {Получаем палитру}
CloseGraph; {Возвращаемся в текстовый режим}
with Palette do {Выводим номера цветов}
for k: = 0 to pred(Size) do
Write(Colors[k]:5);
end
end.
Процедура SetAllPalette
Изменяет одновременно несколько цветов палитры. Заголовок процедуры:
Procedure SetAllPalette(var Palette);
Параметр Palette в заголовке процедуры описан как нетипизированный параметр. Первый байт этого параметра должен содержать длину N палитры, остальные N байты – номера вновь устанавливаемых цветов в диапазоне от -1 до MaxColors. Код -1 означает, что соответствующий цвет исходной палитры не меняется.
В следующей программе происходит одновременная смена сразу всех цветов палитры.
Uses Graph, CRT;
var
Palette: array [0..MaxColors] of Shortint;
d,r,e,k: Integer;
begin
{Инициируем графику}
d: = Detect; InitGraph(d, r, '');
e: = GraphResult; if e <> grOk then
WriteLn(GraphErrorMsg(e))
else
begin
{Выбираем толстые сплошные линии}
SetLineStyle(SolidLn, 0, ThickWidth);
{Выводим линии всеми доступными цветами}
for k: = 1 to GetMaxColor do
begin
SetColor(k);
Line(GetMaxX div 3,k*10.2*GetMaxX div 3,k*10)
end;
Palette[0]: = MaxColors; {Размер палитры}
repeat {Цикл смены палитры}
for k: = 1 to MaxColors do
Palette[k]: = Random(succ(MaxCoLors));
SetAllPalette(Palette)
until KeyPressed;
if ReadKey=#0 then k: = ord(ReadKey);
CloseGraph
end
end.