frxdsgnintf.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Design interface }
{ }
{ Copyright (c) 1998-2005 }
{ 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;

  TfrxDateProperty = 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 }

  TfrxObjectItem = class(TCollectionItem)
  public
    ClassRef:TfrxComponentClass;
    ButtonBmp:TBitmap;
    ButtonImageIndex:Integer;
    ButtonHint:String;
    CategoryName:String;
    Flags:Word;
  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);
    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);
    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);
    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 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);

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

implementation

uses
  Consts, Forms, Dialogs, frxUtils, frxRes;

type
  TIntegerSet = set of 0..31;

{ 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
    if s[i] in [',', '.'] then
      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;

destructor TfrxPropertyEditor.Destroy;
begin
  FCompList.Free;
  FPropList.Free;
  FValues.Free;
  inherited;
end;

function TfrxPropertyEditor.GetAttributes:TfrxPropertyAttributes;
begin
  Result:= [paMultiSelect];
end;

function TfrxPropertyEditor.GetName:String;
begin
  Result:= PropInfo.Name;
end;

function TfrxPropertyEditor.GetComponent:TPersistent;
begin
  Result:= FCompList[0];
end;

function TfrxPropertyEditor.GetfrComponent:TfrxComponent;
begin
  if TObject(FCompList[0]) is TfrxComponent then
    Result:= FCompList[0] else
    Result:= nil;
end;

function TfrxPropertyEditor.GetPropInfo:PPropInfo;
begin
  Result:= FPropList[0];
end;

function TfrxPropertyEditor.GetValue:String;
begin
  Result:= '(Unknown)';
end;

procedure TfrxPropertyEditor.SetValue(const Value:String);
begin
  { empty method }
end;

function TfrxPropertyEditor.GetFloatValue:Extended;
begin
  Result:= GetFloatProp(Component, PropInfo);
end;

function TfrxPropertyEditor.GetOrdValue:Integer;
begin
  Result:= GetOrdProp(Component, PropInfo);
end;

function TfrxPropertyEditor.GetStrValue:String;
begin
  Result:= GetStrProp(Component, PropInfo);
end;

function TfrxPropertyEditor.GetVarValue:Variant;
begin
  Result:= GetVariantProp(Component, PropInfo);
end;

procedure TfrxPropertyEditor.SetFloatValue(Value:Extended);
var
  i:Integer;
begin
  for i:= 0 to FCompList.Count-1 do
    SetFloatProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
end;

procedure TfrxPropertyEditor.SetOrdValue(Value:Integer);
var
  i:Integer;
begin
  for i:= 0 to FCompList.Count-1 do
    SetOrdProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
end;

procedure TfrxPropertyEditor.SetStrValue(const Value:String);
var
  i:Integer;
begin
  for i:= 0 to FCompList.Count-1 do
    SetStrProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
end;

procedure TfrxPropertyEditor.SetVarValue(Value:Variant);
var
  i:Integer;
begin
  for i:= 0 to FCompList.Count-1 do
    SetVariantProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
end;

procedure TfrxPropertyEditor.GetValues;
begin
  FValues.Clear;
  TStringList(FValues).Sorted:= paSortList in GetAttributes;
end;

procedure TfrxPropertyEditor.GetStrProc(const s:String);
begin
  FValues.Add(s);
end;

function TfrxPropertyEditor.Edit:Boolean;
var
  i:Integer;
begin
  Result:= False;
  GetValues;
  if FValues.Count > 0 then
  begin
    i:= FValues.IndexOf(Value)+1;
    if i = FValues.Count then
      i:= 0;
    Value:= FValues[i];
    Result:= True;
  end;
end;