GDI+ 在Delphi程序的应用 -- Photoshop色相/饱和度/明度功能

GDI+在Delphi程序的应用 – Photoshop色相/饱和度/明度功能

本文用GDI+实现Photoshop色相/饱和度/明度功能，参照我的其它有关GDI+在 Delphi程序的应用的文章，代码也可供TBitmap使用。

有些人不喜欢，或者不太懂Delphi的BASM代码，所以本文给出纯PAS代码。须说明的是，纯PAS代码效率较低，不适合实际应用。喜欢C/C++的，可以看本人文章《C++实现Photoshop色相/饱和度/明度功能》，除了语言不同，其它都一样。

有关Photoshop饱和度调整原理可参见《GDI+ 在Delphi程序的应用 -- 图像饱和度调整》，明度调整原理可参见《GDI+ 在Delphi程序的应用 -- 仿Photoshop的明度调整》。

下面是一个完整的Delphi程序，Photoshop色相/饱和度/明度功能纯PAS代码包含在其中：

[delphi] view plaincopyprint?

unit main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ComCtrls, Gdiplus;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Hbar: TTrackBar;

SBar: TTrackBar;

BBar: TTrackBar;

HEdit: TEdit;

SEdit: TEdit;

BEdit: TEdit;

Button1: TButton;

PaintBox1: TPaintBox;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure HBarChange(Sender: TObject);

procedure SBarChange(Sender: TObject);

procedure BBarChange(Sender: TObject);

procedure HEditChange(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

Source: TGpBitmap;

Bitmap: TGpBitmap;

r: TGpRect;

Lock: Boolean;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure SwapRGB(var a, b: Integer);

begin

Inc(a, b);

b := a - b;

Dec(a, b);

end;

procedure CheckRGB(var Value: Integer);

begin

if Value < 0 then Value := 0

else if Value > 255 then Value := 255;

end;

procedure AssignRGB(var R, G, B: Byte; intR, intG, intB: Integer);

begin

R := intR;

G := intG;

B := intB;

end;

procedure SetBright(var R, G, B: Byte; bValue: Integer);

var

intR, intG, intB: Integer;

begin

intR := R;

intG := G;

intB := B;

if bValue > 0 then

begin

Inc(intR, (255 - intR) * bValue div 255);

Inc(intG, (255 - intG) * bValue div 255);

Inc(intB, (255 - intB) * bValue div 255);

end

else if bValue < 0 then

begin

Inc(intR, intR * bValue div 255);

Inc(intG, intG * bValue div 255);

Inc(intB, intB * bValue div 255);

end;

CheckRGB(intR);

CheckRGB(intG);

CheckRGB(intB);

AssignRGB(R, G, B, intR, intG, intB);

end;

procedure SetHueAndSaturation(var R, G, B: Byte; hValue, sValue: Integer);

var

intR, intG, intB: Integer;

H, S, L, Lum: Integer;

delta, entire: Integer;

index, extra: Integer;

begin

intR := R;

intG := G;

intB := B;

if intR < intG then SwapRGB(intR, intG);

if intR < intB then SwapRGB(intR, intB);

if intB > intG then SwapRGB(intB, intG);

delta := intR - intB;

if delta = 0 then Exit;

entire := intR + intB;

L := entire shr 1;

if L < 128 then

S := delta * 255 div entire

else

S := delta * 255 div (510 - entire);

if hValue <> 0 then

begin

if intR = R then

H := (G - B) * 60 div delta

else if intR = G then

H := (B - R) * 60 div delta + 120

else

H := (R - G) * 60 div delta + 240;

Inc(H, hValue);

if H < 0 then

Inc(H, 360)

else if H > 360 then

Dec(H, 360);

index := H div 60;

extra := H mod 60;

if (index and 1) <> 0 then

extra := 60 - extra;

extra := (extra * 255 + 30) div 60;

intG := extra - (extra - 128) * (255 - S) div 255;

Lum := L - 128;

if Lum > 0 then

Inc(intG, (((255 - intG) * Lum + 64) div 128))

else if Lum < 0 then

Inc(intG, (intG * Lum div 128));

CheckRGB(intG);

case index of

1: SwapRGB(intR, intG);

2:

begin

SwapRGB(intR, intB);

SwapRGB(intG, intB);

end;

3: SwapRGB(intR, intB);

4:

begin

SwapRGB(intR, intG);

SwapRGB(intG, intB);

end;

5: SwapRGB(intG, intB);

end;

end

else

begin

intR := R;

intG := G;

intB := B;

end;

if sValue <> 0 then

begin

if sValue > 0 then

begin

if sValue + S >= 255 then sValue := S

else sValue := 255 - sValue;

sValue := 65025 div sValue - 255;

end;

Inc(intR, ((intR - L) * sValue div 255));

Inc(intG, ((intG - L) * sValue div 255));

Inc(intB, ((intB - L) * sValue div 255));

CheckRGB(intR);

CheckRGB(intG);

CheckRGB(intB);

end;

AssignRGB(R, G, B, intR, intG, intB);

end;

procedure GdipHSBAdjustment(Bmp: TGpBitmap; hValue, sValue, bValue: Integer);

var

Data: TBitmapData;

x, y: Integer;

p: PRGBQuad;

begin

sValue := sValue * 255 div 100;

bValue := bValue * 255 div 100;

Data := Bmp.LockBits(GpRect(0, 0, Bmp.Width, Bmp.Height), [imRead, imWrite], pf32bppARGB);

try

p := Data.Scan0;

for y := 1 to Data.Height do

begin

for x := 1 to Data.Width do

begin

if (sValue > 0) and (bValue <> 0) then

SetBright(p^.rgbRed, p^.rgbGreen, p^.rgbBlue, bValue);

SetHueAndSaturation(p^.rgbRed, p^.rgbGreen, p^.rgbBlue, hValue, sValue);

if (sValue <= 0) and (bValue <> 0) then

SetBright(p^.rgbRed, p^.rgbGreen, p^.rgbBlue, bValue);

Inc(p);

end;

end;

finally

Bmp.UnlockBits(Data);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Source := TGpBitmap.Create('http://www.cnblogs.com/GdiplusDemo/media/100_0349.jpg');

r := GpRect(0, 0, Source.Width, Source.Height);

Bitmap := Source.Clone(r, pf32bppARGB);

DoubleBuffered := True;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Bitmap.Free;

Source.Free;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

var

g: TGpGraphics;

begin

g := TGpGraphics.Create(PaintBox1.Canvas.Handle);

try

g.DrawImage(Bitmap, r);

g.TranslateTransform(0, r.Height);

g.DrawImage(Source, r);

finally

g.Free;

end;

end;

procedure TForm1.HBarChange(Sender: TObject);

begin

if not Lock then

HEdit.Text := IntToStr(HBar.Position);

end;

procedure TForm1.SBarChange(Sender: TObject);

begin

if not Lock then

SEdit.Text := IntToStr(SBar.Position);

end;

procedure TForm1.BBarChange(Sender: TObject);

begin

if not Lock then

BEdit.Text := IntToStr(BBar.Position);

end;

procedure TForm1.HEditChange(Sender: TObject);

begin

Lock := True;

if TEdit(Sender).Text = '' then

TEdit(Sender).Text := '0';

case TEdit(Sender).Tag of

0: HEdit.Text := IntToStr(HBar.Position);

1: HEdit.Text := IntToStr(HBar.Position);

2: HEdit.Text := IntToStr(HBar.Position);

end;

Lock := False;

Bitmap.Free;

Bitmap := Source.Clone(r, pf32bppARGB);

if (HBar.Position <> 0) or (SBar.Position <> 0) or (BBar.Position <> 0) then

GdipHSBAdjustment(Bitmap, HBar.Position, SBar.Position, BBar.Position);

PaintBox1.Invalidate;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

HBar.Position := 0;

SBar.Position := 0;

BBar.Position := 0;

end;

end.

程序运行界面截图：



代码中所用Gdiplus单元下载地址及BUG更正见文章《GDI+ for VCL基础 -- GDI+ 与 VCL》。