当前位置： 文江博客话题详情

是否可以使用“填充颜色” Delphi 的图像组件上的函数？

发布于 2024-10-17 05:08:49 字数 169 浏览 1 评论 0原文

我的表单上有一个 TImage 组件。我需要实现以下功能：（

如果鼠标指针位于红色点上，则对该点应用“填充绿色”）

这里的“填充颜色”是指 Paint 的功能“填充颜色”。 TImage中有类似的东西吗？还是我应该自己实现这个功能？

你

谢谢 我用的是德尔福7

原文

I have a TImage component on the form. I need to implement the following functionality:

(If mouse pointer is over point with red color, then apply "Fill with color green" to that point)

Here by "Fill with color" I mean Paint's function "Fill with color". Is there anything similar in TImage? Or should I implement this function myself?

Thank you

P.S. I use Delphi 7

如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论， 你可以免费 注册 一个本站的账号。

评论（3）

夏日落 2024-10-24 05:08:49

我猜你说的是“洪水填充”。不久前，我根据维基百科文章编写了自己的实现。我将位图表示为 TRGBQuad 像素的二维数组。

function PMFloodFill(Pixmap: TASPixmap; const X0: integer; const Y0: integer; const Color: TColor): TASPixmap;
var
  w, h: integer;
  MatchColor, QColor: TRGBQuad;
  Queue: packed {SIC!} array of TPoint;
  cp: TPoint;

  procedure push(Point: TPoint);
  begin
    SetLength(Queue, length(Queue) + 1);
    Queue[High(Queue)] := Point;
  end;

  function pop: TPoint;
  var
    lm1: integer;
  begin
    assert(length(Queue) > 0);
    result := Queue[0];
    lm1 := length(Queue) - 1;
    if lm1 > 0 then
      MoveMemory(@(Queue[0]), @(Queue[1]), lm1 * sizeof(TPoint));
    SetLength(Queue, lm1);
  end;

begin
  PMSize(Pixmap, h, w);
  result := Pixmap;
  if not (IsIntInInterval(X0, 0, w-1) and IsIntInInterval(Y0, 0, h-1)) then
    Exit;
  // Find color to match
  MatchColor := Pixmap[Y0, X0];
  QColor := PascalColorToRGBQuad(Color);
  SetLength(Queue, 0);
  push(point(X0, Y0));
  while length(Queue) > 0 do
  begin
    if RGBQuadEqual(result[Queue[0].Y, Queue[0].X], MatchColor) then
      result[Queue[0].Y, Queue[0].X] := QColor;

    cp := pop;

    if cp.X > 0 then
      if RGBQuadEqual(result[cp.Y, cp.X - 1], MatchColor) then
      begin
        result[cp.Y, cp.X - 1] := QColor;
        push(point(cp.X - 1, cp.Y));
      end;

    if cp.X < w-1 then
      if RGBQuadEqual(result[cp.Y, cp.X + 1], MatchColor) then
      begin
        result[cp.Y, cp.X + 1] := QColor;
        push(point(cp.X + 1, cp.Y));
      end;

    if cp.Y > 0 then
      if RGBQuadEqual(result[cp.Y - 1, cp.X], MatchColor) then
      begin
        result[cp.Y - 1, cp.X] := QColor;
        push(point(cp.X, cp.Y - 1));
      end;

    if cp.Y < h-1 then
      if RGBQuadEqual(result[cp.Y + 1, cp.X], MatchColor) then
      begin
        result[cp.Y + 1, cp.X] := QColor;
        push(point(cp.X, cp.Y + 1));
      end;
  end;
end;

完整代码为

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin;

type
  TForm4 = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure UpdateBitmap(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;
  bm: TBitmap;
  CurrentColor: TColor = clRed;

implementation

{$R *.dfm}

type
  TASPixmap = array of packed array of TRGBQuad;

  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;
  PRGB32Array = ^TRGB32Array;

  TScanline = TRGB32Array;
  PScanline = ^TScanline;

function IsIntInInterval(x, xmin, xmax: integer): boolean; {inline;}
begin
  IsIntInInterval := (xmin <= x) and (x <= xmax);
end;

function PascalColorToRGBQuad(const Color: TColor): TRGBQuad;
begin
  with Result do
  begin
    rgbBlue := GetBValue(Color);
    rgbGreen := GetGValue(Color);
    rgbRed := GetRValue(Color);
    rgbReserved := 0;
  end;
end;

function RGBQuadEqual(const Color1: TRGBQuad; const Color2: TRGBQuad): boolean;
begin
  RGBQuadEqual := (Color1.rgbBlue = Color2.rgbBlue) and
                  (Color1.rgbGreen = Color2.rgbGreen) and
                  (Color1.rgbRed = Color2.rgbRed);
end;

function PMFloodFill(Pixmap: TASPixmap; const X0: integer; const Y0: integer; const Color: TColor): TASPixmap;
var
  w, h: integer;
  MatchColor, QColor: TRGBQuad;
  Queue: packed {SIC!} array of TPoint;
  cp: TPoint;

  procedure push(Point: TPoint);
  begin
    SetLength(Queue, length(Queue) + 1);
    Queue[High(Queue)] := Point;
  end;

  function pop: TPoint;
  var
    lm1: integer;
  begin
    assert(length(Queue) > 0);
    result := Queue[0];
    lm1 := length(Queue) - 1;
    if lm1 > 0 then
      MoveMemory(@(Queue[0]), @(Queue[1]), lm1 * sizeof(TPoint));
    SetLength(Queue, lm1);
  end;

begin
  h := length(Pixmap);
  if h > 0 then
    w := length(Pixmap[0]);
  result := Pixmap;
  if not (IsIntInInterval(X0, 0, w-1) and IsIntInInterval(Y0, 0, h-1)) then
    Exit;
  // Find color to match
  MatchColor := Pixmap[Y0, X0];
  QColor := PascalColorToRGBQuad(Color);
  SetLength(Queue, 0);
  push(point(X0, Y0));
  while length(Queue) > 0 do
  begin
    if RGBQuadEqual(result[Queue[0].Y, Queue[0].X], MatchColor) then
      result[Queue[0].Y, Queue[0].X] := QColor;

    cp := pop;

    if cp.X > 0 then
      if RGBQuadEqual(result[cp.Y, cp.X - 1], MatchColor) then
      begin
        result[cp.Y, cp.X - 1] := QColor;
        push(point(cp.X - 1, cp.Y));
      end;

    if cp.X < w-1 then
      if RGBQuadEqual(result[cp.Y, cp.X + 1], MatchColor) then
      begin
        result[cp.Y, cp.X + 1] := QColor;
        push(point(cp.X + 1, cp.Y));
      end;

    if cp.Y > 0 then
      if RGBQuadEqual(result[cp.Y - 1, cp.X], MatchColor) then
      begin
        result[cp.Y - 1, cp.X] := QColor;
        push(point(cp.X, cp.Y - 1));
      end;

    if cp.Y < h-1 then
      if RGBQuadEqual(result[cp.Y + 1, cp.X], MatchColor) then
      begin
        result[cp.Y + 1, cp.X] := QColor;
        push(point(cp.X, cp.Y + 1));
      end;
  end;
end;

function GDIBitmapToASPixmap(const Bitmap: TBitmap): TASPixmap;
var
  scanline: PScanline;
  width, height, bytewidth: integer;
  y: Integer;
begin

  Bitmap.PixelFormat := pf32bit;

  width := Bitmap.Width;
  height := Bitmap.Height;
  bytewidth := width * 4;

  SetLength(Result, height);
  for y := 0 to height - 1 do
  begin
    SetLength(Result[y], width);
    scanline := @(Result[y][0]);
    CopyMemory(scanline, Bitmap.ScanLine[y], bytewidth);
  end;

end;

procedure GDIBitmapAssign(Bitmap: TBitmap; const Pixmap: TASPixmap);
var
  y: Integer;
  scanline: PScanline;
  bytewidth: integer;
begin
  Bitmap.PixelFormat := pf32bit;
  Bitmap.SetSize(length(Pixmap[0]), length(Pixmap));
  bytewidth := Bitmap.Width * 4;

  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := @(Pixmap[y][0]);
    CopyMemory(Bitmap.ScanLine[y], scanline, bytewidth);
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  bm := TBitmap.Create;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  x0, y0: integer;
  pm: TASPixmap;
begin
  x0 := X;
  y0 := Y - ToolBar1.Height;

  if IsIntInInterval(x0, 0, bm.Width) and IsIntInInterval(y0, 0, bm.Height) then
  begin
    pm := GDIBitmapToASPixmap(bm);
    pm := PMFloodFill(pm, x0, y0, CurrentColor);
    GDIBitmapAssign(bm, pm);
    UpdateBitmap(Self);
  end;
end;

procedure TForm4.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, ToolBar1.Height, bm);
end;

procedure TForm4.UpdateBitmap(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm4.ToolButton1Click(Sender: TObject);
begin
  with TOpenDialog.Create(self) do
    try
      Filter := 'Windows Bitmaps (*.bmp)|*.bmp';
      Title := 'Open Bitmap';
      Options := [ofPathMustExist, ofFileMustExist];
      if Execute then
      begin
        bm.LoadFromFile(FileName);
        UpdateBitmap(Sender);
      end;
    finally
      Free;
    end;
end;

procedure TForm4.ToolButton2Click(Sender: TObject);
begin
  with TColorDialog.Create(self) do
    try
      Color := CurrentColor;
      Options := [cdFullOpen];
      if Execute then
        CurrentColor := Color;
    finally
      Free;
    end;
end;

end.

Flood Fill Sample Application

项目文件

为了方便起见，您可以下载整个来自

的项目示例位图。

I guess you are talking about "flood fill". Some time ago, I wrote my own implementation of this based on the Wikipedia article. I represent the bitmap as a two-dimensional array of TRGBQuad pixels.

function PMFloodFill(Pixmap: TASPixmap; const X0: integer; const Y0: integer; const Color: TColor): TASPixmap;
var
  w, h: integer;
  MatchColor, QColor: TRGBQuad;
  Queue: packed {SIC!} array of TPoint;
  cp: TPoint;

  procedure push(Point: TPoint);
  begin
    SetLength(Queue, length(Queue) + 1);
    Queue[High(Queue)] := Point;
  end;

  function pop: TPoint;
  var
    lm1: integer;
  begin
    assert(length(Queue) > 0);
    result := Queue[0];
    lm1 := length(Queue) - 1;
    if lm1 > 0 then
      MoveMemory(@(Queue[0]), @(Queue[1]), lm1 * sizeof(TPoint));
    SetLength(Queue, lm1);
  end;

begin
  PMSize(Pixmap, h, w);
  result := Pixmap;
  if not (IsIntInInterval(X0, 0, w-1) and IsIntInInterval(Y0, 0, h-1)) then
    Exit;
  // Find color to match
  MatchColor := Pixmap[Y0, X0];
  QColor := PascalColorToRGBQuad(Color);
  SetLength(Queue, 0);
  push(point(X0, Y0));
  while length(Queue) > 0 do
  begin
    if RGBQuadEqual(result[Queue[0].Y, Queue[0].X], MatchColor) then
      result[Queue[0].Y, Queue[0].X] := QColor;

    cp := pop;

    if cp.X > 0 then
      if RGBQuadEqual(result[cp.Y, cp.X - 1], MatchColor) then
      begin
        result[cp.Y, cp.X - 1] := QColor;
        push(point(cp.X - 1, cp.Y));
      end;

    if cp.X < w-1 then
      if RGBQuadEqual(result[cp.Y, cp.X + 1], MatchColor) then
      begin
        result[cp.Y, cp.X + 1] := QColor;
        push(point(cp.X + 1, cp.Y));
      end;

    if cp.Y > 0 then
      if RGBQuadEqual(result[cp.Y - 1, cp.X], MatchColor) then
      begin
        result[cp.Y - 1, cp.X] := QColor;
        push(point(cp.X, cp.Y - 1));
      end;

    if cp.Y < h-1 then
      if RGBQuadEqual(result[cp.Y + 1, cp.X], MatchColor) then
      begin
        result[cp.Y + 1, cp.X] := QColor;
        push(point(cp.X, cp.Y + 1));
      end;
  end;
end;

The complete code is

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin;

type
  TForm4 = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure UpdateBitmap(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;
  bm: TBitmap;
  CurrentColor: TColor = clRed;

implementation

{$R *.dfm}

type
  TASPixmap = array of packed array of TRGBQuad;

  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;
  PRGB32Array = ^TRGB32Array;

  TScanline = TRGB32Array;
  PScanline = ^TScanline;

function IsIntInInterval(x, xmin, xmax: integer): boolean; {inline;}
begin
  IsIntInInterval := (xmin <= x) and (x <= xmax);
end;

function PascalColorToRGBQuad(const Color: TColor): TRGBQuad;
begin
  with Result do
  begin
    rgbBlue := GetBValue(Color);
    rgbGreen := GetGValue(Color);
    rgbRed := GetRValue(Color);
    rgbReserved := 0;
  end;
end;

function RGBQuadEqual(const Color1: TRGBQuad; const Color2: TRGBQuad): boolean;
begin
  RGBQuadEqual := (Color1.rgbBlue = Color2.rgbBlue) and
                  (Color1.rgbGreen = Color2.rgbGreen) and
                  (Color1.rgbRed = Color2.rgbRed);
end;

function PMFloodFill(Pixmap: TASPixmap; const X0: integer; const Y0: integer; const Color: TColor): TASPixmap;
var
  w, h: integer;
  MatchColor, QColor: TRGBQuad;
  Queue: packed {SIC!} array of TPoint;
  cp: TPoint;

  procedure push(Point: TPoint);
  begin
    SetLength(Queue, length(Queue) + 1);
    Queue[High(Queue)] := Point;
  end;

  function pop: TPoint;
  var
    lm1: integer;
  begin
    assert(length(Queue) > 0);
    result := Queue[0];
    lm1 := length(Queue) - 1;
    if lm1 > 0 then
      MoveMemory(@(Queue[0]), @(Queue[1]), lm1 * sizeof(TPoint));
    SetLength(Queue, lm1);
  end;

begin
  h := length(Pixmap);
  if h > 0 then
    w := length(Pixmap[0]);
  result := Pixmap;
  if not (IsIntInInterval(X0, 0, w-1) and IsIntInInterval(Y0, 0, h-1)) then
    Exit;
  // Find color to match
  MatchColor := Pixmap[Y0, X0];
  QColor := PascalColorToRGBQuad(Color);
  SetLength(Queue, 0);
  push(point(X0, Y0));
  while length(Queue) > 0 do
  begin
    if RGBQuadEqual(result[Queue[0].Y, Queue[0].X], MatchColor) then
      result[Queue[0].Y, Queue[0].X] := QColor;

    cp := pop;

    if cp.X > 0 then
      if RGBQuadEqual(result[cp.Y, cp.X - 1], MatchColor) then
      begin
        result[cp.Y, cp.X - 1] := QColor;
        push(point(cp.X - 1, cp.Y));
      end;

    if cp.X < w-1 then
      if RGBQuadEqual(result[cp.Y, cp.X + 1], MatchColor) then
      begin
        result[cp.Y, cp.X + 1] := QColor;
        push(point(cp.X + 1, cp.Y));
      end;

    if cp.Y > 0 then
      if RGBQuadEqual(result[cp.Y - 1, cp.X], MatchColor) then
      begin
        result[cp.Y - 1, cp.X] := QColor;
        push(point(cp.X, cp.Y - 1));
      end;

    if cp.Y < h-1 then
      if RGBQuadEqual(result[cp.Y + 1, cp.X], MatchColor) then
      begin
        result[cp.Y + 1, cp.X] := QColor;
        push(point(cp.X, cp.Y + 1));
      end;
  end;
end;

function GDIBitmapToASPixmap(const Bitmap: TBitmap): TASPixmap;
var
  scanline: PScanline;
  width, height, bytewidth: integer;
  y: Integer;
begin

  Bitmap.PixelFormat := pf32bit;

  width := Bitmap.Width;
  height := Bitmap.Height;
  bytewidth := width * 4;

  SetLength(Result, height);
  for y := 0 to height - 1 do
  begin
    SetLength(Result[y], width);
    scanline := @(Result[y][0]);
    CopyMemory(scanline, Bitmap.ScanLine[y], bytewidth);
  end;

end;

procedure GDIBitmapAssign(Bitmap: TBitmap; const Pixmap: TASPixmap);
var
  y: Integer;
  scanline: PScanline;
  bytewidth: integer;
begin
  Bitmap.PixelFormat := pf32bit;
  Bitmap.SetSize(length(Pixmap[0]), length(Pixmap));
  bytewidth := Bitmap.Width * 4;

  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := @(Pixmap[y][0]);
    CopyMemory(Bitmap.ScanLine[y], scanline, bytewidth);
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  bm := TBitmap.Create;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  x0, y0: integer;
  pm: TASPixmap;
begin
  x0 := X;
  y0 := Y - ToolBar1.Height;

  if IsIntInInterval(x0, 0, bm.Width) and IsIntInInterval(y0, 0, bm.Height) then
  begin
    pm := GDIBitmapToASPixmap(bm);
    pm := PMFloodFill(pm, x0, y0, CurrentColor);
    GDIBitmapAssign(bm, pm);
    UpdateBitmap(Self);
  end;
end;

procedure TForm4.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, ToolBar1.Height, bm);
end;

procedure TForm4.UpdateBitmap(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm4.ToolButton1Click(Sender: TObject);
begin
  with TOpenDialog.Create(self) do
    try
      Filter := 'Windows Bitmaps (*.bmp)|*.bmp';
      Title := 'Open Bitmap';
      Options := [ofPathMustExist, ofFileMustExist];
      if Execute then
      begin
        bm.LoadFromFile(FileName);
        UpdateBitmap(Sender);
      end;
    finally
      Free;
    end;
end;

procedure TForm4.ToolButton2Click(Sender: TObject);
begin
  with TColorDialog.Create(self) do
    try
      Color := CurrentColor;
      Options := [cdFullOpen];
      if Execute then
        CurrentColor := Color;
    finally
      Free;
    end;
end;

end.

Flood Fill Sample Application

Project files

For your convenience, you can download the entire project from

Don't forget the sample bitmap.

回复 原文
看轻我的陪伴 2024-10-24 05:08:49

TImage 中没有内置任何内容来执行您所要求的操作。

您可以自己实现，尽管您可能不会从 TImage 开始。或者，您可能会很幸运地寻找能够提供您所需功能的第三方绘画组件。

There's nothing built in to TImage to do what you ask.

You could implement yourself although you would probably not start from TImage. Or perhaps you might have some fortune searching for a 3rd party painting component that offered the functionality you need.

回复 原文
黑白记忆 2024-10-24 05:08:49

实际上我设法使用 Image1.Canvas.FloodFill 函数来实现这一点。我只需使用 (Image1.ClientWidth/Image1.Picture.Bitmap.Width) 比率（高度相同）缩放坐标。获得新坐标后，我可以使用 Image1.Canvas.Pixels 矩阵和缩放坐标来获取点的颜色。似乎对我来说工作得很好，不需要额外的功能。

Actually I managed to implement this using Image1.Canvas.FloodFill function. I just had to scale the coordinates using (Image1.ClientWidth/Image1.Picture.Bitmap.Width) ratio (same for height). After getting new coordinates I could get the color of point by using Image1.Canvas.Pixels matrix and scaled coordinates. Seems to work fine with me, and no need for additional functions.

回复 原文
~没有更多了~

关于作者

以酷

暂无简介

0 文章
0 评论
23 人气
发私信

相关话题

更多

热门标签

操作系统 程序设计 IT运维 Linux系统管理 JavaScript 服务器应用 solaris C/C++ PHP Shell BSD Vue.js aix Oracle Python HTML 系统管理 HTML5 CSS 前端
更多

推荐作者

lorenzathorton8

文章 0 评论 0

Zero

文章 0 评论 0

萧瑟寒风

文章 0 评论 0

mylayout

文章 0 评论 0

tkewei

文章 0 评论 0

17818769742

文章 0 评论 0

更多

友情链接

文江博客
    我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站，即表示您同意使用 Cookies 和您的相关数据。
    原文