delphi替换bmp图片中的颜色

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

 

 

窗体代码

object  Form1: TForm1
  Left  =   0
  Top  =   0
  Caption  =   ' BMP ' # 22270 # 29255 # 39068 # 33394 # 26367 # 25442 # 22120
  ClientHeight  =   627
  ClientWidth  =   949
  Color  =  clBtnFace
  Font.Charset  =  DEFAULT_CHARSET
  Font.Color  =  clWindowText
  Font.Height  =   - 11
  Font.Name  =   ' Tahoma '
  Font.Style  =  []
  OldCreateOrder  =  False
  OnCreate  =  FormCreate
  PixelsPerInch  =   96
  TextHeight  =   13
   object  grp1: TGroupBox
    Left  =   8
    Top  =   0
    Width  =   833
    Height  =   621
    TabOrder  =   0
     object  img1: TImage
      Left  =   14
      Top  =   16
      Width  =   800
      Height  =   600
     end
   end
   object  btn1: TButton
    Left  =   866
    Top  =   407
    Width  =   75
    Height  =   25
    Caption  =  # 36716 # 25442
    TabOrder  =   1
    OnClick  =  btn1Click
   end
   object  btn2: TButton
    Left  =   866
    Top  =   376
    Width  =   75
    Height  =   25
    Caption  =  # 25171 # 24320 # 22270 # 29255
    TabOrder  =   2
    OnClick  =  btn2Click
   end
   object  grp2: TGroupBox
    Left  =   847
    Top  =   0
    Width  =   98
    Height  =   129
    Caption  =  # 26367 # 25442 # 21069 # 39068 # 33394
    TabOrder  =   3
     object  lbl1: TLabel
      Left  =   10
      Top  =   23
      Width  =   64
      Height  =   13
      Caption  =  # 26367 # 25442 # 21069 # 39068 # 33394 ' : '
     end
     object  btn3: TBitBtn
      Left  =   11
      Top  =   46
      Width  =   30
      Height  =   25
      Caption  =  # 21462 # 33394
      DoubleBuffered  =  True
      ParentDoubleBuffered  =  False
      TabOrder  =   0
      OnMouseMove  =  btn3MouseMove
     end
     object  btn4: TBitBtn
      Left  =   58
      Top  =   46
      Width  =   30
      Height  =   25
      Caption  =  # 36873 # 33394
      DoubleBuffered  =  True
      ParentDoubleBuffered  =  False
      TabOrder  =   1
      OnClick  =  btn4Click
     end
     object  pnl1: TPanel
      Left  =   11
      Top  =   83
      Width  =   77
      Height  =   31
      BevelKind  =  bkFlat
      BevelOuter  =  bvNone
      Caption  =   ' Color '
      TabOrder  =   2
     end
   end
   object  grp3: TGroupBox
    Left  =   847
    Top  =   152
    Width  =   98
    Height  =   129
    Caption  =  # 26367 # 25442 # 21518 # 39068 # 33394
    TabOrder  =   4
     object  lbl2: TLabel
      Left  =   10
      Top  =   23
      Width  =   64
      Height  =   13
      Caption  =  # 26367 # 25442 # 21518 # 39068 # 33394 ' : '
     end
     object  btn5: TBitBtn
      Left  =   11
      Top  =   46
      Width  =   30
      Height  =   25
      Caption  =  # 21462 # 33394
      DoubleBuffered  =  True
      ParentDoubleBuffered  =  False
      TabOrder  =   0
      OnMouseMove  =  btn5MouseMove
     end
     object  btn6: TBitBtn
      Left  =   58
      Top  =   46
      Width  =   30
      Height  =   25
      Caption  =  # 36873 # 33394
      DoubleBuffered  =  True
      ParentDoubleBuffered  =  False
      TabOrder  =   1
      OnClick  =  btn6Click
     end
     object  pnl2: TPanel
      Left  =   11
      Top  =   83
      Width  =   77
      Height  =   31
      BevelKind  =  bkFlat
      BevelOuter  =  bvNone
      Caption  =   ' Color '
      TabOrder  =   2
     end
   end
   object  dlgOpenPic1: TOpenPictureDialog
    Filter  =   ' Bitmaps (*.bmp)|*.bmp '
    Left  =   277
    Top  =   360
   end
   object  dlgColor1: TColorDialog
    Left  =   232
    Top  =   360
   end
end