色の使い方(3) グラデーションを描く[2]

Tip&解説

色の使い方(2) グラデーションを描く [1]では予約色以外の色使う方法を説明しました。しかし前回のコードはアプリケーションが起動されてから終わるまで同じパレットを使いました。実は，アプリケーションを実行中にフォームのパレットが変わる場合，つまり実行中に新しい色が欲しくなった場合はもう少しテクニックが必要になります。

今度はもう少し色を増やして 200色のグラデーションに挑戦してみましょう。ボタンが2個有って，片方は赤の 200色のグラデーションを，もう片方は緑の２００色のグラデーションを表示するアプリケーションを作ります。

ソースを以下に示します

List 1

unit Tips016_03_frm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    DisplayGreenGradation: Boolean;
    hPalRed, hPalGreen: HPALETTE;
  protected
    function GetPalette: HPALETTE; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.GetPalette: HPALETTE;
begin
  if DisplayGreenGradation then
    Result := hPalGreen
  else
    Result := hPalRed;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DisplayGreenGradation := True;
  Invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DisplayGreenGradation := False;
  Invalidate;
end;


procedure TForm1.FormCreate(Sender: TObject);
var pPal: ^TLogPalette;
    i: Integer;
begin
  // パレット作成のための200色分のパラメータ用メモリを確保
  GetMem(pPal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * (200-1));

  pPal^.palNumEntries := 200; // 色数を設定
  pPal^.palVersion := $0300; // おまじない

  // 色を設定。
  for i := 0 to 199 do begin
    pPal.palPalEntry[i].peRed   := 50 + i;
    pPal.palPalEntry[i].peGreen := 0;
    pPal.palPalEntry[i].peBlue  := 0;
    pPal.palPalEntry[i].peFlags := 0;
  end;

  // パレットを作る。
  hPalRed := CreatePalette(pPal^);

  // 色を設定。
  for i := 0 to 199 do begin
    pPal.palPalEntry[i].peRed   := 0;
    pPal.palPalEntry[i].peGreen := 50 + i;
    pPal.palPalEntry[i].peBlue  := 0;
    pPal.palPalEntry[i].peFlags := 0;
  end;

  // パレットを作る。
  hPalGreen := CreatePalette(pPal^);

  // パラメータ用メモリを廃棄
  FreeMem(pPal);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteObject(hPalRed);
  DeleteObject(hPalGreen);
end;

procedure TForm1.FormPaint(Sender: TObject);
var x, y: Integer;
    OldPal: HPALETTE;
begin
  if DisplayGreenGradation then
    OldPal := SelectPalette(Canvas.Handle, hPalGreen, True)
  else
    OldPal := SelectPalette(Canvas.Handle, hPalRed, True);

  RealizePalette(Canvas.Handle);

  for x := 0 to 199 do
    for y := 0 to 255 do
      Canvas.Pixels[x, y] := PaletteIndex(x);

  SelectPalette(Canvas.Handle, OldPal, True);

end;


end.

前の Tipsをお読みになったならこのプログラムの行っていることはだいたいお判りかと思います。このプログラムではフォームが作成される時にパレットを赤のグラデーション用と緑のグラデーション用の2個パレットを作ります。どちらを描くかはフォームの中 Private な変数 DisplayGreenGradation で決めるようにしています。

List 2

type
  TForm1 = class(TForm)
   :
   :
  private
    DisplayGreenGradation: Boolean;
   :
   :
  end;

VCL にパレットを通知する GetPalette メソッドは以下のようになっています。

List 3

function TForm1.GetPalette: HPALETTE;
begin
  if DisplayGreenGradation then
    Result := hPalGreen
  else
    Result := hPalRed;
end;

この処理は完璧で何の問題もありません。

そして描画は DisplayGreenGradation を見ながら，以下のように赤と緑のグラデーションを描きわけています。

List 4

procedure TForm1.FormPaint(Sender: TObject);
var x, y: Integer;
    OldPal: HPALETTE;
begin
  // 赤又は緑のパレットを選択／実体化
  if DisplayGreenGradation then
    OldPal := SelectPalette(Canvas.Handle, hPalGreen, True)
  else
    OldPal := SelectPalette(Canvas.Handle, hPalRed, True);

  RealizePalette(Canvas.Handle);

  // 描画。ここでは PaletteIndex 形式の色値を使用
  for x := 0 to 199 do
    for y := 0 to 255 do
      Canvas.Pixels[x, y] := PaletteIndex(x);

  SelectPalette(Canvas.Handle, OldPal, True);

end;

これも完璧です。しかしこのプログラムはうまく動きません。

このプログラムを起動すると最初は DisplayGreenGradation は False ですから，赤のグラデーションが表示されます。これはうまく行きます。

起動直後の状態

しかし，ここで Button1 を押して緑のグラデーションに変えようとするとうまく行きません。

Button1 を押すと

何が足りないのでしょうか？答えは簡単です。パレットが変わったことが VCL に伝わっていないのです。

前の Tipsではフォームの GetPalette を override して VCL にフォームがパレットを持っていることを伝えました。確かにこのアプリケーションの立ち上げ時には赤いグラデーションが正しく表示されます。これはフォームが表示される前にパレットを作っているからうまく行っているのです。この場合，表示時に VCL は GetPalette を使ってフォームのパレットを読み適切な処置をしてくれます。しかしフォームがいったん表示された後にパレットが変わったことを VCL に通知するにはフォームの PaletteChanged メソッドを使わなくてはなりません。

以下のようにパレットを切り替える部分を書き換えればうまく行きます。

List 5

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DisplayGreenGradation = False then begin
    DisplayGreenGradation := True;
    PaletteChanged(True); // これを挿入
    Invalidate;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if DisplayGreenGradation = True then begin
    DisplayGreenGradation := False;
    PaletteChanged(True); // これを挿入
    Invalidate;
  end;
end;

Button1 を押すと

何故 PaletteChanged を呼べばうまく行くのかを理解するにはパレットに関する深い理解が必要です。詳しくは Inside VCL 2.6 のパレットを読んでみてください。

また，取り敢えず使えればいいやという方はフォームのパレットを変更したら PaletteChanged(True) を呼べばよいということだけ覚えておいてください。

Tips １8に続く