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