teefilterseditor.pas

BCB第三方组件

{********************************************}
{  TeeChart Pro Charting Library             }
{  Filters Editor Dialog                     }
{  Copyright (c) 2006-2007 by David Berneda  }
{  All Rights Reserved                       }
{********************************************}
unit TeeFiltersEditor;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     SysUtils, Classes,
     {$IFDEF CLX}
     QGraphics, QControls, QForms, QDialogs, QStdCtrls, QComCtrls, QExtCtrls,
     QMenus, QCheckLst, QButtons,
     {$ELSE}
     Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
     Menus, CheckLst,
     {$ENDIF}
     {$IFDEF CLR}
     Variants,
     {$ENDIF}
     TeeProcs, TeCanvas, TeePenDlg, TeeDraw3D, TeeFilters;

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

type
  TFormItem=class
  public
    PropName : String;
    OnChange : TNotifyEvent;
  end;

  TFormItems=class(TList)
  private
    function Get(Index:Integer):TFormItem;
  public
    Procedure Clear; override;
    property Items[Index:Integer]:TFormItem read Get; default;
  end;

  TFormCreator=class(TComponent,IFormCreator)
  private
    FParent   : TWinControl;
    FOnChange : TNotifyEvent;

    IChanging : Boolean;
    IPosY     : Integer;

    function AddItem(const PropName:String; AOnChange:TNotifyEvent=nil):TFormItem;
    procedure ChangeProp(Sender:TObject; const Value:Variant);
    procedure CheckBoxChanged(Sender:TObject);
    procedure ColorChanged(Sender:TObject);
    procedure ComboChanged(Sender:TObject);
    procedure EditChanged(Sender:TObject);
    procedure ScrollChanged(Sender:TObject);
  public
    Instance : TObject;
    Items    : TFormItems;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function AddCheckBox(const PropName,ACaption:String; OnChange:TNotifyEvent=nil):TCheckBox;
    function AddColor(const PropName,ACaption:String):TButton;
    function AddCombo(const PropName:String):TComboBox;
    function AddInteger(const PropName,ACaption:String; AMin,AMax:Integer):TEdit;
    function AddScroll(const PropName:String; AMin,AMax:Integer):TScrollBar;

    property OnChange:TNotifyEvent read FOnChange write FOnChange;
  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;
    PopupMenu1: TPopupMenu;
    Scaled1: TMenuItem;
    Panel3: TPanel;
    Panel4: TPanel;
    Button2: TButton;
    CBPreview: TCheckBox;
    CBScaled: TCheckBox;
    PageProps: TPageControl;
    Properties: TTabSheet;
    TabRegion: TTabSheet;
    Splitter2: TSplitter;
    Timer1: TTimer;
    Label1: TLabel;
    ELeft: TEdit;
    UDLeft: TUpDown;
    Label2: TLabel;
    ETop: TEdit;
    UDTop: TUpDown;
    Label3: TLabel;
    EWidth: TEdit;
    UDWidth: TUpDown;
    Label4: TLabel;
    EHeight: TEdit;
    UDHeight: TUpDown;
    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);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CBPreviewClick(Sender: TObject);
    procedure CBScaledClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ELeftChange(Sender: TObject);
    procedure ETopChange(Sender: TObject);
    procedure EWidthChange(Sender: TObject);
    procedure EHeightChange(Sender: TObject);
  private
    { Private declarations }
    Backup      : TFilterItems;
    Creator     : TFormCreator;
    IBitmap     : TBitmap;
    IChanging   : Boolean;

    procedure ClearProperties;
    procedure ChangedProperties(Sender: TObject);
    Function CompareClass(a,b:Integer):Integer;
    function CurrentFilter:TTeeFilter;
    procedure EnableButtons;
    procedure FilterSelected(Sender:TObject);
    procedure Preview(ReuseBitmap:Boolean=False);
    procedure Swap(A,B:Integer);
    Procedure SwapClass(a,b:Integer);
  public
    { Public declarations }
    Changed     : TNotifyEvent;
    FilterItems : TFilterItems;
    Picture     : TGraphic;
  end;

function ShowFiltersEditor(AOwner:TComponent; APicture:TTeePicture):Boolean; overload;
function ShowFiltersEditor(AOwner:TComponent; APicture:TGraphic; AFilters:TFilterItems):Boolean; overload;

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
  Math,
  TeeConst,
  TypInfo;

function ShowFiltersEditor(AOwner:TComponent; APicture:TGraphic; AFilters:TFilterItems):Boolean;
begin
  with TFiltersEditor.Create(AOwner) do
  try
    Picture:=APicture;
    FilterItems:=AFilters;
    result:=ShowModal=mrOk;
  finally
    Free;
  end;
end;

function ShowFiltersEditor(AOwner:TComponent; APicture:TTeePicture):Boolean;
begin
  result:=ShowFiltersEditor(AOwner,APicture.Graphic,APicture.Filters);

  if result then 
     APicture.Repaint;
end;

procedure TFiltersEditor.FormCreate(Sender: TObject);
begin
  IChanging:=True;
  
  TeeLoadArrowBitmaps(BMoveUp.Glyph,BMoveDown.Glyph);
  Creator:=TFormCreator.Create(Properties);
  Creator.OnChange:=ChangedProperties;
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;

type
  TFilterAccess=class(TTeeFilter);

procedure TFiltersEditor.FiltersClick(Sender: TObject);

  procedure CreateProperties;
  var tmp : TTabSheet;
  begin
    if Filters.ItemIndex<>-1 then
    begin
      tmp:=PageProps.ActivePage;

      try
        Creator.Items.Clear;
        Creator.IPosY:=8;
        Creator.Instance:=CurrentFilter;

        {$IFDEF D5} // D4 does not support GetPropValue / SetPropValue
        Creator.IChanging:=True;
        try
          CurrentFilter.CreateEditor(Creator,ChangedProperties);
        finally
          Creator.IChanging:=False;
        end;
        {$ENDIF}

        Properties.TabVisible:=Properties.ControlCount>0;
        TabRegion.TabVisible:=TFilterAccess(Creator.Instance).AllowRegion;

        if (not Properties.TabVisible) and (not TabRegion.TabVisible) then
           PageProps.Hide
        else
        begin
          TeeTranslateControl(Properties);

          PageProps.Show;

          if not Properties.TabVisible then
             tmp:=TabRegion;

          if TabRegion.TabVisible then
          with CurrentFilter.Region do
          begin
            UDLeft.Position:=Left;
            UDTop.Position:=Top;
            UDWidth.Position:=Width;
            UDHeight.Position:=Height;
          end
          else
            tmp:=Properties;
        end;

      finally
        PageProps.ActivePage:=tmp;
      end;
    end;

    PageProps.Visible:=Filters.ItemIndex<>-1;
  end;

begin
  IChanging:=True;
  try
    EnableButtons;
    ClearProperties;
    CreateProperties;
  finally
    IChanging:=False;
  end;
end;

Function TFiltersEditor.CompareClass(a,b:Integer):Integer;
var tmpA : TFilterClass;
    tmpB : TFilterClass;
begin
  tmpA:=TFilterClass(FilterClasses[a]);
  tmpB:=TFilterClass(FilterClasses[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
  FilterClasses.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,FilterClasses.Count-1,CompareClass,SwapClass);

    for t:=0 to FilterClasses.Count-1 do
    begin
      tmpItem:=TMenuItem.Create(Self);
      tmpItem.Caption:=TFilterClass(FilterClasses[t]).Description;

      if tmpItem.Caption='' then
         tmpItem.Caption:=TFilterClass(FilterClasses[t]).ClassName;
         
      tmpItem.OnClick:=FilterSelected;
      tmpItem.Tag:={$IFDEF CLR}Variant{$ENDIF}(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   : TTeeFilter;
begin
  tmpFilter:=TFilterClass(FilterClasses[TMenuItem(Sender).Tag]);
  tmpItem:=tmpFilter.Create(FilterItems);
  tmp:=Filters.Items.AddObject(tmpFilter.Description,tmpItem);
  Filters.Checked[tmp]:=True;
  Filters.ItemIndex:=tmp;
  FiltersClick(Self);
  Preview;
end;

procedure StretchTo(Graphic:TGraphic; Picture:TPicture; AWidth,AHeight:Integer);
var tmpDest : TBitmap;
    tmp     : TBitmap;
begin
  tmpDest:=TBitmap.Create;
  try
    TeeSetBitmapSize(tmpDest,AWidth,AHeight);

    if Graphic is TBitmap then
       tmp:=TBitmap(Graphic)
    else
    begin
      tmp:=TBitmap.Create;
      tmp.Assign(Graphic);
    end;

    try
      SmoothStretch(tmp,tmpDest);
      Picture.Assign(tmpDest);
    finally
      if not (Graphic is TBitmap) then
         tmp.Free;
    end;
  finally
    tmpDest.Free;
  end;
end;

procedure TFiltersEditor.Preview(ReuseBitmap:Boolean=False);

  function GetFilteredBitmap:TGraphic;
  begin
    if not Assigned(IBitmap) then
       IBitmap:=TBitmap.Create;

    IBitmap.Assign(Picture);

    if Assigned(FilterItems) then
       FilterItems.ApplyTo(IBitmap);

    result:=IBitmap;
  end;

begin
  if CBPreview.Checked then
  begin
    Image.BackImageMode:=pbmCustom;

    if Scaled1.Checked then
       StretchTo(GetFilteredBitmap,Image.BackImage,Image.Width,Image.Height)
    else
       Image.BackImage.Assign(GetFilteredBitmap);
  end;

  if Assigned(Changed) then
     Changed(Self);
end;

function TFiltersEditor.CurrentFilter:TTeeFilter;
begin
  result:=TTeeFilter(Filters.Items.Objects[Filters.ItemIndex]);
end;

procedure TFiltersEditor.ImageResize(Sender: TObject);
begin
  Preview(True);
end;

procedure TFiltersEditor.FiltersClickCheck(Sender: TObject);
begin
  CurrentFilter.Enabled:=Filters.Checked[Filters.ItemIndex];
  Preview;
end;

procedure TFiltersEditor.BDeleteClick(Sender: TObject);