怎样在Image控件中实现对一种颜色区域填充 ( 积分: 50 )

  • 主题发起人 主题发起人 qwinds
  • 开始时间 开始时间
Q

qwinds

Unregistered / Unconfirmed
GUEST, unregistred user!
  比如一个中国地图一样的JPG图像,用image控件载入后,想把里面的一个颜色区域填充成另一种颜色,怎么做。。。。
  我用image.picture.bitmap.canvas.pixes[x,y]获得鼠标点击位置的颜色值,可是一点击图像就没有了,如果直接用canvas.pixes[x,y]获得的颜色值又不对,谁有解决办法吗?
  另外,我在填充时,用canvas.floodEllip填充,可是一样会出现一点击图像就没了,各位大侠们,有知道的说下啊!!!
急啊。。。!!!!!!!!
 
  比如一个中国地图一样的JPG图像,用image控件载入后,想把里面的一个颜色区域填充成另一种颜色,怎么做。。。。
  我用image.picture.bitmap.canvas.pixes[x,y]获得鼠标点击位置的颜色值,可是一点击图像就没有了,如果直接用canvas.pixes[x,y]获得的颜色值又不对,谁有解决办法吗?
  另外,我在填充时,用canvas.floodEllip填充,可是一样会出现一点击图像就没了,各位大侠们,有知道的说下啊!!!
急啊。。。!!!!!!!!
 
有人知道吗?知道的说一下,急啊!!!!!!!
 
你的想法是对的,要通过 bmp 来替换:
先将你的 image.picture.bitmap copy 为另外的 tmpbmp, 修改这样 Bmp(用bitmap.canvas.pixes[x,y]或者scanline,scanline快很多) , 最后将这个tmpbmp assign 为 image.picture.bitmap 就可以了,
 
请上个完整的例子啊!
 
unit Patternmain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, ColorGrd;

type
TForm1 = class(TForm)
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
ColorDialog1: TColorDialog;
ColorGrid1: TColorGrid;
CheckBox1: TCheckBox;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ColorGrid1Click(Sender: TObject);
private
{ Private declarations }
procedure FillColors(FBitmap: TBitmap; FWidth: Integer; FHeight: Integer;
Xs: integer; Ys: integer; OldColor, NewColor: Byte);
public
{ Public declarations }
end;

var
Form1: TForm1;
FRendering: boolean;
org, next1: TPoint;
mycolor: byte;
implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pa: pbytearray;
oc: byte;
// n: TPixelFormat;
mybmp: tbitmap;
begin
if CheckBox1.Checked then
begin
mybmp := tbitmap.Create;
mybmp.Width := image1.Picture.Bitmap.Width;
mybmp.Height := image1.Picture.Bitmap.Height;
mybmp.Assign(image1.Picture.Bitmap);
mybmp.PixelFormat := pf8bit;

pa := mybmp.ScanLine[y];
oc := pa[x];
FillColors(mybmp, image1.picture.bitmap.Width,
image1.picture.bitmap.Height,
X, Y, oc, mycolor);
image1.Picture.Bitmap.Assign(mybmp);
mybmp.free;
frendering := false;
end
else
begin
FRendering := true;
org := Point(X, Y);
next1 := Point(X, Y);
end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
points: array[1..4] of TPOINT;
// p: pchar;
begin
if FRendering then
begin
next1 := Point(X, Y);
points[1] := org;
points[2] := next1;
points[3] := Point(next1.x + 8, next1.y + 8);
points[4] := Point(org.x + 8, org.y + 8);
Image1.Canvas.Polygon(points);

org := Point(X, Y);
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

begin

FRendering := false;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
bmp: tbitmap;
begin
self.DoubleBuffered := true;
bmp := tbitmap.Create;
bmp.Width := image1.Width;
bmp.Height := image1.Height;
bmp.PixelFormat := pf8bit;
image1.Picture.Bitmap.Assign(bmp);
bmp.free;
Image1.Canvas.Brush.Color := clred;
Image1.Canvas.Pen.Color := clred;
end;

procedure TForm1.FillColors(FBitmap: TBitmap; FWidth, FHeight, Xs,
Ys: integer; OldColor, NewColor: Byte);
type
stackfield = record
xl, xr, y: integer;
end;
var
i, X, Xl, Xr, p_Xl, p_Xr, signed_Y: integer;
P: PByteArray;
stack: array of stackfield;
procedure set_stack_empty();
begin

setlength(stack, 1);
stack[0].y := 0;
end;
function stack_not_empty(): boolean;
begin
if stack[0].y = 0 then
result := false
else
result := true;
end;
procedure push(xl, xr, yd: integer);
begin
stack[0].y := stack[0].y + 1;
if stack[0].y > (length(stack) - 1) then
setlength(stack, length(stack) + 1);
stack[stack[0].y].xl := xl;
stack[stack[0].y].xr := xr;
stack[stack[0].y].y := yd
end;
procedure pop(var xl: integer; var xr: integer; var yd: integer);
begin
if stack[0].y > 0 then
begin
xl := stack[stack[0].y].xl;
xr := stack[stack[0].y].xr;
yd := stack[stack[0].y].y;
stack[0].y := stack[0].y - 1;
setlength(stack, length(stack) - 1);
end;
end;
begin
//Fwidth,FHeight为位图的宽度和高度
set_stack_empty; //////////
P := fbitmap.ScanLine[Ys];
i := Xs;
if P = Newcolor then
exit;
while (P = OldColor) do
begin
P := NewColor;
i := i + 1;
if i = fbitmap.Width then
break;
end;
Xr := i - 1;
i := Xs - 1;
while (P = OldColor) do
begin
P := NewColor;
i := i - 1;
if i = -1 then
break;
end;
Xl := i + 1;
if ys > 0 then
push(Xl, Xr, -(Ys - 1));
if ys < fbitmap.height - 1 then
push(Xl, Xr, (Ys + 1));
while stack_not_empty do
begin
pop(p_Xl, p_Xr, signed_Y);
//y:=abs(signed_Y);
P := fbitmap.scanline[abs(signed_y)];
if (P[p_Xl] = OldColor) then //xl处是oldcolor时
if p_xl > 0 then
begin
x := p_Xl - 1; //,xl非边界,否则将会出边界
while (P[x] = OldColor) do
begin
P[x] := NewColor;
x := x - 1;
if x = -1 then
break;
end;
Xl := x + 1;
x := p_Xl;
end
else
begin
xl := 0; // 左边界已是0 时,新的xl自然取0
x := p_xl;
end
else
begin
x := p_Xl;
// 否则xl处非oldcolor,xl的左邻点不为olodcolor时,xl的右邻点可能为oldcolor时 ,向右找xl
if ((x > 0) and (p[x - 1] <> oldcolor)) or (x = 0) then
begin
while (p[x] <> OldColor) do
begin
x := x + 1;
if x = fbitmap.Width then
begin
x := x + 1;
break;
end;
end;
xl := x;
end
else if p_xl > 0 then
//否则xl 的左邻点是oldcolor时,先考虑左边,向左找xl
begin
x := p_Xl - 1;
while (P[x] = OldColor) do
begin
P[x] := NewColor;
x := x - 1;
if x = -1 then
break;
end;
Xl := x + 1;
x := p_Xl;
end
else
begin
xl := 0;
x := p_xl;
end

end;
while x <= (p_Xr + 1) do
begin
while (p[x] = OldColor) do
begin
p[x] := NewColor;
x := x + 1;
if x = fbitmap.Width then
begin
break;
end;
end;
Xr := x - 1;
if (abs(signed_y - 1) <= (fbitmap.Height - 1)) and (abs(signed_y - 1)
>= 0) then
begin
if (Xl <= p_Xl - 1) then
push(xl, p_Xl - 1, -(signed_y - 1));
if (Xr >= p_Xr + 1) then
push(p_xr + 1, xr, -(signed_y - 1));
end;
if (abs(signed_y + 1) <= (fbitmap.Height - 1)) and (abs(signed_y + 1)
>= 0) then
push(Xl, Xr, signed_y + 1);
if x = fbitmap.Width then
x := X + 1;
if x <= (fbitmap.width - 1) then
while (x <= p_xr + 1) and (p[x] <> OldColor) do
begin
x := x + 1;
if x = fbitmap.Width then
begin
x := x + 1;
BREAK;
end;

end;
Xl := x;
end;
end;
// Fbitmap.invalidate;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp: Tbitmap;
begin
if openpicturedialog1.Execute then
begin
bmp := tbitmap.Create;
bmp.LoadFromFile(openpicturedialog1.filename);
bmp.PixelFormat := pf8bit;
image1.Width := bmp.Width;
image1.Height := bmp.Height;
image1.Picture.Bitmap.Assign(bmp);
bmp.free;
end;
end;

procedure TForm1.ColorGrid1Click(Sender: TObject);
var
acolor: tcolor;
begin
acolor := colorgrid1.ForegroundColor;
mycolor := getnearestpaletteindex(image1.Picture.Bitmap.Palette, acolor);
end;

end.
 
如果那种制定颜色范围的填充怎么解决呢?比如red正负5的范围内
floodfill只能填充某一个固定指的颜色:(
这个问题比较难搞,如果用pixel取颜色的话就很慢,而且还得自己做填充算法,如果图片很大深度/广度优先都要耗时很久
不知道photoshop是怎么实现的,哪位有想法?
 
试试设备场景
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
772
import
I
后退
顶部