Delphi图像处理之图像着色

-----开发环境Delphi7

----效果图：

---Unit开始

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls, ExtDlgs, ExtCtrls, ComCtrls, Math, TypInfo;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     Image1: TImage;
 12     Image2: TImage;
 13     Label1: TLabel;
 14     OpenPictureDialog1: TOpenPictureDialog;
 15     Button1: TButton;
 16     Label2: TLabel;
 17     ColorDialog1: TColorDialog;
 18     Button2: TButton;
 19     Label3: TLabel;
 20     procedure Button1Click(Sender: TObject);
 21     procedure FormCreate(Sender: TObject);
 22     procedure Button2Click(Sender: TObject);
 23   private
 24     procedure SetImageColor(sColor: TColor);
 25     { Private declarations }
 26   public
 27     { Public declarations }
 28   end;
 29 
 30 var
 31   Form1: TForm1;
 32 
 33 implementation
 34 
 35 {$R *.dfm}
 36 
 37 procedure TForm1.Button1Click(Sender: TObject);
 38 begin
 39   if OpenPictureDialog1.Execute then
 40   begin
 41     Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
 42     Label1.Caption:='图片宽x高:'+inttostr(Image1.Picture.Width)+'x'+inttostr(Image1.Picture.Height);
 43   end;
 44 end;
 45 
 46 procedure TForm1.FormCreate(Sender: TObject);
 47 begin
 48   OpenPictureDialog1.Filter:='Bitmaps (*.bmp)|*.bmp';
 49   Self.DoubleBuffered:=True;
 50 end;
 51 
 52 procedure TForm1.Button2Click(Sender: TObject);
 53 var
 54   vR,vG,vB: Byte;
 55 begin
 56   if ColorDialog1.Execute then
 57   begin
 58     SetImageColor(ColorDialog1.Color);
 59     Label2.Color:=ColorDialog1.Color;
 60     vR:=Byte(ColorDialog1.Color);
 61     vG:=(ColorDialog1.Color shr 8) and $FF;
 62     vB:=(ColorDialog1.Color shr 16) and $FF;
 63     Label3.Caption:='R:'+IntToStr(vR)+' G:'+IntToStr(vG)+' B:'+IntToStr(vB);
 64   end;
 65 end;
 66 
 67 procedure TForm1.SetImageColor(sColor: TColor);
 68 const
 69   vThresholdValue:Byte=128;
 70 var
 71   vP: PByteArray;
 72   x,y: Integer;
 73   vBmp: TBitmap;
 74   vGray: Integer;
 75   vR,vG,vB: Byte;
 76 begin
 77   //着色原理：给图像换上换上指定的颜色，把原来的图案保留下来
 78   {着色公式：
 79     R目标=(R选中颜色*R原图) div 255
 80     G目标=(G选中颜色*G原图) div 255
 81     B目标=(B选中颜色*B原图) div 255
 82   }
 83   if Image1.Picture.Graphic =nil then
 84   begin
 85     Label2.Caption:='请加载图片！';
 86     Exit;
 87   end;
 88   vBmp:=TBitmap.Create;
 89   vBmp.Assign(Image1.Picture.Bitmap);
 90   vBmp.PixelFormat:=pf24bit;
 91   vR:=Byte(sColor);
 92   vG:=(sColor shr 8) and $FF;
 93   vB:=(sColor shr 16) and $FF;
 94   for y:=0 to vBmp.Height-1 do
 95   begin
 96     vP:=vBmp.ScanLine[y];
 97     for x:=0 to vBmp.Width-1 do
 98     begin
 99       vP[3*x+2]:=(vR*vP[3*x+2]) div 255;
100       vP[3*x+1]:=(vG*vP[3*x+1]) div 255;
101       vP[3*x]:=(vB*vP[3*x]) div 255;
102     end;
103   end;
104   Image2.Picture.Assign(vBmp);
105   vBmp.Free;
106 end;
107 
108 end.

----Unit结束

-----Form开始

 1 object Form1: TForm1
 2   Left = 152
 3   Top = 186
 4   BorderStyle = bsDialog
 5   Caption = 'Form1'
 6   ClientHeight = 485
 7   ClientWidth = 886
 8   Color = clBtnFace
 9   Font.Charset = DEFAULT_CHARSET
10   Font.Color = clWindowText
11   Font.Height = -11
12   Font.Name = 'MS Sans Serif'
13   Font.Style = []
14   OldCreateOrder = False
15   OnCreate = FormCreate
16   PixelsPerInch = 96
17   TextHeight = 13
18   object Image1: TImage
19     Left = 8
20     Top = 16
21     Width = 425
22     Height = 337
23     Center = True
24     Proportional = True
25     Stretch = True
26   end
27   object Image2: TImage
28     Left = 448
29     Top = 16
30     Width = 425
31     Height = 337
32     Center = True
33     Proportional = True
34     Stretch = True
35   end
36   object Label1: TLabel
37     Left = 16
38     Top = 360
39     Width = 385
40     Height = 25
41     AutoSize = False
42     Caption = '图片宽x高:'
43   end
44   object Label2: TLabel
45     Left = 448
46     Top = 416
47     Width = 129
48     Height = 25
49     Alignment = taCenter
50     AutoSize = False
51   end
52   object Label3: TLabel
53     Left = 598
54     Top = 428
55     Width = 265
56     Height = 17
57     AutoSize = False
58   end
59   object Button1: TButton
60     Left = 16
61     Top = 416
62     Width = 161
63     Height = 25
64     Caption = 'Button1_加载图片'
65     TabOrder = 0
66     OnClick = Button1Click
67   end
68   object Button2: TButton
69     Left = 256
70     Top = 416
71     Width = 179
72     Height = 25
73     Caption = '设定颜色'
74     TabOrder = 1
75     OnClick = Button2Click
76   end
77   object OpenPictureDialog1: TOpenPictureDialog
78     Filter = 'Bitmaps (*.bmp)|*.bmp'
79     Left = 72
80     Top = 368
81   end
82   object ColorDialog1: TColorDialog
83     Left = 336
84     Top = 448
85   end
86 end

-------Form结束