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 plain copy print ?

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

来源：https://www.cnblogs.com/esreal/archive/2013/01/02/2841845.html

标签

Delphi

gdi