写一个调色板控件(1)

给朋友写了一个HD6845显示芯片图形处理工具。里面要用到直观的调色板，查看delphi现有的控件，发现没有很实用的，于是就动手写了一个。写着写着，感觉把它功能扩展一下会更好，更合适这个工具的运用。

软件开发完成后的界面：

控件运用：上图带小格子的都是（图1，图2，图3，彩图，调色板，可用色彩）。

别为那些粗大的方格担心，网上可以查到很多HD6845芯片的资料。如果看不明白，可以查任天堂游戏机（红白机）；查6502CPU也是个不错主意，苹果2代个人电脑用的也是HD6845显示芯片，用的是字符模式。我这个软件针对HD6845的图形模式，是为特定的硬件（IC板）写的，所以对绝大数人来说：没用！这里只是分享控件一下开发过程。更准确的说是记录控件开发过程，写点心得。

开发工具：delphi Xe10.2
初期规划：写一个16X16小格的色盘，显示0~255个颜色，可以选取更改色格中颜色，显示R,G,B值。控件从TPaintBox继承，控件名：TPaletteBoxVCL。

delphi Xe 10.1以前有个Bug，就是它：

当你的IDE这个位置显示控件时（用多了delphi 7的人就这习惯），那么在新建控制时，就会报错，所以关了它，并习惯在右下角找控件。

建立后，马上就后悔了，我不需要TPaintBox.Paint这个过程，而这是我要改动最大的地方。于是手动更改从TGraphicControl继承，再上去是TControl，那会累死，TGraphicControl刚刚好。

加上两个最重要过程：Create, Paint。后面跟上override是必须的。然后代码实现第一个目标：画上16X16个小正方形，每个正方形之间隔2个象素，正方形大小根据控件的宽高自动调整大小，paint代码如下：

procedure TPaletteBoxVCL.Paint;
var
  i, j: integer;
  Pw, Ph: integer;
  R: TRect;
begin
  Pw := (Width - 2) div 16; // 留边 2Pix
  Ph := (Height - 2) div 16;
  Pw := min(Pw, Ph);
  Pw := Pw - 2; // 相距 2PIX
  Ph := Pw;

  Canvas.Pen.Color:=clGray;
  Canvas.Brush.Color := clbtnFace;
  Canvas.Rectangle(0, 0, Width, Height);

  Canvas.Brush.Color := clGray;

  Canvas.Pen.Width:=1;
  for i := 0 to 15 do begin
    R := RECT(0, 0, Pw, Ph);
    R.Offset(2, 2);
    R.Offset(0, i*(Ph+2));
    for j := 0 to 15 do begin
      Canvas.Rectangle(R.Left, R.Top, R.Right,R.Bottom);
      R.Offset(Pw+2, 0);
    end;
  end;
end;

用到TRect，颜色，和min函数，要加上引用单元：Winapi.windows， Vcl.Graphics, System.math。新建单元测试如下：

接下来要实现每个方格要显示颜色。由于程序特殊性：通过两个二进制文件合成RGB值。所以定义一个新的数据结构:

  TRGBColor = packed record
    case Integer of
    0:(
      R,G,B,A: Byte;
      );
    1:(C:Dword);
  end;

packed 一定要用上，强制对齐，否则转换成TColor时，R,G,B会搞得晕头转向。
定义一个数组：FPaletteBin: array [0 .. 16*16-1] of TRGBColor;
增加一个设置颜色公用过程：procedure SetColor(index:integer;Color:Dword);
增加一个读取颜色函数：function GetColor(index:integer):TRGBColor;
不把这两东东合成一个叫Color的属性，因为Color会产生异议，还有设置颜色时，直接丢个Dword进去，感觉更方便些。这两个代码很简单：

function TPaletteBoxVCL.GetColor(index: integer): TRGBColor;
begin
  result:=FPaletteBin[Index];
end;

procedure TPaletteBoxVCL.SetColor(index: integer; Color: Dword);
begin
  FPaletteBin[index].C:=Color;
  Paint;
end;

如果循环调用SetColor，会不停的调用Paint，就会出现效率和闪烁问题。这是个病得治。增加BeginUpdate，EndUpdate过程，解决效率问题。闪烁很好处理，Paint加个Bitmap就行了。

constructor TPaletteBoxVCL.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanDraw:=true;
end;

procedure TPaletteBoxVCL.Paint;
  function RGBtoColor(R,G,B:Byte):TColor;
  begin
    result:=TColor((B shl 16) +(G shl 8)+R);
  end;
var
  i, j, a: integer;
  Pw, Ph: integer;
  R: TRect;
  BMP:TBitmap;//使用TBitmap 正确引用顺序：Winapi.windows，  Vcl.Graphics 
              //windows 中定义：TBitmap = tagBITMAP;是个数据结构，delphi调用顺序是一切向后看
begin
  if not FCanDraw then exit;
  BMP:=TBitmap.Create;   //防闪烁
  BMP.Width:=Width;
  BMP.Height:=Height;

  Pw := (Width - 2) div 16; // 留边 2Pix
  Ph := (Height - 2) div 16;
  Pw := min(Pw, Ph);
  Pw := Pw - 2; // 相距 2PIX
  Ph:= Pw;

  with BMP do begin
    Canvas.Pen.Color:=clGray;
    Canvas.Brush.Color := clbtnFace;
    Canvas.Rectangle(0, 0, Width, Height);

    Canvas.Brush.Color := clGray;

    Canvas.Pen.Width:=1;
    a:=0;
    for i := 0 to 15 do begin
      R := RECT(0, 0, Pw, Ph);
      R.Offset(2, 2);
      R.Offset(0, i*(Ph+2));
      for j := 0 to 15 do begin
        Canvas.Pen.Color:=clGray;
        Canvas.Brush.Color := RGBtoColor(FPaletteBin[a].R,FPaletteBin[a].G,FPaletteBin[a].B);
        Canvas.Rectangle(R.Left, R.Top, R.Right,R.Bottom);
        R.Offset(Pw+2, 0);

        inc(a);
      end;
    end;
  end;

  Canvas.Draw(0,0,BMP);
  BMP.Free;
end;

写一个小小测试：

procedure TForm3.Button1Click(Sender: TObject);
var
  i:integer;
begin
  PaletteBoxVCL1.BeginUpdate;
  for i :=0 to 255 do
    PaletteBoxVCL1.SetColor(i,$FF0000);
  PaletteBoxVCL1.EndUpdate;
end;

达到目标。(暂停)