写一个调色板控件（终结）
写到这，再加上一个选择索引颜色的功能，基本实现我的要求。但控件的还有很多要素还没有加入。比如，对齐属性没有，事件一个也没有。所有的这些将在这里终结，并最后给出所有原码。
用户要设置颜色，就windows来说：就鼠标是左键点击。那么这里就得先增加几个变量，方便程序处理：
FMRect: array [0 .. 32 * 32] of TRect; //所有的小正方形所在区域
FColorIndex： Integer； //选择颜色序号
FX, FY: Integer; //鼠标坐标
当然，要处理鼠标移动和点击。
private……FMRect: array [0 .. 32 * 32] of TRect; //所有的小正方形所在区域FColorIndex: Integer; //选择颜色序号FX, FY: Integer; //鼠标坐标procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;procedure SetColorIndex(const Value: Integer);published……property ColorIndex: Integer read FColorIndex write SetColorIndex;……
implementation
……
procedure TPaletteBoxVCL.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
beginFX := X;FY := Y;
end;procedure TPaletteBoxVCL.WMLButtonDown(var Message: TWMLButtonDown);
vari: Integer;R: TRect;
beginfor i := 0 to 32 * 32 - 1 do beginif FMRect[i].Contains(Point(FX, FY)) then beginFColorIndex := i;break;end;end;inherited;
end;procedure TPaletteBoxVCL.SetColorIndex(const Value: Integer);
beginFColorIndex := Value;Paint;
end;画出选择的小正方形，也就是矩形上、左两边画白色，右、下两边画上深灰色，视觉效果就会突起：
procedure TPaletteBoxVCL.Paint;
……for j := 0 to Col - 1 do beginFMRect[A] := R;if A = FColorIndex thenIR := R; // 索引色 RECT
…… if FColorIndex<>-1 then beginCanvas.Pen.Color := clwhite;Canvas.MoveTo(IR.Left, IR.Top);Canvas.LineTo(IR.Right - FInterval, IR.Top);Canvas.MoveTo(IR.Left, IR.Top);Canvas.LineTo(IR.Left, IR.Bottom - FInterval);Canvas.Pen.Color := $A0A0A0;Canvas.MoveTo(IR.Right - FInterval, IR.Top);Canvas.LineTo(IR.Right - FInterval, IR.Bottom);Canvas.MoveTo(IR.Left, IR.Bottom);Canvas.LineTo(IR.Right - FInterval, IR.Bottom);end;end;Canvas.Draw(0, 0, BMP);BMP.Free;
end;
现在，只需实现最后一个功能：Tile用的是哪8个索引色。在写这个文章过程中，朋友提出看不太清楚程序的提示，特别是更改索引文件后。于是又加了一堆代码，实现象Ps选择区域那样的蚂蚁线，动态，且不受颜色影响，那就醒目多了，如下图：
参考试Ps的蚂蚁线，每根黑线或白钱长度为6，动作步骤为3步，每步移动两个象素。
Ps好象有两种动画画蚂蚁线，我这里只写了顺时钟旋转那种植，矩形转角时，颜色的连续和象素的连续不完美，将就着就用了。直接代码，不啰嗦了。
unit PaletteBoxVCL;interfaceusesSystem.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, System.math,Winapi.Messages, Winapi.windows, Vcl.Graphics;typeTRGBColor = packed recordcase Integer of0: (R, G, B, A: Byte;);1: (C: Dword);end;TPaletteBoxVCL = class(TGraphicControl)privateFPaletteBin: array [0 .. 32 * 32 - 1] of TRGBColor;FCanDraw: boolean;FPalCount: Integer;FCol: Integer;FRow: Integer;FInterval: Integer;FShowTile: boolean;FMRect: array [0 .. 32 * 32] of TRect; // 所有的小正方形所在区域FColorIndex: Integer; // 选择颜色序号FX, FY: Integer; // 鼠标坐标
(*画蚂蚁线变量*)FTime: TTimer;FShowIndexRect: Integer; //Tile 8色索引位置FFlowRect:TRect; //画蚂蚁线的 RECTFFlowStep: Integer; //动画步骤FlowEndColor: TColor; //黑白色控件变量
（****）procedure SetCol(const Value: Integer);procedure SetRow(const Value: Integer);procedure SetInterva(const Value: Integer);procedure SetShowTile(const Value: boolean);procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;procedure SetColorIndex(const Value: Integer);procedure SetShowIndexRect(const Value: Integer);procedure OnTimer(Sender: TObject);protectedprocedure Paint; override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;procedure SetColor(index: Integer; Color: Dword);function GetColor(index: Integer): TRGBColor;procedure BeginUpdate;procedure EndUpdate;publishedproperty Align;property Col: Integer read FCol write SetCol;property Row: Integer read FRow write SetRow;property Interval: Integer read FInterval write SetInterva;property ShowTile: boolean read FShowTile write SetShowTile;property ColorIndex: Integer read FColorIndex write SetColorIndex;property ShowIndexRect: Integer read FShowIndexRect write SetShowIndexRect;property OnClick;property OnDblClick;end;procedure Register;implementationprocedure Register;
beginRegisterComponents('redsky', [TPaletteBoxVCL]);
end;{ TPaletteBoxVCL }constructor TPaletteBoxVCL.Create(AOwner: TComponent);
begininherited Create(AOwner);FCanDraw := true;FCol := 16;FRow := 16;FInterval := 2;FShowTile := true;FColorIndex := -1;FFlowRect:=RECT(0,0,0,0);FlowEndColor := clBlack;FFlowStep := 0;FTime := TTimer.Create(self);FTime.Enabled := true;FTime.Interval := 200;FTime.OnTimer := OnTimer;
end;destructor TPaletteBoxVCL.Destroy;
beginFTime.OnTimer := nil;FTime.Enabled:=false;FTime.Free;inherited;
end;procedure TPaletteBoxVCL.Paint;function RGBtoColor(R, G, B: Byte): TColor;beginresult := TColor((B shl 16) + (G shl 8) + R);end;vari, j, A: Integer;Pw, Ph: Integer;R, IR: TRect;BMP: TBitmap;
beginif not FCanDraw then exit;BMP := TBitmap.Create; // 防闪烁BMP.Width := Width;BMP.Height := Height;Pw := (Width - FInterval) div FCol; // 留边 2PixPh := (Height - FInterval) div FRow;Pw := min(Pw, Ph);Pw := Pw - FInterval; // 相距 2PIXPh := Pw;with BMP do beginCanvas.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 beginR := RECT(0, 0, Pw, Ph);R.Offset(FInterval, FInterval);R.Offset(0, i * (Ph + FInterval));for j := 0 to Col - 1 do beginFMRect[A] := R;if A = FColorIndex thenIR := R; // 索引色 RECTif (A = FShowIndexRect) then begin // 画蚂蚁线 RECTFFlowRect := TRect.Create(R);FFlowRect.Right := FFlowRect.Left + 8 * (Pw + FInterval); //每个Tile 8种颜色FFlowRect.Right := FFlowRect.Right - 1;FFlowRect.Left := R.Left - 1;FFlowRect.Top := FFlowRect.Top - 1;FFlowRect.Bottom := FFlowRect.Bottom + 1;end;Canvas.Pen.Color := clGray;Canvas.Brush.Color := RGBtoColor(FPaletteBin[A].R, FPaletteBin[A].G, FPaletteBin[A].B);if FInterval > 0 thenCanvas.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 beginCanvas.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;if (FInterval = 0) and FShowTile then beginCanvas.Pen.Width := 2;Canvas.Pen.Color := clGray;for i := 1 to (FCol div 8) - 1 do beginCanvas.MoveTo(i * 8 * Pw, 0);Canvas.LineTo(i * 8 * Pw, Ph * FRow);end;for i := 1 to (FRow div 8) - 1 do beginCanvas.MoveTo(0, i * 8 * Ph);Canvas.LineTo(Ph * Col, i * 8 * Ph);end;end;if FColorIndex<>-1 then beginCanvas.Pen.Color := clwhite;Canvas.MoveTo(IR.Left, IR.Top);Canvas.LineTo(IR.Right - FInterval, IR.Top);Canvas.MoveTo(IR.Left, IR.Top);Canvas.LineTo(IR.Left, IR.Bottom - FInterval);Canvas.Pen.Color := $A0A0A0;Canvas.MoveTo(IR.Right - FInterval, IR.Top);Canvas.LineTo(IR.Right - FInterval, IR.Bottom);Canvas.MoveTo(IR.Left, IR.Bottom);Canvas.LineTo(IR.Right - FInterval, IR.Bottom);end;end;Canvas.Draw(0, 0, BMP);BMP.Free;
end;function TPaletteBoxVCL.GetColor(index: Integer): TRGBColor;
beginresult := FPaletteBin[Index];
end;procedure TPaletteBoxVCL.SetColor(index: Integer; Color: Dword);
beginFPaletteBin[index].C := Color;Paint;
end;procedure TPaletteBoxVCL.SetInterva(const Value: Integer);
beginif Value >= 0 then beginFInterval := Value;Paint;end;
end;procedure TPaletteBoxVCL.SetCol(const Value: Integer);
beginif Value > 0 then beginif (Value * FRow) <= 1024 then beginFCol := Value;FPalCount := FCol * FRow;Paint;end;end;
end;procedure TPaletteBoxVCL.SetRow(const Value: Integer);
beginif Value > 0 then beginif (FCol * Value) <= 1024 then beginFRow := Value;FPalCount := FCol * FRow;Paint;end;end;
end;procedure TPaletteBoxVCL.SetShowTile(const Value: boolean);
beginFShowTile := Value;Paint;
end;procedure TPaletteBoxVCL.BeginUpdate;
beginFCanDraw := false;
end;procedure TPaletteBoxVCL.EndUpdate;
beginFCanDraw := true;Paint;
end;procedure TPaletteBoxVCL.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
beginFX := X;FY := Y;
end;procedure TPaletteBoxVCL.WMLButtonDown(var Message: TWMLButtonDown);
vari: Integer;R: TRect;
beginfor i := 0 to 32 * 32 - 1 do beginif FMRect[i].Contains(Point(FX, FY)) then beginFColorIndex := i;break;end;end;inherited;
end;procedure TPaletteBoxVCL.SetColorIndex(const Value: Integer);
beginFColorIndex := Value;Paint;
end;procedure TPaletteBoxVCL.SetShowIndexRect(const Value: Integer);
beginFShowIndexRect := Value;Paint;
end;procedure TPaletteBoxVCL.OnTimer(Sender: TObject);procedure DrawFlowLine(Canvas: Tcanvas; P1, P2: TPoint; Step: Integer); //画蚂蚁线vari: Integer;A, B: Integer;P: TPoint;bb: boolean;beginif P1.X = P2.X then beginif P2.Y > P1.Y then A := P1.Y + Step * 2else A := P1.Y - Step * 2;Canvas.Pen.Color := FlowEndColor;Canvas.MoveTo(P1.X, P1.Y);Canvas.LineTo(P2.X, A);i := 0;repeatinc(i);case i mod 2 of0: Canvas.Pen.Color := FlowEndColor;1: Canvas.Pen.Color := ColorToRGB(FlowEndColor) xor $FFFFFF;end;B := A;if P2.Y > P1.Y then A := min(P2.Y, A + 6)else A := max(P2.Y, A - 6);Canvas.MoveTo(P1.X, B);Canvas.LineTo(P2.X, A);if P2.Y > P1.Y then bb := A >= P2.Yelse bb := A <= P2.Y;until bb;end;if P1.Y = P2.Y then beginif P2.X > P1.X then A := P1.X + Step * 2else A := P1.X - Step * 2;Canvas.Pen.Color := FlowEndColor;Canvas.MoveTo(P1.X, P1.Y);Canvas.LineTo(A, P2.Y);i := 0;repeatinc(i);case i mod 2 of0: Canvas.Pen.Color := FlowEndColor;1: Canvas.Pen.Color := ColorToRGB(FlowEndColor) xor $FFFFFF;end;B := A;if P2.X > P1.X then A := min(P2.X, A + 6)else A := max(P2.X, A - 6);Canvas.MoveTo(B, P1.Y);Canvas.LineTo(A, P2.Y);if P2.X > P1.X then bb := A >= P2.Xelse bb := A <= P2.X;until bb;end;end;procedure DrawFlowRECT(Canvas: Tcanvas; R: TRect); //画矩形beginDrawFlowLine(Canvas, R.TopLeft, Point(R.Right, R.Top), FFlowStep);DrawFlowLine(Canvas, Point(R.Right, R.Top), R.BottomRight, FFlowStep);DrawFlowLine(Canvas, R.BottomRight, Point(R.Left, R.Bottom), FFlowStep);DrawFlowLine(Canvas, Point(R.Left, R.Bottom), R.TopLeft, FFlowStep);end;beginif FShowIndexRect=-1 then exit;inc(FFlowStep);FFlowStep := FFlowStep mod 3;if FFlowStep = 0 thenFlowEndColor := ColorToRGB(FlowEndColor) xor $FFFFFF;DrawFlowRECT(Canvas,FFlowRect);
end;end.本文来自互联网用户投稿，文章观点仅代表作者本人，不代表本站立场，不承担相关法律责任。如若转载，请注明出处。 如若内容造成侵权/违法违规/事实不符，请点击【内容举报】进行投诉反馈！