⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxstdwizard.pas

📁 报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  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.PaintBoxPaint(Sender:TObject);
var
  i:Integer;
  c:TfrxComponent;
begin
  with PaintBox.Canvas do
  begin
    Pen.Color:= clBlack;
    Brush.Color:= clWindow;
    Rectangle(0, 0, PaintBox.Width, PaintBox.Height);

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

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

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

procedure TfrxStdWizardForm.FinishBClick(Sender:TObject);
var
  DataSet:TfrxDataSet;
  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
    if FDotMatrix then
      Page:= TfrxDMPPage.Create(FReport) else
      Page:= TfrxReportPage.Create(FReport);
    Page.Name:= 'Page1';
    Page.SetDefaults;
    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(DataSet.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:= DataSet.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:= DataSet;
      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:= DataSet;
    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:= DataSet;
        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:= DataSet;
        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.Clear;
    FReport.FileName:= '';
    FReport.DotMatrixReport:= FDotMatrix;

    DataSet:= nil;
    if DatasetsCB.ItemIndex<>-1 then
    begin
      DataSet:= TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]);
      FReport.DataSets.Add(DataSet);
    end;

    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;

var
  Bmp, Bmp1:TBitmap;

initialization
  Bmp:= TBitmap.Create;
  Bmp.LoadFromResourceName(hInstance, 'frxSTDWIZARD');
  frxWizards.Register(TfrxStdWizard, Bmp);
  frxWizards.Register(TfrxDotMatrixWizard, Bmp);
  Bmp1:= TBitmap.Create;
  Bmp1.LoadFromResourceName(hInstance, 'frxSTDWIZARD1');
  frxWizards.Register(TfrxStdEmptyWizard, Bmp1);
  frxWizards.Register(TfrxDMPEmptyWizard, Bmp1);

finalization
  frxWizards.Unregister(TfrxStdWizard);
  frxWizards.Unregister(TfrxDotMatrixWizard);
  frxWizards.Unregister(TfrxStdEmptyWizard);
  frxWizards.Unregister(TfrxDMPEmptyWizard);
  Bmp.Free;
  Bmp1.Free;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -