teefilters.pas

BCB第三方组件

{**********************************************}
{   TeeChart and TeeTree Image Filters         }
{                                              }
{   Copyright (c) 2006-2007 by David Berneda   }
{        All Rights Reserved                   }
{**********************************************}
unit TeeFilters;
{$I TeeDefs.inc}

{$R-}

interface

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  Classes,
  {$IFDEF D6}
  Types,
  {$ENDIF}
  {$IFDEF CLX}
  Qt, QControls, QGraphics, QStdCtrls, QExtCtrls,
  {$ELSE}
  Controls, Graphics, StdCtrls, ExtCtrls,
  {$ENDIF}
  TeCanvas;

{$IFDEF CLR}
{$UNSAFECODE ON}
{$ENDIF}

type
  TResizeFilter=class(TTeeFilter)
  private
    FWidth  : Integer;
    FHeight : Integer;
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;

    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Width:Integer read FWidth write FWidth default 0;
    property Height:Integer read FHeight write FHeight default 0;
  end;

  TCropFilter=class(TResizeFilter)
  private
    FLeft   : Integer;
    FSmooth : Boolean;
    FTop    : Integer;
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;

    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Left:Integer read FLeft write FLeft default 0;
    property Smooth:Boolean read FSmooth write FSmooth default False;
    property Top:Integer read FTop write FTop default 0;
  end;

  TInvertFilter=class(TTeeFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TGrayMethod=(gmSimple, gmEye, gmEye2);

  TGrayScaleFilter=class(TTeeFilter)
  private
    FMethod : TGrayMethod;
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;

    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Method:TGrayMethod read FMethod write FMethod default gmSimple;
  end;

  TFlipFilter=class(TTeeFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TReverseFilter=class(TTeeFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TAmountFilter=class(TTeeFilter)
  private
    FAmount  : Integer;
    FPercent : Boolean;
    FScrollBar : TScrollBar;

    IOnlyPositive : Boolean;
    procedure ResetScroll(Sender:TObject);
    function ScrollMin:Integer;
    function ScrollMax:Integer;
  public
    Constructor Create(Collection:TCollection); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
  published
    property Percent:Boolean read FPercent write FPercent default True;
    property Amount:Integer read FAmount write FAmount default 5;
  end;

  TMosaicFilter=class(TAmountFilter)
  public
    Constructor Create(Collection:TCollection); override;
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TBrightnessFilter=class(TAmountFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TContrastFilter=class(TAmountFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TColorFilter=class(TTeeFilter)
  private
    FBlue  : Integer;
    FGreen : Integer;
    FRed   : Integer;
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Red:Integer read FRed write FRed default 0;
    property Green:Integer read FGreen write FGreen default 0;
    property Blue:Integer read FBlue write FBlue default 0;
  end;

  THueLumSatFilter=class(TTeeFilter)
  private
    FHue : Integer;
    FLum : Integer;
    FSat : Integer;
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Hue:Integer read FHue write FHue default 0;
    property Luminance:Integer read FLum write FLum default 0;
    property Saturation:Integer read FSat write FSat default 0;
  end;

  TSharpenFilter=class(TConvolveFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TEmbossFilter=class(TConvolveFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TSoftenFilter=class(TConvolveFilter)
  public
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  end;

  TGammaCorrectionFilter=class(TAmountFilter)
  public
    Constructor Create(Collection:TCollection); override;
    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    class function Description: String; override;
  published
    property Amount default 70;
  end;

  TRotateFilter=class(TTeeFilter)
  private
    FAngle     : Double;
    FAutoSize  : Boolean;
    FBackColor : TColor;
    procedure SetAngle(const Value: Double);
  public
    Constructor Create(Collection:TCollection); override;

    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Angle:Double read FAngle write SetAngle;
    property AutoSize:Boolean read FAutoSize write FAutoSize default True;
    property BackColor:TColor read FBackColor write FBackColor default clWhite;
  end;

  TMirrorDirection=(mdDown, mdUp, mdRight, mdLeft);

  TMirrorFilter=class(TTeeFilter)
  private
    FDirection : TMirrorDirection;
  public
    Constructor Create(Collection:TCollection); override;

    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Direction:TMirrorDirection read FDirection write FDirection
                                default mdDown;
  end;

  TTileFilter=class(TTeeFilter)
  private
    FNumCols : Integer;
    FNumRows : Integer;
  public
    Constructor Create(Collection:TCollection); override;

    procedure Apply(Bitmap:TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property NumCols:Integer read FNumCols write FNumCols default 3;
    property NumRows:Integer read FNumRows write FNumRows default 3;
  end;

  TBevelFilter=class(TTeeFilter)
  private
    FBright : Integer;
    FSize   : Integer;
  public
    Constructor Create(Collection:TCollection); override;

    procedure Apply(Bitmap: TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Bright:Integer read FBright write FBright default 64;
    property Size:Integer read FSize write FSize default 15;
  end;

  TZoomFilter=class(TTeeFilter)
  private
    FPercent : Double;
    FSmooth  : Boolean;
  public
    Constructor Create(Collection:TCollection); override;

    procedure Apply(Bitmap: TBitmap; const R:TRect); override;
    procedure CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent); override;
    class function Description: String; override;
  published
    property Percent:Double read FPercent write FPercent;
    property Smooth:Boolean read FSmooth write FSmooth default False;
  end;

  TImageFiltered=class(TImage)
  private
    FFilters : TFilterItems;

    function FiltersStored:Boolean;
    procedure ReadFilters(Reader: TReader);
    procedure SetFilters(const Value: TFilterItems);
    procedure WriteFilters(Writer: TWriter);
  protected
    procedure DefineProperties(Filer:TFiler); override;
    procedure Paint; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function Filtered:TBitmap;
  published
    property Filters:TFilterItems read FFilters write SetFilters stored False;
  end;

var
  FilterClasses : TList;

procedure TeeRegisterFilters(const FilterList:Array of TFilterClass);
procedure TeeUnRegisterFilters(const FilterList:Array of TFilterClass);

procedure ColorToHLS(Color: TColor; out Hue, Luminance, Saturation: Word);
procedure RGBToHLS(const Color: TRGB; out Hue, Luminance, Saturation: Word);

procedure HLSToRGB(Hue, Luminance, Saturation: Word; out rgb: TRGB);
function HLSToColor(Hue, Luminance, Saturation: Word):TColor;

// Converts ABitmap pixels into Gray Scale (levels of gray) v5.02 (v8 moved from TeCanvas.pas)
Procedure TeeGrayScale(ABitmap:TBitmap; Inverted:Boolean; AMethod:Integer);

implementation

uses
  Math, SysUtils, TypInfo, TeeConst;

procedure TeeRegisterFilters(const FilterList:Array of TFilterClass);
var t : Integer;
begin
  if not Assigned(FilterClasses) then
     FilterClasses:=TList.Create;

  for t:=Low(FilterList) to High(FilterList) do
  if FilterClasses.IndexOf({$IFDEF CLR}TObject{$ENDIF}(FilterList[t]))=-1 then
  begin
    FilterClasses.Add({$IFDEF CLR}TObject{$ENDIF}(FilterList[t]));
    RegisterClass(FilterList[t]);
  end;
end;

procedure TeeUnRegisterFilters(const FilterList:Array of TFilterClass);
var t : Integer;
begin
  if Assigned(FilterClasses) then
  for t:=Low(FilterList) to High(FilterList) do
      FilterClasses.Remove({$IFDEF CLR}TObject{$ENDIF}(FilterList[t]));
end;

{ TResizeFilter }

function SmoothBitmap(Bitmap:TBitmap; Width,Height:Integer):TBitmap;
begin
  result:=TBitmap.Create;
  TeeSetBitmapSize(result,Width,Height);
  SmoothStretch(Bitmap,result);
end;

procedure TResizeFilter.Apply(Bitmap:TBitmap; const R:TRect);
var tmp : TBitmap;
begin
  if (Width>0) and (Height>0) then
  begin
    tmp:=SmoothBitmap(Bitmap,Width,Height);
    try
      TeeSetBitmapSize(Bitmap,Width,Height);
      Bitmap.Canvas.Draw(0,0,tmp);
    finally
      tmp.Free;
    end;
  end;
// Do not call inherited;
end;

procedure TResizeFilter.CreateEditor(Creator: IFormCreator;
  AChanged: TNotifyEvent);
begin
  inherited;
  Creator.AddInteger('Width',TeeMsg_Width,0,10000); // Do not localize
  Creator.AddInteger('Height',TeeMsg_Height,0,10000); // Do not localize
end;

class function TResizeFilter.Description: String;
begin
  result:=TeeMsg_Resize;
end;

{ TCropFilter }

procedure TCropFilter.Apply(Bitmap: TBitmap; const R: TRect);
var tmp : TBitmap;
begin
  if (Width>0) and (Height>0) then
  begin
    tmp:=TBitmap.Create;
    try
      tmp.PixelFormat:=Bitmap.PixelFormat;
      TeeSetBitmapSize(tmp,Width,Height);

      tmp.Canvas.CopyRect(TeeRect(0,0,tmp.Width,tmp.Height),
         Bitmap.Canvas,TeeRect(Left,Top,Left+Width-1,Top+Height-1));

      if FSmooth then
         SmoothStretch(tmp,Bitmap)
      else
         Bitmap.Canvas.StretchDraw(TeeRect(0,0,Bitmap.Width-1,Bitmap.Height-1),tmp);
    finally
      tmp.Free;
    end;
  end;

// Do not call inherited;
end;

procedure TCropFilter.CreateEditor(Creator: IFormCreator;
  AChanged: TNotifyEvent);
begin
  inherited;
  Creator.AddInteger('Left',TeeMsg_Left,0,10000); // Do not localize
  Creator.AddInteger('Top',TeeMsg_Top,0,10000); // Do not localize
  Creator.AddCheckBox('Smooth',TeeMsg_Smooth); // Do not localize
end;

class function TCropFilter.Description: String;
begin
  result:=TeeMsg_Crop;
end;

{ TInvertFilter }
procedure TInvertFilter.Apply(Bitmap:TBitmap; const R:TRect);
var x,y : Integer;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;
     
  for y:=R.Top to R.Bottom do
    for x:=R.Left to R.Right do
    with Lines[y,x] do
    begin
      Blue:=255-Blue;
      Green:=255-Green;
      Red:=255-Red;
    end;
end;

class function TInvertFilter.Description: String;
begin
  result:=TeeMsg_Invert;
end;

{ TGrayScaleFilter }
procedure TGrayScaleFilter.Apply(Bitmap:TBitmap; const R:TRect);
var x,y :  Integer;
    tmp : Byte;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;
     
  case Method of
    gmSimple: for y:=R.Top to R.Bottom do
                  for x:=R.Left to R.Right do
                  with Lines[y,x] do
                  begin
                    tmp:=(Blue+Green+Red) div 3;
                    Blue:=tmp;
                    Green:=tmp;
                    Red:=tmp;
                  end;
       gmEye: for y:=R.Top to R.Bottom do
                  for x:=R.Left to R.Right do
                  with Lines[y,x] do
                  begin
                    tmp:=Round( (0.30*Red) +
                                (0.59*Green) +
                                (0.11*Blue));

                    Blue:=tmp;
                    Green:=tmp;
                    Red:=tmp;
                  end;
      gmEye2: for y:=R.Top to R.Bottom do
                  for x:=R.Left to R.Right do
                  with Lines[y,x] do
                  begin
                    tmp:=(11*Red+16*Green+5*Blue) div 32;
                    Blue:=tmp;
                    Green:=tmp;
                    Red:=tmp;
                  end;
    end;
end;

procedure TGrayScaleFilter.CreateEditor(Creator: IFormCreator;
  AChanged: TNotifyEvent);
begin
  inherited;
  Creator.AddCombo('Method'); // Do not localize
end;

class function TGrayScaleFilter.Description: String;
begin
  result:=TeeMsg_GrayScale;
end;

{ TMosaicFilter }
constructor TMosaicFilter.Create(Collection:TCollection);
begin
  inherited;
  FAmount:=8;
  IOnlyPositive:=True;
end;

procedure TMosaicFilter.Apply(Bitmap:TBitmap; const R:TRect); {$IFDEF CLR}unsafe;{$ENDIF}
var
  tmpAmountX : Integer;
  tmpAmountY : Integer;
  tmpDims    : Single;

  procedure DoMosaic(const tmpX,tmpY:Integer); {$IFDEF CLR}unsafe;{$ENDIF}
  var ar,
      ag,
      ab : Integer;
      xx,
      yy : Integer;
      a    : TRGB;
      Line : PRGBs;
  begin
    ar:=0;
    ag:=0;
    ab:=0;

    for yy:=0 to tmpAmountY do
    begin
      Line:=Lines[tmpY+yy];

      for xx:=0 to tmpAmountX do
      with Line[tmpX+xx] do
      begin
        Inc(ar,Red);
        Inc(ag,Green);
        Inc(ab,Blue);
      end;
    end;

    a.Red:=Round(ar*tmpDims);
    a.Green:=Round(ag*tmpDims);
    a.Blue:=Round(ab*tmpDims);

    for yy:=0 to tmpAmountY do
    begin
      Line:=Lines[tmpY+yy];
      for xx:=0 to tmpAmountX do
          Line[tmpX+xx]:=a;
    end;
  end;

  procedure DoMosaicRow(const tmpY:Integer);
  var tmpX : Integer;
  begin
    tmpX:=R.Left;
    while tmpX<R.Right-Amount do
    begin
      DoMosaic(tmpX,tmpY);
      Inc(tmpX,Amount);
    end;

    // Remainder horizontal mosaic cell
    if tmpX<R.Right then
    begin
      tmpAmountX:=R.Right-tmpX;
      tmpDims:=1.0/(Succ(tmpAmountX)*Succ(tmpAmountY));

      DoMosaic(tmpX,tmpY);

      tmpAmountX:=tmpAmountY;
      tmpDims:=1.0/Sqr(Amount);
    end;
  end;

var tmpY : Integer;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  if Amount>0 then
  begin
    tmpDims:=1.0/Sqr(Amount);
    tmpAmountX:=Amount-1;
    tmpAmountY:=tmpAmountX;

    tmpY:=R.Top;
    while tmpY<R.Bottom-Amount do
    begin
      DoMosaicRow(tmpY);
      Inc(tmpY,Amount);
    end;

    // Remainder vertical mosaic row cells
    if tmpY<R.Bottom then
    begin
      tmpAmountY:=R.Bottom-tmpY-1;
      tmpDims:=1.0/(Succ(tmpAmountX)*Succ(tmpAmountY));
      DoMosaicRow(tmpY);
    end;
  end;
end;

class function TMosaicFilter.Description: String;
begin
  result:=TeeMsg_Mosaic;
end;

{ TFlipFilter }
procedure TFlipFilter.Apply(Bitmap:TBitmap; const R:TRect); {$IFDEF CLR}unsafe;{$ENDIF}
var tmp : TRGB;
    tmpH,
    tmpY,