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图像处理》系列文章中，特此致歉。