untactreport.pas.bak

飞思科技的书不错

    end;
    if bHasSummary and lstSummary[i] then
      with TQRExpr(bandSummary.Controls[idxSummary]) do begin
        AutoSize := False;
        // fit the width to the maximum value
        Size.Width := lstWidths[i] - dDetailMargin*2;
        tmpSize := Size;
        SetPosition(tmpSize, posx, lstWidths[i], dHeightDetail,
                    lstAlign[i], dDetailMargin);
        Size := tmpSize;
        Top := Top + nSegbarWidth;
        Alignment := CustomToStandardAlign(lstAlign[i]);
        Inc(idxSummary);
      end;
    posx := posx + lstWidths[i];
  end;

  // create the vertical frame lines here
  // if 'not bHasFrameLine' then the lines are disabled
  for i := -1 to upFields do begin
    if i = -1 then
      posx := 0
    else
      posx := posx + lstWidths[i];
    with TQRShape.Create(bandHeader) do begin
      Parent := bandHeader;
      Enabled := bHasFrameLine;
      Shape := qrsVertLine;
      Size.Left := posx;
      Top := 0;
      Width := 1;
      Height := bandHeader.Height;
    end;
    with TQRShape.Create(bandDetail) do begin
      Parent := bandDetail;
      Enabled := bHasFrameLine;
      Shape := qrsVertLine;
      Size.Left := posx;
      Top := 0;
      Width := 1;
      Height := bandDetail.Height;
    end;
    if bHasSummary then
      with TQRShape.Create(bandSummary) do begin
        Parent := bandSummary;
        Enabled := bHasFrameLine;
        Shape := qrsVertLine;
        Size.Left := posx;
        Top := 0;
        Width := 1;
        Height := bandSummary.Height;
      end;
  end;

  // create the horizental frame lines here
  // if 'not bHasFrameLine' then the lines are disabled
  with TQRShape.Create(bandHeader) do begin
    Parent := bandHeader;
    Enabled := bHasFrameLine;
    Shape := qrsHorLine;
    Left := 0;
    Top := 0;
    Size.Width := posx;
    Height := 1;
  end;
  with TQRShape.Create(bandHeader) do begin
    Parent := bandHeader;
    Enabled := bHasFrameLine;
    Shape := qrsRectangle;
    Left := 0;
    Top := bandHeader.Height - nSegbarWidth;
    Size.Width := posx;
    Height := nSegbarWidth;
    Brush.Color := clBlack;
  end;
  with TQRShape.Create(bandDetail) do begin
    Parent := bandDetail;
    Enabled := bHasFrameLine;
    Shape := qrsHorLine;
    Left := 0;
    Top := 0;
    Size.Width := posx;
    Height := 1;
  end;
  with TQRShape.Create(bandDetail) do begin
    Parent := bandDetail;
    Enabled := bHasFrameLine;
    Shape := qrsHorLine;
    Left := 0;
    Top := bandDetail.Height;
    Size.Width := posx;
    Height := 1;
  end;
  if bHasSummary then begin
    with TQRShape.Create(bandSummary) do begin
      Parent := bandSummary;
      Enabled := bHasFrameLine;
      Shape := qrsRectangle;
      Left := 0;
      Top := 0;
      Size.Width := posx;
      Height := nSegbarWidth;
      Brush.Color := clBlack;
    end;
    with TQRShape.Create(bandSummary) do begin
      Parent := bandSummary;
      Enabled := bHasFrameLine;
      Shape := qrsHorLine;
      Left := 0;
      Top := bandSummary.Height;
      Size.Width := posx;
      Height := 1;
    end;
  end;

  // adjust the position of the title
  with TQRLabel(bandTitle.Controls[0]) do begin
    AutoSize := False;
    tmpSize := Size;
    SetPosition(tmpSize, 0, posX, dHeightTitle,
                a_center, dDetailMargin);
    Size := tmpSize;
  end;

  // adjust the position of the report
  with m_rptActive.Page do begin
    case alnReport of
      a_left: begin
                LeftMargin := dPageHorMargin;
                RightMargin := Max(0, Width - LeftMargin - posx);
              end;
      a_center: begin
                  LeftMargin := (Width - posx) / 2;
                  RightMargin := LeftMargin;
                end;
      a_right: begin
                 RightMargin := dPageHorMargin;
                 LeftMargin := Max(0, Width - RightMargin - posx);
               end;
    end;
    TopMargin := dPageVertMargin;
    BottomMargin := dPageVertMargin;
  end;

  Result := True;
end;

procedure TActReport.PrepareMemory(nAryLen: Integer);
begin
  SetLength(m_blstDisplay, nAryLen);
  m_strlstFieldNames := TStringList.Create;
  SetLength(m_dlstFieldWidths, nAryLen);
  m_strlstDispNames := TStringList.Create;
  SetLength(m_alnlstFields, nAryLen);
  SetLength(m_blstSummary, nAryLen);
end;

procedure TActReport.ReleaseMemory;
begin
  SetLength(m_blstDisplay, 0);
  m_strlstFieldNames.Free;
  m_strlstFieldNames := nil;
  SetLength(m_dlstFieldWidths, 0);
  m_strlstDispNames.Free;
  m_strlstDispNames := nil;
  SetLength(m_alnlstFields, 0);
  SetLength(m_blstSummary, 0);
end;

function TActReport.Initialize : Boolean;
begin
  m_bInitialized := False;
  m_bPrepared := False;
  m_bReportReady := False;

  Clear;
  m_grpGlobalContainer := grpGlobalParaList;
  m_grpFieldContainer := grpFieldParaList;
  CreateRep;
  m_bInitialized := True;
  Result := m_bInitialized;
end;

function TActReport.BeginSession(dst: TDBDataSet;
                                 strTitle: string = '';
                                 strlstDispNames: TStringList = nil
                                 ) : Boolean;
var
  i: Integer;
begin
  m_bPrepared := False;
  m_bReportReady := False;
  m_dstActive := dst;

  FillInCtrls;
  m_nFieldCount := m_dstActive.FieldCount;
  PrepareMemory(m_nFieldCount);
  ParamsDefault;
  if Length(strTitle) > 0 then
    m_strTitle := strTitle;
  if Assigned(strlstDispNames) then
    for i := 0 to Min(dst.FieldCount, strlstDispNames.Count) - 1 do
      m_strlstDispNames.Strings[i] := strlstDispNames.Strings[i];

  m_bPrepared := True;
  Result := True;
end;

function TActReport.BuildRep : Boolean;
var
  i: Integer;
  cntFields, idxFields: Integer;

  lstIdxs: TIndexList;
  lstDispNames: TStringList;
  lstWidths: TCurrencyList;
  lstAlign: TAlignList;
  lstSummary: TBooleanList;
begin
  m_bReportReady := False;
  Result := False;
  ResetRep;
  if not m_bPrepared then
    Exit;

  cntFields := 0;
  for i := 0 to High(m_blstDisplay) do
    if m_blstDisplay[i] then
      Inc(cntFields);
  SetLength(lstIdxs, cntFields);
  SetLength(lstWidths, cntFields);
  SetLength(lstAlign, cntFields);
  SetLength(lstSummary, cntFields);

  idxFields := 0;
  lstDispNames := TStringList.Create;
  for i := 0 to High(m_blstDisplay) do
    if m_blstDisplay[i] then begin
      lstIdxs[idxFields] := i;
      lstWidths[idxFields] := m_dlstFieldWidths[i];
      lstDispNames.Add(m_strlstDispNames.Strings[i]);
      lstAlign[idxFields] := m_alnlstFields[i];
      lstSummary[idxFields] := m_blstSummary[i];
      Inc(idxFields);
    end;

  BuildRep(m_strTitle, m_bHasFrameLine, m_bHasSummary,
           m_nPageWidth, m_nPageHeight, m_oriPage, m_alnHeader,
           m_dTitleHeight, m_dHeaderHeight, m_dDetailHeight,
           m_dDetailMargin, c_segbar_width,
           m_dPageHorMargin, m_dPageVertMargin,
           m_fntTitle, m_fntHeader, m_fntDetail,
           c_page_width, c_page_height,
           c_band_width, c_band_height,
           c_page_hor_margin, c_page_vert_margin,
           c_band_margin, lstIdxs, lstDispNames,
           lstWidths, lstAlign, lstSummary, m_alnReport);
  lstDispNames.Free;

  m_bReportReady := True;
  Result := True;
end;

procedure TActReport.TerminateSession;
var
  i: Integer;
begin
  if Assigned(m_grpFieldContainer) then
    for i := 0 to m_grpFieldContainer.ControlCount - 1 do begin
      m_grpFieldContainer.Controls[0].Free;
    end;
  PrepareCtrls(0);
  ReleaseMemory;
end;

procedure TActReport.Clear;
begin
  TerminateSession;
  ResetRep;
end;

//===== public functions/procedures go from here =====

//===== constructors/destructors =====

constructor TActReport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  m_bInitialized := False;
  m_bPrepared := False;
  m_bReportReady := False;

  m_rptActive := nil;

  m_fntTitle := TFont.Create;
  m_fntHeader := TFont.Create;
  m_fntDetail := TFont.Create;
end;

procedure TActReport.Free;
begin
  Clear;
  m_fntTitle.Free;
  m_fntHeader.Free;
  m_fntDetail.Free;
  inherited Free;
end;

//===== public interfaces =====

procedure TActReport.Initialize(dst: TDBDataSet;
                                strTitle: string = '';
                                strlstDispNames: TStringList = nil
                                );
begin
  Initialize;
  BeginSession(dst, strTitle, strlstDispNames);
  ParamsToForm;

  m_strFileName := m_strTitle;
  if Length(m_strFileName) = 0 then
    if m_dstActive is TTable then
      m_strFileName := TTable(m_dstActive).TableName
    else
      m_strFileName := m_dstActive.Name;
  if Length(m_strFileName) = 0 then
    m_strFileName := c_file_name;
  m_strFileName := GetCurrentDir + '\' + m_strFileName + c_file_ext;
end;

function TActReport.Make : Boolean;
begin
  Result := False;
  if not m_bPrepared then
    Exit;
  ParamsFromForm;
  BuildRep;
  ParamsFromReport;
  Result := True;
end;

function TActReport.PreviewRep : Boolean;
begin
  Result := False;
  if not m_bReportReady then
    Exit;
  m_rptActive.OnPreview := nil;
  m_rptActive.Preview;
  Result := True;
end;

function TActReport.PreviewRep(prv: TQRPreview) : Boolean;
var
  bShowError: Boolean;
begin
  Result := False;
  if not m_bReportReady then
    Exit;
  if Assigned(prv) then begin
    m_prvActive := prv;
    m_rptActive.OnPreview := OnPreview;

    // QuickReport may cause error here,
    //  we have to keep previewing till succeed
    bShowError := True;
    while bShowError do begin
      try
        m_rptActive.PreviewModeless;
        bShowError := False;
      except
      end;
    end;
  end
  else
  begin
    m_rptActive.OnPreview := nil;
    m_rptActive.Preview;
  end;

  Result := True;
end;

function TActReport.PrintRep(callback: TQRAfterPrintEvent = nil) : Boolean;
begin
  Result := False;
  if not m_bReportReady then
    Exit;
  m_rptActive.AfterPrint := callback;  
  m_rptActive.Print;
  Result := True;
end;

function TActReport.LoadRep : Boolean;
begin
  Result := False;
  if not m_bInitialized then
    Exit;

  ParamsFromFile(m_strFileName);
  BuildRep;
  ParamsFromReport;
  ParamsToForm;
  Result := True;
end;

function TActReport.SaveRep : Boolean;
begin
  Result := False;
  if not m_bInitialized then
    Exit;

  ParamsToFile(m_strFileName);
  Result := True;
end;

function TActReport.GetFileName : string;
begin
  Result := m_strFileName;
end;

procedure TActReport.SetFileName(strFileName: string);
begin
  m_strFileName := strFileName;
end;

function TActReport.ShowModal : Integer;
begin
  Result := 0;
  if m_bPrepared then
    inherited ShowModal;
end;

end.