frxstdwizard.pas

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

{******************************************}
{ }
{ FastReport v3.0 }
{ Standard Report wizard }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxStdWizard;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ExtCtrls, frxClass, frxDesgn;

type
  TfrxStdWizard = class(TfrxCustomWizard)
  public
    class function GetDescription:String; override;
    function Execute:Boolean; override;
  end;

  TfrxDotMatrixWizard = class(TfrxCustomWizard)
  public
    class function GetDescription:String; override;
    function Execute:Boolean; override;
  end;

  TfrxStdEmptyWizard = class(TfrxCustomWizard)
  public
    class function GetDescription:String; override;
    function Execute:Boolean; override;
  end;

  TfrxDMPEmptyWizard = class(TfrxCustomWizard)
  public
    class function GetDescription:String; override;
    function Execute:Boolean; override;
  end;

  TfrxStdWizardForm = class(TForm)
    Pages:TPageControl;
    DataTab:TTabSheet;
    GroupsTab:TTabSheet;
    LayoutTab:TTabSheet;
    DatasetsCB:TComboBox;
    FieldsLB:TListBox;
    AddFieldB:TSpeedButton;
    AddAllFieldsB:TSpeedButton;
    RemoveFieldB:TSpeedButton;
    RemoveAllFieldsB:TSpeedButton;
    SelectedFieldsLB:TListBox;
    SelectedFieldsL:TLabel;
    FieldUpB:TSpeedButton;
    FieldDownB:TSpeedButton;
    AvailableFieldsLB:TListBox;
    AddGroupB:TSpeedButton;
    RemoveGroupB:TSpeedButton;
    GroupsLB:TListBox;
    GroupsL:TLabel;
    GroupUpB:TSpeedButton;
    GroupDownB:TSpeedButton;
    AvailableFieldsL:TLabel;
    BackB:TButton;
    NextB:TButton;
    CancelB:TButton;
    FinishB:TButton;
    FitWidthCB:TCheckBox;
    Step1L:TLabel;
    Step2L:TLabel;
    Step3L:TLabel;
    StyleTab:TTabSheet;
    Step4L:TLabel;
    ScrollBox1:TScrollBox;
    PaintBox:TPaintBox;
    StyleLB:TListBox;
    OrientationL:TGroupBox;
    LayoutL:TGroupBox;
    PortraitImg:TImage;
    LandscapeImg:TImage;
    PortraitRB:TRadioButton;
    LandscapeRB:TRadioButton;
    TabularRB:TRadioButton;
    ColumnarRB:TRadioButton;
    procedure FormCreate(Sender:TObject);
    procedure FormShow(Sender:TObject);
    procedure DatasetsCBClick(Sender:TObject);
    procedure AddFieldBClick(Sender:TObject);
    procedure AddAllFieldsBClick(Sender:TObject);
    procedure RemoveFieldBClick(Sender:TObject);
    procedure RemoveAllFieldsBClick(Sender:TObject);
    procedure AddGroupBClick(Sender:TObject);
    procedure RemoveGroupBClick(Sender:TObject);
    procedure FieldUpBClick(Sender:TObject);
    procedure FieldDownBClick(Sender:TObject);
    procedure GroupUpBClick(Sender:TObject);
    procedure GroupDownBClick(Sender:TObject);
    procedure NextBClick(Sender:TObject);
    procedure BackBClick(Sender:TObject);
    procedure GroupsTabShow(Sender:TObject);
    procedure PaintBoxPaint(Sender:TObject);
    procedure PortraitRBClick(Sender:TObject);
    procedure PagesChange(Sender:TObject);
    procedure StyleLBClick(Sender:TObject);
    procedure FinishBClick(Sender:TObject);
  private
    FDesigner:TfrxDesignerForm;
    FDotMatrix:Boolean;
    FReport:TfrxReport;
    FSampleReport:TfrxReport;
    FStyleSheet:TfrxStyleSheet;
    procedure FillDatasets;
    procedure FillFields;
    procedure UpdateAvailableFields;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  end;

implementation

{$R *.DFM}
{$R *.RES}

uses frxDsgnIntf, frxRes, frxUtils, frxDMPClass, Printers;

const
  SampleReport =
'<?xml version="1.0" encoding="utf-8"?>'+
'<TfrxReport>'+
'<TfrxReportPage>'+
'<TfrxMemoView Width="439,65337" Height="26" HAlign="haCenter" Memo.Text="Customers" Style="Title" VAlign="vaCenter"/>'+
'<TfrxMemoView Top="36" Width="253" Height="20" Style="Header line"/>'+
'<TfrxMemoView Top="36" Width="126,96846" Height="20" Memo.Text="Company" Style="Header"/>'+
'<TfrxMemoView Left="137,74799" Top="36" Width="126,2047" Height="20" Memo.Text="Address" Style="Header"/>'+
'<TfrxMemoView Top="60,47248" Width="264,5671" Height="26,45671" Memo.Text="Action Club" Style="Group header" VAlign="vaCenter"/>'+
'<TfrxMemoView Top="92" Width="126,96846" Height="20" Memo.Text="Action Club" Style="Data"/>'+
'<TfrxMemoView Left="137,74799" Top="92" Width="126,2047" Height="20" Memo.Text="PO Box 5451-F" Style="Data"/>'+
'<TfrxMemoView Top="112" Width="126,96846" Height="20" Memo.Text="Action Diver Supply" Style="Data"/>'+
'<TfrxMemoView Left="137,74799" Top="112" Width="126,2047" Height="20" Memo.Text="Blue Spar Box #3" Style="Data"/>'+
'<TfrxMemoView Top="132" Width="126,96846" Height="20" Memo.Text="Adventure Undersea" Style="Data"/>'+
'<TfrxMemoView Left="137,74799" Top="132" Width="126,2047" Height="20" Memo.Text="PO Box 744" Style="Data"/>'+
'<TfrxMemoView Top="157,98423" Width="264,47248" Height="18" Memo.Text="Count:3" Style="Group footer"/>'+
'</TfrxReportPage>'+
'</TfrxReport>';

  Style =
'<?xml version="1.0" encoding="utf-8"?>'+
'<stylesheet>'+
'<style Name="FastReport">'+
'<item Name="Title" Color="8388608" Font.Color="16777215" Font.Height="-16" Font.Style="1"/>'+
'<item Name="Header" Color="536870911" Font.Color="128" Font.Style="1"/>'+
'<item Name="Group header" Color="15790320" Font.Style="1"/>'+
'<item Name="Data" Color="536870911"/>'+
'<item Name="Group footer" Color="536870911" Font.Style="1"/>'+
'<item Name="Header line" Color="536870911" Frame.Typ="8" Frame.Width="2"/>'+
'</style>'+
'<style Name="Standard">'+
'<item Name="Title" Color="536870911" Font.Height="-16" Font.Style="1"/>'+
'<item Name="Header" Color="536870911" Font.Style="1"/>'+
'<item Name="Group header" Color="536870911" Frame.Typ="8"/>'+
'<item Name="Data" Color="536870911"/>'+
'<item Name="Group footer" Color="536870911" Frame.Typ="4"/>'+
'<item Name="Header line" Color="536870911" Frame.Typ="8" Frame.Width="2"/>'+
'</style>'+
'<style Name="Soft gray">'+
'<item Name="Title" Color="14211288" Font.Height="-16" Font.Style="1"/>'+
'<item Name="Header" Color="15790320" Font.Style="1"/>'+
'<item Name="Group header" Color="15790320" Font.Style="1"/>'+
'<item Name="Data" Color="536870911" Font.Style="0"/>'+
'<item Name="Group footer" Color="536870911" Frame.Typ="4"/>'+
'<item Name="Header line" Color="536870911" Frame.Width="2"/>'+
'</style>'+
'<style Name="Corporate">'+
'<item Name="Title" Color="0" Font.Color="16777215" Font.Height="-16" Font.Style="1"/>'+
'<item Name="Header" Color="0" Font.Color="16777215" Font.Style="1"/>'+
'<item Name="Group header" Color="52479" Font.Style="1"/>'+
'<item Name="Data" Color="536870911"/>'+
'<item Name="Group footer" Color="536870911" Font.Style="1"/>'+
'<item Name="Header line" Color="536870911" Frame.Width="2"/>'+
'</style>'+
'</stylesheet>';

{ TfrxStdWizard }

class function TfrxStdWizard.GetDescription:String;
begin
  Result:= frxResources.Get('wzStd');
end;

function TfrxStdWizard.Execute:Boolean;
begin
  with TfrxStdWizardForm.Create(Owner) do
  begin
    FDesigner:= TfrxDesignerForm(Self.Designer);
    FReport:= Report;
    Result:= ShowModal = mrOk;
    Free;
  end;
end;

{ TfrxDotMatrixWizard }

class function TfrxDotMatrixWizard.GetDescription:String;
begin
  Result:= frxResources.Get('wzDMP');
end;

function TfrxDotMatrixWizard.Execute:Boolean;
begin
  with TfrxStdWizardForm.Create(Owner) do
  begin
    FDesigner:= TfrxDesignerForm(Self.Designer);
    FDotMatrix:= True;
    FReport:= Report;
    Result:= ShowModal = mrOk;
    Free;
  end;
end;

{ TfrxStdEmptyWizard }

class function TfrxStdEmptyWizard.GetDescription:String;
begin
  Result:= frxResources.Get('wzStdEmpty');
end;

function TfrxStdEmptyWizard.Execute:Boolean;
var
  Page:TfrxReportPage;
begin
  Result:= True;
  try
    Designer.Lock;
    Report.Clear;
    Report.FileName:= '';
    Report.DotMatrixReport:= False;

    Page:= TfrxReportPage.Create(Report);
    Page.Name:= 'Page1';
    Page.SetDefaults;
  finally
    Designer.ReloadReport;
  end;
end;

{ TfrxDMPEmptyWizard }

class function TfrxDMPEmptyWizard.GetDescription:String;
begin
  Result:= frxResources.Get('wzDMPEmpty');
end;

function TfrxDMPEmptyWizard.Execute:Boolean;
var
  Page:TfrxReportPage;
begin
  Result:= True;
  try
    Designer.Lock;
    Report.Clear;
    Report.FileName:= '';
    Report.DotMatrixReport:= True;

    Page:= TfrxDMPPage.Create(Report);
    Page.Name:= 'Page1';
    Page.SetDefaults;
  finally
    Designer.ReloadReport;
  end;
end;

{ TfrxStdWizardForm }

constructor TfrxStdWizardForm.Create(AOwner:TComponent);
var
  s:TStringStream;
begin
  inherited;
  FSampleReport:= TfrxReport.Create(nil);
  s:= TStringStream.Create(SampleReport);
  FSampleReport.LoadFromStream(s);
  s.Free;

  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
  FSampleReport.Free;
  FStyleSheet.Free;
  inherited;
end;

procedure TfrxStdWizardForm.FormCreate(Sender:TObject);
begin
  frxResources.LocalizeForm(Self);
end;

procedure TfrxStdWizardForm.FormShow(Sender:TObject);
begin
  FillDatasets;
  DatasetsCB.ItemIndex:= 0;
  DatasetsCBClick(nil);

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

  if FDotMatrix then
    StyleTab.Free;
end;

procedure TfrxStdWizardForm.FillDatasets;
var
  i:Integer;
  ds:TfrxDataSet;
  dsList:TStrings;
begin
  dsList:= TStringList.Create;
  frxGetComponents(FReport, TfrxDataSet, dsList, nil);
  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;

  FieldsLB.SetFocus;
  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.DatasetsCBClick(Sender:TObject);
begin
  FillFields;
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