teefilters.pas

BCB第三方组件

    x,y : Integer;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  tmpH:=R.Bottom-R.Top;

  for y:=R.Top to R.Top+(tmpH div 2)-1 do
      for x:=R.Left to R.Right do
      begin
        tmp:=Lines[y,x];
        tmpY:=tmpH-y;
        Lines[y,x]:=Lines[tmpY,x];
        Lines[tmpY,x]:=tmp;
      end;
end;

class function TFlipFilter.Description: String;
begin
  result:=TeeMsg_Flip;
end;

{ TReverseFilter }
procedure TReverseFilter.Apply(Bitmap:TBitmap; const R:TRect);
var tmp : TRGB;
    tmpW,
    tmpX,
    x,y : Integer;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;
     
  tmpW:=R.Right-R.Left;

  for x:=R.Left to R.Left+(tmpW div 2)-1 do
      for y:=R.Top to R.Bottom do
      begin
        tmp:=Lines[y,x];
        tmpX:=tmpW-x;
        Lines[y,x]:=Lines[y,tmpX];
        Lines[y,tmpX]:=tmp;
      end;
end;

class function TReverseFilter.Description: String;
begin
  result:=TeeMsg_Reverse;
end;

{ TAmountFilter }
Constructor TAmountFilter.Create(Collection:TCollection);
begin
  inherited;
  FPercent:=True;
  FAmount:=5; // %
end;

function TAmountFilter.ScrollMin:Integer;
begin
  if FPercent then
     if IOnlyPositive then result:=0 else result:=-100
  else
     if IOnlyPositive then result:=0 else result:=-255;
end;

function TAmountFilter.ScrollMax:Integer;
begin
  if FPercent then result:=100
              else result:=255;
end;

procedure TAmountFilter.ResetScroll(Sender:TObject);
begin
  FScrollBar.Min:=ScrollMin;
  FScrollBar.Max:=ScrollMax;
end;

procedure TAmountFilter.CreateEditor(Creator:IFormCreator; AChanged:TNotifyEvent);
begin
  inherited;
  FScrollBar:=Creator.AddScroll('Amount',ScrollMin,ScrollMax); // Do not localize
  Creator.AddCheckBox('Percent',TeeMsg_Percent,ResetScroll); // Do not localize
end;

{ TBrightnessFilter }
procedure TBrightnessFilter.Apply(Bitmap:TBitmap; const R: TRect);
var x,y,l :  Integer;
    IPercent : Single;
begin
  if Amount=0 then
     Exit;

  inherited;

  if Length(Lines)=0 then
     Exit;

  if Percent then
  begin
    IPercent:=FAmount*0.01;

    for y:=R.Top to R.Bottom do
        for x:=R.Left to R.Right do
        with Lines[y,x] do
        begin
          l:=Red+Round(255*IPercent);
          if l<0 then Red:=0 else if l>255 then Red:=255 else Red:=l;

          l:=Green+Round(255*IPercent);
          if l<0 then Green:=0 else if l>255 then Green:=255 else Green:=l;

          l:=Blue+Round(255*IPercent);
          if l<0 then Blue:=0 else if l>255 then Blue:=255 else Blue:=l;
        end;
  end
  else
  for y:=R.Top to R.Bottom do
      for x:=R.Left to R.Right do
      with Lines[y,x] do
      begin
        l:=Red+Amount;
        if l<0 then Red:=0 else if l>255 then Red:=255 else Red:=l;

        l:=Green+Amount;
        if l<0 then Green:=0 else if l>255 then Green:=255 else Green:=l;

        l:=Blue+Amount;
        if l<0 then Blue:=0 else if l>255 then Blue:=255 else Blue:=l;
      end;
end;

class function TBrightnessFilter.Description: String;
begin
  result:=TeeMsg_Brightness;
end;

procedure ColorToHLS(Color: TColor; out Hue, Luminance, Saturation: Word);
var tmp : TRGB;
begin
  Color:=ColorToRGB(Color);
  tmp.Red:=GetRValue(Color);
  tmp.Green:=GetGValue(Color);
  tmp.Blue:=GetBValue(Color);
  RGBToHLS(tmp,Hue,Luminance,Saturation);
end;

type
  Float=Single;

const
  // HLSMAX BEST IF DIVISIBLE BY 6.  RGBMAX, HLSMAX must each fit in a byte.
  HLSMAX = 240;  // H,L, and S vary over 0-HLSMAX
  RGBMAX = 255;  // R,G, and B vary over 0-RGBMAX

  RGBMAX2 = 2.0*RGBMAX;
  InvRGBMAX2 = 1.0/RGBMAX2;

  HLSMAXDiv2=HLSMAX/2;
  HLSMAXDiv3=HLSMAX/3;
  HLSMAXDiv6=HLSMAX/6;
  HLSMAXDiv12=HLSMAX/12;
  HLSMAX2=HLSMAX*2;
  HLSMAX3=HLSMAX*3;
  HLSMAX2Div3=HLSMAX2/3;

  { Hue is undefined if Saturation is 0 (grey-scale)
    This value determines where the Hue scrollbar is
    initially set for achromatic colors }
  HLSUndefined = 160; // HLSMAX2Div3;

procedure RGBToHLS(const Color: TRGB; out Hue, Luminance, Saturation: Word);
var
  H, L, S: Float;
  R, G, B: Word;
  dif : Integer;
  sum, cMax, cMin: Word;
  Rdelta, Gdelta, Bdelta: Extended; { intermediate value: % of spread from max }
begin
  R:=Color.Red;
  G:=Color.Green;
  B:=Color.Blue;

  { calculate lightness }
  if R>G then
     if R>B then cMax:=R else cMax:=B
  else
     if G>B then cMax:=G else cMax:=B;

  if R<G then
     if R<B then cMin:=R else cMin:=B
  else
     if G<B then cMin:=G else cMin:=B;

  sum:=(cMax + cMin);

  L := ( (sum * HLSMAX) + RGBMAX ) / ( 2 * RGBMAX);

  if cMax = cMin then  { r=g=b --> achromatic case }
  begin                { saturation }
    Hue := Round(HLSUndefined);
//    pwHue := 160;      { MS ColoroHLS always defaults to 160 in this case }
    Luminance := Round(L);
    Saturation := 0;
  end
  else                 { chromatic case }
  begin
    dif:=cMax-cMin;

    { saturation }
    if L <= HLSMAXDiv2 then
       S := ( (dif*HLSMAX) + (sum*0.5) ) / sum
    else
       S := ( (dif*HLSMAX) + ( RGBMAX-(sum*0.5) )) / (2*RGBMAX-sum);

    { hue }
    Rdelta := ( ((cMax-R)*HLSMAXDiv6) + (dif*0.5) ) / dif;
    Gdelta := ( ((cMax-G)*HLSMAXDiv6) + (dif*0.5) ) / dif;
    Bdelta := ( ((cMax-B)*HLSMAXDiv6) + (dif*0.5) ) / dif;

    if R = cMax then
       H := Bdelta - Gdelta
    else
    if G = cMax then
       H := HLSMAX3 + Rdelta - Bdelta
    else // B == cMax
       H := HLSUndefined + Gdelta - Rdelta;

    if H < 0 then H := H + HLSMAX
    else
    if H > HLSMAX then H := H - HLSMAX;

    Hue := Round(H);
    Luminance := Round(L);
    Saturation := Round(S);
  end;
end;

function HLSToColor(Hue, Luminance, Saturation: Word):TColor;
var tmp : TRGB;
begin
  HLSToRGB(Hue,Luminance,Saturation,tmp);
  result:=RGB(tmp.Red,tmp.Green,tmp.Blue);
end;

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

  function HueToRGB(const Lum, Sat:Float; Hue: Float): Integer;
  begin
    { range check: note values passed add/subtract thirds of range }
    if hue < 0 then hue:=hue+HLSMAX;
    if hue > HLSMAX then hue:=hue-HLSMAX;

    { return r,g, or b value from this tridrant }
    if hue < HLSMAXDiv6 then
        Result := Round( Lum + (((Sat-Lum)*hue+HLSMAXDiv12)/HLSMAXDiv6))
    else
    if hue < HLSMAXDiv2 then
        Result := Round( Sat)
    else
    if hue < HLSMAX2Div3 then
        Result := Round( Lum + (((Sat-Lum)*(HLSMAX2Div3-hue)+HLSMAXDiv12)/HLSMAXDiv6) )
    else
        Result := Round( Lum );
  end;

  function RoundColor(const Value: Integer): Integer;
  begin
    if Value > 255 then Result := 255 else Result := Round(Value);
  end;

var
  Magic1, Magic2: Float;       { calculated magic numbers (really!) }

  function RoundColor2(const Hue: Float): Integer;
  begin
    result:=RoundColor(Round((HueToRGB(Magic1,Magic2,Hue)*RGBMAX + HLSMAXDiv2)/HLSMAX));
  end;

begin
  if Saturation = 0 then
  with rgb do
  begin            { achromatic case }
    Red := RoundColor(Round((Luminance * RGBMAX)/HLSMAX) );
    Green:=Red;
    Blue:=Green;
    if Hue <> HLSUndefined then ;{ ERROR }
  end
  else
  begin            { chromatic case }
    { set up magic numbers }
    if Luminance <= HLSMAXDiv2 then
       Magic2 := (Luminance * (HLSMAX + Saturation) + HLSMAXDiv2) / HLSMAX
    else
       Magic2 := Luminance + Saturation - ((Luminance * Saturation) + HLSMAXDiv2) / HLSMAX;

    Magic1 := 2 * Luminance - Magic2;

    { get RGB, change units from HLSMAX to RGBMAX }
    rgb.Red:=RoundColor2(Hue+HLSMAXDiv3);
    rgb.Green:=RoundColor2(Hue);
    rgb.Blue:=RoundColor2(Hue-HLSMAXDiv3);
  end;
end;

{ TColorFilter }

procedure TColorFilter.Apply(Bitmap:TBitmap; const R: TRect); {$IFDEF CLR}unsafe;{$ENDIF}
var x,y    : Integer;
    tmpInt : Integer;
    Line   : PRGBs;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  if (Red<>0) or (Green<>0) or (Blue<>0) then
  for y:=R.Top to R.Bottom do
  begin
    Line:=Lines[y];

    for x:=R.Left to R.Right do
    with Line[x] do
    begin
      if Self.FRed<>0 then
      begin
        tmpInt:=Red+Self.FRed;
        if tmpInt<0 then Red:=0 else
        if tmpInt>255 then Red:=255 else
                           Red:=tmpInt;
      end;

      if Self.FGreen<>0 then
      begin
        tmpInt:=Green+Self.FGreen;
        if tmpInt<0 then Green:=0 else
        if tmpInt>255 then Green:=255 else
                           Green:=tmpInt;
      end;

      if Self.FBlue<>0 then
      begin
        tmpInt:=Blue+Self.FBlue;
        if tmpInt<0 then Blue:=0 else
        if tmpInt>255 then Blue:=255 else
                           Blue:=tmpInt;
      end;
    end;
  end;
end;

procedure TColorFilter.CreateEditor(Creator: IFormCreator;
  AChanged: TNotifyEvent);
begin
  inherited;
  Creator.AddScroll('Red',-255,255); // Do not localize
  Creator.AddScroll('Green',-255,255); // Do not localize
  Creator.AddScroll('Blue',-255,255); // Do not localize
end;

class function TColorFilter.Description: String;
begin
  result:=TeeMsg_Color;
end;

{ THueLumSatFilter }

procedure THueLumSatFilter.Apply(Bitmap:TBitmap; const R: TRect); {$IFDEF CLR}unsafe;{$ENDIF}
var x,y    : Integer;
    tmpInt : Integer;
    tmpHue : Word;
    tmpLum : Word;
    tmpSat : Word;
    Line   : PRGBs;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  if (FHue<>0) or (FLum<>0) or (FSat<>0) then
  for y:=R.Top to R.Bottom do
  begin
    Line:=Lines[y];

    for x:=R.Left to R.Right do
    begin
      RGBToHLS(Line[x],tmpHue,tmpLum,tmpSat);

      if Self.FHue<>0 then
      begin
        tmpInt:=tmpHue+Self.FHue;
        if tmpInt<0 then tmpHue:=0 else
        if tmpInt>255 then tmpHue:=255 else
                           tmpHue:=tmpInt;
      end;

      if Self.FLum<>0 then
      begin
        tmpInt:=tmpLum+Self.FLum;
        if tmpInt<0 then tmpLum:=0 else
        if tmpInt>255 then tmpLum:=255 else
                           tmpLum:=tmpInt;
      end;

      if Self.FSat<>0 then
      begin
        tmpInt:=tmpSat+Self.FSat;
        if tmpInt<0 then tmpSat:=0 else
        if tmpInt>255 then tmpSat:=255 else
                           tmpSat:=tmpInt;
      end;

      HLSToRGB(tmpHue,tmpLum,tmpSat,Line[x]);
    end;
  end;
end;

procedure THueLumSatFilter.CreateEditor(Creator: IFormCreator;
  AChanged: TNotifyEvent);
begin
  inherited;
  Creator.AddScroll('Hue',-255,255); // Do not localize
  Creator.AddScroll('Luminance',-255,255); // Do not localize
  Creator.AddScroll('Saturation',-255,255); // Do not localize
end;

class function THueLumSatFilter.Description: String;
begin
  result:=TeeMsg_HueLumSat;
end;

{ TSharpenFilter }

procedure TSharpenFilter.Apply(Bitmap:TBitmap; const R: TRect);
const Center=2.0;
      Pix=-((Center-1)/8.0);
begin
  Weights[-1,-1]:=Pix;  Weights[-1,0]:=Pix;    Weights[-1,1]:=Pix;
  Weights[ 0,-1]:=Pix;  Weights[ 0,0]:=Center; Weights[ 0,1]:=Pix;
  Weights[ 1,-1]:=Pix;  Weights[ 1,0]:=Pix;    Weights[ 1,1]:=Pix;

  InvTotalWeight:=1.0/16.0;

  inherited;
end;

class function TSharpenFilter.Description: String;
begin
  result:=TeeMsg_Sharpen;
end;

{ TGammaCorrectionFilter }
Constructor TGammaCorrectionFilter.Create(Collection:TCollection);
begin
  inherited;
  FAmount:=70;
  IOnlyPositive:=True;
end;

procedure TGammaCorrectionFilter.Apply(Bitmap:TBitmap; const R: TRect);
var t,
    x,y    : Integer;
    IGamma : Array[0..255] of Byte;
    tmp    : Single;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  tmp:=Max(0.001,Abs(Amount)*0.01);

  IGamma[0]:=0;
  for t:=1 to 255 do
      IGamma[t]:=Round(Exp(Ln(t/255.0)/tmp)*255.0);

  for y:=R.Top to R.Bottom do
    for x:=R.Left to R.Right do
    with Lines[y,x] do
    begin
      Red:=IGamma[Red];
      Green:=IGamma[Green];
      Blue:=IGamma[Blue];
    end;
end;

class function TGammaCorrectionFilter.Description: String;
begin
  result:=TeeMsg_GammaCorrection;
end;

{ TEmbossFilter }

procedure TEmbossFilter.Apply(Bitmap:TBitmap; const R: TRect);
begin
  Weights[-1,-1]:= 0;  Weights[-1,0]:=-1;    Weights[-1,1]:=0;
  Weights[ 0,-1]:=-1;  Weights[ 0,0]:=1;     Weights[ 0,1]:=1;
  Weights[ 1,-1]:= 0;  Weights[ 1,0]:=-1;    Weights[ 1,1]:=0;

  InvTotalWeight:=1.0/1.0;

  inherited;
end;

class function TEmbossFilter.Description: String;
begin
  result:=TeeMsg_Emboss;
end;

{ TContrastFilter }

procedure TContrastFilter.Apply(Bitmap:TBitmap; const R: TRect);
var x,y,l :  Integer;
    IPercent : Single;
begin
  inherited;

  if Length(Lines)=0 then
     Exit;

  if Percent then
     IPercent:=FAmount*0.01
  else
     IPercent:=1;

  for y:=R.Top to R.Bottom do
      for x:=R.Left to R.Right do
      with Lines[y,x] do
      begin
        if Percent then l:=Red+(Round(Red*IPercent)*(Red-128) div 256)
                   else l:=Red+(Amount*(Red-128) div 256);

        if l<0 then Red:=0 else if l>255 then Red:=255 else Red:=l;

        if Percent then l:=Green+(Round(Green*IPercent)*(Green-128) div 256)
                   else l:=Green+(Amount*(Green-128) div 256);

        if l<0 then Green:=0 else if l>255 then Green:=255 else Green:=l;

        if Percent then l:=Blue+(Round(Blue*IPercent)*(Blue-128) div 256)
                   else l:=Blue+(Amount*(Blue-128) div 256);

        if l<0 then Blue:=0 else if l>255 then Blue:=255 else Blue:=l;
      end;
end;

class function TContrastFilter.Description: String;
begin
  result:=TeeMsg_Contrast;
end;

{ TSoftenFilter }

procedure TSoftenFilter.Apply(Bitmap:TBitmap; const R: TRect);
begin
  Weights[-1,-1]:=0;  Weights[-1,0]:=0;    Weights[-1,1]:=0;
  Weights[ 0,-1]:=0;  Weights[ 0,0]:=1;    Weights[ 0,1]:=1;
  Weights[ 1,-1]:=0;  Weights[ 1,0]:=1;    Weights[ 1,1]:=1;

  InvTotalWeight:=1.0/4.0;

  inherited;
end;

class function TSoftenFilter.Description: String;
begin
  result:=TeeMsg_AntiAlias;
end;

{ TImageFiltered }

Constructor TImageFiltered.Create(AOwner: TComponent);
begin
  inherited;
  FFilters:=TFilterItems.Create(Self,TTeeFilter);
end;

Destructor TImageFiltered.Destroy;
begin
  FFilters.Free;
  inherited;
end;

function TImageFiltered.Filtered:TBitmap;
var tmpDest : TBitmap;
    tmpR    : TRect;
    tmpW    : Integer;
    tmpH    : Integer;
begin
  result:=TBitmap.Create;
  result.Assign(Picture.Graphic);

  tmpR:=DestRect;
  tmpW:=tmpR.Right-tmpR.Left;
  tmpH:=tmpR.Bottom-tmpR.Top;

  if (tmpW<>result.Width) or (tmpH<>result.Height) then
  begin
    tmpDest:=SmoothBitmap(result,tmpW,tmpH);