写一个调色板控件(2)

HD6845图形模式，一个图片块（8X8象素组成的一个小图片，称为Tile）最多只能支持8种颜色，整个屏幕最多可显示64种颜色。这点和任天堂红白机不太一样。差不多用一个星期的工作日时间，改写RAM、内存数据，查资料，并通过获得的数据，推算出结果，在IC板上确认。最终结果就是：一个Tile最多8种颜色，整个屏幕64色。CRT显示管拍照方式无法找到正确颜色显示值，最终只能采取近似的方法确定：R,G,B的颜色值只能取 $0, $40,$BF, $FF,这4个。组合成的64色，如下图：
（图一）
用Tile显示图形字符时，如显示A时会出下面这的情况：
一个或者多Tile组成。（图二）

控件必须要有上面两种功能！！
那么接下来的目标是要实现：定义行列个数；每个小正方形之间的间隔可调整，8X8个小正方形之间在用粗线分开(直观的显示出Tile)。
控件要增加属性Row，Col，相应的定义：FPaletteBin：: array [0 .. 16*16-1] of TRGBColor就要改变了，跟据实际需要，4X4个TILE(32X32个小正方形)完全能够满足需要，那么数组就改为：FPaletteBin：: array [0 .. 32*32-1] of TRGBColor。为了方便操作增加一个私有变量：PalCount：共有多少个小正方形：

private
    FPalCount: Integer;
published
    property Col: Integer read FCol write SetCOL;  //不能write FCol因为FCol有最大限制
    property Row: Integer read FRow write SetRow;
……
constructor TPaletteBoxVCL.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanDraw:=true;

  FCol := 16;  //初始值
  FRow := 16;
end;

procedure TPaletteBoxVCL.SetCol(const Value: Integer);
begin
  if Value > 0 then begin
    if (Value * FRow) <= 1024 then begin
      FCol := Value;
      FPalCount := FCol * FRow;
      Paint;
    end;
  end;
end;

procedure TPaletteBoxVCL.SetRow(const Value: Integer);
begin
  if Value > 0 then begin
    if (FCol * Value) <= 1024 then begin
      FRow := Value;
      FPalCount := FCol * FRow;
      Paint;
    end;
  end;
end;

接下来就要改Paint里面代码了。分三步走：
第一步，按设定的Col,Row画控件：这个很简单（见 16 改为 FCol 或 FRow）
将Pw := (Width - 2) div 16 改为 ： Pw := (Width - 2) div FCol
Ph := (Height - 2) div 16 改为： Ph := (Height - 2) div FRow;
for i := 0 to 15 do begin 改为：for i := 0 to Row-1 do begin
for j := 0 to 15 do begin 改为:for j := 0 to Col-1 do begin 就OK了。
第二步，实现可调整间隔，在这这前代码，间隔值是默认为2。需将它改为属性变量。

published
    property Interval: Integer read FInterval write SetInterva;
……
//初始值 2 代码略
procedure TPaletteBoxVCL.SetInterva(const Value: Integer);
begin
  if Value >= 0 then begin
    FInterval := Value;
    Paint;   //设计期间立即看到效果
  end;
end;    

同时更改 Paint 内代码：见 2 改为 FInterval ；同时增加FInterval ：= 0 只画细线。更改后代码：

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;
begin
  if not FCanDraw then exit;
  BMP:=TBitmap.Create;   //防闪烁
  BMP.Width:=Width;
  BMP.Height:=Height;

  Pw := (Width - FInterval) div FCol; // 留边 2Pix
  Ph := (Height - FInterval) div FRow;
  Pw := min(Pw, Ph);
  Pw := Pw - FInterval; // 相距 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 Row-1 do begin
      R := RECT(0, 0, Pw, Ph);
      R.Offset(FInterval, FInterval);
      R.Offset(0, i*(Ph+FInterval));
      for j := 0 to Col-1 do begin
        Canvas.Pen.Color:=clGray;
        Canvas.Brush.Color := RGBtoColor(FPaletteBin[a].R,FPaletteBin[a].G,FPaletteBin[a].B);
          if FInterval > 0 then  //加判断
            Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom)
          else begin //新增代码 间隔为 0 ，画线， 
            Canvas.FillRect(RECT(R.Left + 1, R.Top + 1, R.Right, R.Bottom));
            if i = 0 then begin // 顶上一根线
              Canvas.MoveTo(R.Left, R.Top);
              Canvas.LineTo(R.Right, R.Top);
            end;
            if j = 0 then begin
              Canvas.MoveTo(R.Left, R.Top);
              Canvas.LineTo(R.Left, R.Bottom);
            end;

            Canvas.MoveTo(R.Left, R.Bottom);
            Canvas.LineTo(R.Right, R.Bottom);

            Canvas.MoveTo(R.Right, R.Top);
            Canvas.LineTo(R.Right, R.Bottom);

          end;
        R.Offset(Pw+FInterval, 0);
        inc(a);
      end;
    end;
  end;

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

每三步：8X8之间用粗线分隔，一个8X8就是一个Tile,为了以后方便使用增加一个属性：ShowTile：boolean。定义略过， 为方便维护，不加入原有循环中，代码如下：

procedure TPaletteBoxVCL.Paint;
……
  with BMP do begin
  ……
    if (FInterval = 0) and FShowTile then begin
      Canvas.Pen.Width := 2;
      Canvas.Pen.Color := clGray;
      for i := 1 to (FCol div 8) - 1 do begin
        Canvas.MoveTo(i * 8 * Pw, 0);
        Canvas.LineTo(i * 8 * Pw, Ph * FRow);
      end;
      for i := 1 to (FRow div 8) - 1 do begin
        Canvas.MoveTo(0, i * 8 * Ph);
        Canvas.LineTo(Ph * Col, i * 8 * Ph);
      end;
    end;
  end;
  Canvas.Draw(0,0,BMP);
  BMP.Free;
end;

实现目标：

图一的实现：
属性设置： Col：16，Row：4；Interval：2；
代码：

procedure TForm3.Button1Click(Sender: TObject);
  function RGBtoColor(R, G, B: Byte): Dword;
  begin
    result := (B shl 16) + (G shl 8) + R;
  end;
const
  Cs: array [0 .. 3] of Byte = ($0, $40, $BF, $FF);
var
  i, j, k, a: Integer;
  Cl: TColor;
begin
  a := 0;
  PaletteBoxVCL1.BeginUpdate;
  for i := 0 to 3 do
    for j := 0 to 3 do
      for k := 0 to 3 do begin
        Cl := RGBtoColor(Cs[k], Cs[j], Cs[i]);
        PaletteBoxVCL1.SetColor(a, Cl);
        inc(a);
      end;
  PaletteBoxVCL1.EndUpdate;
end;