替换bmp图片中的颜色 good

工作中，经常需要将bmp图片中的某个颜色修改为另外一种颜色。比如:将图片中的所有白色均修改成灰色。

平时都是拿画图板中的油漆桶工具一点一点的刷，费时又费力。(这么干好几年了 :( )

今天抽空编了一个小软件，实现了这种功能。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, StdCtrls, ExtDlgs, Buttons;

type
TForm1 = class(TForm)
grp1: TGroupBox;
img1: TImage;
btn1: TButton;
dlgOpenPic1: TOpenPictureDialog;
btn2: TButton;
grp2: TGroupBox;
lbl1: TLabel;
btn3: TBitBtn;
btn4: TBitBtn;
pnl1: TPanel;
dlgColor1: TColorDialog;
grp3: TGroupBox;
lbl2: TLabel;
btn5: TBitBtn;
btn6: TBitBtn;
pnl2: TPanel;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure btn3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btn3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btn4Click(Sender: TObject);
procedure btn5MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure btn6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
imgbmp:TBitmap;
imgpath:string;
bOpen:Boolean;
OriginalColor,Changedtoc:TColor;
implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
height:Integer;
width:Integer;
h,w:Integer;


begin
if bOpen then
begin
imgbmp := TBitmap.Create;
imgbmp.LoadFromFile(imgpath);
imgbmp.SaveToFile(imgpath + '_bak');
height := imgbmp.Height;
width := imgbmp.Width;
//ShowMessage(IntToStr(width)+'--'+ IntToStr(height));
for h:= 0 to height-1 do
begin
for w := 0 to width-1 do
begin
if imgbmp.Canvas.Pixels[w,h]=OriginalColor then
imgbmp.Canvas.Pixels[w,h] := Changedtoc;
end;
end;
imgbmp.SaveToFile(imgpath);
img1.Picture.LoadFromFile(imgpath);
imgbmp.Free;

end
else
ShowMessage('图片未打开');

end;

procedure TForm1.btn2Click(Sender: TObject);
var
s1:string;
begin
if dlgOpenPic1.Execute then
begin
imgpath := dlgOpenPic1.FileName;
img1.Picture.LoadFromFile(dlgOpenPic1.FileName);
bOpen := True;
btn1.Enabled := True;
end;
end;

procedure TForm1.btn3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
pnl1.Color := Canvas.Pixels[x,y];
end;

procedure TForm1.btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Pt: TPoint;
begin
GetCursorPos(Pt);
if Pt.X < 900 then
begin
OriginalColor := GetPixel(GetDC(0), pt.X, pt.Y);
pnl1.Color := OriginalColor;//Form1.Canvas.Pixels[p.X,p.Y];
end;
end;

procedure TForm1.btn3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
pnl1.Color := Canvas.Pixels[x,y];
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
if dlgColor1.Execute then
begin
OriginalColor := dlgColor1.Color;
pnl1.Color := OriginalColor;
end;
end;

procedure TForm1.btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Pt: TPoint;
begin
GetCursorPos(Pt);
if Pt.X < 900 then
begin
Changedtoc := GetPixel(GetDC(0), pt.X, pt.Y);
pnl2.Color := Changedtoc;//Form1.Canvas.Pixels[p.X,p.Y];
end;

end;

procedure TForm1.btn6Click(Sender: TObject);
begin
if dlgColor1.Execute then
begin
Changedtoc := dlgColor1.Color;
pnl2.Color := Changedtoc;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
btn1.Enabled := false;
end;

end.

 

http://www.cnblogs.com/dabiao/archive/2010/09/09/1822238.html