Иллюстрированный самоучитель по Turbo Pascal

Краски, палитры, заполнения

Процедура 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.
Если Вы заметили ошибку, выделите, пожалуйста, необходимый текст и нажмите CTRL + Enter, чтобы сообщить об этом редактору.