zoukankan      html  css  js  c++  java
  • 替换bmp图片中的颜色 good

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

  • 相关阅读:
    linux ——process
    linux ipc—msgqueue
    JDEclipse源码查看
    用 AXIOM 促进 XML 处理
    使jets3t支持https
    正版太贵了……
    Axis2学习笔记 (Axiom 篇 )
    基于Hadoop的海量文本处理系统介绍
    详解ASP.NET MVC的请求生命周期
    .Net相关的资源连接
  • 原文地址:https://www.cnblogs.com/findumars/p/5034705.html
Copyright © 2011-2022 走看看