frxdsgnintf.pas

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

end;

procedure TfrxCursorProperty.SetValue(const Value: string);
var
  NewValue: Integer;
begin
  if IdentToCursor(Value, NewValue) then
    SetOrdValue(NewValue) else
    inherited;
end;


{ TfrxDateTimeProperty }

function TfrxDateTimeProperty.GetValue: String;
var
  DT: TDateTime;
begin
  DT := GetFloatValue;
  if DT = 0.0 then
    Result := ''
  else
    Result := DateTimeToStr(DT);
end;

procedure TfrxDateTimeProperty.SetValue(const Value: String);
var
  DT: TDateTime;
begin
  if Value = '' then
    DT := 0.0
  else
    DT := StrToDateTime(Value);
  SetFloatValue(DT);
end;


{ TfrxDateProperty }

function TfrxDateProperty.GetValue: String;
var
  DT: TDateTime;
begin
  DT := GetFloatValue;
  if DT = 0.0 then
    Result := ''
  else
    Result := DateToStr(DT);
end;

procedure TfrxDateProperty.SetValue(const Value: String);
var
  DT: TDateTime;
begin
  if Value = '' then
    DT := 0.0
  else
    DT := StrToDate(Value);
  SetFloatValue(DT);
end;


{ TfrxTimeProperty }

function TfrxTimeProperty.GetValue: String;
var
  DT: TDateTime;
begin
  DT := GetFloatValue;
  if DT = 0.0 then
    Result := ''
  else
    Result := TimeToStr(DT);
end;

procedure TfrxTimeProperty.SetValue(const Value: String);
var
  DT: TDateTime;
begin
  if Value = '' then
    DT := 0.0
  else
    DT := StrToTime(Value);
  SetFloatValue(DT);
end;


{ TfrxObjectCollection }

constructor TfrxObjectCollection.Create;
begin
  inherited Create(TfrxObjectItem);
end;

function TfrxObjectCollection.GetObjectItem(Index: Integer): TfrxObjectItem;
begin
  Result := TfrxObjectItem(inherited Items[Index]);
end;

procedure TfrxObjectCollection.RegisterCategory(const CategoryName: String;
  ButtonBmp: TBitmap; const ButtonHint: String; ImageIndex: Integer);
begin
  RegisterObject1(nil, ButtonBmp, ButtonHint, CategoryName, 0, ImageIndex);
end;

procedure TfrxObjectCollection.RegisterObject(ClassRef: TfrxComponentClass;
  ButtonBmp: TBitmap; const CategoryName: String);
begin
  RegisterObject1(ClassRef, ButtonBmp, '', CategoryName);
end;

procedure TfrxObjectCollection.RegisterObject1(
  ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
  const ButtonHint: String = ''; const CategoryName: String = '';
  Flags: Integer = 0; ImageIndex: Integer = -1;
  Category: TfrxObjectCategories = []);
var
  i: Integer;
  Item: TfrxObjectItem;
begin
  for i := 0 to Count - 1 do
  begin
    Item := Items[i];
    if (Item.ClassRef <> nil) and (Item.ClassRef = ClassRef) and
      (Item.Flags = Flags) then
      Exit;
  end;

  if ClassRef <> nil then
    RegisterClass(ClassRef);

  Item := TfrxObjectItem(Add);
  Item.ClassRef := ClassRef;
  Item.ButtonBmp := ButtonBmp;
  Item.ButtonImageIndex := ImageIndex;
  Item.ButtonHint := ButtonHint;
  Item.CategoryName := CategoryName;
  Item.Flags := Flags;
  Item.Category := Category;

  { if category is not set, determine it automatically }
  if (ClassRef <> nil) and (Category = []) then
  begin
    if ClassRef.InheritsFrom(TfrxDataset) or
      ClassRef.InheritsFrom(TfrxCustomDatabase) then
      Item.Category := [ctData]
    else if ClassRef.InheritsFrom(TfrxDialogControl) or
      ClassRef.InheritsFrom(TfrxDialogComponent) then
      Item.Category := [ctDialog]
    else
      Item.Category := [ctReport];
  end;

  if ButtonBmp <> nil then
    ButtonBmp.Dormant;
end;

procedure TfrxObjectCollection.UnRegister(ClassRef: TfrxComponentClass);
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    if Items[i].ClassRef = ClassRef then
      Items[i].Free else
      Inc(i);
  end;
end;


{ TfrxComponentEditorCollection }

constructor TfrxComponentEditorCollection.Create;
begin
  inherited Create(TfrxComponentEditorItem);
end;

function TfrxComponentEditorCollection.GetComponentEditorItem(
  Index: Integer): TfrxComponentEditorItem;
begin
  Result := TfrxComponentEditorItem(inherited Items[Index]);
end;

function TfrxComponentEditorCollection.GetComponentEditor(Component: TfrxComponent;
  Designer: TfrxCustomDesigner; Menu: TMenu): TfrxComponentEditor;
var
  i, j: Integer;
begin
  Result := nil;
  j := -1;
  for i := 0 to Count - 1 do
    if Items[i].ComponentClass = Component.ClassType then
    begin
      j := i;
      break;
    end
    else if Component.InheritsFrom(Items[i].ComponentClass) then
      j := i;

  if j <> -1 then
  begin
    Result := TfrxComponentEditor(Items[j].ComponentEditor.NewInstance);
    Result.Create(Component, Designer, Menu);
  end;
end;

procedure TfrxComponentEditorCollection.Register(ComponentClass: TfrxComponentClass;
  ComponentEditor: TfrxComponentEditorClass);
var
  Item: TfrxComponentEditorItem;
begin
  Item := TfrxComponentEditorItem(Add);
  Item.ComponentClass := ComponentClass;
  Item.ComponentEditor := ComponentEditor;
end;

procedure TfrxComponentEditorCollection.UnRegister(ComponentEditor: TfrxComponentEditorClass);
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    if Items[i].ComponentEditor = ComponentEditor then
      Items[i].Free else
      Inc(i);
  end;
end;


{ TfrxPropertyEditorCollection }

constructor TfrxPropertyEditorCollection.Create;
begin
  inherited Create(TfrxPropertyEditorItem);
  FEventEditorItem := -1;
end;

function TfrxPropertyEditorCollection.GetPropertyEditorItem(
  Index: Integer): TfrxPropertyEditorItem;
begin
  Result := TfrxPropertyEditorItem(inherited Items[Index]);
end;

function TfrxPropertyEditorCollection.GetPropertyEditor(PropertyType: PTypeInfo;
  Component: TPersistent; PropertyName: String): Integer;
var
  i: Integer;
  Item: TfrxPropertyEditorItem;
begin
  if (Pos('tfrx', LowerCase(String(PropertyType.Name))) = 1) and
    (Pos('event', LowerCase(String(PropertyType.Name))) = Length(PropertyType.Name) - 4) then
  begin
    Result := FEventEditorItem;
    Exit;
  end;

  Result := -1;
  for i := Count - 1 downto 0 do
  begin
    Item := Items[i];
    if (Item.ComponentClass = nil) and (Item.PropertyName = '') and
      (Item.PropertyType = PropertyType) then
      Result := i
    else if (Item.ComponentClass = nil) and (Item.PropertyType = PropertyType) and
      (CompareText(Item.PropertyName, PropertyName) = 0) then
    begin
      Result := i;
      break;
    end
    else if (Component.InheritsFrom(Item.ComponentClass)) and
      (CompareText(Item.PropertyName, PropertyName) = 0) then
    begin
      Result := i;
      break;
    end;
  end;
end;

procedure TfrxPropertyEditorCollection.Register(PropertyType: PTypeInfo;
  ComponentClass: TClass; const PropertyName: String;
  EditorClass: TfrxPropertyEditorClass);
var
  Item: TfrxPropertyEditorItem;
begin
  Item := TfrxPropertyEditorItem(Add);
  Item.PropertyType := PropertyType;
  Item.ComponentClass := ComponentClass;
  Item.PropertyName := PropertyName;
  Item.EditorClass := EditorClass;
end;

procedure TfrxPropertyEditorCollection.RegisterEventEditor(
  EditorClass: TfrxPropertyEditorClass);
begin
  Register(nil, nil, '', EditorClass);
  FEventEditorItem := Count - 1;
end;

procedure TfrxPropertyEditorCollection.UnRegister(EditorClass: TfrxPropertyEditorClass);
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    if Items[i].EditorClass = EditorClass then
      Items[i].Free else
      Inc(i);
  end;
end;


{ TfrxExportFilterCollection }

constructor TfrxExportFilterCollection.Create;
begin
  inherited Create(TfrxExportFilterItem);
end;

function TfrxExportFilterCollection.GetExportFilterItem(
  Index: Integer): TfrxExportFilterItem;
begin
  Result := TfrxExportFilterItem(inherited Items[Index]);
end;

procedure TfrxExportFilterCollection.Register(Filter: TfrxCustomExportFilter);
var
  i: Integer;
  Item: TfrxExportFilterItem;
begin
  if Filter = nil then Exit;
  for i := 0 to Count - 1 do
    if Items[i].Filter = Filter then
      Exit;

  Item := TfrxExportFilterItem(Add);
  Item.Filter := Filter;
end;

procedure TfrxExportFilterCollection.UnRegister(Filter: TfrxCustomExportFilter);
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    if Items[i].Filter = Filter then
      Items[i].Free else
      Inc(i);
  end;
end;


{ TfrxWizardCollection }

constructor TfrxWizardCollection.Create;
begin
  inherited Create(TfrxWizardItem);
end;

function TfrxWizardCollection.GetWizardItem(Index: Integer): TfrxWizardItem;
begin
  Result := TfrxWizardItem(inherited Items[Index]);
end;

procedure TfrxWizardCollection.Register(ClassRef: TfrxWizardClass;
  ButtonBmp: TBitmap; IsToolbarWizard: Boolean);
var
  i: Integer;
  Item: TfrxWizardItem;
begin
  for i := 0 to Count - 1 do
    if Items[i].ClassRef = ClassRef then
      Exit;

  Item := TfrxWizardItem(Add);
  Item.ClassRef := ClassRef;
  Item.ButtonBmp := ButtonBmp;
  Item.ButtonImageIndex := -1;
  Item.IsToolbarWizard := IsToolbarWizard;

  if ButtonBmp <> nil then
    ButtonBmp.Dormant;
end;

procedure TfrxWizardCollection.Register1(ClassRef: TfrxWizardClass;
  ImageIndex: Integer);
var
  i: Integer;
  Item: TfrxWizardItem;
begin
  for i := 0 to Count - 1 do
    if Items[i].ClassRef = ClassRef then
      Exit;

  Item := TfrxWizardItem(Add);
  Item.ClassRef := ClassRef;
  Item.ButtonImageIndex := ImageIndex;
end;

procedure TfrxWizardCollection.UnRegister(ClassRef: TfrxWizardClass);
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    if Items[i].ClassRef = ClassRef then
      Items[i].Free else
      Inc(i);
  end;
end;


{ globals }

function frxObjects: TfrxObjectCollection;
begin
  if FObjects = nil then
    FObjects := TfrxObjectCollection.Create;
  Result := FObjects;
end;

function frxComponentEditors: TfrxComponentEditorCollection;
begin
  if FComponentEditors = nil then
    FComponentEditors := TfrxComponentEditorCollection.Create;
  Result := FComponentEditors;
end;

function frxPropertyEditors: TfrxPropertyEditorCollection;
begin
  if FPropertyEditors = nil then
    FPropertyEditors := TfrxPropertyEditorCollection.Create;
  Result := FPropertyEditors;
end;

function frxExportFilters: TfrxExportFilterCollection;
begin
  if FExportFilters = nil then
    FExportFilters := TfrxExportFilterCollection.Create;
  Result := FExportFilters;
end;

function frxWizards: TfrxWizardCollection;
begin
  if FWizards = nil then
    FWizards := TfrxWizardCollection.Create;
  Result := FWizards;
end;


initialization
  frxPropertyEditors.Register(TypeInfo(TComponentName), nil, 'Name', TfrxNameProperty);
  frxPropertyEditors.Register(TypeInfo(TColor), nil, '', TfrxColorProperty);
  frxPropertyEditors.Register(TypeInfo(TFont), nil, '', TfrxFontProperty);
  frxPropertyEditors.Register(TypeInfo(String), TFont, 'Name', TfrxFontNameProperty);
  frxPropertyEditors.Register(TypeInfo(Integer), TFont, 'Charset', TfrxFontCharsetProperty);
  frxPropertyEditors.Register(TypeInfo(TModalResult), nil, '', TfrxModalResultProperty);
  frxPropertyEditors.Register(TypeInfo(TShortCut), nil, '', TfrxShortCutProperty);
  frxPropertyEditors.Register(TypeInfo(TCursor), nil, '', TfrxCursorProperty);
  frxPropertyEditors.Register(TypeInfo(TDateTime), nil, '', TfrxDateTimeProperty);
  frxPropertyEditors.Register(TypeInfo(TDate), nil, '', TfrxDateProperty);
  frxPropertyEditors.Register(TypeInfo(TTime), nil, '', TfrxTimeProperty);


finalization
  if FObjects <> nil then
    FObjects.Free;
  FObjects := nil;
  if FComponentEditors <> nil then
    FComponentEditors.Free;
  FComponentEditors := nil;
  if FPropertyEditors <> nil then
    FPropertyEditors.Free;
  FPropertyEditors := nil;
  if FExportFilters <> nil then
    FExportFilters.Free;
  FExportFilters := nil;
  if FWizards <> nil then
    FWizards.Free;
  FWizards := nil;  


end.


//