frxdsgnintf.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{             Design interface             }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxDsgnIntf;

interface

{$I frx.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  Menus, TypInfo, frxClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxPropertyAttribute = (paValueList, paSortList, paDialog,
    paMultiSelect, paSubProperties, paReadOnly, paOwnerDraw);
  TfrxPropertyAttributes = set of TfrxPropertyAttribute;

  TfrxPropertyEditor = class(TObject)
  private
    FDesigner: TfrxCustomDesigner;
    FCompList: TList;
    FPropList: TList;
    FItemHeight: Integer;
    FValues: TStrings;
    function GetPropInfo: PPropInfo;
    function GetComponent: TPersistent;
    function GetfrComponent: TfrxComponent;
  protected
    procedure GetStrProc(const s: String);
    function GetFloatValue: Extended;
    function GetOrdValue: Integer;
    function GetStrValue: String;
    function GetVarValue: Variant;
    procedure SetFloatValue(Value: Extended);
    procedure SetOrdValue(Value: Integer);
    procedure SetStrValue(const Value: String);
    procedure SetVarValue(Value: Variant);
  public
    constructor Create(Designer: TfrxCustomDesigner); virtual;
    destructor Destroy; override;
    function Edit: Boolean; virtual;
    function GetAttributes: TfrxPropertyAttributes; virtual;
    function GetName: String; virtual;
    function GetExtraLBSize: Integer; virtual;
    function GetValue: String; virtual;
    procedure GetValues; virtual;
    procedure SetValue(const Value: String); virtual;
    procedure OnDrawLBItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState); virtual;
    procedure OnDrawItem(Canvas: TCanvas; ARect: TRect); virtual;
    property Component: TPersistent read GetComponent;
    property frComponent: TfrxComponent read GetfrComponent;
    property Designer: TfrxCustomDesigner read FDesigner;
    property ItemHeight: Integer read FItemHeight write FItemHeight;
    property PropInfo: PPropInfo read GetPropInfo;
    property Value: String read GetValue write SetValue;
    property Values: TStrings read FValues;
  end;

  TfrxPropertyEditorClass = class of TfrxPropertyEditor;

  TfrxComponentEditor = class(TObject)
  private
    FComponent: TfrxComponent;
    FDesigner: TfrxCustomDesigner;
    FMenu: TMenu;
  protected
    function AddItem(const Caption: String; Tag: Integer;
      Checked: Boolean = False): TMenuItem;
  public
    constructor Create(Component: TfrxComponent; Designer: TfrxCustomDesigner;
      Menu: TMenu);
    function Edit: Boolean; virtual;
    function HasEditor: Boolean; virtual;
    procedure GetMenuItems; virtual;
    function Execute(Tag: Integer; Checked: Boolean): Boolean; virtual;
    property Component: TfrxComponent read FComponent;
    property Designer: TfrxCustomDesigner read FDesigner;
  end;

  TfrxComponentEditorClass = class of TfrxComponentEditor;

  TfrxIntegerProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxFloatProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxCharProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxStringProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxEnumProperty = class(TfrxPropertyEditor)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxSetProperty = class(TfrxPropertyEditor)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
  end;

  TfrxSetElementProperty = class(TfrxPropertyEditor)
  private
    FElement: Integer;
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetName: String; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
   end;

  TfrxClassProperty = class(TfrxPropertyEditor)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
  end;

  TfrxComponentProperty = class(TfrxPropertyEditor)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxNameProperty = class(TfrxStringProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
  end;

  TfrxColorProperty = class(TfrxIntegerProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function Edit: Boolean; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
    procedure OnDrawLBItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState); override;
    procedure OnDrawItem(Canvas: TCanvas; ARect: TRect); override;
  end;

  TfrxFontProperty = class(TfrxClassProperty)
  public
    function Edit: Boolean; override;
    function GetAttributes: TfrxPropertyAttributes; override;
  end;

  TfrxFontNameProperty = class(TfrxStringProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    procedure GetValues; override;
  end;

  TfrxFontCharsetProperty = class(TfrxIntegerProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxModalResultProperty = class(TfrxIntegerProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxShortCutProperty = class(TfrxPropertyEditor)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxCursorProperty = class(TfrxIntegerProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: String; override;
    procedure GetValues; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxDateTimeProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxDateProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

  TfrxTimeProperty = class(TfrxPropertyEditor)
  public
    function GetValue: String; override;
    procedure SetValue(const Value: String); override;
  end;

{ Internal classes used by Object Inspector }

  TfrxPropertyList = class;

  TfrxPropertyItem = class(TCollectionItem)
  private
    FEditor: TfrxPropertyEditor;
    FExpanded: Boolean;
    FSubProperty: TfrxPropertyList;
  public
    destructor Destroy; override;
    property Editor: TfrxPropertyEditor read FEditor;
    property Expanded: Boolean read FExpanded write FExpanded;
    property SubProperty: TfrxPropertyList read FSubProperty;
  end;

  TfrxPropertyList = class(TCollection)
  private
    FComponent: TPersistent;
    FDesigner: TfrxCustomDesigner;
    FParent: TfrxPropertyList;
    procedure AddProperties(PropertyList: TfrxPropertyList);
    procedure FillProperties(AClass: TPersistent);
    procedure FillCommonProperties(PropertyList: TfrxPropertyList);
    procedure SetComponent(Value: TPersistent);
    function GetPropertyItem(Index: Integer): TfrxPropertyItem;
  public
    constructor Create(Designer: TfrxCustomDesigner);
    function Add: TfrxPropertyItem;
    property Component: TPersistent read FComponent write SetComponent;
    property Items[Index: Integer]: TfrxPropertyItem read GetPropertyItem; default;
    property Parent: TfrxPropertyList read FParent;
  end;


{ registered items }

  TfrxObjectCategory = (ctData, ctReport, ctDialog, ctDMP);
  TfrxObjectCategories = set of TfrxObjectCategory;

  TfrxObjectItem = class(TCollectionItem)
  public
    ClassRef: TfrxComponentClass;
    ButtonBmp: TBitmap;
    ButtonImageIndex: Integer;
    ButtonHint: String;
    CategoryName: String;
    Flags: Word;
    Category: TfrxObjectCategories;
  end;

  TfrxComponentEditorItem = class(TCollectionItem)
  public
    ComponentClass: TfrxComponentClass;
    ComponentEditor: TfrxComponentEditorClass;
  end;

  TfrxPropertyEditorItem = class(TCollectionItem)
  public
    PropertyType: PTypeInfo;
    ComponentClass: TClass;
    PropertyName: String;
    EditorClass: TfrxPropertyEditorClass;
  end;

  TfrxExportFilterItem = class(TCollectionItem)
  public
    Filter: TfrxCustomExportFilter;
  end;

  TfrxWizardItem = class(TCollectionItem)
  public
    ClassRef: TfrxWizardClass;
    ButtonBmp: TBitmap;
    ButtonImageIndex: Integer;
    IsToolbarWizard: Boolean;
  end;

  TfrxObjectCollection = class(TCollection)
  private
    function GetObjectItem(Index: Integer): TfrxObjectItem;
  public
    constructor Create;
    procedure RegisterCategory(const CategoryName: String; ButtonBmp: TBitmap;
      const ButtonHint: String; ImageIndex: Integer = -1);
    procedure RegisterObject(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
      const CategoryName: String = '');
    procedure RegisterObject1(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
      const ButtonHint: String = ''; const CategoryName: String = '';
      Flags: Integer = 0; ImageIndex: Integer = -1;
      Category: TfrxObjectCategories = []);
    procedure Unregister(ClassRef: TfrxComponentClass);
    property Items[Index: Integer]: TfrxObjectItem read GetObjectItem; default;
  end;

  TfrxComponentEditorCollection = class(TCollection)
  private
    function GetComponentEditorItem(Index: Integer): TfrxComponentEditorItem;
  public
    constructor Create;
    procedure Register(ComponentClass: TfrxComponentClass;
      ComponentEditor: TfrxComponentEditorClass);
    procedure UnRegister(ComponentEditor: TfrxComponentEditorClass);
    function GetComponentEditor(Component: TfrxComponent;
      Designer: TfrxCustomDesigner; Menu: TMenu): TfrxComponentEditor;
    property Items[Index: Integer]: TfrxComponentEditorItem
      read GetComponentEditorItem; default;
  end;

  TfrxPropertyEditorCollection = class(TCollection)
  private
    FEventEditorItem: Integer;
    function GetPropertyEditorItem(Index: Integer): TfrxPropertyEditorItem;
  public
    constructor Create;
    procedure Register(PropertyType: PTypeInfo; ComponentClass: TClass;
      const PropertyName: String; EditorClass: TfrxPropertyEditorClass);
    procedure RegisterEventEditor(EditorClass: TfrxPropertyEditorClass);
    procedure UnRegister(EditorClass: TfrxPropertyEditorClass);
    function GetPropertyEditor(PropertyType: PTypeInfo; Component: TPersistent;
      PropertyName: String): Integer;
    property Items[Index: Integer]: TfrxPropertyEditorItem
      read GetPropertyEditorItem; default;
  end;

  TfrxExportFilterCollection = class(TCollection)
  private
    function GetExportFilterItem(Index: Integer): TfrxExportFilterItem;
  public
    constructor Create;
    procedure Register(Filter: TfrxCustomExportFilter);
    procedure Unregister(Filter: TfrxCustomExportFilter);
    property Items[Index: Integer]: TfrxExportFilterItem
      read GetExportFilterItem; default;
  end;

  TfrxWizardCollection = class(TCollection)
  private
    function GetWizardItem(Index: Integer): TfrxWizardItem;
  public
    constructor Create;
    procedure Register(ClassRef: TfrxWizardClass; ButtonBmp: TBitmap;
      IsToolbarWizard: Boolean = False);
    procedure Register1(ClassRef: TfrxWizardClass; ImageIndex: Integer);
    procedure Unregister(ClassRef: TfrxWizardClass);
    property Items[Index: Integer]: TfrxWizardItem read GetWizardItem; default;
  end;


{ internal methods }

function frxCreatePropertyList(ComponentList: TList; Designer: TfrxCustomDesigner): TfrxPropertyList;
procedure frxHideProperties(ComponentClass: TClass; const Properties: String);


function frxObjects: TfrxObjectCollection;
function frxComponentEditors: TfrxComponentEditorCollection;
function frxPropertyEditors: TfrxPropertyEditorCollection;
function frxExportFilters: TfrxExportFilterCollection;
function frxWizards: TfrxWizardCollection;


implementation

uses
  Consts, Forms, Dialogs, frxUtils, frxRes;

type
  TIntegerSet = set of 0..31;

var
  FObjects: TfrxObjectCollection = nil;
  FComponentEditors: TfrxComponentEditorCollection = nil;
  FPropertyEditors: TfrxPropertyEditorCollection = nil;
  FExportFilters: TfrxExportFilterCollection = nil;
  FWizards: TfrxWizardCollection = nil;

{ Routines }

procedure frxHideProperties(ComponentClass: TClass; const Properties: String);
var
  i: Integer;
  sl: TStringList;
begin
  sl := TStringList.Create;
  frxSetCommaText(Properties, sl);

  for i := 0 to sl.Count - 1 do
    frxPropertyEditors.Register(nil, ComponentClass, sl[i], nil);

  sl.Free;
end;

function frxCreatePropertyList(ComponentList: TList;
  Designer: TfrxCustomDesigner): TfrxPropertyList;
var
  i: Integer;
  p: TfrxPropertyList;
  l: TList;
begin
  if ComponentList.Count = 0 then
  begin
    Result := nil;
    Exit;
  end;

  l := TList.Create;
  for i := 0 to ComponentList.Count - 1 do
  begin
    p := TfrxPropertyList.Create(Designer);
    l.Add(p);
    p.Component := ComponentList[i];
  end;

  Result := l[0];
  for i := 1 to ComponentList.Count - 1 do
    Result.FillCommonProperties(TfrxPropertyList(l[i]));

  for i := 1 to ComponentList.Count - 1 do
  begin
    TfrxPropertyList(l[i]).FillCommonProperties(Result);
    Result.AddProperties(TfrxPropertyList(l[i]));
    TfrxPropertyList(l[i]).Free;
  end;

  l.Free;
end;

function frStrToFloat(s: String): Extended;
var
  i: Integer;
begin
  for i := 1 to Length(s) do
{$IFDEF Delphi12}
    if CharInSet(s[i], [',', '.']) then
{$ELSE}
    if s[i] in [',', '.'] then
{$ENDIF}
      s[i] := DecimalSeparator;
  Result := StrToFloat(Trim(s));
end;


{ TfrxPropertyEditor }

constructor TfrxPropertyEditor.Create(Designer: TfrxCustomDesigner);
begin
  FDesigner := Designer;
  FCompList := TList.Create;
  FPropList := TList.Create;
  FValues := TStringList.Create;
end;