📄 teefilterseditor.pas
字号:
{********************************************}
{ TeeChart Pro Charting Library }
{ Filters Editor Dialog }
{ Copyright (c) 2005 by David Berneda }
{ All Rights Reserved }
{********************************************}
unit TeeFiltersEditor;
{$I TeeDefs.inc}
interface
uses {$IFNDEF LINUX}
Windows, Messages, SysUtils,
{$ENDIF}
Classes,
{$IFDEF CLX}
QGraphics, QControls, QForms, QDialogs, QStdCtrls, QComCtrls, QExtCtrls,
QMenus, QCheckLst,
{$ELSE}
Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
Menus, CheckLst,
{$ENDIF}
TeeProcs, TeCanvas, TeePenDlg, TeeEditCha, TeeDraw3D, TeeLisB;
const
TeeMsg_Filters = 'Filters';
TeeMsg_Percent = '&Percent';
type
TRGBTriples=Array[0..0] of TRGBTriple;
PRGBTriples=^TRGBTriples;
TFilter=class(TCollectionItem)
protected
Lines : Array of PRGBTriples;
FChanged : TNotifyEvent;
procedure CalcLines;
procedure CreateEditor(AParent:TWinControl; AChanged:TNotifyEvent); virtual;
public
Bitmap : TBitmap;
Disabled : Boolean;
class procedure ApplyTo(Bitmap:TBitmap); overload;
procedure Apply; overload;
procedure Apply(const R:TRect); overload; virtual;
class function Description:String; virtual;
end;
TFilterClass=class of TFilter;
TFilterItems=class(TOwnedCollection)
private
Function Get(Index:Integer):TFilter;
Procedure Put(Index:Integer; Const Value:TFilter);
{$IFNDEF D7}
function Owner:TObject;
{$ENDIF}
protected
procedure Update(Item: TCollectionItem); override;
public
property Item[Index:Integer]:TFilter read Get write Put; default;
end;
TFilters=class(TComponent)
private
FBitmap : TBitmap;
FItems : TFilterItems;
FPanel : TCustomTeePanel;
function ApplyFilters(const R:TRect): TBitmap;
Procedure SetItems(const Value:TFilterItems);
public
Constructor Create(AOwner:TComponent); override;
Destructor Destroy; override;
function Bitmap:TBitmap;
procedure StretchTo(Picture:TPicture; AWidth,AHeight:Integer);
published
property Items:TFilterItems read FItems write SetItems;
property Panel:TCustomTeePanel read FPanel write FPanel;
end;
TFiltersEditor = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Splitter1: TSplitter;
Panel1: TPanel;
Panel2: TPanel;
BAdd: TSpeedButton;
BDelete: TSpeedButton;
BMoveUp: TSpeedButton;
BMoveDown: TSpeedButton;
Filters: TCheckListBox;
Image: TDraw3D;
MenuFilters: TPopupMenu;
Properties: TPanel;
PopupMenu1: TPopupMenu;
Scaled1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FiltersClick(Sender: TObject);
procedure BAddClick(Sender: TObject);
procedure FiltersClickCheck(Sender: TObject);
procedure BDeleteClick(Sender: TObject);
procedure BMoveUpClick(Sender: TObject);
procedure BMoveDownClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ImageResize(Sender: TObject);
procedure Scaled1Click(Sender: TObject);
private
{ Private declarations }
procedure ClearProperties;
procedure ChangedProperties(Sender: TObject);
Function CompareClass(a,b:Integer):Integer;
function CurrentFilter:TFilter;
procedure EnableButtons;
procedure FilterSelected(Sender:TObject);
procedure Preview(ReuseBitmap:Boolean=False);
procedure Swap(A,B:Integer);
Procedure SwapClass(a,b:Integer);
public
{ Public declarations }
FilterList : TFilters;
end;
TInvertFilter=class(TFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TGrayMethod=(gmSimple, gmEye, gmEye2);
TGrayScaleFilter=class(TFilter)
private
FMethod : TGrayMethod;
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
published
property Method:TGrayMethod read FMethod write FMethod default gmSimple;
end;
TFlipFilter=class(TFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TReverseFilter=class(TFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TAmountFilter=class(TFilter)
private
FAmount : Integer;
FPercent : Boolean;
FScrollBar : TScrollBar;
IOnlyPositive : Boolean;
procedure CheckClick(Sender: TObject);
procedure ResetScroll;
procedure ScrollChanged(Sender: TObject);
protected
procedure CreateEditor(AParent:TWinControl; AChanged:TNotifyEvent); override;
public
Constructor Create(Collection:TCollection); 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(const R:TRect); override;
class function Description: String; override;
end;
TBrightnessFilter=class(TAmountFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TContrastFilter=class(TAmountFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TRedFilter=class(TAmountFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TGreenFilter=class(TAmountFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TBlueFilter=class(TAmountFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TConvolveFilter=class(TFilter)
private
protected
Prev,
This,
Next : PRGBTriples;
InvTotalWeight : Single;
procedure CalcWeightsFor(x:Integer); virtual;
public
Weights : Array[-1..1,-1..1] of Single;
Constructor Create(Collection:TCollection); override;
procedure Apply(const R:TRect); override;
end;
TBlurFilter=class(TConvolveFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TSharpenFilter=class(TConvolveFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TEmbossFilter=class(TConvolveFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TAntiAliasFilter=class(TConvolveFilter)
public
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
TGammaCorrectionFilter=class(TAmountFilter)
public
Constructor Create(Collection:TCollection); override;
procedure Apply(const R:TRect); override;
class function Description: String; override;
end;
procedure ShowFiltersEditor(Owner:TComponent; AFilters:TFilters);
procedure RGBToHLS(const Color:TRGBTriple; var Hue, Luminance, Saturation: Word);
procedure HLSToRGB(Hue, Luminance, Saturation: Word; var rgb: TRGBTriple);
implementation
{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}
uses
Math, TeeConst;
var
FilterClass : TList;
procedure TeeRegisterFilters(const FilterList:Array of TFilterClass);
var t : Integer;
begin
if not Assigned(FilterClass) then
FilterClass:=TList.Create;
for t:=Low(FilterList) to High(FilterList) do
FilterClass.Add(FilterList[t]);
end;
procedure ShowFiltersEditor(Owner:TComponent; AFilters:TFilters);
begin
with TFiltersEditor.Create(nil) do
try
FilterList:=AFilters;
FreeAndNil(FilterList.FBitmap);
ShowModal;
finally
Free;
end;
end;
procedure TFiltersEditor.FormCreate(Sender: TObject);
begin
TeeLoadArrowBitmaps(BMoveUp.Glyph,BMoveDown.Glyph);
end;
Procedure TeeFiltersShowEditor(Editor:TChartEditForm; Tab:TTabSheet);
var tmpForm : TFiltersEditor;
tmpActive : TTabSheet;
begin
tmpActive:=Editor.MainPage.ActivePage;
if not Assigned(Tab) then
begin
Tab:=TTabSheet.Create(Editor);
Tab.Caption:=TeeMsg_Filters;
Tab.PageControl:=Editor.MainPage;
end
else
if (Tab.ControlCount=0) and (Tab.Caption=TeeMsg_Filters) then
begin
tmpForm:=TFiltersEditor.Create(Editor);
with tmpForm do
begin
FilterList:=TFilters.Create(nil);
FilterList.Panel:=Editor.Chart;
//Button2.Visible:=False;
//BOK.Left:=Button2.Left;
//BOK.ModalResult:=mrNone;
//BOK.Caption:=TeeMsg_Apply;
Align:=alClient;
end;
AddFormTo(tmpForm,Tab);
{$IFNDEF CLR}
tmpForm.RequestAlign;
{$ENDIF}
end;
Editor.MainPage.ActivePage:=tmpActive;
end;
procedure TFiltersEditor.EnableButtons;
begin
BDelete.Enabled:=Filters.ItemIndex<>-1;
BMoveUp.Enabled:=Filters.ItemIndex>0;
BMoveDown.Enabled:=BDelete.Enabled and (Filters.ItemIndex<Filters.Items.Count-1);
end;
procedure TFiltersEditor.ChangedProperties(Sender: TObject);
begin
Preview;
end;
procedure TFiltersEditor.ClearProperties;
begin
with Properties do
while ControlCount>0 do Controls[0].Free;
end;
procedure TFiltersEditor.FiltersClick(Sender: TObject);
procedure CreateProperties;
begin
if Filters.ItemIndex<>-1 then
CurrentFilter.CreateEditor(Properties,ChangedProperties);
end;
begin
EnableButtons;
ClearProperties;
CreateProperties;
end;
Function TFiltersEditor.CompareClass(a,b:Integer):Integer;
var tmpA : TFilterClass;
tmpB : TFilterClass;
begin
tmpA:=TFilterClass(FilterClass[a]);
tmpB:=TFilterClass(FilterClass[b]);
if tmpA.Description=tmpB.Description then
result:=0
else
if tmpA.Description<tmpB.Description then
result:=-1
else
result:=1;
end;
Procedure TFiltersEditor.SwapClass(a,b:Integer);
begin
FilterClass.Exchange(a,b);
end;
procedure TFiltersEditor.BAddClick(Sender: TObject);
var t : Integer;
tmpItem : TMenuItem;
P : TPoint;
begin
if MenuFilters.Items.Count=0 then
begin
TeeSort(0,FilterClass.Count-1,CompareClass,SwapClass);
for t:=0 to FilterClass.Count-1 do
begin
tmpItem:=TMenuItem.Create(Self);
tmpItem.Caption:=TFilterClass(FilterClass[t]).Description;
tmpItem.OnClick:=FilterSelected;
tmpItem.Tag:=t;
MenuFilters.Items.Add(tmpItem);
end;
end;
P.X:=BAdd.Left+BAdd.Width-1;
P.Y:=BAdd.Top+BAdd.Height-1;
P:=BAdd.ClientToScreen(P);
MenuFilters.Popup(P.X,P.Y);
end;
procedure TFiltersEditor.FilterSelected(Sender:TObject);
var tmp : Integer;
tmpFilter : TFilterClass;
tmpItem : TFilter;
begin
tmpFilter:=TFilterClass(FilterClass[TMenuItem(Sender).Tag]);
tmpItem:=tmpFilter.Create(FilterList.Items);
tmp:=Filters.Items.AddObject(tmpFilter.Description,tmpItem);
Filters.Checked[tmp]:=True;
Filters.ItemIndex:=tmp;
FiltersClick(Self);
Preview;
end;
procedure TFiltersEditor.Preview(ReuseBitmap:Boolean=False);
var tmp : TBitmap;
begin
if not ReuseBitmap then
FreeAndNil(FilterList.FBitmap);
if Scaled1.Checked then
FilterList.StretchTo(Image.BackImage,Image.Width,Image.Height)
else
begin
tmp:=FilterList.ApplyFilters(Image.GetRectangle);
try
Image.BackImage.Assign(tmp);
finally
tmp.Free;
end;
end;
end;
function TFiltersEditor.CurrentFilter:TFilter;
begin
result:=TFilter(Filters.Items.Objects[Filters.ItemIndex]);
end;
procedure TFiltersEditor.ImageResize(Sender: TObject);
begin
Preview(True);
end;
procedure TFiltersEditor.FiltersClickCheck(Sender: TObject);
begin
CurrentFilter.Disabled:=not Filters.Checked[Filters.ItemIndex];
Preview;
end;
procedure TFiltersEditor.BDeleteClick(Sender: TObject);
var tmp : Integer;
begin
tmp:=Filters.ItemIndex;
CurrentFilter.Free;
Filters.Items.Delete(Filters.ItemIndex);
if tmp>=Filters.Items.Count then
tmp:=Filters.Items.Count-1;
if tmp>=0 then
begin
Filters.ItemIndex:=tmp;
FiltersClick(Self);
end
else
ClearProperties;
EnableButtons;
Preview;
end;
procedure TFiltersEditor.Swap(A,B:Integer);
var tmp : TFilter;
begin
Filters.Items.Exchange(A,B);
tmp:=FilterList.Items[B];
FilterList.Items[A].Index:=B;
tmp.Index:=A;
EnableButtons;
Preview;
end;
procedure TFiltersEditor.BMoveUpClick(Sender: TObject);
begin
with Filters do
if ItemIndex>0 then
Swap(ItemIndex,ItemIndex-1);
end;
procedure TFiltersEditor.BMoveDownClick(Sender: TObject);
begin
with Filters do
if (ItemIndex<>-1) and (ItemIndex<Items.Count-1) then
Swap(ItemIndex,ItemIndex+1);
end;
procedure TFiltersEditor.FormShow(Sender: TObject);
var t : Integer;
begin
for t:=0 to FilterList.Items.Count-1 do
begin
Filters.Items.AddObject(FilterList.Items[t].Description,FilterList.Items[t]);
Filters.Checked[t]:=not FilterList.Items[t].Disabled;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -