⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxdesgn.pas

📁 报表控件。FastReport 是非常强大的报表控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        FrameWidthCB.Text := FloatToStr(Width);
      end;
  end
  else
  begin
    FontNameCB.Text := '';
    FontSizeCB.Text := '';
    FrameWidthCB.Text := '';

    ButtonUp([BoldB, ItalicB, UnderlineB, TextAlignLeftB, TextAlignCenterB,
      TextAlignRightB, TextAlignBlockB, TextAlignTopB, TextAlignMiddleB,
      TextAlignBottomB, FrameTopB, FrameBottomB, FrameLeftB,
      FrameRightB, ShadowB]);
  end;

  FontEnabled := (p1 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
  AlignEnabled := (c is TfrxCustomMemoView) and (FPage <> nil);
  Frame1Enabled := (p2 <> nil) and not (c is TfrxLineView) and
    not (c is TfrxShapeView) and not (c is TfrxDMPPage) and (FPage <> nil);
  Frame2Enabled := (p2 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
  Frame3Enabled := (p3 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
  IsReportPage := FPage is TfrxReportPage;
  ObjSelected := (Count <> 0) and (FPage <> nil) and (FSelectedObjects[0] <> FPage);
  DMPEnabled := (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
    (c is TfrxDMPCommand) or (c is TfrxDMPPage);

  SetEnabled([FontNameCB, FontSizeCB, BoldB, ItalicB, UnderlineB, FontColorB],
    (FontEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
  SetEnabled([FontB], (FontEnabled or DMPEnabled or (Count > 1)));
  SetEnabled([TextAlignLeftB, TextAlignCenterB, TextAlignRightB,
    TextAlignBlockB, TextAlignTopB, TextAlignMiddleB, TextAlignBottomB],
    AlignEnabled or (Count > 1));
  SetEnabled([StyleCB, HighlightB, RotateB],
    (AlignEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
  SetEnabled([FrameTopB, FrameBottomB, FrameLeftB, FrameRightB, FrameAllB,
    FrameNoB, ShadowB], Frame1Enabled or (Count > 1));
  SetEnabled([FrameColorB, FrameStyleB, FrameWidthCB],
    (Frame2Enabled or (Count > 1)) and not (FPage is TfrxDMPPage));
  SetEnabled([FillColorB], Frame3Enabled and not (FPage is TfrxDMPPage));
  SampleFormatB.Enabled := (AlignEnabled and (Count = 1)) or (IsReportPage and not ObjSelected);
  if Report.DotMatrixReport then
  begin
    FontB.DropDownMenu := DMPPopup;
    FontB.OnClick := nil;
  end
  else
  begin
    FontB.DropDownMenu := nil;
    FontB.OnClick := ToolButtonClick;
  end;

  DMPFontStyle := [];
  if c is TfrxDMPMemoView then
    DMPFontStyle := TfrxDMPMemoView(c).FontStyle;
  if c is TfrxDMPLineView then
    DMPFontStyle := TfrxDMPLineView(c).FontStyle;
  if c is TfrxDMPPage then
    DMPFontStyle := TfrxDMPPage(c).FontStyle;

  BoldMI.Checked := fsxBold in DMPFontStyle;
  ItalicMI.Checked := fsxItalic in DMPFontStyle;
  UnderlineMI.Checked := fsxUnderline in DMPFontStyle;
  SuperScriptMI.Checked := fsxSuperScript in DMPFontStyle;
  SubScriptMI.Checked := fsxSubScript in DMPFontStyle;
  CondensedMI.Checked := fsxCondensed in DMPFontStyle;
  WideMI.Checked := fsxWide in DMPFontStyle;
  N12cpiMI.Checked := fsx12cpi in DMPFontStyle;
  N15cpiMI.Checked := fsx15cpi in DMPFontStyle;

  UndoCmd.Enabled := (FUndoBuffer.UndoCount > 1) or (FPage = nil);
  RedoCmd.Enabled := (FUndoBuffer.RedoCount > 0) and (FPage <> nil);
  CutCmd.Enabled := ((Count <> 0) and (FSelectedObjects[0] <> FPage)) or (FPage = nil);
  CopyCmd.Enabled := CutCmd.Enabled;
  TimerTimer(nil);

  PageSettingsCmd.Enabled := IsReportPage and CheckOp(drDontChangePageOptions);
  DeletePageCmd.Enabled := (Report.PagesCount > 1) and (FPage <> nil) and
    CheckOp(drDontDeletePage);
  SaveCmd.Enabled := Modified and CheckOp(drDontSaveReport);
  DeleteCmd.Enabled := ObjSelected;
  SelectAllCmd.Enabled := (FObjects.Count > 2) and (FPage <> nil);
  EditCmd.Enabled := (Count = 1) and (FPage <> nil);
  SetToGridB.Enabled := ObjSelected;
  BringToFrontCmd.Enabled := ObjSelected;
  SendToBackCmd.Enabled := ObjSelected;
  GroupCmd.Enabled := ObjSelected and (FSelectedObjects[0] <> Report);
  UngroupCmd.Enabled := GroupCmd.Enabled;
  ScaleCB.Enabled := IsReportPage;

  SetEnabled([HandToolB, ZoomToolB, TextToolB], IsReportPage);
  SetEnabled([FormatToolB], AlignEnabled and (Count = 1));
  TabOrderMI.Visible := not IsReportPage;

  if Count <> 1 then
    s := ''
  else
  begin
    s := c.Name;
    if c is TfrxView then
      if TfrxView(c).IsDataField then
        s := s + ': ' + Report.GetAlias(TfrxView(c).DataSet) + '."' + TfrxView(c).DataField + '"'
      else if c is TfrxCustomMemoView then
        s := s + ': ' + Copy(TfrxCustomMemoView(c).Text, 1, 128);
    if c is TfrxDataBand then
      if TfrxDataBand(c).DataSet <> nil then
        s := s + ': ' + Report.GetAlias(TfrxDataBand(c).DataSet);
    if c is TfrxGroupHeader then
      s := s + ': ' + TfrxGroupHeader(c).Condition
  end;

  StatusBar.Panels[2].Text := s;

  FUpdatingControls := False;
end;

procedure TfrxDesignerForm.UpdateDataControls;
var
  i, j: Integer;
  li: TListItem;
  oi: TfrxObjectItem;
begin
  FUpdatingControls := True;
  try
    DataLV.Items.BeginUpdate;
    DataLV.Items.Clear;

    for i := 0 to Objects.Count - 1 do
      if TfrxComponent(Objects[i]) is TfrxDialogComponent then
      begin
        li := DataLV.Items.Add;
        li.Caption := TfrxComponent(Objects[i]).Name;
        li.Data := Objects[i];

        for j := 0 to frxObjects.Count - 1 do
        begin
          oi := frxObjects[j];
          if oi.ClassRef = TfrxComponent(Objects[i]).ClassType then
          begin
            li.ImageIndex := oi.ButtonImageIndex;
            break;
          end;
        end;
      end;

    DataLV.Visible := DataLV.Items.Count <> 0;
    Splitter1.Visible := DataLV.Visible;
    if Splitter1.Visible then
      Splitter1.Top := DataLV.Top - 10;
    DataLV.Items.EndUpdate;
    DataLV.Arrange(arSnapToGrid);
  finally
    FUpdatingControls := False;
  end;
end;

procedure TfrxDesignerForm.UpdateDataTree;
begin
  FDataTree.UpdateItems;
end;

procedure TfrxDesignerForm.UpdateStyles;
begin
  Report.Styles.GetList(StyleCB.Items);
  StyleCB.Items.Insert(0, frxResources.Get('dsNoStyle'));
end;

procedure TfrxDesignerForm.UpdateSyntaxType;
begin
  CodeWindow.Syntax := Report.ScriptLanguage;
  if CompareText(Report.ScriptLanguage, 'PascalScript') = 0 then
  begin
    OpenScriptDialog.FilterIndex := 1;
    OpenScriptDialog.DefaultExt := 'pas';
    SaveScriptDialog.FilterIndex := 1;
    SaveScriptDialog.DefaultExt := 'pas';
  end
  else if CompareText(Report.ScriptLanguage, 'C++Script') = 0 then
  begin
    OpenScriptDialog.FilterIndex := 2;
    OpenScriptDialog.DefaultExt := 'cpp';
    SaveScriptDialog.FilterIndex := 2;
    SaveScriptDialog.DefaultExt := 'cpp';
  end
  else if CompareText(Report.ScriptLanguage, 'JScript') = 0 then
  begin
    OpenScriptDialog.FilterIndex := 3;
    OpenScriptDialog.DefaultExt := 'js';
    SaveScriptDialog.FilterIndex := 3;
    SaveScriptDialog.DefaultExt := 'js';
  end
  else if CompareText(Report.ScriptLanguage, 'BasicScript') = 0 then
  begin
    OpenScriptDialog.FilterIndex := 4;
    OpenScriptDialog.DefaultExt := 'vb';
    SaveScriptDialog.FilterIndex := 4;
    SaveScriptDialog.DefaultExt := 'vb';
  end
  else
  begin
    OpenScriptDialog.FilterIndex := 5;
    OpenScriptDialog.DefaultExt := '';
    SaveScriptDialog.FilterIndex := 5;
    SaveScriptDialog.DefaultExt := '';
  end
end;

procedure TfrxDesignerForm.Lock;
begin
  FObjects.Clear;
  FSelectedObjects.Clear;
  AttachDialogFormEvents(False);
  FWorkspace.DisableUpdate;
  FInspector.DisableUpdate;
end;

procedure TfrxDesignerForm.CreateColorSelector(Sender: TToolButton);
var
  AColor: TColor;
  i: Integer;
begin
  AColor := clBlack;
  for i := 0 to SelectedObjects.Count - 1 do
    if TObject(SelectedObjects[i]) is TfrxView then
    begin
      if Sender = FontColorB then
        AColor := TfrxView(SelectedObjects[i]).Font.Color
      else if Sender = FrameColorB then
        AColor := TfrxView(SelectedObjects[i]).Frame.Color
      else
        AColor := TfrxView(SelectedObjects[i]).Color;
      break;
    end;

  with TfrxColorSelector.Create(Sender) do
  begin
    Color := AColor;
    OnColorChanged := Self.OnColorChanged;
  end;
end;

procedure TfrxDesignerForm.SwitchToCodeWindow;
begin
  Page := nil;
end;

function TfrxDesignerForm.AskSave: Word;
begin
  if IsPreviewDesigner then
    Result := frxConfirmMsg(frxResources.Get('dsSavePreviewChanges'), mb_YesNoCancel)
  else
    Result := frxConfirmMsg(frxResources.Get('dsSaveChangesTo') + ' ' +
      GetReportName + '?', mb_YesNoCancel);
end;

function TfrxDesignerForm.CheckOp(Op: TfrxDesignerRestriction): Boolean;
begin
  Result := True;
  if (frxDesignerComp <> nil) and (Op in frxDesignerComp.Restrictions) then
    Result := False;
end;

function TfrxDesignerForm.GetPageIndex: Integer;
begin
  Result := Report.Objects.IndexOf(FPage);
end;

function TfrxDesignerForm.GetReportName: String;
begin
  if Report.FileName = '' then
    Result := 'Untitled.fr3' else
    Result := ExtractFileName(Report.FileName);
end;

procedure TfrxDesignerForm.LoadFile(FileName: String; UseOnLoadEvent: Boolean);
var
  SaveSilentMode: Boolean;

  function SaveCurrentFile: Boolean;
  var
    w: Word;
  begin
    Result := True;
    if Modified then
    begin
      w := AskSave;
      if w = mrYes then
        SaveFile(False, UseOnLoadEvent)
      else if w = mrCancel then
        Result := False;
    end;
  end;

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

  procedure Error;
  begin
    frxErrorMsg(frxResources.Get('dsCantLoad'));
  end;

begin
  SaveSilentMode := Report.EngineOptions.SilentMode;
  Report.EngineOptions.SilentMode := False;

  if FileName <> '' then  // call from recent filelist
  begin
    if SaveCurrentFile then
    begin
      Lock;
      try
        if not Report.LoadFromFile(FileName) then
          Error;
      except
        EmptyReport;
      end;
    end;
    Report.EngineOptions.SilentMode := SaveSilentMode;
    ReloadReport;
    Exit;
  end;

  if UseOnLoadEvent then
    if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnLoadReport) then
    begin
      Lock;
      if frxDesignerComp.FOnLoadReport(Report) then
        ReloadReport else
        ReloadPages(0);
      Report.EngineOptions.SilentMode := SaveSilentMode;
      Exit;
    end;

  if frxDesignerComp <> nil then
    OpenDialog.InitialDir := frxDesignerComp.OpenDir;
  if OpenDialog.Execute then
  begin
    if SaveCurrentFile then
    begin
      Lock;
      try
        Report.LoadFromFile(OpenDialog.FileName);
      except
        Error;
        EmptyReport;
      end;
    end;
    Report.EngineOptions.SilentMode := SaveSilentMode;
    ReloadReport;
  end;
end;

procedure TfrxDesignerForm.SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean);
var
  Saved: Boolean;
begin
  Report.ScriptText := CodeWindow.Lines;
  Report.ReportOptions.LastChange := Now;

  if UseOnSaveEvent then
    if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnSaveReport) then
    begin
      if frxDesignerComp.FOnSaveReport(Report, SaveAs) then
      begin
        UpdateRecentFiles(Report.FileName);
        UpdateCaption;
        Modified := False;
      end;
      Exit;
    end;

  Saved := True;
  if SaveAs or (Report.FileName = '') then
  begin
    SaveDialog.Filter := frxResources.Get('dsRepFilter');
    if frxCompressorClass <> nil then
      SaveDialog.Filter := SaveDialog.Filter + '|' + frxResources.Get('dsComprRepFilter');
    if Report.ReportOptions.Compressed then
      SaveDialog.FilterIndex := 2 else
      SaveDialog.FilterIndex := 1;
    if frxDesignerComp <> nil then
      SaveDialog.InitialDir := frxDesignerComp.SaveDir;
    Saved := SaveDialog.Execute;
    if Saved then
    begin
      Report.ReportOptions.Compressed := SaveDialog.FilterIndex = 2;
      Report.FileName := ChangeFileExt(SaveDialog.FileName, '.fr3');
      Report.SaveToFile(Report.FileName);
    end
  end
  else
    Report.SaveToFile(Report.FileName);

  UpdateRecentFiles(Report.FileName);
  UpdateCaption;
  if Saved then
    Modified := False;
end;

procedure TfrxDesignerForm.UpdateCaption;
begin
{$IFDEF FR_LITE}
  Caption := 'FreeReport - ' + GetReportName;
{$ELSE}
  Caption := 'FastReport - ' + GetReportName;
{$ENDIF}
end;

procedure TfrxDesignerForm.UpdateRecentFiles(NewFile: String);
var
  i: Integer;
  m: TMenuItem;
begin
  if NewFile <> '' then
  begin
    if FRecentFiles.IndexOf(NewFile) <> -1 then
      FRecentFiles.Delete(FRecentFiles.IndexOf(NewFile));
    FRecentFiles.Add(NewFile);
    while FRecentFiles.Count > 8 do
      FRecentFiles.Delete(0);
  end;

  SepMI11.Visible := FRecentFiles.Count <> 0;

  for i := FileMenu.Count - 1 downto 0 do
  begin
    m := FileMenu.Items[i];
    if (m.Caption <> '-') and (FRecentFiles.IndexOf(m.Caption) <> -1) then
      m.Free;
  end;

  for i := FRecentFiles.Count - 1 downto 0 do
  begin
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -