rm_e_main.pas

这是一个功能强大

    Value: Integer;
  end;


constructor TRMIEMList.Create(aExportComponent: TRMExportFilter);
begin
  inherited Create;

  FExportComp := aExportComponent;
  FTopOffset := 0;
  FMaxHeight := 0;
  FExportPrecision := 1;
  FDrawFrame := True;
  FCols := TList.Create;
  FRows := TList.Create;
  FObjList := TList.Create;
  FStyleList := TList.Create;

  FExportImage := True;
  FExportRtf := False;
  FExportHighQualityPicture := False;
end;

destructor TRMIEMList.Destroy;
begin
  Clear(True);
  FCols.Free;
  FRows.Free;
  FObjList.Free;
  FStyleList.Free;

  inherited;
end;

procedure TRMIEMList.Clear(aClearStyle: Boolean);
var
  i: Integer;
begin
  FMaxHeight := 0;
  FTopOffset := 0;
  SetLength(FCells, 0);
  SetLength(FAryPageBreak, 0);

  for i := 0 to FCols.Count - 1 do
    TRMIEMValue(FCols[i]).Free;
  FCols.Clear;

  for i := 0 to FRows.Count - 1 do
    TRMIEMValue(FRows[i]).Free;
  FRows.Clear;

  for i := 0 to FObjList.Count - 1 do
    TRMIEMData(FObjList[i]).Free;
  FObjList.Clear;

  if aClearStyle then
  begin
    for i := 0 to FStyleList.Count - 1 do
      TRMIEMCellStyle(FStyleList[i]).Free;
    FStyleList.Clear;
  end;
end;

procedure TRMIEMList.AddValue(aList: TList; aValue: Integer);
var
  i: Integer;
  tmp: TRMIEMValue;
begin
  for i := 0 to aList.Count - 1 do
  begin
    if TRMIEMValue(aList[i]).Value = aValue then
      Exit;
  end;

  tmp := TRMIEMValue.Create;
  tmp.Value := aValue;
  aList.Add(tmp);
end;

procedure TRMIEMList.AddObject(aReportView: TRMReportView);
var
  lObj: TRMIEMData;

  procedure _AddStyle;
  var
    i: Integer;
    tmp, tmp1: TRMIEMCellStyle;
    lAddFlag: Boolean;
  begin
    lObj.FStyleIndex := -1;

    lAddFlag := True;
    tmp := TRMIEMCellStyle.Create;
    tmp.LeftFrame.Assign(aReportView.LeftFrame);
    tmp.TopFrame.Assign(aReportView.TopFrame);
    tmp.RightFrame.Assign(aReportView.RightFrame);
    tmp.BottomFrame.Assign(aReportView.BottomFrame);
    tmp.FillColor := aReportView.FillColor;
    if THackRMView(aReportView).GetExportMode = rmemText then
    begin
      tmp.HAlign := TRMCustomMemoView(aReportView).HAlign;
      tmp.VAlign := TRMCustomMemoView(aReportView).VAlign;
      tmp.Font.Assign(TRMCustomMemoView(aReportView).Font);
      tmp.DisplayFormat := THackMemoView(aReportView).FormatFlag;
    end;

    for i := 0 to FStyleList.Count - 1 do
    begin
      tmp1 := TRMIEMCellStyle(FStyleList[i]);
      if tmp1.IsEqual(tmp) then
      begin
        FreeAndNil(tmp);
        lObj.FStyleIndex := i;
        lAddFlag := False;
        Break;
      end;
    end;

    if lAddFlag then
    begin
      lObj.FStyleIndex := FStyleList.Add(tmp);
    end;
  end;

  procedure _GetExportPicture1;
  var
    lSaveOffsetLeft, lSaveOffsetTop: Integer;
    lSave1, lSave2, lSave3, lSave4: Boolean;
    lBitmap: TBitmap;
  begin
    lSaveOffsetLeft := THackRMView(aReportView).OffsetLeft;
    lSaveOffsetTop := THackRMView(aReportView).OffsetTop;
    lSave1 := THackRMView(aReportView).LeftFrame.Visible;
    lSave2 := THackRMView(aReportView).TopFrame.Visible;
    lSave3 := THackRMView(aReportView).RightFrame.Visible;
    lSave4 := THackRMView(aReportView).BottomFrame.Visible;
    lBitmap := TBitmap.Create;
    try
      lBitmap.Width := lObj.Width + 1;
      lBitmap.Height := lObj.Height + 1;
      if not DrawFrame then
      begin
        THackRMView(aReportView).LeftFrame.Visible := False;
        THackRMView(aReportView).TopFrame.Visible := False;
        THackRMView(aReportView).RightFrame.Visible := False;
        THackRMView(aReportView).BottomFrame.Visible := False;
      end;

      THackRMView(aReportView).OffsetLeft := 0;
      THackRMView(aReportView).OffsetTop := 0;
      aReportView.SetspBounds(0, 0, lObj.Width, lObj.Height);
      aReportView.Draw(lBitmap.Canvas);
      lObj.Graphic.Assign(lBitmap);
      lObj.ObjType := rmemPicture;
    finally
      THackRMView(aReportView).OffsetLeft := lSaveOffsetLeft;
      THackRMView(aReportView).OffsetTop := lSaveOffsetTop;
      THackRMView(aReportView).LeftFrame.Visible := lSave1;
      THackRMView(aReportView).TopFrame.Visible := lSave2;
      THackRMView(aReportView).RightFrame.Visible := lSave3;
      THackRMView(aReportView).BottomFrame.Visible := lSave4;
      lBitmap.Free;
    end;
  end;

  procedure _GetExportPicture;
  begin
    if ExportHighQualityPicture and (aReportView is TRMPictureView) then
    begin
      lObj.ObjType := rmemPicture;
      if (TRMPictureView(aReportView).Picture.Graphic <> nil) and
        (not TRMPictureView(aReportView).Picture.Graphic.Empty) then
      begin
        lObj.Graphic.Assign(TRMPictureView(aReportView).Picture.Graphic);
      end;
    end;

    if lObj.Graphic.Empty then
      _GetExportPicture1;
  end;

  procedure _GetExportRtf;
  begin
    lObj.ObjType := rmemRtf;
    lObj.Memo.Text := THackRMView(aReportView).GetExportData;
  end;

  procedure _GetExportText;
  var
    i: Integer;
    lStr: string;
  begin
    lObj.ObjType := rmemText;
    lObj.Memo.Assign(aReportView.Memo);
    lObj.ExportAsNum := THackMemoView(aReportView).ExportAsNumber;
    _AddStyle;

    if THackMemoView(aReportView).WordWrap then
    begin
      for i := 0 to lObj.Memo.Count - 1 do
      begin
        lStr := lObj.Memo[i];
        if (Length(lStr) > 0) and (lStr[1] = #1) then
        begin
          Delete(lStr, 1, 1);
          lObj.Memo[i] := lStr;
        end;
      end;

      if (lObj.Memo.Count > 1) and (lObj.Memo[lObj.Memo.Count - 1] = #1) then
        lObj.Memo.Delete(lObj.Memo.Count - 1);
    end;
  end;

begin
  lObj := TRMIEMData.Create;
  lObj.Left := aReportView.spLeft;
  lObj.Top := aReportView.spTop + FTopOffset;
  lObj.Width := aReportView.spWidth;
  lObj.Height := aReportView.spHeight;
  lObj.Obj := aReportView;
  case THackRMView(aReportView).GetExportMode of
    rmemText:
      begin
        _GetExportText;
      end;
    rmemRtf:
      begin
        _AddStyle;
        if FExportRtf then
          _GetExportRtf
        else
          _GetExportPicture;
      end;
    rmemPicture:
      begin
        _AddStyle;
        if ExportImage then
          _GetExportPicture;
      end;
  end;

  FMaxHeight := Max(FMaxHeight, lObj.Top + lObj.Height);
  AddValue(FCols, lObj.Left);
  AddValue(FCols, lObj.Left + lObj.Width);
  AddValue(FRows, lObj.Top);
  AddValue(FRows, lObj.Top + lObj.Height);
  FObjList.Add(lObj);
end;

procedure TRMIEMList.EndPage;
begin
  SetLength(FAryPageBreak, Length(FAryPageBreak) + 1);
  FTopOffset := FMaxHeight;
  FAryPageBreak[Length(FAryPageBreak) - 1] := FTopOffset;
  FMaxHeight := 0;
end;

function _ListSortProc(aItem1, aItem2: Pointer): Integer;
begin
  Result := TRMIEMValue(aItem1).Value - TRMIEMValue(aItem2).Value;
end;

procedure TRMIEMList.Prepare;

  procedure _SortList(aList: TList);
  var
    i, lCount: integer;
    lValue1, lValue2: Integer;
  begin
    lValue2 := 0;
    aList.Sort(_ListSortProc);
    for i := 0 to aList.Count - 1 do
    begin
      lValue1 := TRMIEMValue(aList[i]).Value;
      if lValue1 >= 0 then
        Break
      else
        lValue2 := Min(lValue2, lValue1);
    end;

    if lValue2 < 0 then
    begin
      for i := 0 to aList.Count - 1 do
      begin
        TRMIEMValue(aList[i]).Value := TRMIEMValue(aList[i]).Value + (-lValue2);
      end;
    end;

    if (aList.Count > 0) and (TRMIEMValue(aList[0]).Value = 0) then
    begin
      TRMIEMValue(aList[0]).Free;
      aList.Delete(0);
    end;

    lCount := aList.Count - 1;
    for i := lCount - 1 downto 0 do
    begin
      lValue1 := TRMIEMValue(aList[i + 1]).Value;
      lValue2 := TRMIEMValue(aList[i]).Value;
      if lValue1 - lValue2 <= FExportPrecision then
      begin
        TRMIEMValue(aList[i]).Free;
        aList.Delete(i);
      end;
    end;
  end;

  function _FindIndex(aList: TList; aPosition: Integer): Integer;
  var
    i: Integer;
  begin
    Result := -1;
    for i := 0 to aList.Count - 1 do
    begin
      if TRMIEMValue(aList[i]).Value > aPosition then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;

  procedure _SortCells;
  var
    i, j, lIndex: Integer;
    lObj: TRMIEMData;
  begin
    _SortList(FCols);
    _SortList(FRows);
    for i := 0 to FObjList.Count - 1 do
    begin
      lObj := TRMIEMData(FObjList[i]);
      lObj.StartCol := -1;
      lObj.StartRow := -1;
      lObj.EndCol := -1;
      lObj.EndRow := -1;
      lIndex := _FindIndex(FCols, lObj.Left);
      if lIndex >= 0 then
      begin
        lObj.StartCol := lIndex + 1;
        lObj.EndCol := lObj.StartCol;
        for j := lIndex to FCols.Count - 1 do
        begin
          if TRMIEMValue(FCols[j]).Value >= lObj.Left + lObj.Width then
          begin
            lObj.EndCol := j + 1;
            Break;
          end;
        end;
      end;

      lIndex := _FindIndex(FRows, lObj.Top);
      if lIndex >= 0 then
      begin
        lObj.StartRow := lIndex + 1;
        lObj.EndRow := lObj.StartRow;
        for j := lIndex to FRows.Count - 1 do
        begin
          if TRMIEMValue(FRows[j]).Value >= lObj.Top + lObj.Height then
          begin
            lObj.EndRow := j + 1;
            Break;
          end;
        end;
      end;
    end;
  end;

  procedure _FillCells;
  var
    i, lCol, lRow: Integer;
    lObj: TRMIEMData;
    lRowCount, lColCount: Integer;
  begin