学步园

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

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

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

 

源码下载地址:网络U盘

 

 

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