delphi替换bmp图片中的颜色

原作者: [db:作者] 来自: [db:来源] 收藏邀请

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

鲜花

握手

雷人

路过

鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

地址搜索器工作原理分析与源码(delphi)（转）发布时间：2022-07-18

DELPHI设置枚举类型size发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：19216|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：9995|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8331|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8699|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8643|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9665|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8628|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：8003|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8661|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7537|2022-11-06

客服电话

电子邮件

delphi替换bmp图片中的颜色

请发表评论

全部评论

上一篇：

下一篇：

bradtraversy/iweather: Ionic 3 mobile we

joaomh/curso-de-matlab

断牙刷新位置时间（断牙属性及刷新位置介绍

CVE-2022-20876

rugk/mastodon-simplified-federation: Sim

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

SimpleSoftwareIO/simple-sms: Send and re

关于我们

产品与服务

解决方案

139-2527-9053