frxstdwizard.pas

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

  FStyleSheet := TfrxStyleSheet.Create;
  if FileExists(ExtractFilePath(Application.ExeName) + 'wizstyle.xml') then
    FStyleSheet.LoadFromFile(ExtractFilePath(Application.ExeName) + 'wizstyle.xml')
  else
  begin
    s := TStringStream.Create(Style);
    FStyleSheet.LoadFromStream(s);
    s.Free;
  end;
end;

destructor TfrxStdWizardForm.Destroy;
begin
  FStyleReport.Free;
  FLayoutReport.Free;
  FStyleSheet.Free;
  inherited;
end;

procedure TfrxStdWizardForm.FormCreate(Sender: TObject);
begin
  Caption := frxGet(5600);
  DataTab.Caption := frxGet(5601);
  FieldsTab.Caption := frxGet(5602);
  GroupsTab.Caption := frxGet(5603);
  LayoutTab.Caption := frxGet(5604);
  StyleTab.Caption := frxGet(5605);
  Step1L.Caption := frxGet(5606);
  Step2L.Caption := frxGet(5607);
  Step3L.Caption := frxGet(5608);
  Step4L.Caption := frxGet(5609);
  Step5L.Caption := frxGet(5610);
  AddFieldB.Caption := frxGet(5611);
  AddAllFieldsB.Caption := frxGet(5612);
  RemoveFieldB.Caption := frxGet(5613);
  RemoveAllFieldsB.Caption := frxGet(5614);
  AddGroupB.Caption := frxGet(5615);
  RemoveGroupB.Caption := frxGet(5616);
  SelectedFieldsL.Caption := frxGet(5617);
  AvailableFieldsL.Caption := frxGet(5618);
  AvailableFieldsL1.Caption := frxGet(5618);
  GroupsL.Caption := frxGet(5619);
  OrientationL.Caption := frxGet(5620);
  LayoutL.Caption := frxGet(5621);
  PortraitRB.Caption := frxGet(5622);
  LandscapeRB.Caption := frxGet(5623);
  TabularRB.Caption := frxGet(5624);
  ColumnarRB.Caption := frxGet(5625);
  FitWidthCB.Caption := frxGet(5626);
  BackB.Caption := frxGet(5627);
  NextB.Caption := frxGet(5628);
  FinishB.Caption := frxGet(5629);
  NewTableB.Caption := frxGet(5630);
  NewQueryB.Caption := frxGet(5631);

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;

procedure TfrxStdWizardForm.FormShow(Sender: TObject);
var
  Page: TfrxPage;
begin
  FDesigner.Lock;
  FReport.Clear;

  Page := TfrxDataPage.Create(FReport);
  Page.Name := 'Data';

  if FDotMatrix then
    Page := TfrxDMPPage.Create(FReport) else
    Page := TfrxReportPage.Create(FReport);
  Page.Name := 'Page1';
  TfrxReportPage(Page).SetDefaults;
  FDesigner.SetReportDefaults;
  FDesigner.ReloadReport;

  FillDatasets;
  DatasetsCB.ItemIndex := 0;
  DatasetsCBClick(nil);

  FStyleSheet.GetList(StyleLB.Items);
  StyleLB.ItemIndex := 0;
  StyleLBClick(nil);

  TabularRBClick(nil);
  if FDotMatrix then
    StyleTab.Free;
end;

procedure TfrxStdWizardForm.FillDatasets;
var
 i: Integer;
 ds: TfrxDataSet;
 dsList: TStringList;
begin
 dsList := TStringList.Create;
 FReport.GetActiveDataSetList(dsList);
 dsList.Sort;

 DatasetsCB.Clear;

 for i := 0 to dsList.Count - 1 do
 begin
   ds := TfrxDataSet(dsList.Objects[i]);
   if ds is TfrxCustomDBDataSet then
     DatasetsCB.Items.AddObject(ds.UserName, ds);
 end;

 dsList.Free;
end;

procedure TfrxStdWizardForm.FillFields;
var
  ds: TfrxDataSet;
begin
  FieldsLB.Clear;
  SelectedFieldsLB.Clear;
  UpdateAvailableFields;

  if DatasetsCB.ItemIndex <> -1 then
  begin
    ds := TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]);
    ds.GetFieldList(FieldsLB.Items);
  end;

  if FieldsLB.Items.Count <> 0 then
  begin
    FieldsLB.ItemIndex := 0;
    FieldsLB.Selected[0] := True;
  end;
end;

procedure TfrxStdWizardForm.UpdateAvailableFields;
begin
  AvailableFieldsLB.Items := SelectedFieldsLB.Items;
  GroupsLB.Clear;
end;

procedure TfrxStdWizardForm.NewDBItem(const wizName: String);
var
  i: Integer;
  wiz: TfrxCustomWizard;
begin
  for i := 0 to frxWizards.Count - 1 do
    if frxWizards[i].ClassRef.ClassName = wizName then
    begin
      wiz := TfrxCustomWizard(frxWizards[i].ClassRef.NewInstance);
      wiz.Create(FDesigner);
      try
        FReport.Datasets.Clear;
        if wiz.Execute then
        begin
          FillDatasets;
          DatasetsCB.ItemIndex := DatasetsCB.Items.IndexOf(FReport.Datasets[0].Dataset.UserName);
          DatasetsCBClick(nil);
          FReport.Datasets.Clear;
          FDesigner.ReloadReport;
        end;
      finally
        wiz.Free;
      end;
      break;
    end;
end;

procedure TfrxStdWizardForm.DrawSample(PaintBox: TPaintBox; Report: TfrxReport);
var
  i: Integer;
  c: TfrxComponent;
begin
  with PaintBox do
  begin
    Canvas.Pen.Color := clBlack;
    Canvas.Brush.Color := clWindow;
    Canvas.Rectangle(0, 0, Width, Height);

    for i := 0 to Report.AllObjects.Count - 1 do
    begin
      c := Report.AllObjects[i];
      if c is TfrxCustomMemoView then
        with TfrxCustomMemoView(c) do
          Draw(Canvas, 1, 1, 10, 10);
    end;
  end;
end;

procedure TfrxStdWizardForm.DatasetsCBClick(Sender: TObject);
begin
  FillFields;
end;

procedure TfrxStdWizardForm.NewTableBClick(Sender: TObject);
begin
  NewDBItem('TfrxDBTableWizard');
end;

procedure TfrxStdWizardForm.NewQueryBClick(Sender: TObject);
begin
  NewDBItem('TfrxDBQueryWizard');
end;

procedure TfrxStdWizardForm.AddFieldBClick(Sender: TObject);
var
  i, j: Integer;
begin
  if FieldsLB.ItemIndex = -1 then Exit;

  i := 0;
  j := -1;
  while i < FieldsLB.Items.Count do
    if FieldsLB.Selected[i] then
    begin
      if j = -1 then
        j := i;
      SelectedFieldsLB.Items.Add(FieldsLB.Items[i]);
      FieldsLB.Items.Delete(i);
    end
    else
      Inc(i);

  if j = FieldsLB.Items.Count then
    Dec(j);
  if j <> -1 then
  begin
    FieldsLB.ItemIndex := j;
    FieldsLB.Selected[j] := True;
  end;

  UpdateAvailableFields;
end;

procedure TfrxStdWizardForm.AddAllFieldsBClick(Sender: TObject);
begin
  if FieldsLB.Items.Count = 0 then Exit;
  FillFields;
  SelectedFieldsLB.Items := FieldsLB.Items;
  FieldsLB.Items.Clear;
  UpdateAvailableFields;
end;

procedure TfrxStdWizardForm.RemoveFieldBClick(Sender: TObject);
var
  i, j: Integer;
begin
  if SelectedFieldsLB.ItemIndex = -1 then Exit;

  i := 0;
  j := -1;
  while i < SelectedFieldsLB.Items.Count do
    if SelectedFieldsLB.Selected[i] then
    begin
      if j = -1 then
        j := i;
      FieldsLB.Items.Add(SelectedFieldsLB.Items[i]);
      SelectedFieldsLB.Items.Delete(i);
    end
    else
      Inc(i);

  if j = SelectedFieldsLB.Items.Count then
    Dec(j);
  if j <> -1 then
  begin
    SelectedFieldsLB.ItemIndex := j;
    SelectedFieldsLB.Selected[j] := True;
  end;

  UpdateAvailableFields;
end;

procedure TfrxStdWizardForm.RemoveAllFieldsBClick(Sender: TObject);
begin
  FillFields;
end;

procedure TfrxStdWizardForm.AddGroupBClick(Sender: TObject);
var
  i: Integer;
begin
  i := AvailableFieldsLB.ItemIndex;
  if i = -1 then Exit;
  GroupsLB.Items.Add(AvailableFieldsLB.Items[i]);
  AvailableFieldsLB.Items.Delete(i);
  AvailableFieldsLB.ItemIndex := i;
end;

procedure TfrxStdWizardForm.RemoveGroupBClick(Sender: TObject);
var
  i: Integer;
begin
  i := GroupsLB.ItemIndex;
  if i = -1 then Exit;
  AvailableFieldsLB.Items.Add(GroupsLB.Items[i]);
  GroupsLB.Items.Delete(i);
  GroupsLB.ItemIndex := i;
end;

procedure TfrxStdWizardForm.FieldUpBClick(Sender: TObject);
var
  i: Integer;
begin
  i := SelectedFieldsLB.ItemIndex;
  if i < 1 then Exit;
  SelectedFieldsLB.Items.Exchange(i, i - 1);
  UpdateAvailableFields;
end;

procedure TfrxStdWizardForm.FieldDownBClick(Sender: TObject);
var
  i: Integer;
begin
  i := SelectedFieldsLB.ItemIndex;
  if (i = -1) or (SelectedFieldsLB.Items.Count = 0) or
    (i = SelectedFieldsLB.Items.Count - 1) then Exit;
  SelectedFieldsLB.Items.Exchange(i, i + 1);
  SelectedFieldsLB.ItemIndex := i + 1;
  UpdateAvailableFields;
end;

procedure TfrxStdWizardForm.GroupUpBClick(Sender: TObject);
var
  i: Integer;
begin
  i := GroupsLB.ItemIndex;
  if i < 1 then Exit;
  GroupsLB.Items.Exchange(i, i - 1);
end;

procedure TfrxStdWizardForm.GroupDownBClick(Sender: TObject);
var
  i: Integer;
begin
  i := GroupsLB.ItemIndex;
  if (i = -1) or (i = GroupsLB.Items.Count - 1) then Exit;
  GroupsLB.Items.Exchange(i, i + 1);
  GroupsLB.ItemIndex := i + 1;
end;

procedure TfrxStdWizardForm.NextBClick(Sender: TObject);
begin
  Pages.SelectNextPage(True);
  PagesChange(nil);
end;

procedure TfrxStdWizardForm.BackBClick(Sender: TObject);
begin
  Pages.SelectNextPage(False);
  PagesChange(nil);
end;

procedure TfrxStdWizardForm.PagesChange(Sender: TObject);
begin
  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);