zoukankan      html  css  js  c++  java
  • 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图像处理》系列文章中,特此致歉。

  • 相关阅读:
    网站安全检测
    Centos下Subversion 服务器安装配置
    报错:1130-host ... is not allowed to connect to this MySql server 开放mysql远程连接 不使用localhost
    八个免费在线网站速度测试服务-分析影响网页加载因素提高网站访问速度
    Python处理HTML转义字符
    atitit.TokenService  token服务模块的设计
    Atitit.木马 病毒 免杀 技术 360免杀 杀毒软件免杀 原理与原则 attilax 总结
    atitit.TokenService  token服务模块的设计
    Atitit.atijson 类库的新特性设计与实现 v3 q31
    Atitit.atijson 类库的新特性设计与实现 v3 q31
  • 原文地址:https://www.cnblogs.com/blogpro/p/11426649.html
Copyright © 2011-2022 走看看