frxdsgnintf.pas

报表控件。FastReport 是非常强大的报表控件

    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);

function TfrxShortCutProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList];
end;

function TfrxShortCutProperty.GetValue: String;
var
  CurValue: TShortCut;
begin
  CurValue := GetOrdValue;
  if CurValue = scNone then
    Result := srNone else
    Result := ShortCutToText(CurValue);
end;

procedure TfrxShortCutProperty.SetValue(const Value: String);
var
  NewValue: TShortCut;
begin
  NewValue := 0;
  if (Value <> '') and (AnsiCompareText(Value, srNone) <> 0) then
    NewValue := TextToShortCut(Value);
  SetOrdValue(NewValue);
end;

procedure TfrxShortCutProperty.GetValues;
var
  i: Integer;
begin
  inherited;
  Values.Add(srNone);
  for i := 1 to High(ShortCuts) do
    Values.Add(ShortCutToText(ShortCuts[i]));
end;


{ TfrxCursorProperty }

function TfrxCursorProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TfrxCursorProperty.GetValue: string;
begin
  Result := CursorToString(TCursor(GetOrdValue));
end;

procedure TfrxCursorProperty.GetValues;
begin
  inherited;
  GetCursorValues(GetStrProc);
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);
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;

  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;


{ 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(PropertyType.Name)) = 1) and
    (Pos('event', LowerCase(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;


{ 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.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;


initialization
  frxObjects := TfrxObjectCollection.Create;
  frxComponentEditors := TfrxComponentEditorCollection.Create;
  frxPropertyEditors := TfrxPropertyEditorCollection.Create;
  frxExportFilters := TfrxExportFilterCollection.Create;
  frxWizards := TfrxWizardCollection.Create;

  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
  frxObjects.Free;
  frxComponentEditors.Free;
  frxPropertyEditors.Free;
  frxExportFilters.Free;
  frxWizards.Free;


end.


//<censored>