给朋友写了一个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;
达到目标。(暂停)