tchart

TeeChart 图像滤镜介绍

最新推荐文章于 2019-08-01 04:06:19 发布

转载最新推荐文章于 2019-08-01 04:06:19 发布 · 634 阅读

DELPHI开发专栏收录该内容

194 篇文章

订阅专栏

{**********************************************}
{ TeeChart and TeeTree Image Filters }
{ }
{**********************************************}
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,
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);
result.Free;
result:=tmpDest;
end;
FFilters.ApplyTo(result);
end;
procedure TImageFiltered.SetFilters(const Value: TFilterItems);
begin
FFilters.Assign(Value);
end;
procedure TImageFiltered.Paint;
var tmpCanvas : TCanvas;
tmp : TGraphic;
begin
tmp:=Filtered;
try
tmpCanvas:=TControlCanvas.Create;
try
TControlCanvas(tmpCanvas).Control:=Self;
tmpCanvas.Draw(0,0,tmp);
if csDesigning in ComponentState then
with tmpCanvas do
begin
Pen.Style:=psDash;
Brush.Style:=bsClear;
{$IFDEF CLX}
Start;
QPainter_setBackgroundMode(Handle,BGMode_TransparentMode);
Stop;
{$ELSE}
SetBkMode(Handle,Windows.TRANSPARENT);
{$ENDIF}
with ClientRect do
Rectangle(Left,Top,Right,Bottom);
end;
finally
tmpCanvas.Free;
end;
finally
tmp.Free;
end;
end;
procedure TImageFiltered.ReadFilters(Reader: TReader);
begin
TTeePicture.ReadFilters(Reader,Filters);
end;
procedure TImageFiltered.WriteFilters(Writer: TWriter);
begin
TTeePicture.WriteFilters(Writer,Filters);
end;
function TImageFiltered.FiltersStored:Boolean;
begin
result:=Assigned(FFilters) and (FFilters.Count>0);
end;
procedure TImageFiltered.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('FilterItems',ReadFilters,WriteFilters,FiltersStored); // Do not localize
end;
{ TRotateFilter }
Constructor TRotateFilter.Create(Collection:TCollection);
begin
inherited;
FBackColor:=clWhite;
FAutoSize:=True;
end;
procedure TRotateFilter.Apply(Bitmap: TBitmap; const R: TRect); {$IFDEF CLR}unsafe;{$ENDIF}
const
TeePiStep:Single=Pi/180.0;
var tmp : TBitmap;
x,
y,
xc,
yc,
xxc,
yyc,
tmpY,
tmpX,
h,
w : Integer;
f2 : TTeeFilter;
f2Lines : PRGBs;
xx,
yy : Integer;
tmpSin,
tmpCos,
tmpYSin,
tmpYCos : Single;
Sin,
Cos : Extended;
begin
inherited;
if Length(Lines)=0 then
Exit;
while Angle>360 do
FAngle:=Angle-360;
if Angle=180 then
begin
TFlipFilter.ApplyTo(Bitmap);
TReverseFilter.ApplyTo(Bitmap);
end
else
if Angle<>0 then
begin
tmp:=TBitmap.Create;
try
h:=Bitmap.Height;
w:=Bitmap.Width;
if (Angle=90) or (Angle=270) then
TeeSetBitmapSize(tmp,h,w)
else
begin
SinCos((360-Angle)*TeePiStep,Sin,Cos);
if AutoSize then
begin
if Sin*Cos>0 then
TeeSetBitmapSize(tmp,Abs(Round(w*Cos+h*Sin)),
Abs(Round(w*Sin+h*Cos)))
else
TeeSetBitmapSize(tmp,Abs(Round(w*Cos-h*Sin)),
Abs(Round(w*Sin-h*Cos)));
end
else
TeeSetBitmapSize(tmp,w,h);
end;
if (w>1) and (h>1) then
begin
if BackColor=clNone then
tmp.Transparent:=True
else
if BackColor<>clWhite then
with tmp.Canvas do
begin
Brush.Style:=bsSolid;
Brush.Color:=FBackColor;
FillRect(TeeRect(0,0,tmp.Width,tmp.Height));
end;
f2:=TTeeFilter.Create(nil);
try
f2.Apply(tmp);
if Angle=90 then
begin
for y:=0 to h-1 do
for x:=0 to w-1 do
f2.Lines[x,h-y-1]:=Lines[y,x];
end
else
if Angle=270 then
begin
for y:=0 to h-1 do
for x:=0 to w-1 do
f2.Lines[w-x-1,y]:=Lines[y,x];
end
else
begin
xxc:=tmp.Width div 2;
yyc:=tmp.Height div 2;
xc:=w div 2;
yc:=h div 2;
tmpSin:=Sin;
tmpCos:=Cos;
tmpY:=-yyc-1;
for y:=0 to tmp.Height-1 do
begin
Inc(tmpY);
tmpYSin:=(tmpY*tmpSin)-xc;
tmpYCos:=(tmpY*tmpCos)+yc;
f2Lines:=f2.Lines[y];
tmpX:=-xxc-1;
for x:=0 to tmp.Width-1 do
begin
Inc(tmpX);
xx:=Round(tmpX*tmpCos-tmpYSin);
if (xx>=0) and (xx<w) then
begin
yy:=Round(tmpX*tmpSin+tmpYCos);
if (yy>=0) and (yy<h) then
f2Lines[x]:=Lines[yy,xx];
end;
end;
end;
end;
Bitmap.FreeImage;
Bitmap.Assign(tmp);
finally
f2.Free;
end;
end;
finally
tmp.Free;
end;
end;
end;
class function TRotateFilter.Description: String;
begin
result:=TeeMsg_Rotate;
end;
procedure TRotateFilter.SetAngle(const Value: Double);
begin
if FAngle<>Value then
begin
FAngle:=Value;
// Repaint;
end;
end;
procedure TRotateFilter.CreateEditor(Creator:IFormCreator; AChanged: TNotifyEvent);
begin
inherited;
Creator.AddScroll('Angle',0,360); // Do not localize
Creator.AddColor('BackColor',TeeMsg_Back); // Do not localize
Creator.AddCheckBox('AutoSize',TeeMsg_Autosize); // Do not localize
end;
{ TMirrorFilter }
Constructor TMirrorFilter.Create(Collection: TCollection);
begin
inherited;
AllowRegion:=False;
end;
procedure TMirrorFilter.Apply(Bitmap: TBitmap; const R: TRect);
var tmp : TBitmap;
begin
inherited;
if Length(Lines)=0 then
Exit;
tmp:=TBitmap.Create;
try
if (Direction=mdDown) or (Direction=mdUp) then
begin
TeeSetBitmapSize(tmp,Bitmap.Width,Bitmap.Height*2);
if Direction=mdDown then
tmp.Canvas.Draw(0,0,Bitmap)
else
tmp.Canvas.Draw(0,Bitmap.Height,Bitmap);
TFlipFilter.ApplyTo(Bitmap);
if Direction=mdDown then
tmp.Canvas.Draw(0,Bitmap.Height,Bitmap)
else
tmp.Canvas.Draw(0,0,Bitmap);
Bitmap.Height:=Bitmap.Height*2;
end
else
begin
TeeSetBitmapSize(tmp,Bitmap.Width*2,Bitmap.Height);
if Direction=mdRight then
tmp.Canvas.Draw(0,0,Bitmap)
else
tmp.Canvas.Draw(Bitmap.Width,0,Bitmap);
TReverseFilter.ApplyTo(Bitmap);
if Direction=mdRight then
tmp.Canvas.Draw(Bitmap.Width,0,Bitmap)
else
tmp.Canvas.Draw(0,0,Bitmap);
Bitmap.Width:=Bitmap.Width*2;
end;
Bitmap.Canvas.Draw(0,0,tmp);
finally
tmp.Free;
end;
end;
procedure TMirrorFilter.CreateEditor(Creator: IFormCreator;
AChanged: TNotifyEvent);
begin
inherited;
Creator.AddCombo('Direction'); // Do not localize
end;
class function TMirrorFilter.Description: String;
begin
result:=TeeMsg_Mirror;
end;
{ TTileFilter }
Constructor TTileFilter.Create(Collection: TCollection);
begin
inherited;
FNumCols:=3;
FNumRows:=3;
end;
procedure TTileFilter.Apply(Bitmap: TBitmap; const R: TRect);
var tmpCol,
tmpRow,
tmpW,
tmpH : Integer;
tmp : TBitmap;
begin
inherited;
if Length(Lines)=0 then
Exit;
if FNumCols<1 then FNumCols:=1;
if FNumRows<1 then FNumRows:=1;
tmpW:=(R.Right-R.Left) div FNumCols;
tmpH:=(R.Bottom-R.Top) div FNumRows;
if (tmpW>0) and (tmpH>0) then
begin
tmp:=SmoothBitmap(Bitmap,tmpW,tmpH);
try
for tmpCol:=0 to FNumCols-1 do
for tmpRow:=0 to FNumRows-1 do
Bitmap.Canvas.Draw(tmpCol*tmpW,tmpRow*tmpH,tmp);
finally
tmp.Free;
end;
end;
end;
procedure TTileFilter.CreateEditor(Creator: IFormCreator;
AChanged: TNotifyEvent);
begin
inherited;
Creator.AddInteger('NumCols',TeeMsg_Columns,1,1000); // Do not localize
Creator.AddInteger('NumRows',TeeMsg_Rows,1,1000); // Do not localize
end;
class function TTileFilter.Description: String;
begin
result:=TeeMsg_Tile;
end;
{ TBevelFilter }
Constructor TBevelFilter.Create(Collection: TCollection);
begin
inherited;
FBright:=64;
FSize:=15;
end;
procedure TBevelFilter.Apply(Bitmap: TBitmap; const R: TRect);
var t,
x,y,
h2,w2,
x1,x2,
y1,y2 : Integer;
begin
inherited;
if Length(Lines)=0 then
Exit;
x1:=R.Left;
x2:=R.Right;
y1:=R.Top;
y2:=R.Bottom;
w2:=(R.Right-R.Left) div 2;
h2:=(R.Bottom-R.Top) div 2;
for t:=0 to FSize-1 do
begin
if t<h2 then
for x:=R.Left+t to R.Right-t do
begin
with Lines[y1,x] do
begin
if Red+Bright>255 then Red:=255
else Inc(Red,Bright);
if Green+Bright>255 then Green:=255
else Inc(Green,Bright);
if Blue+Bright>255 then Blue:=255
else Inc(Blue,Bright);
end;
with Lines[y2,x] do
begin
if Red-Bright<0 then Red:=0
else Dec(Red,Bright);
if Green-Bright<0 then Green:=0
else Dec(Green,Bright);
if Blue-Bright<0 then Blue:=0
else Dec(Blue,Bright);
end;
end;
Inc(y1);
Dec(y2);
if t<w2 then
for y:=R.Top+t+1 to R.Bottom-t do
begin
with Lines[y,x1] do
begin
if Red+Bright>255 then Red:=255
else Inc(Red,Bright);
if Green+Bright>255 then Green:=255
else Inc(Green,Bright);
if Blue+Bright>255 then Blue:=255
else Inc(Blue,Bright);
end;
with Lines[y,x2] do
begin
if Red-Bright<0 then Red:=0
else Dec(Red,Bright);
if Green-Bright<0 then Green:=0
else Dec(Green,Bright);
if Blue-Bright<0 then Blue:=0
else Dec(Blue,Bright);
end;
end;
Inc(x1);
Dec(x2);
end;
end;
procedure TBevelFilter.CreateEditor(Creator: IFormCreator;
AChanged: TNotifyEvent);
begin
inherited;
Creator.AddScroll('Bright',1,255); // Do not localize
Creator.AddScroll('Size',1,1000); // Do not localize
end;
class function TBevelFilter.Description: String;
begin
result:=TeeMsg_Bevel;
end;
{ TZoomFilter }
Constructor TZoomFilter.Create(Collection: TCollection);
begin
inherited;
FPercent:=10;
end;
procedure TZoomFilter.Apply(Bitmap: TBitmap; const R: TRect);
var w,h,
wp,hp : Integer;
procedure DoCrop(ALeft,ATop:Integer; ABitmap:TBitmap);
begin
with TCropFilter.Create(nil) do
try
Left:=ALeft+wp;
Top:=ATop+hp;
Width:=Max(1,w-2*wp);
Height:=Max(1,h-2*hp);
Smooth:=Self.Smooth;
Apply(ABitmap,R);
finally
Free;
end;
end;
var tmp : TBitmap;
begin
w:=R.Right-R.Left+1;
h:=R.Bottom-R.Top+1;
wp:=Round(FPercent*w*0.005);
hp:=Round(FPercent*h*0.005);
if (Bitmap.Width=w) and (Bitmap.Height=h) then
DoCrop(R.Left,R.Top,Bitmap)
else
begin
tmp:=TBitmap.Create;
try
TeeSetBitmapSize(tmp,w,h);
tmp.Canvas.CopyRect(TeeRect(0,0,w,h),Bitmap.Canvas,R);
DoCrop(0,0,tmp);
Bitmap.Canvas.Draw(R.Left,R.Top,tmp);
finally
tmp.Free;
end;
end;
end;
procedure TZoomFilter.CreateEditor(Creator: IFormCreator;
AChanged: TNotifyEvent);
begin
inherited;
Creator.AddScroll('Percent',0,100); // Do not localize
Creator.AddCheckBox('Smooth',TeeMsg_Smooth); // Do not localize
end;
class function TZoomFilter.Description: String;
begin
result:=TeeMsg_Zoom;
end;
procedure RotateGradient(Gradient:TCustomTeeGradient; ABitmap:TBitmap);
begin
with TRotateFilter.Create(nil) do
try
Angle:=Gradient.Angle;
Apply(ABitmap);
finally
Free;
end;
end;
// This procedure will convert all pixels in ABitmap to levels of gray
Procedure TeeGrayScale(ABitmap:TBitmap; Inverted:Boolean; AMethod:Integer);
var tmp : TGrayScaleFilter;
begin
tmp:=TGrayScaleFilter.Create(nil);
try
if AMethod<>0 then tmp.Method:=gmEye;
tmp.Apply(ABitmap);
finally
tmp.Free;
end;
if Inverted then
TInvertFilter.ApplyTo(ABitmap);
end;
initialization
TeeRegisterFilters([ TInvertFilter,
TGrayScaleFilter,
TMosaicFilter,
TFlipFilter,
TReverseFilter,
TBrightnessFilter,
TContrastFilter,
TColorFilter,
THueLumSatFilter,
TBlurFilter,
TSharpenFilter,
TGammaCorrectionFilter,
TEmbossFilter,
TSoftenFilter,
TCropFilter,
TResizeFilter,
TRotateFilter,
TMirrorFilter,
TTileFilter,
TBevelFilter,
TZoomFilter ]);
TeeGradientRotate:=RotateGradient;
finalization
TeeGradientRotate:=nil;
FreeAndNil(FilterClasses);
end.