工作中,经常需要将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; 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