写一个调色板控件(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;