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》。

建议和指导请来信：maozefa@hotmail.com

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