frxdesgn.pas

这个是功能强大的报表软件

  Localize;
  CreateLangMenu;

  with ScaleCB.Items do
  begin
    Clear;
    Add('25%');
    Add('50%');
    Add('75%');
    Add('100%');
    Add('150%');
    Add('200%');
    Add(frxResources.Get('zmPageWidth'));
    Add(frxResources.Get('zmWholePage'));
  end;

  if Screen.PixelsPerInch > 96 then
  begin
    StyleCB.Font.Height := -11;
    FontNameCB.Font.Height := -11;
    FontSizeCB.Font.Height := -11;
    ScaleCB.Font.Height := -11;
    FrameWidthCB.Font.Height := -11;
    LangL.Font.Height := -11;
    LangCB.Font.Height := -11;
  end;

  RestoreState;
  ToolsMI.Visible := ExtraToolsTB.ButtonCount > 0;
  ExtraToolsTB.Visible := ExtraToolsTB.ButtonCount > 0;
  ReloadReport;
  RestoreState(False, True);

  ConnectionsMI.Visible := False;
  if frxDesignerComp <> nil then
  begin
    ConnectionsMI.Visible := frxDesignerComp.Standalone;
    FTemplatePath := frxDesignerComp.FTemplateDir;
    if Assigned(frxDesignerComp.FOnShow) then
      frxDesignerComp.FOnShow(Self);
  end;
  if FTemplatePath = '' then
    FTemplatePath := Report.GetApplicationFolder;
end;

procedure TfrxDesignerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveState;
  Done;
  Report.Modified := Modified;
  Report.Designer := nil;
  Action := caFree;
end;

procedure TfrxDesignerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  w: Word;
begin
  FInspector.FormDeactivate(nil);
  if FScriptRunning then
  begin
    CanClose := False;
    Exit;
  end;
  CanClose := True;
  Report.ScriptText := CodeWindow.Lines;

  if (frxDesignerComp <> nil) and not frxDesignerComp.CloseQuery then
    Exit;

  if Modified and not (csDesigning in Report.ComponentState) and CheckOp(drDontSaveReport) then
  begin
    w := AskSave;

    if IsPreviewDesigner then
    begin
      if w = mrNo then
        Modified := False
    end
    else if w = mrYes then
      if not SaveFile(False, True) then
        CanClose := False;

    if not IsPreviewDesigner then
    begin
      if w = mrNo then
        Modified := False
      else
        Modified := True;
    end;

    if w = mrCancel then
      CanClose := False;
  end;
end;

procedure TfrxDesignerForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((FDialogForm <> nil) or (FPage is TfrxDataPage)) and
    (ActiveControl <> FInspector.Edit1) then
    THackControl(FWorkspace).KeyDown(Key, Shift);

  if Key = vk_Return then
    if ActiveControl = FontSizeCB then
      ToolButtonClick(FontSizeCB)
    else if ActiveControl = ScaleCB then
      ScaleCBClick(Self);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then
    if Key = vk_Insert then
      if Shift = [ssShift] then
        PasteCmdExecute(nil)
      else if Shift = [ssCtrl] then
        CopyCmdExecute(nil);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then
    if Key = vk_Delete then
      if Shift = [ssShift] then
        CutCmdExecute(nil);

  if (Key = Ord('E')) and (Shift = [ssCtrl]) then
    Page := nil;

  if ((Key = vk_F4) or (Key = vk_F5)) and (Shift = []) and (Page = nil) then
  begin
    if Key = vk_F4 then
      RunToCursorBClick(nil)
    else
      BreakPointBClick(nil);
  end
  else if (Key = vk_F2) and (Shift = [ssCtrl]) then
    StopScriptBClick(StopScriptB)
  else if (Key = vk_F7) and (Shift = [ssCtrl]) and (Page = nil) then
    EvaluateBClick(EvaluateB)
  else if Key = vk_F9 then
    RunScriptBClick(RunScriptB)
  else if ((Key = vk_F7) or (Key = vk_F8)) and (Page = nil) then
    RunScriptBClick(StepScriptB);
end;

procedure TfrxDesignerForm.CMStartup(var Message: TMessage);
begin

  if FShowStartup then

    if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnShowStartupScreen) then
      frxDesignerComp.FOnShowStartupScreen(Self);
end;

procedure TfrxDesignerForm.WMSysCommand(var Message: TWMSysCommand);
begin
{$IFDEF Delphi9}
  inherited;
{$ELSE}
  if (Message.CmdType and $FFF0 = SC_MINIMIZE) and (FormStyle <> fsMDIChild)
    and (fsModal in FormState)  then
      Application.Minimize
  else
    inherited;
{$ENDIF}
end;

procedure TfrxDesignerForm.DoTopmosts(Enable: Boolean);
var
  fStyle: UINT;

  procedure SetFormStyle(Control: TWinControl);
  begin
    if Control is TToolBar then
      if Control.Floating then
        Control := Control.Parent
      else
        Exit;
    SetWindowPos(Control.Handle, fStyle, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
  end;

begin
  if Enable then
    fStyle := HWND_TOPMOST
  else
    fStyle := HWND_NOTOPMOST;

  SetFormStyle(FReportTree);
  SetFormStyle(FDataTree);
  SetFormStyle(FInspector);

  SetFormStyle(StandardTB);
  SetFormStyle(TextTB);
  SetFormStyle(FrameTB);
  SetFormStyle(AlignTB);
  SetFormStyle(ExtraToolsTB);
end;

procedure TfrxDesignerForm.NormalizeTopmosts;
begin
  DoTopmosts(False);
end;

procedure TfrxDesignerForm.RestoreTopmosts;
begin
  DoTopmosts(True);
end;

procedure TfrxDesignerForm.WMEnable(var Message: TMessage);
begin
  inherited;
  { workaround for ShowModal bug. If form with fsStayOnTop style is visible
    before ShowModal call, it will be topmost }
  if Message.WParam <> 0 then
    RestoreTopmosts
  else
    NormalizeTopmosts;
end;

procedure TfrxDesignerForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Message.Active then
    RestoreTopmosts
  else
    NormalizeTopmosts;
end;


{ Get/Set methods }
{------------------------------------------------------------------------------}

function TfrxDesignerForm.GetDefaultObjectSize: TfrxPoint;
begin
  case FUnits of
    duCM:     Result := frxPoint(fr1cm * 2.5, fr1cm * 0.5);
    duInches: Result := frxPoint(fr1in, fr1in * 0.2);
    duPixels: Result := frxPoint(80, 16);
    duChars:  Result := frxPoint(fr1CharX * 10, fr1CharY);
  end;
end;

function TfrxDesignerForm.GetCode: TStrings;
begin
  Result := CodeWindow.Lines;
end;

procedure TfrxDesignerForm.SetGridAlign(const Value: Boolean);
begin
  FGridAlign := Value;
  AlignToGridB.Down := FGridAlign;
  FWorkspace.GridAlign := FGridAlign;
end;

procedure TfrxDesignerForm.SetModified(const Value: Boolean);
var
  i: Integer;
begin
  inherited;
  Report.ScriptText := CodeWindow.Lines;
  if IsPreviewDesigner then
    FUndoBuffer.AddUndo(FPage)
  else
    FUndoBuffer.AddUndo(Report);
  FUndoBuffer.ClearRedo;
  SaveCmd.Enabled := Modified;

  if FModifiedBy <> Self then
    UpdateControls;

  if FModifiedBy = FInspector then
    if (FSelectedObjects[0] = FPage) {or
       (TObject(FSelectedObjects[0]) is TfrxSubreport)} then
    begin
      FLockSelectionChanged := True;
      try
        i := Report.Objects.IndexOf(FPage);
        if i >= 0 then
          ReloadPages(i);
      finally
        FLockSelectionChanged := False;
      end;
    end;

  if FModifiedBy <> FWorkspace then
  begin
    FWorkspace.UpdateView;
    FWorkspace.AdjustBands;
  end;

  if FModifiedBy <> FInspector then
    FInspector.UpdateProperties;

  FReportTree.UpdateItems;
  FModifiedBy := nil;
end;

procedure TfrxDesignerForm.SetPage(const Value: TfrxPage);
begin
  inherited;

  FTabs.TabIndex := Report.Objects.IndexOf(FPage) + 1;
  AttachDialogFormEvents(False);
  ScrollBoxPanel.Visible := FPage <> nil;
  CodePanel.Visible := FPage = nil;

  SwitchToolbar;
  UpdateControls;

  if FPage = nil then
  begin
    CodeWindow.SetFocus;
    Exit;
  end
  else if FPage is TfrxReportPage then
  begin
    with FWorkspace do
    begin
      Parent := ScrollBox;
      Align := alNone;
      Color := FWorkspaceColor;
      Scale := Self.Scale;
    end;

    if FPage is TfrxDMPPage then
      Units := duChars else
      Units := FOldUnits;
    UpdatePageDimensions;
    if Visible then
      ScrollBox.SetFocus;
  end
  else if FPage is TfrxDialogPage then
  begin
    Units := duPixels;
    FDialogForm := TfrxDialogForm(TfrxDialogPage(FPage).DialogForm);

    with FWorkspace do
    begin
      Parent := FDialogForm;
      Align := alClient;
      GridType := gtDialog;
      GridX := FGridSize4;
      GridY := FGridSize4;
      Color := TfrxDialogPage(FPage).Color;
      Scale := 1;
      SetPageDimensions(0, 0, Rect(0, 0, 0, 0));
    end;

    if FDialogForm <> nil then
    with FDialogForm do
    begin
      Position := poDesigned;
      BorderStyle := bsSizeable;
      AttachDialogFormEvents(True);
      Show;
    end;
  end
  else if FPage is TfrxDataPage then
  begin
    Units := duPixels;
    with FWorkspace do
    begin
      Parent := ScrollBox;
      Align := alNone;
      Color := FWorkspaceColor;
      Scale := 1;
      GridType := gtNone;
      GridX := FGridSize4;
      GridY := FGridSize4;
    end;

    UpdatePageDimensions;
    if Visible then
      ScrollBox.SetFocus;
  end
  else
  begin
    Report.Errors.Add('Page object is not page');
  end;

  ReloadObjects;
  RestorePagePosition;
end;

procedure TfrxDesignerForm.SetScale(Value: Extended);
begin
  ScrollBox.AutoScroll := False;
  if Value = 0 then
    Value := 1;
  if Value > 20 then
    Value := 20;
  FScale := Value;
  TopRuler.Scale := Value;
  LeftRuler.Scale := Value;
  FWorkspace.Scale := Value;
  ScaleCB.Text := IntToStr(Round(FScale * 100)) + '%';
  UpdatePageDimensions;
  ScrollBox.AutoScroll := True;
end;

procedure TfrxDesignerForm.SetShowGrid(const Value: Boolean);
begin
  FShowGrid := Value;
  ShowGridB.Down := FShowGrid;
  FWorkspace.ShowGrid := FShowGrid;
end;

procedure TfrxDesignerForm.SetShowRulers(const Value: Boolean);
begin
  FShowRulers := Value;
  TopRuler.Visible := FShowRulers;
  LeftRuler.Visible := FShowRulers;
  ShowRulersCmd.Checked := FShowRulers;
end;

procedure TfrxDesignerForm.SetShowGuides(const Value: Boolean);
begin
  FShowGuides := Value;
  TDesignerWorkspace(FWorkspace).ShowGuides := FShowGuides;
  ShowGuidesCmd.Checked := FShowGuides;
end;

procedure TfrxDesignerForm.SetUnits(const Value: TfrxDesignerUnits);
var
  s: String;
  gType: TfrxGridType;
  gSizeX, gSizeY: Extended;
begin
  FUnits := Value;
  s := '';
  if FUnits = duCM then
  begin
    s := frxResources.Get('dsCm');
    gType := gt1cm;
    gSizeX := FGridSize1 * fr1cm;
    gSizeY := gSizeX;