写一个调色板控件（终结）

最新推荐文章于 2024-07-03 17:12:41 发布
最新推荐文章于 2024-07-03 17:12:41 发布
阅读量649 收藏
点赞数
分类专栏： delphi 控件 文章标签： 控件
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/redsky_l/article/details/77170879
版权

写到这，再加上一个选择索引颜色的功能，基本实现我的要求。但控件的还有很多要素还没有加入。比如，对齐属性没有，事件一个也没有。所有的这些将在这里终结，并最后给出所有原码。

用户要设置颜色，就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);
begin
  FX := X;
  FY := Y;
end;

procedure TPaletteBoxVCL.WMLButtonDown(var Message: TWMLButtonDown);
var
  i: Integer;
  R: TRect;
begin
  for i := 0 to 32 * 32 - 1 do begin
    if FMRect[i].Contains(Point(FX, FY)) then begin
      FColorIndex := i;
      break;
    end;
  end;
  inherited;
end;

procedure TPaletteBoxVCL.SetColorIndex(const Value: Integer);
begin
  FColorIndex := Value;
  Paint;
end;

画出选择的小正方形，也就是矩形上、左两边画白色，右、下两边画上深灰色，视觉效果就会突起：

procedure TPaletteBoxVCL.Paint;
……
      for j := 0 to Col - 1 do begin
        FMRect[A] := R;
        if A = FColorIndex then
          IR := R; // 索引色 RECT
……          
    if FColorIndex<>-1 then begin
      Canvas.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;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, System.math,
  Winapi.Messages, Winapi.windows, Vcl.Graphics;

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

  TPaletteBoxVCL = class(TGraphicControl)
  private
    FPaletteBin: 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;           //画蚂蚁线的 RECT
    FFlowStep: 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);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetColor(index: Integer; Color: Dword);
    function GetColor(index: Integer): TRGBColor;
    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property 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;

implementation

procedure Register;
begin
  RegisterComponents('redsky', [TPaletteBoxVCL]);
end;

{ TPaletteBoxVCL }

constructor TPaletteBoxVCL.Create(AOwner: TComponent);
begin
  inherited 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;
begin
  FTime.OnTimer := nil;
  FTime.Enabled:=false;
  FTime.Free;
  inherited;
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, IR: 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
        FMRect[A] := R;
        if A = FColorIndex then
          IR := R; // 索引色 RECT

         if (A = FShowIndexRect) then begin // 画蚂蚁线 RECT
          FFlowRect := 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 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;
    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;
    if FColorIndex<>-1 then begin
      Canvas.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;
begin
  result := FPaletteBin[Index];
end;

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

procedure TPaletteBoxVCL.SetInterva(const Value: Integer);
begin
  if Value >= 0 then begin
    FInterval := Value;
    Paint;
  end;
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;

procedure TPaletteBoxVCL.SetShowTile(const Value: boolean);
begin
  FShowTile := Value;
  Paint;
end;

procedure TPaletteBoxVCL.BeginUpdate;
begin
  FCanDraw := false;
end;

procedure TPaletteBoxVCL.EndUpdate;
begin
  FCanDraw := true;
  Paint;
end;

procedure TPaletteBoxVCL.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FX := X;
  FY := Y;
end;

procedure TPaletteBoxVCL.WMLButtonDown(var Message: TWMLButtonDown);
var
  i: Integer;
  R: TRect;
begin
  for i := 0 to 32 * 32 - 1 do begin
    if FMRect[i].Contains(Point(FX, FY)) then begin
      FColorIndex := i;
      break;
    end;
  end;
  inherited;
end;

procedure TPaletteBoxVCL.SetColorIndex(const Value: Integer);
begin
  FColorIndex := Value;
  Paint;
end;

procedure TPaletteBoxVCL.SetShowIndexRect(const Value: Integer);
begin
  FShowIndexRect := Value;
  Paint;
end;

procedure TPaletteBoxVCL.OnTimer(Sender: TObject);
  procedure DrawFlowLine(Canvas: Tcanvas; P1, P2: TPoint; Step: Integer);  //画蚂蚁线
  var
    i: Integer;
    A, B: Integer;
    P: TPoint;
    bb: boolean;
  begin
    if P1.X = P2.X then begin
      if P2.Y > P1.Y then A := P1.Y + Step * 2
      else A := P1.Y - Step * 2;
      Canvas.Pen.Color := FlowEndColor;
      Canvas.MoveTo(P1.X, P1.Y);
      Canvas.LineTo(P2.X, A);
      i := 0;
      repeat
        inc(i);
        case i mod 2 of
          0: 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.Y
        else bb := A <= P2.Y;
      until bb;
    end;
    if P1.Y = P2.Y then begin
      if P2.X > P1.X then A := P1.X + Step * 2
      else A := P1.X - Step * 2;

      Canvas.Pen.Color := FlowEndColor;
      Canvas.MoveTo(P1.X, P1.Y);
      Canvas.LineTo(A, P2.Y);
      i := 0;
      repeat
        inc(i);
        case i mod 2 of
          0: 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.X
        else bb := A <= P2.X;
      until bb;
    end;
  end;

  procedure DrawFlowRECT(Canvas: Tcanvas; R: TRect);   //画矩形
  begin
    DrawFlowLine(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;

begin
  if FShowIndexRect=-1 then exit;

  inc(FFlowStep);
  FFlowStep := FFlowStep mod 3;
  if FFlowStep = 0 then
  FlowEndColor := ColorToRGB(FlowEndColor) xor $FFFFFF;
  DrawFlowRECT(Canvas,FFlowRect);
end;

end.
量无海大
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
Qt开发经验总结
草上爬的博客
12-02 8145
增加了很多轮子，同时原有模块拆分的也更细致，估计为了方便拓展个管理。把一些过度封装的东西移除了（比如同样的功能有多个函数），保证了只有一个函数执行该功能。把一些Qt5中兼容Qt4的方法废弃了，必须用Qt5中对应的新的函数。跟随时代脚步，增加了不少新特性以满足日益增长的客户需求。对某些模块和类型及处理进行了革命性的重写，运行效率提高不少。有参数类型的变化，比如 long * 到 qintptr * 等，更加适应后续的拓展以及同时对32 64位不同系统的兼容。
每个程序员必须掌握的常用英语词汇（建议收藏）
Blue92120的博客
06-07 789
“我英语不好可以学编程吗”相信这个问题，困扰着太多想学习编程，但英文不好的同学。学习编程，常用的单词就那么多，只要把常见的单词学会，你的代码就能写的很6，英语和编程的关系就是这么纯粹和简单。现在小编把这些常用的单词整理了出来，小伙伴们可以收藏分享此篇文章，每天坐公交，坐地铁，睡觉前，任何闲暇之余，翻开读一读，看一看，以后再也不用担心自己的英语不好就不能学习编程啦！Aabstract 抽象的abstract base class (ABC)抽象基类abstract class 抽象类abstraction 抽
C#调色板取色器控件
07-18
C#调色板取色器控件，自定义控件。类似Photoshop，效果请看此图：http://img.my.csdn.net/uploads/201207/18/1342599609_4295.png
调色板控件
a575292877的专栏
05-23 327
UI控件 $(function(){ $(".color_a").cxColor(); $(".color_f").cxColor({ color:"#0066ff" }); }) 标题颜色： ...
微信小程序 调色板
最新发布
Hacker_Hacker007的博客
07-03 637
这是插件的地址，使用的话先把这个插件下载下来，找到src，在项目创建一个文件夹，把src中的内容拷进去，然后调这个就可以了，具体的话看微信开发如何调用插件。注意：是在uniapp中直接使用的一个color-picker插件，改一下格式即可在微信小程序的原生代码中使用。我这是uniapp vue3版本的，微信小程序版本的github上已经有了，照着写就可以。
写一个调色板控件(1)
量无海大的专栏
08-03 833
给朋友写了一个HD6845显示芯片图形处理工具。里面要用到直观的调色板，查看delphi现有的控件，发现没有很实用的，于是就动手写了一个。写着写着，感觉把它功能扩展一下会更好，更合适这个工具的运用。软件开发完成后的界面： 控件运用：上图带小格子的都是（图1，图2，图3，彩图，调色板，可用色彩）。别为那些粗大的方格担心，网上可以查到很多HD6845芯片的资料。如果看不明白，可以查任天堂游戏机（红白机
C#自定义调色板控件演示.rar
10-10
C#自定义调色板控件演示.rar QQ:292258449
计算机算法常用术语中英对照（分为两部分 其中一部分表格形式 ）
weixin_30488085的博客
06-25 4862
第一部分 Data Structures 基本数据结构 Dictionaries 字典 Priority Queues 堆 Graph Data Structures 图 Set Data Structures 集合 Kd-Trees 线段树 Numerical Problems 数值问题 Solving Linear Equations 线性方程组 B...
C# for CSDN 乱七八糟的看不懂
06-03
数组长度 line0.GetLength(1) 数组赋值 可以从一个已经赋值的数组 array2 向未赋值的同等数组 array1 赋值，用 array1=array2; 这时，array1 就变成和 array2 一样的数组了。 集合 集合的使用 集合可以看成是可以...
写一个调色板控件(2)
量无海大的专栏
08-05 310
HD6845图形模式，一个图片块（8X8象素组成的一个小图片，称为Tile）最多只能支持8种颜色，整个屏幕最多可显示64种颜色。这点和任天堂红白机不太一样。差不多用一个星期的工作日时间，改写RAM、内存数据，查资料，并通过获得的数据，推算出结果，在IC板上确认。最终结果就是：一个Tile最多8种颜色，整个屏幕64色。CRT显示管拍照方式无法找到正确颜色显示值，最终只能采取近似的方法确定：R,G,B的
ember-palette：简单的调色板组件，用于选择预定义的颜色
02-04
灰烬调色板 简单的调色板组件，用于选择预定义的颜色 兼容性 Ember.js v3.12或更高版本 Ember CLI v2.13或更高版本 Node.js v10或更高版本 安装 ember install ember-palette 用法 < ColorPalette xss=removed xss=removed> API selected -CSS颜色字符串，十六进制使用默认颜色，例如'＃333333'。 onselect接收所选颜色字符串的操作。 colors -颜色字符串
简单的c#调色板
06-18
利用c#简单的调色板，刚刚开始学，不一定很好
c#简单调色板
12-17
简单的调色板程序，很实用，想更加了解c#程序就拿走吧。用的愉快
C#编写的调色板小工具
07-25
简单实用的调色工具，支持CMYK模式
jQuery调色板插件spectrum
12-08
jQuery调色板插件spectrum，十分好用，内有说明文档和Demo。
简易调色盘控件 for .NET（EN）
weixin_30521161的博客
02-06 150
By Conmajia Originally posted in 2012 Introduction Simple & fast implementation of a rectangular RGB palette control for .NET Fx 2.0. Old-school shit. Name it as SRP. Project download… Nah... (a...
JQuery调色板 插件
kogu的博客
03-14 6729
官网：http://acko.net/dev/farbtastic 用法： 下载Farbtastic 1.2.zip 1、首先要在页面引用JQuery，然后在页面引用farbtastic.js和farbtastic.css（Include farbtastic.js and farbtastic.css in your HTML）: cript" src="farbtastic.js">
vue-调色板
10-18
使用vue实现的一个调色板功能 适合初学vue的人进行参考，谢谢！
写一个获取图片调色板的代码
06-01
下面是一个基于Python和OpenCV库的获取图片调色板的代码示例： ```python import cv2 # 载入图像 img = cv2.imread('image.jpg') # 转换成HSV颜色空间 hsv = cv2.cvtColor(img, cv2.COLOR_BGR2HSV) # 计算直方图...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值