rm_e_main.pas

这是一个功能强大

    lRowCount := RowCount;
    lColCount := ColCount;
    for i := 0 to FObjList.Count - 1 do
    begin
      lObj := TRMIEMData(FObjList[i]);
      if (lObj.StartCol < 1) or (lObj.StartRow < 1) or
        (lObj.EndCol > lColCount) or (lObj.EndRow > lRowCount) then
        Continue;

      for lCol := lObj.StartCol to lObj.EndCol do
      begin
        for lRow := lObj.StartRow to lObj.EndRow do
        begin
          FCells[lRow - 1, lCol - 1] := i;
        end;
      end;
    end;
  end;

  procedure _SetNewXY(aCol, aRow: Integer; var aCell: TRMIEMData);
  var
    lRow, lCol, i: Integer;
    lCell: TRMIEMData;
  begin
    for lCol := aCol + 1 to aCell.EndCol - 1 do
    begin
      lCell := Cells[lCol, aRow];
      if (lCell <> nil) and (lCell <> aCell) then
      begin
        aCell.EndCol := lCol;
        aCell.Width := 0;
        for i := aCell.StartCol to aCell.EndCol do
          aCell.Width := aCell.Width + ColWidth[i - 1];

        Break;
      end;
    end;

    for lRow := aRow + 1 to aCell.EndRow - 1 do
    begin
      lCell := Cells[aCol, lRow];
      if (lCell <> nil) and (lCell <> aCell) then
      begin
        aCell.EndRow := lRow;
        aCell.Height := 0;
        for i := aCell.StartRow to aCell.EndRow do
          aCell.Height := aCell.Height + RowHeight[i - 1];

        Break;
      end;
    end;
  end;

  procedure _SplitCells;
  var
    lRow, lCol: Integer;
    lCell: TRMIEMData;
  begin
    for lRow := 0 to RowCount - 1 do
    begin
      for lCol := 0 to ColCount - 1 do
      begin
        lCell := Cells[lCol, lRow];
        if (lCell = nil) or (lCell.FCounter > 0) then Continue;

        _SetNewXY(lCol, lRow, lCell);
        lCell.FCounter := 1;
      end;
    end;

    for lRow := 0 to RowCount - 1 do
    begin
      for lCol := 0 to ColCount - 1 do
      begin
        lCell := Cells[lCol, lRow];
        if lCell <> nil then
          lCell.FCounter := 0;
      end;
    end;
  end;

var
  lRow, lCol, lRowCount, lColCount: Integer;
begin
  _SortCells;
  lRowCount := RowCount;
  lColCount := ColCount;
  SetLength(FCells, lRowCount);
  for lRow := 0 to lRowCount - 1 do
  begin
    SetLength(FCells[lRow], lColCount);
    for lCol := 0 to lColCount - 1 do
      FCells[lRow, lCol] := -1;
  end;

  _FillCells;
  _SplitCells;
end;

function TRMIEMList.GetRowCount: Integer;
begin
  Result := FRows.Count;
end;

function TRMIEMList.GetColCount: Integer;
begin
  Result := FCols.Count;
end;

function TRMIEMList.GetCellRowPos(aIndex: Integer): Integer;
begin
  Result := TRMIEMValue(FRows[aIndex]).Value;
end;

function TRMIEMList.GetCellColPos(aIndex: Integer): Integer;
begin
  Result := TRMIEMValue(FCols[aIndex]).Value;
end;

function TRMIEMList.GetRowHeight(aIndex: Integer): Integer;
begin
  if aIndex = 0 then
    Result := TRMIEMValue(FRows[aIndex]).Value
  else
    Result := TRMIEMValue(FRows[aIndex]).Value - TRMIEMValue(FRows[aIndex - 1]).Value;
end;

function TRMIEMList.GetColWidth(aIndex: Integer): Integer;
begin
  if aIndex = 0 then
    Result := TRMIEMValue(FCols[aIndex]).Value
  else
    Result := TRMIEMValue(FCols[aIndex]).Value - TRMIEMValue(FCols[aIndex - 1]).Value;
end;

function TRMIEMList.GetCell(aCol, aRow: Integer): TRMIEMData;
begin
  if FCells[aRow, aCol] >= 0 then
    Result := TRMIEMData(FObjList[FCells[aRow, aCol]])
  else
    Result := nil;
end;

function TRMIEMList.GetCellStyle(aCell: TRMIEMData): TRMIEMCellStyle;
begin
  if aCell.FStyleIndex >= 0 then
    Result := TRMIEMCellStyle(FStyleList[aCell.FStyleIndex])
  else
    Result := nil;
end;

function TRMIEMList.GetPageBreak(Index: Integer): Integer;
begin
  if Index < Length(FAryPageBreak) then
    Result := FAryPageBreak[Index]
  else
    Result := $FFFFFF;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMMainExportFilter}

constructor TRMMainExportFilter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FScaleX := 1;
  FScaleY := 1;
  ShowDialog := True;
{$IFDEF JPEG}
  FJPEGQuality := High(TJPEGQualityRange);
  FExportImageFormat := ifJPG;
{$ELSE}
  FExportImageFormat := ifBMP;
{$ENDIF}

  FExportImages := True;
  FExportFrames := True;
  FPixelFormat := pf24bit;
end;

destructor TRMMainExportFilter.Destroy;
begin
  RMUnRegisterExportFilter(Self);
  inherited Destroy;
end;

procedure TRMMainExportFilter.OnBeginDoc;
begin
  FDataList := TList.Create;
  FViewNames := TStringList.Create;

  FPageNo := 0;
  FPageWidth := ParentReport.EndPages[0].PageWidth;
  FPageHeight := ParentReport.EndPages[0].PageHeight;
end;

procedure TRMMainExportFilter.OnEndDoc;
begin
  ClearDataList;
  FDataList.Free;
  FViewNames.Free;
end;

procedure TRMMainExportFilter.OnBeginPage;
begin
  ClearDataList;
end;

procedure TRMMainExportFilter.OnEndPage;
begin
  Inc(FPageNo);
end;

procedure TRMMainExportFilter.OnText(aDrawRect: TRect; x, y: Integer; const aText: string; View: TRMView);
var
  lTextRec: pRMEFTextRec;
begin
  New(lTextRec);
  lTextRec.Left := x;
  lTextRec.Top := y;
  lTextRec.Text := aText;
  lTextRec.TextWidth := RMGetTextSize(TRMCustomMemoView(FNowDataRec.Obj).Font, aText).cx;
  lTextRec.TextHeight := RMGetTextSize(TRMCustomMemoView(FNowDataRec.Obj).Font, aText).cy;
  FNowDataRec.TextList.Add(lTextRec);
end;

procedure TRMMainExportFilter.InternalOnePage(aPage: TRMEndPage);
begin
end;

procedure TRMMainExportFilter.OnExportPage(const aPage: TRMEndPage);
var
  i, lIndex: Integer;
  t: TRMReportView;
  lDataRec: TRMIEMData;
  lSaveOffsetLeft, lSaveOffsetTop: Integer;
  lIsMemoView: Boolean;
begin
  FPageWidth := Round(aPage.PrinterInfo.ScreenPageWidth * ScaleX);
  FPageHeight := Round(aPage.PrinterInfo.ScreenPageHeight * ScaleY);

  for i := 0 to aPage.Page.Objects.Count - 1 do
  begin
    t := aPage.Page.Objects[i];
    if t.IsBand or (t is TRMSubReportView) then Continue;

    lDataRec := TRMIEMData.Create;
    lDataRec.Obj := t;
    lDataRec.FGraphic := nil;
    lDataRec.ObjType := rmemText;

    lIndex := FViewNames.IndexOf(t.Name);
    if lIndex < 0 then
      lIndex := FViewNames.Add(t.Name);
    lDataRec.ViewIndex := lIndex;

    lDataRec.Left := Round(t.spLeft * ScaleX);
    lDataRec.Top := Round(t.spTop * ScaleY);
    lDataRec.Width := Round(t.spWidth * ScaleX);
    lDataRec.Height := Round(t.spHeight * ScaleY);

    lIsMemoView := (t.ClassName = TRMMemoView.ClassName) or (t.ClassName = TRMCalcMemoView.ClassName);
    lIsMemoView := lIsMemoView and (CanMangeRotationText or (THackMemoView(lDataRec.Obj).RotationType = rmrtNone));
    if lIsMemoView then
    begin
      lDataRec.Width := lDataRec.Width + 1;
      lDataRec.TextWidth := RMGetTextSize(TRMCustomMemoView(t).Font, t.Memo.Text).cx;

      lSaveOffsetLeft := THackRMView(t).OffsetLeft;
      lSaveOffsetTop := THackRMView(t).OffsetTop;
      THackRMView(t).OffsetLeft := 0;
      THackRMView(t).OffsetTop := 0;
      FNowDataRec := lDataRec;
      THackRMView(t).ExportData;
      THackRMView(t).OffsetLeft := lSaveOffsetLeft;
      THackRMView(t).OffsetTop := lSaveOffsetTop;
    end
    else
    begin
      lDataRec.ObjType := rmemPicture;
      if ExportImages then
      begin
        lDataRec.FGraphic := TBitmap.Create;
        TBitmap(lDataRec.FGraphic).PixelFormat := FPixelFormat;
        lDataRec.FGraphic.Width := Round(t.spWidth * ScaleX + 1);
        lDataRec.FGraphic.Height := Round(t.spHeight * ScaleY + 1);

        lSaveOffsetLeft := THackRMView(t).OffsetLeft;
        lSaveOffsetTop := THackRMView(t).OffsetTop;
        THackRMView(t).OffsetLeft := 0;
        THackRMView(t).OffsetTop := 0;
        t.SetspBounds(0, 0, lDataRec.FGraphic.Width - 1, lDataRec.FGraphic.Height - 1);
        t.Draw(TBitmap(lDataRec.FGraphic).Canvas);
        t.SetspBounds(t.spLeft, t.spTop, t.spWidth, t.spHeight);
        THackRMView(t).OffsetLeft := lSaveOffsetLeft;
        THackRMView(t).OffsetTop := lSaveOffsetTop;
      end;
    end;

    FDataList.Add(lDataRec);
  end;

  InternalOnePage(aPage);
end;

procedure TRMMainExportFilter.ClearDataList;
var
  i: Integer;
  p: TRMIEMData;
begin
  if FDataList = nil then Exit;

  for i := 0 to FDataList.Count - 1 do
  begin
    p := FdataList[i];
    if p.FGraphic <> nil then
      FreeAndNil(p.FGraphic); //by waw
    p.Free;
  end;
  FDataList.Clear;
end;

procedure TRMMainExportFilter.SaveBitmapToPicture(aBmp: TBitmap; aImgFormat: TRMEFImageFormat
{$IFDEF JPEG}; aJPEGQuality: TJPEGQualityRange{$ENDIF}; var aPicture: TPicture);
var
  lGraphic: TGraphic;

  procedure SaveJpgGif;
  begin
    try
      lGraphic.Assign(aBmp);
      aPicture.Assign(lGraphic);
    finally
      lGraphic.Free;
    end;
  end;

begin
  aBmp.PixelFormat := FPixelFormat;
  case aImgFormat of
    ifBMP:
      begin
        aPicture.Assign(aBmp);
      end;
    ifGIF:
      begin
{$IFDEF RXGIF}
        lGraphic := TJvGIFImage.Create;
        SaveJpgGif;
{$ELSE}
{$IFDEF JPEG}
        lGraphic := TJPEGImage.Create;
        SaveJpgGif;
{$ELSE}
        aPicture.Assign(aBmp);
{$ENDIF}
{$ENDIF}
      end;
    ifJPG:
      begin
{$IFDEF JPEG}
        lGraphic := TJPEGImage.Create;
        TJPEGImage(lGraphic).CompressionQuality := JPEGQuality;
        SaveJpgGif;
{$ELSE}
        aPicture.Assign(aBmp);
{$ENDIF}
      end;
  end;
end;

end.