frxdesgn.pas

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

    OnDragDrop := CodeWindowDragDrop;
  end;
end;

procedure TfrxDesignerForm.CreateObjectsToolbar;
var
  i: Integer;
  Item: TfrxObjectItem;

  function HasButtons(Item: TfrxObjectItem): Boolean;
  var
    i: Integer;
    Item1: TfrxObjectItem;
  begin
    Result := False;
    for i := 0 to frxObjects.Count - 1 do
    begin
      Item1 := frxObjects[i];
      if (Item1.ClassRef <> nil) and (Item1.CategoryName = Item.CategoryName) then
        Result := True;
    end;
  end;

  procedure CreateButton(Index: Integer; Item: TfrxObjectItem);
  var
    b: TToolButton;
    s: String;
  begin
    b := TToolButton.Create(ObjectsTB1);
    b.Parent := ObjectsTB1;
    b.Style := tbsCheck;
    b.ImageIndex := Item.ButtonImageIndex;
    b.Grouped := True;
    s := Item.ButtonHint;
    if s = '' then
    begin
      if Item.ClassRef <> nil then
        s := Item.ClassRef.GetDescription;
    end
    else
      s := frxResources.Get(s);
    b.Hint := s;
    b.Tag := Index;
    if Item.ClassRef = nil then  { category }
      if not HasButtons(Item) then
      begin
        b.Free;
        Exit;
      end;
    b.OnClick := ObjectsButtonClick;
    b.Wrap := True;
    {$IFDEF FR_LITE}
    if Item.CategoryName = 'Other' then
    begin
      b.Enabled := False;
      b.Hint := b.Hint + #13#10 + 'This feature is not available in FreeReport';
    end;
    {$ENDIF}  
  end;

begin
  { add category buttons }
  for i := frxObjects.Count - 1 downto 0 do
  begin
    Item := frxObjects[i];
    if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
    begin
      frxResources.SetObjectImages(Item.ButtonBmp);
      Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
    end;
    if Item.ClassRef = nil then
      CreateButton(i, Item);
  end;

  { add object buttons }
  for i := frxObjects.Count - 1 downto 0 do
  begin
    Item := frxObjects[i];
    if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
    begin
      frxResources.SetObjectImages(Item.ButtonBmp);
      Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
    end;

    if (Item.ClassRef <> nil) and (Item.CategoryName = '') then
      CreateButton(i, Item);
  end;

  ObjectBandB := TToolButton.Create(Self);
  with ObjectBandB do
  begin
    Parent := ObjectsTB1;
    Tag := 1000;
    Grouped := True;
    ImageIndex := 1;
    Style := tbsCheck;
    OnClick := ObjectBandBClick;
    Wrap := True;
  end;

  FormatToolB := TToolButton.Create(Self);
  with FormatToolB do
  begin
    Parent := ObjectsTB1;
    Tag := 1000;
    Grouped := True;
    ImageIndex := 30;
    Style := tbsCheck;
    OnClick := SelectToolBClick;
    Wrap := True;
  end;

  TextToolB := TToolButton.Create(Self);
  with TextToolB do
  begin
    Parent := ObjectsTB1;
    Tag := 1000;
    Grouped := True;
    ImageIndex := 29;
    Style := tbsCheck;
    OnClick := SelectToolBClick;
    Wrap := True;
  end;

  ZoomToolB := TToolButton.Create(Self);
  with ZoomToolB do
  begin
    Parent := ObjectsTB1;
    Tag := 1000;
    Grouped := True;
    ImageIndex := 28;
    Style := tbsCheck;
    OnClick := SelectToolBClick;
    Wrap := True;
  end;

  HandToolB := TToolButton.Create(Self);
  with HandToolB do
  begin
    Parent := ObjectsTB1;
    Tag := 1000;
    Grouped := True;
    ImageIndex := 27;
    Style := tbsCheck;
    OnClick := SelectToolBClick;
    Wrap := True;
  end;

  ObjectSelectB := TToolButton.Create(Self);
  with ObjectSelectB do
  begin
    Parent := ObjectsTB1;
    Down := True;
    Grouped := True;
    ImageIndex := 0;
    Style := tbsCheck;
    OnClick := SelectToolBClick;
    Wrap := True;
  end;
end;

procedure TfrxDesignerForm.CreateExtraToolbar;
var
  i: Integer;
  Item: TfrxWizardItem;
  b: TToolButton;
begin
  for i := 0 to frxWizards.Count - 1 do
  begin
    Item := frxWizards[i];
    if Item.IsToolbarWizard then
    begin
      b := TToolButton.Create(Self);
      with b do
      begin
        Tag := i;
        if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
        begin
          frxResources.SetButtonImages(Item.ButtonBmp);
          Item.ButtonImageIndex := frxResources.MainButtonImages.Count - 1;
        end;
        ImageIndex := Item.ButtonImageIndex;
        Hint := Item.ClassRef.GetDescription;
        SetBounds(1000, 0, 22, 22);
        Parent := ExtraToolsTB1;
      end;
      b.OnClick := OnExtraToolClick;
    end;
  end;

  ExtraToolsTB.Height := 27;
  ExtraToolsTB.Width := 27;
  ExtraToolsTB.AdjustBounds;
end;

procedure TfrxDesignerForm.AttachDialogFormEvents(Attach: Boolean);
begin
  if Attach then
  begin
    FDialogForm.Parent := Self;
    FDialogForm.OnModify := DialogFormModify;
    FDialogForm.OnKeyDown := DialogFormKeyDown;
    FDialogForm.OnKeyUp := DialogFormKeyUp;
    FDialogForm.OnKeyPress := DialogFormKeyPress;
  end
  else
    if FDialogForm <> nil then
    begin
      FWorkspace.Parent := nil;
      FDialogForm.Parent := nil;
      FDialogForm.Hide;
      FDialogForm.OnModify := nil;
      FDialogForm.OnKeyDown := nil;
      FDialogForm.OnKeyUp := nil;
      FDialogForm.OnKeyPress := nil;
      FDialogForm := nil;
    end;
end;

procedure TfrxDesignerForm.ReloadReport;

  procedure EmptyReport;
  var
    p: TfrxPage;
  begin
    Report.Clear;
    p := TfrxReportPage.Create(Report);
    p.Name := 'Page1';
  end;

begin
  if Report.PagesCount = 0 then
    EmptyReport;
  LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
  CodeWindow.Lines := Report.ScriptText;
  UpdateSyntaxType;
  ReloadPages(0);
  UpdateRecentFiles(Report.FileName);
  UpdateCaption;
  UpdateStyles;
  FUndoBuffer.ClearUndo;
  Modified := False;
end;

procedure TfrxDesignerForm.ReloadPages(Index: Integer);
var
  i: Integer;
  c: TfrxPage;
  s: String;
begin
  FDialogForm := nil;
  Tab.Tabs.BeginUpdate;
  Tab.Tabs.Clear;
  Tab.Tabs.Add(frxResources.Get('dsCode'));

  for i := 0 to Report.PagesCount - 1 do
  begin
    c := Report.Pages[i];
    c.IsDesigning := True;
    if (c is TfrxReportPage) and (TfrxReportPage(c).Subreport <> nil) then
      s := TfrxReportPage(c).Subreport.Name
    else if c.Name = '' then
      s := frxResources.Get('dsPage') + IntToStr(i + 1) else
      s := c.Name;
    Tab.Tabs.Add(s);
  end;

  Tab.Tabs.EndUpdate;

  if Index = -1 then
    Page := nil
  else if Index < Report.PagesCount then
    Page := Report.Pages[Index] else
    Page := Report.Pages[0];
end;

procedure TfrxDesignerForm.ReloadObjects;
var
  i: Integer;
begin
  FObjects.Clear;
  FSelectedObjects.Clear;

  for i := 0 to FPage.AllObjects.Count - 1 do
    FObjects.Add(FPage.AllObjects[i]);

  FObjects.Add(Report);
  FObjects.Add(FPage);
  FSelectedObjects.Add(FPage);
  FWorkspace.Page := FPage;
  FWorkspace.EnableUpdate;
  FWorkspace.AdjustBands;

  FInspector.EnableUpdate;

  UpdateDataTree;
  FReportTree.UpdateItems;
  OnSelectionChanged(Self);
end;

procedure TfrxDesignerForm.SetReportDefaults;
begin
  if frxDesignerComp <> nil then
  begin
    Report.ScriptLanguage := frxDesignerComp.DefaultScriptLanguage;
    frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
    UpdateSyntaxType;
    LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);

    with TfrxReportPage(Report.Pages[0]) do
    begin
      LeftMargin := frxDesignerComp.DefaultLeftMargin;
      BottomMargin := frxDesignerComp.DefaultBottomMargin;
      RightMargin := frxDesignerComp.DefaultRightMargin;
      TopMargin := frxDesignerComp.DefaultTopMargin;
      PaperSize := frxDesignerComp.DefaultPaperSize;
      Orientation := frxDesignerComp.DefaultOrientation;
    end;
  end
  else
  begin
    Report.ScriptLanguage := 'PascalScript';
    frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
    UpdateSyntaxType;
    LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);

    TfrxReportPage(Report.Pages[0]).SetDefaults;
  end;
end;

procedure TfrxDesignerForm.UpdatePageDimensions;
var
  h: Extended;
begin
  if FPage is TfrxReportPage then
    with FPage as TfrxReportPage do
    begin
      ScrollBox.HorzScrollBar.Position := 0;
      ScrollBox.VertScrollBar.Position := 0;

      FWorkspace.Origin := Point(10, 10);
      h := PaperHeight;
      if LargeDesignHeight then
        h := h * 5;
      FWorkspace.SetPageDimensions(
        Round(PaperWidth * 96 / 25.4),
        Round(h * 96 / 25.4),
        Rect(Round(LeftMargin * 96 / 25.4), Round(TopMargin * 96 / 25.4),
             Round(RightMargin * 96 / 25.4), Round(BottomMargin * 96 / 25.4)));
    end;
end;

procedure TfrxDesignerForm.UpdateControls;
var
  c: TfrxComponent;
  p1, p2, p3: PPropInfo;
  Count: Integer;
  FontEnabled, AlignEnabled, IsReportPage: Boolean;
  Frame1Enabled, Frame2Enabled, Frame3Enabled, ObjSelected, DMPEnabled: Boolean;
  s: String;
  Frame: TfrxFrame;
  DMPFontStyle: TfrxDMPFontStyles;

  procedure SetEnabled(cAr: array of TControl; Enabled: Boolean);
  var
    i: Integer;
  begin
    for i := 0 to High(cAr) do
    begin
      cAr[i].Enabled := Enabled;
      if (cAr[i] is TToolButton) and not Enabled then
        TToolButton(cAr[i]).Down := False;
    end;
  end;

  procedure ButtonUp(cAr: array of TToolButton);
  var
    i: Integer;
  begin
    for i := 0 to High(cAr) do
      cAr[i].Down := False;
  end;

begin
  FUpdatingControls := True;

  Count := FSelectedObjects.Count;
  if Count > 0 then
  begin
    c := FSelectedObjects[0];
    p1 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Font');
    p2 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Frame');
    p3 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Color');
  end
  else
  begin
    c := nil;
    p1 := nil;
    p2 := nil;
    p3 := nil;
  end;

  if Count = 1 then
  begin
    FontNameCB.Text := c.Font.Name;
    FontSizeCB.Text := IntToStr(c.Font.Size);

    BoldB.Down := fsBold in c.Font.Style;
    ItalicB.Down := fsItalic in c.Font.Style;
    UnderlineB.Down := fsUnderline in c.Font.Style;

    if c is TfrxCustomMemoView then
      with TfrxCustomMemoView(c) do
      begin
        TextAlignLeftB.Down := HAlign = haLeft;
        TextAlignCenterB.Down := HAlign = haCenter;
        TextAlignRightB.Down := HAlign = haRight;
        TextAlignBlockB.Down := HAlign = haBlock;

        TextAlignTopB.Down := VAlign = vaTop;
        TextAlignMiddleB.Down := VAlign = vaCenter;
        TextAlignBottomB.Down := VAlign = vaBottom;
        if not (c is TfrxDMPMemoView) then
          if Style = '' then
            StyleCB.ItemIndex := 0 else
            StyleCB.Text := Style;
      end;

    Frame := nil;
    if c is TfrxView then
      Frame := TfrxView(c).Frame
    else if c is TfrxReportPage then
      Frame := TfrxReportPage(c).Frame;

    if Frame <> nil then
      with Frame do
      begin
        FrameTopB.Down := ftTop in Typ;
        FrameBottomB.Down := ftBottom in Typ;
        FrameLeftB.Down := ftLeft in Typ;
        FrameRightB.Down := ftRight in Typ;
        ShadowB.Down := DropShadow;