frxdesgn.pas

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

    Lock;
    try
      if not Report.LoadFromFile(FileName) then
        Error;
    except
      EmptyReport;
    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
    SaveCurrentFile;
    Lock;
    try
      Report.LoadFromFile(OpenDialog.FileName);
    except
      Error;
      EmptyReport;
    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
  Caption:= 'FastReport-'+GetReportName;
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 FRecentFiles.IndexOf(m.Caption)<>-1 then
      m.Free;
  end;

  for i:= FRecentFiles.Count-1 downto 0 do
  begin
    m:= TMenuItem.Create(FileMenu);
    m.Caption:= FRecentFiles[i];
    m.OnClick:= OpenRecentFile;
    FileMenu.Insert(FileMenu.IndexOf(SepMI4), m);
  end;
end;

procedure TfrxDesignerForm.SwitchToolbar;
var
  i:Integer;
  Item:TfrxObjectItem;
  b:TToolButton;
  v:Boolean;

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

  function IsDataCategory(Category:Integer):Boolean;
  var
    i:Integer;
    Item:TfrxObjectItem;
  begin
    Result:= False;
    if Category = 1000 then Exit;
    for i:= 0 to frxObjects.Count-1 do
    begin
      Item:= frxObjects[i];
      if (Item.ClassRef<>nil) and
         (Item.CategoryName = frxObjects[Category].CategoryName) then
      begin
        Result:= Item.ClassRef.InheritsFrom(TfrxDialogComponent);
        break;
      end;
    end;
  end;

begin
  ObjectSelectB.Down:= True;
  SelectToolBClick(nil);

  for i:= 0 to ObjectsTB1.ControlCount-1 do
  begin
    b:= TToolButton(ObjectsTB1.Controls[i]);

    if (b<>ObjectSelectB) and (b<>SepTB14) then
    begin
      Item:= nil;
      if b.Tag = 1000 then { tools and band }
        v:= False
      else { object or category }
      begin
        Item:= frxObjects[b.Tag];
        if Item.ClassRef<>nil then { object }
          v:= Item.ClassRef.InheritsFrom(TfrxDialogControl) else
          v:= IsDialogCategory(b.Tag);
      end;

      if FPage is TfrxDialogPage then
        b.Visible:= v or IsDataCategory(b.Tag)
      else
        b.Visible:= not v;

      if Item<>nil then
        if FPage is TfrxDMPPage then
        begin
          if (Item.ClassRef = TfrxMemoView) or
            (Item.ClassRef = TfrxSysMemoView) or
            (Item.ClassRef = TfrxLineView) or
            (Item.ClassRef = TfrxPictureView) or
            (Item.CategoryName = 'Draw') then
            b.Visible:= False;
        end
        else if (FPage is TfrxReportPage) or (FPage = nil) then
        begin
          if (Item.ClassRef = TfrxDMPMemoView) or
            (Item.ClassRef = TfrxDMPLineView) or
            (Item.ClassRef = TfrxDMPCommand) then
            b.Visible:= False;
        end;
    end;
  end;

  ObjectsTB1.Height:= ObjectsTB1.Height+1;
end;

function TfrxDesignerForm.mmToUnits(mm:Extended; X:Boolean = True):Extended;
begin
  Result:= 0;
  case FUnits of
    duCM:
      Result:= mm / 10;
    duInches:
      Result:= mm / 25.4;
    duPixels:
      Result:= mm * 96 / 25.4;
    duChars:
      if X then
        Result:= Round(mm * fr01cm / fr1CharX) else
        Result:= Round(mm * fr01cm / fr1CharY);
  end;
end;

function TfrxDesignerForm.UnitsTomm(mm:Extended; X:Boolean = True):Extended;
begin
  Result:= 0;
  case FUnits of
    duCM:
      Result:= mm * 10;
    duInches:
      Result:= mm * 25.4;
    duPixels:
      Result:= mm / 96 * 25.4;
    duChars:
      if X then
        Result:= Round(mm) * fr1CharX / fr01cm else
        Result:= Round(mm) * fr1CharY / fr01cm;
  end;
end;

function TfrxDesignerForm.InsertExpression(const Expr:String):String;
begin
  with TfrxExprEditorForm.Create(Self) do
  begin
    ExprMemo.Text:= Expr;
    if ShowModal = mrOk then
      Result:= ExprMemo.Text else
      Result:= '';
    Free;
  end
end;

procedure TfrxDesignerForm.UpdatePage;
begin
  FWorkspace.Repaint;
end;

procedure TfrxDesignerForm.FindText;
var
  i:Integer;
  c:TfrxComponent;
  s:String;
  Found, FoundOne:Boolean;
  Flags:TReplaceFlags;
  ReplaceAll:Boolean;

  function AskReplace:Boolean;
  var
    i:Integer;
  begin
    if not ReplaceAll then
      i:= MessageDlg(Format(frxResources.Get('dsReplace'), [FSearchText]),
        mtConfirmation, [mbYes, mbNo, mbCancel, mbAll], 0)
    else
      i:= mrAll;
    Result:= i in [mrYes, mrAll];
    ReplaceAll:= i = mrAll;

{ Result:= Application.MessageBox(
      PChar(Format(frxResources.Get('dsReplace'), [FSearchText])),
      PChar(frxResources.Get('mbConfirm')), mb_IconQuestion+mb_YesNo) = mrYes;}
  end;

begin
  ReplaceAll:= False;
  FoundOne:= False;

  repeat
    Found:= False;
    if FPage<>nil then
    begin
      c:= nil;
      for i:= FSearchIndex to Objects.Count-1 do
      begin
        c:= Objects[i];
        if c is TfrxCustomMemoView then
        begin
          s:= TfrxCustomMemoView(c).Text;
          if FSearchCase then
          begin
            if Pos(FSearchText, s)<>0 then
              Found:= True;
          end
          else if Pos(AnsiUpperCase(FSearchText), AnsiUpperCase(s))<>0 then
            Found:= True;
        end;
        if Found then break;
      end;

      if Found then
      begin
        FSearchIndex:= i+1;
        SelectedObjects.Clear;
        SelectedObjects.Add(c);
        OnSelectionChanged(Self);
        if FSearchReplace then
          if AskReplace then
          begin
            Flags:= [rfReplaceAll];
            if not FSearchCase then
              Flags:= Flags+[rfIgnoreCase];
            TfrxCustomMemoView(c).Text:= StringReplace(s, FSearchText,
              FSearchReplaceText, Flags);
            Modified:= True;
          end;
      end;
    end
    else
    begin
      Found:= CodeWindow.Find(FSearchText, FSearchCase, FSearchIndex);
      if FSearchReplace then
        if Found and AskReplace then
        begin
          CodeWindow.SelText:= FSearchReplaceText;
          Modified:= True;
        end;
    end;

    if Found then
      FoundOne:= True;
  until not ReplaceAll or not Found;

  if not FoundOne then
    Application.MessageBox(
      PChar(Format(frxResources.Get('dsTextNotFound'), [FSearchText])),
      PChar(frxResources.Get('mbInfo')), mb_IconInformation+mb_Ok);
end;

procedure TfrxDesignerForm.RestorePagePosition;
var
  pt:TPoint;
begin
  if (Tab.TabIndex > 0) and (Tab.TabIndex < 255) then
  begin
    pt:= fsPosToPoint(FPagePositions[Tab.TabIndex]);
    ScrollBox.VertScrollBar.Position:= pt.X;
    ScrollBox.HorzScrollBar.Position:= pt.Y;
  end;
end;

procedure TfrxDesignerForm.SavePagePosition;
begin
  if (Tab.TabIndex > 0) and (Tab.TabIndex < 255) then
    FPagePositions[Tab.TabIndex]:= IntToStr(ScrollBox.HorzScrollBar.Position)+
      ':'+IntToStr(ScrollBox.VertScrollBar.Position);
end;

{ Workspace/Inspector event handlers }
{------------------------------------------------------------------------------}

procedure TfrxDesignerForm.OnModify(Sender:TObject);
begin
  FModifiedBy:= Sender;
  Modified:= True;
end;

procedure TfrxDesignerForm.OnSelectionChanged(Sender:TObject);
var
  c:TfrxComponent;
begin
  if Sender = FReportTree then
  begin
    c:= SelectedObjects[0];
    if (c<>Report) and (Page<>nil) then
      if c.Page<>Page then
      begin
        Page:= c.Page;
        SelectedObjects[0]:= c;
        FReportTree.UpdateSelection;
      end;
  end
  else
    FReportTree.UpdateSelection;

  if Sender<>FWorkspace then
    FWorkspace.UpdateView;

  if Sender<>FInspector then
  begin
    FInspector.Objects:= FObjects;
    FInspector.UpdateProperties;
  end;

  UpdateControls;
end;

procedure TfrxDesignerForm.OnEditObject(Sender:TObject);
var
  ed:TfrxComponentEditor;
begin
  ed:= frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, nil);
  if (ed<>nil) and ed.HasEditor then
    if ed.Edit then
    begin
      Modified:= True;
      if FSelectedObjects[0] = FPage then
        UpdatePageDimensions;
    end;
  ed.Free;
end;

procedure TfrxDesignerForm.OnInsertObject(Sender:TObject);
var
  c:TfrxComponent;
begin
  if not CheckOp(drDontInsertObject) or (FWorkspace.Insertion.Top < 0) then
  begin
    FWorkspace.SetInsertion(nil, 0, 0, 0);
    ObjectSelectB.Down:= True;
    Exit;
  end;

  with FWorkspace.Insertion do
  begin
    if (ComponentClass = nil) or ((Width = 0) and (Height = 0)) then Exit;

    c:= TfrxComponent(ComponentClass.NewInstance);
    c.DesignCreate(FPage, Flags);
    c.CreateUniqueName;
    c.SetBounds(Left, Top, Width, Height);
    if c is TfrxCustomLineView then
      FWorkspace.SetInsertion(ComponentClass, 0, 0, Flags)
    else