RG VEDA

カラーダイアログのバグ

Delphiにはいくつかのコモンダイアログがラッピングされてクラスとして提供されています。この中の TColorDialog にはバグがあり(VCLのバグなのかコモンコントロールのバグかは不明)、「作成した色」をクリックしてから、エディットボックスで直接RGBを変更すると、 TColorDialog.Colorが不正な数値になってしまいます。(FFBBGGRRという形になり、これを使用すると真っ黒になってしまう)
このため、カラーダイアログからの戻り値を取る場合、FFの部分を取り除かなければなりません。その為の関数を書いてみましょう。ついでなのでclBackGroundなどの特殊な色もRGB値に変換できるような関数にしてみました。

function GetTrueColor(Color: TColor): TColor;
begin
  Result := Color shr $18;
  case Color of
    $01..$02:Result := Color;
    $80     :Result := ColorToRGB(Color);
    else
      Result := Color xor (Result shl $18);
  end;
end;

ただし、TColorDialog から派生させたコンポで処理すれば、毎回この関数を呼び出す必要もありません。

unit FixColorDialog;

interface

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

type
  TFixColorDialog = class(TColorDialog)
  private
    { Private 宣言 }
    function GetColor: TColor;
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
  published
    { Published 宣言 }
    property Color read GetColor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Dialogs', [TFixColorDialog]);
end;

function GetTrueColor(Color: TColor): TColor;
begin
  Result := Color shr $18;
  case Color of
    $01..$02:Result := Color;
    $80     :Result := ColorToRGB(Color);
    else
      Result := Color xor (Result shl $18);
  end;
end;

{ TFixColorDialog }

function TFixColorDialog.GetColor: TColor;
begin
  Result := GetTrueColor(inherited Color);
end;

end.

Back Prev