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代码包含在其中：

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('..\..\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》。

建议和指导请来信：[e-mail]

注：本文于2009.11.1整理，以前的BASM代码从本文删除，转移到《Delphi图像处理》系列文章中，特此致歉。