frxadowizard.pas

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

  if not FDotMatrix then
    NextB.Enabled := Pages.ActivePage <> StyleTab else
    NextB.Enabled := Pages.ActivePage <> LayoutTab;
  BackB.Enabled := Pages.ActivePage <> DataTab;
end;

procedure TfrxStdWizardForm.GroupsTabShow(Sender: TObject);
begin
  AvailableFieldsLB.ItemIndex := 0;
end;

procedure TfrxStdWizardForm.StylePBPaint(Sender: TObject);
begin
  DrawSample(StylePB, FStyleReport);
end;

procedure TfrxStdWizardForm.LayoutPBPaint(Sender: TObject);
begin
  DrawSample(LayoutPB, FLayoutReport);
end;

procedure TfrxStdWizardForm.PortraitRBClick(Sender: TObject);
begin
  PortraitImg.Visible := PortraitRB.Checked;
  LandscapeImg.Visible := LandscapeRB.Checked;
end;

procedure TfrxStdWizardForm.StyleLBClick(Sender: TObject);
begin
  FStyleReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);
  StylePBPaint(nil);
end;

procedure TfrxStdWizardForm.TabularRBClick(Sender: TObject);
var
  s: TStringStream;
begin
  if TabularRB.Checked then
    s := TStringStream.Create(LayoutTabularReport)
  else
    s := TStringStream.Create(LayoutColumnarReport);
  FLayoutReport.LoadFromStream(s);
  s.Free;
  FLayoutReport.Styles := FStyleSheet[0];
  LayoutPBPaint(nil);
end;

procedure TfrxStdWizardForm.FinishBClick(Sender: TObject);
var
  Page: TfrxReportPage;
  Band: TfrxBand;
  Memo: TfrxCustomMemoView;
  CurY, PageWidth, MaxHeaderWidth: Extended;
  Widths, HeaderWidths, DataWidths: array of Extended;

  function Duplicate(n: Integer): String;
  begin
    Result := '';
    SetLength(Result, n);
    FillChar(Result[1], n, '0');
  end;

  function CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
  begin
    if FDotMatrix then
      Result := TfrxDMPMemoView.Create(Parent) else
      Result := TfrxMemoView.Create(Parent);
    if Parent <> nil then
      Result.CreateUniqueName;
  end;

  procedure CreatePage;
  begin
    Page := TfrxReportPage(FReport.Pages[0]);
    if PortraitRB.Checked then
      Page.Orientation := poPortrait else
      Page.Orientation := poLandscape;
    PageWidth := (Page.PaperWidth - Page.LeftMargin - Page.RightMargin) * 96 / 25.4;
  end;

  procedure CreateWidthsArray;
  var
    i, FieldsCount: Integer;
    HeaderMemo, DataMemo: TfrxCustomMemoView;
    MaxWidth, HeadersWidth, GapWidth: Extended;
    Style: TfrxStyles;
  begin
    FieldsCount := AvailableFieldsLB.Items.Count;
    SetLength(Widths, FieldsCount);
    SetLength(HeaderWidths, FieldsCount);
    SetLength(DataWidths, FieldsCount);

    HeaderMemo := CreateMemo(nil);
    DataMemo := CreateMemo(nil);
    if not FDotMatrix then
    begin
      Style := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);
      HeaderMemo.ApplyStyle(Style.Find('Header'));
      DataMemo.ApplyStyle(Style.Find('Data'));
    end;

    MaxWidth := 0;
    HeadersWidth := 0;
    MaxHeaderWidth := 0;
    GapWidth := 0;
    for i := 0 to FieldsCount - 1 do
    begin
      HeaderMemo.Text := AvailableFieldsLB.Items[i];
      DataMemo.Text := Duplicate(FDataSet.DisplayWidth[AvailableFieldsLB.Items[i]]);
      HeaderWidths[i] := HeaderMemo.CalcWidth;
      DataWidths[i] := DataMemo.CalcWidth;
      if HeaderWidths[i] > DataWidths[i] then
        Widths[i] := HeaderWidths[i]
      else
      begin
        Widths[i] := DataWidths[i];
        GapWidth := GapWidth + DataWidths[i] - HeaderWidths[i];
      end;
      MaxWidth := MaxWidth + Widths[i];
      HeadersWidth := HeadersWidth + HeaderWidths[i];
      if HeaderWidths[i] > MaxHeaderWidth then
        MaxHeaderWidth := HeaderWidths[i];
    end;

    if FitWidthCB.Checked and (MaxWidth > PageWidth) then
    begin
      if HeadersWidth > PageWidth then
      begin
        for i := 0 to FieldsCount - 1 do
          Widths[i] := HeaderWidths[i] / (HeadersWidth / PageWidth);
      end
      else
      begin
        for i := 0 to FieldsCount - 1 do
          if HeaderWidths[i] < DataWidths[i] then
            Widths[i] := Widths[i] - (DataWidths[i] - HeaderWidths[i]) /
              GapWidth * (MaxWidth - PageWidth);
      end;
    end;

    HeaderMemo.Free;
    DataMemo.Free;
  end;

  procedure CreateTitle;
  begin
    Band := TfrxReportTitle.Create(Page);
    Band.CreateUniqueName;
    Band.SetBounds(0, 0, 0, fr01cm * 7);
    CurY := 30;

    Memo := CreateMemo(Band);
    Memo.SetBounds(0, 0, 0, fr01cm * 6);
    Memo.Align := baWidth;
    Memo.HAlign := haCenter;
    Memo.VAlign := vaCenter;
    Memo.Text := 'Report';
    Memo.Style := 'Title';
  end;

  procedure CreateHeader;
  var
    i: Integer;
    X, Y: Extended;
    HeaderMemo: TfrxCustomMemoView;
  begin
    if ColumnarRB.Checked then Exit;

    Band := TfrxPageHeader.Create(Page);
    Band.CreateUniqueName;
    Band.SetBounds(0, CurY, 0, fr01cm * 7);

    HeaderMemo := CreateMemo(Band);
    HeaderMemo.SetBounds(0, 0, PageWidth, 0);
    HeaderMemo.Style := 'Header line';

    X := 0;
    Y := 0;
    for i := 0 to AvailableFieldsLB.Items.Count - 1 do
    begin
      if X + Widths[i] > PageWidth + 1 then
      begin
        X := 0;
        Y := Y + fr01cm * 6;
      end;

      Memo := CreateMemo(Band);
      Memo.SetBounds(X, Y, Widths[i], fr01cm * 6);
      Memo.Text := AvailableFieldsLB.Items[i];
      Memo.Style := 'Header';

      X := X + Widths[i];
    end;

    Band.Height := Y + fr01cm * 6;
    HeaderMemo.Height := Band.Height;
    if FDotMatrix then
      HeaderMemo.Free;
    CurY := CurY + Band.Height;
  end;

  procedure CreateGroupHeaders;
  var
    i: Integer;
  begin
    for i := 0 to GroupsLB.Items.Count - 1 do
    begin
      Band := TfrxGroupHeader.Create(Page);
      Band.CreateUniqueName;
      Band.SetBounds(0, CurY, 0, fr01cm * 7);
      TfrxGroupHeader(Band).Condition := FDataSet.UserName + '."' + GroupsLB.Items[i] + '"';
      CurY := CurY + 30;

      Memo := CreateMemo(Band);
      Memo.SetBounds(0, 0, 0, fr01cm * 6);
      Memo.Align := baWidth;
      Memo.VAlign := vaCenter;
      Memo.DataSet := FDataSet;
      Memo.DataField := GroupsLB.Items[i];
      Memo.Style := 'Group header';
    end;
  end;

  procedure CreateData;
  var
    i: Integer;
    X, Y: Extended;
  begin
    Band := TfrxMasterData.Create(Page);
    Band.CreateUniqueName;
    Band.SetBounds(0, CurY, 0, 0);
    TfrxMasterData(Band).DataSet := FDataSet;
    CurY := CurY + 30;

    X := 0;
    Y := 0;
    for i := 0 to AvailableFieldsLB.Items.Count - 1 do
    begin
      if ColumnarRB.Checked then
      begin
        Memo := CreateMemo(Band);
        Memo.SetBounds(0, Y, MaxHeaderWidth, fr01cm * 5);
        Memo.Text := AvailableFieldsLB.Items[i];
        Memo.Style := 'Header';

        Memo := CreateMemo(Band);
        Memo.SetBounds(MaxHeaderWidth + fr01cm * 5, Y, DataWidths[i], fr01cm * 5);
        Memo.DataSet := FDataSet;
        Memo.DataField := AvailableFieldsLB.Items[i];
        Memo.Style := 'Data';

        Y := Y + fr01cm * 5;
      end
      else
      begin
        if X + Widths[i] > PageWidth + 1 then
        begin
          X := 0;
          Y := Y + fr01cm * 5;
        end;

        Memo := CreateMemo(Band);
        Memo.SetBounds(X, Y, Widths[i], fr01cm * 5);
        Memo.DataSet := FDataSet;
        Memo.DataField := AvailableFieldsLB.Items[i];
        Memo.Style := 'Data';

        X := X + Widths[i];
      end;
    end;

    Band.Height := Y + fr01cm * 5;
    CurY := CurY + Band.Height;
  end;

  procedure CreateGroupFooters;
  var
    i: Integer;
  begin
    CurY := 1000;
    for i := GroupsLB.Items.Count - 1 downto 0 do
    begin
      Band := TfrxGroupFooter.Create(Page);
      Band.CreateUniqueName;
      Band.SetBounds(0, CurY, 0, 0);
      CurY := CurY - 30;
    end;
  end;

  procedure CreateFooter;
  begin
    Band := TfrxPageFooter.Create(Page);
    Band.CreateUniqueName;
    Band.SetBounds(0, 1000, 0, fr01cm * 7);

    Memo := CreateMemo(Band);
    Memo.Align := baWidth;
    Memo.Frame.Typ := [ftTop];
    Memo.Frame.Width := 2;

    Memo := CreateMemo(Band);
    Memo.SetBounds(0, 1, 0, fr01cm * 6);
    Memo.AutoWidth := True;
    Memo.Text := '[Date] [Time]';

    Memo := CreateMemo(Band);
    Memo.SetBounds(100, 1, fr1cm * 2, fr01cm * 6);
    Memo.Align := baRight;
    Memo.HAlign := haRight;
    Memo.Text := 'Page [Page#]';
  end;

begin
  try
    FDesigner.Lock;
    FReport.FileName := '';
    FReport.DotMatrixReport := FDotMatrix;

    FReport.DataSets.Clear;
    if FDataset <> nil then
      FReport.DataSets.Add(FDataSet);

    CreatePage;
    CreateWidthsArray;
    CreateTitle;
    CreateHeader;
    CreateGroupHeaders;
    CreateData;
    CreateGroupFooters;
    CreateFooter;

    if not FDotMatrix then
      FReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);

  finally
    FDesigner.ReloadReport;
    Widths := nil;
    HeaderWidths := nil;
    DataWidths := nil;
  end;
end;

procedure TfrxStdWizardForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;


initialization
  frxWizards.Register1(TfrxStdWizard, 1);
  frxWizards.Register1(TfrxStdEmptyWizard, 0);
{$IFNDEF FR_LITE}
  frxWizards.Register1(TfrxDotMatrixWizard, 1);
  frxWizards.Register1(TfrxDMPEmptyWizard, 0);
{$ENDIF}

finalization
  frxWizards.Unregister(TfrxStdWizard);
  frxWizards.Unregister(TfrxStdEmptyWizard);
{$IFNDEF FR_LITE}
  frxWizards.Unregister(TfrxDotMatrixWizard);
  frxWizards.Unregister(TfrxDMPEmptyWizard);
{$ENDIF}

end.


//