⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teefilterseditor.pas

📁 TeeChart 7.0 With Source在Delphi 7.0中的安装
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{********************************************}
{  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 + -