frxdsgnintf.pas

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

end;

{ TfrxFontCharsetProperty }

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

function TfrxFontCharsetProperty.GetValue:String;
begin
  if not CharsetToIdent(GetOrdValue, Result) then
    FmtStr(Result, '%d', [GetOrdValue]);
end;

procedure TfrxFontCharsetProperty.SetValue(const Value:String);
var
  c:Integer;
begin
  if IdentToCharset(Value, c) then
    SetOrdValue(c) else
    inherited SetValue(Value);
end;

procedure TfrxFontCharsetProperty.GetValues;
begin
  inherited;
  GetCharsetValues(GetStrProc);
end;

{ TfrxModalResultProperty }

const
  ModalResults:array[mrNone..mrYesToAll] of string = (
    'mrNone',
    'mrOk',
    'mrCancel',
    'mrAbort',
    'mrRetry',
    'mrIgnore',
    'mrYes',
    'mrNo',
    'mrAll',
    'mrNoToAll',
    'mrYesToAll');

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

function TfrxModalResultProperty.GetValue:String;
begin
  if GetOrdValue in [mrNone..mrYesToAll] then
    Result:= ModalResults[GetOrdValue] else
    Result:= inherited GetValue;
end;

procedure TfrxModalResultProperty.SetValue(const Value:String);
var
  i:Integer;
  s:String;
begin
  s:= Value;
  if s = '' then
    s:= '0';
  for i:= Low(ModalResults) to High(ModalResults) do
    if CompareText(ModalResults[i], s) = 0 then
    begin
      SetOrdValue(i);
      Exit;
    end;
  inherited SetValue(s);
end;

procedure TfrxModalResultProperty.GetValues;
var
  i:Integer;
begin
  inherited;
  for i:= mrNone to mrYesToAll do
    Values.Add(ModalResults[i]);
end;

{ TfrxShortCutProperty }

const
  ShortCuts:array[0..108] of TShortCut = (
    scNone,
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    Byte('A') or scCtrl or scAlt,
    Byte('B') or scCtrl or scAlt,
    Byte('C') or scCtrl or scAlt,
    Byte('D') or scCtrl or scAlt,
    Byte('E') or scCtrl or scAlt,
    Byte('F') or scCtrl or scAlt,
    Byte('G') or scCtrl or scAlt,
    Byte('H') or scCtrl or scAlt,
    Byte('I') or scCtrl or scAlt,
    Byte('J') or scCtrl or scAlt,
    Byte('K') or scCtrl or scAlt,
    Byte('L') or scCtrl or scAlt,
    Byte('M') or scCtrl or scAlt,
    Byte('N') or scCtrl or scAlt,
    Byte('O') or scCtrl or scAlt,
    Byte('P') or scCtrl or scAlt,
    Byte('Q') or scCtrl or scAlt,
    Byte('R') or scCtrl or scAlt,
    Byte('S') or scCtrl or scAlt,
    Byte('T') or scCtrl or scAlt,
    Byte('U') or scCtrl or scAlt,
    Byte('V') or scCtrl or scAlt,
    Byte('W') or scCtrl or scAlt,
    Byte('X') or scCtrl or scAlt,
    Byte('Y') or scCtrl or scAlt,
    Byte('Z') or scCtrl or scAlt,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    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;

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

{ 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, '', TfrxDateProperty);

finalization
  frxObjects.Free;
  frxComponentEditors.Free;
  frxPropertyEditors.Free;
  frxExportFilters.Free;
  frxWizards.Free;

end.