frxexportmatrix.pas

这个是功能强大的报表软件

          begin
            if not Obj.Exist then
              CutObject(k, j, i, dx, dy)
          end else
            Obj.Exist := true;
        end;
      end;
    end;
  if FShowProgress then
    FProgress.Tick;
end;

procedure TfrxIEMatrix.Clear;
var
  i : Integer;
begin
  for i := 0 to FIEMObjectList.Count - 1 do
    TfrxIEMObjectList(FIEMObjectList[i]).Free;
  FIEMObjectList.Clear;
  for i := 0 to FIEMStyleList.Count - 1 do
    TfrxIEMStyle(FIEMStyleList[i]).Free;
  FIEMStyleList.Clear;
  for i := 0 to FXPos.Count - 1 do
    TfrxIEMPos(FXPos[i]).Free;
  FXPos.Clear;
  for i := 0 to FYPos.Count - 1 do
    TfrxIEMPos(FYPos[i]).Free;
  FYPos.Clear;
  for i := 0 to FPages.Count - 1 do
    TfrxIEMPage(FPages[i]).Free;
  FPages.Clear;
  FFontList.Clear;
  SetLength(FMatrix, 0);
  FDeltaY := 0;
end;

procedure TfrxIEMatrix.CloneFrames(Obj1, Obj2: Integer);
var
  FOld, FNew: TfrxIEMObject;
  FrameTyp: TfrxFrameTypes;
  NewStyle: TfrxIEMStyle;
begin
  FOld := TfrxIEMObjectList(FIEMObjectList[Obj1]).Obj;
  FNew := TfrxIEMObjectList(FIEMObjectList[Obj2]).Obj;
  if (FOld.Style <> nil) and (FNew.Style <> nil) then
  begin
  FrameTyp := [];
  if (ftTop in FOld.Style.FrameTyp) and (FOld.Top = FNew.Top) then
    FrameTyp := FrameTyp + [ftTop];
  if (ftLeft in FOld.Style.FrameTyp) and (FOld.Left = FNew.Left) then
    FrameTyp := FrameTyp + [ftLeft];
  if (ftBottom in FOld.Style.FrameTyp) and
     ((FOld.Top + FOld.Height) = (FNew.Top + FNew.Height)) then
    FrameTyp := FrameTyp + [ftBottom];
  if (ftRight in FOld.Style.FrameTyp) and
     ((FOld.Left + FOld.Width) = (FNew.Left + FNew.Width)) then
    FrameTyp := FrameTyp + [ftRight];
  if FrameTyp <> FNew.Style.FrameTyp then
  begin
    NewStyle := TfrxIEMStyle.Create;
    NewStyle.FrameTyp := FrameTyp;
    NewStyle.FrameWidth := FOld.Style.FrameWidth;
    NewStyle.FrameColor := FOld.Style.FrameColor;
    NewStyle.FrameStyle := FOld.Style.FrameStyle;
    NewStyle.Font.Assign(FOld.Style.Font);
    NewStyle.DisplayFormat.Assign(FOld.Style.DisplayFormat);
    NewStyle.LineSpacing := FOld.Style.LineSpacing;
    NewStyle.GapX := FOld.Style.GapX;
    NewStyle.GapY := FOld.Style.GapY;
    NewStyle.ParagraphGap := FOld.Style.ParagraphGap;
    NewStyle.CharSpacing := FOld.Style.CharSpacing;
    NewStyle.Charset := FOld.Style.Charset;
    NewStyle.WordBreak := FOld.Style.WordBreak;
    NewStyle.VAlign := FOld.Style.VAlign;
    NewStyle.HAlign := FOld.Style.HAlign;
    NewStyle.Color := FOld.Style.Color;
    NewStyle.Rotation := FOld.Style.Rotation;
    NewStyle.BrushStyle := FOld.Style.BrushStyle;
    FNew.StyleIndex := AddStyleInternal(NewStyle);
    FNew.Style := TfrxIEMStyle(FIEMStyleList[FNew.StyleIndex]);
  end;
end;
end;

procedure TfrxIEMatrix.CutObject(ObjIndex, x, y, dx, dy: integer);
var
  Obj: TfrxIEMObject;
  NewObject: TfrxIEMObject;
  NewIndex: Integer;
  fdx, fdy: Extended;
begin
  Obj := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj;
  NewObject := TfrxIEMObject.Create;
  NewObject.StyleIndex := Obj.StyleIndex;
  NewObject.Style := Obj.Style;
  NewObject.Left := TfrxIEMPos(FXPos[x]).Value;
  NewObject.Top := TfrxIEMPos(FYPos[y]).Value;
  NewObject.Width := TfrxIEMPos(FXPos[x + dx]).Value - TfrxIEMPos(FXPos[x]).Value;
  NewObject.Height := TfrxIEMPos(FYPos[y + dy]).Value - TfrxIEMPos(FYPos[y]).Value;
  NewObject.Parent := Obj;
  NewObject.IsText := Obj.IsText;
  NewObject.IsRichText := Obj.IsRichText;
  NewObject.HTMLTags := Obj.HTMLTags;
  fdy := Obj.Top + Obj.Height - NewObject.Top;
  fdx := Obj.Left + Obj.Width - NewObject.Left;
  if (fdy > Obj.Height / 3) and (fdx > Obj.Width / 3) then
  begin
    NewObject.Image := Obj.Image;
    NewObject.Link := Obj.Link;
    NewObject.IsText := Obj.IsText;
    NewObject.Memo := Obj.Memo;
    Obj.Memo.Clear;
    Obj.IsText := True;
    Obj.Link := nil;
    Obj.Image := nil;
  end;
  NewIndex := AddInternalObject(NewObject, x, y, dx, dy);
  ReplaceArea(ObjIndex, x, y, dx, dy, NewIndex);
  CloneFrames(ObjIndex, NewIndex);
  TfrxIEMObjectList(FIEMObjectList[NewIndex]).Exist := True;
end;

procedure TfrxIEMatrix.FillArea(x, y, dx, dy, Value: integer);
var
  i, j: integer;
begin
  for i := y to y + dy - 1 do
    for j := x to x + dx - 1 do
      SetCell(j, i, Value);
end;

procedure TfrxIEMatrix.FindRectArea(x, y: integer; var dx, dy: integer);
var
  px, py: integer;
  Obj: integer;
begin
  Obj := GetCell(x, y);
  px := x;
  py := y;
  dx := 0;
  while GetCell(px, py) = Obj do
  begin
    while GetCell(px, py) = Obj do
      Inc(px);
    if dx = 0 then
      dx := px - x
    else if px - x < dx then
        break;
    Inc(py);
    px := x;
  end;
  dy := py - y;
end;

function TfrxIEMatrix.GetCell(x, y: integer): integer;
begin
  if (x < FWidth) and (y < FHeight) and (x >= 0) and (y >= 0) then
    Result := FMatrix[FWidth * y + x]
  else Result := -1;
end;

function TfrxIEMatrix.GetCellXPos(x: integer): Extended;
begin
  Result := TfrxIEMPos(FXPos[x]).Value;
end;

function TfrxIEMatrix.GetCellYPos(y: integer): Extended;
begin
  Result := TfrxIEMPos(FYPos[y]).Value;
end;

function TfrxIEMatrix.GetObject(x, y: integer): TfrxIEMObject;
var
  i: integer;
begin
  i := GetCell(x, y);
  if i = -1 then
    Result := nil
  else
    Result := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
end;

function TfrxIEMatrix.GetObjectById(ObjIndex: integer): TfrxIEMObject;
begin
  if ObjIndex < FIEMObjectList.Count then
    Result := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj
  else Result := nil;
end;

procedure TfrxIEMatrix.GetObjectPos(ObjIndex: integer; var x, y, dx,
  dy: integer);
begin
  x := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).x;
  y := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).y;
  dx := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dx;
  dy := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dy;
end;

function TfrxIEMatrix.GetObjectsCount: Integer;
begin
  Result := FIEMObjectList.Count;
end;

function TfrxIEMatrix.GetPageBreak(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).Value
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageHeight(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).Height
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageLMargin(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).LeftMargin
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageTMargin(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).TopMargin
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageWidth(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).Width
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageBMargin(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).BottomMargin
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageRMargin(Page: integer): Extended;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).RightMargin
  else
    Result := 0;
end;

function TfrxIEMatrix.GetPageOrientation(Page: integer): TPrinterOrientation;
begin
  if Page < FPages.Count then
    Result := TfrxIEMPage(FPages[Page]).Orientation
  else
    Result := poPortrait;
end;

function TfrxIEMatrix.GetPagesCount: Integer;
begin
  Result := FPages.Count;
end;

function TfrxIEMatrix.GetStyle(x, y: integer): TfrxIEMStyle;
var
  Obj: TfrxIEMObject;
begin
  Obj := GetObject(x, y);
  if Obj <> nil then
    Result := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex])
  else
    Result := nil;
end;

function TfrxIEMatrix.GetStyleById(StyleIndex: integer): TfrxIEMStyle;
begin
  Result := TfrxIEMStyle(FIEMStyleList[StyleIndex]);
end;

function TfrxIEMatrix.GetStylesCount: Integer;
begin
  Result := FIEMStyleList.Count;
end;

function TfrxIEMatrix.GetXPosById(PosIndex: integer): Extended;
begin
  Result := TfrxIEMPos(FXPos[PosIndex]).Value;
end;

function TfrxIEMatrix.GetYPosById(PosIndex: integer): Extended;
begin
  Result := TfrxIEMPos(FYPos[PosIndex]).Value;
end;

function TfrxIEMatrix.IsMemo(Obj: TfrxView): boolean;
begin
  Result := (Obj is TfrxCustomMemoView) and
            ((Obj.BrushStyle in [bsSolid, bsClear]) or (not FBrushAsBitmap)) and
            ((TfrxCustomMemoView(Obj).Rotation = 0) or (not FRotatedImage));
end;

function TfrxIEMatrix.IsLine(Obj: TfrxView): boolean;
begin
  Result := (Obj is TfrxCustomLineView) and ((Obj.Width = 0) or (Obj.Height = 0));
end;

function TfrxIEMatrix.IsRect(Obj: TfrxView): boolean;
begin
  Result := (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle);
end;

procedure TfrxIEMatrix.OptimizeFrames;
var
  x, y: Integer;
  Obj, PrevObj: TfrxIEMObject;
  FrameTyp: TfrxFrameTypes;
  Style: TfrxIEMStyle;
begin
  for y := 0 to Height - 1 do
    for x := 0 to Width - 1 do
    begin
      Obj := GetObject(x, y);
      if Obj = nil then continue;
      FrameTyp := Obj.Style.FrameTyp;

      if (ftTop in FrameTyp) and (y > 0) then
      begin
        PrevObj := GetObject(x, y - 1);
        if (PrevObj <> nil) and (PrevObj <> Obj) then
          if (ftBottom in PrevObj.Style.FrameTyp) and
            (PrevObj.Style.FrameWidth = Obj.Style.FrameWidth) and
            (PrevObj.Style.FrameColor = Obj.Style.FrameColor) then
            FrameTyp := FrameTyp - [ftTop];
      end;
      if (ftLeft in FrameTyp) and (x > 0) then
      begin
        PrevObj := GetObject(x - 1, y);
        if (PrevObj <> nil) and (PrevObj <> Obj) then
          if (ftRight in PrevObj.Style.FrameTyp) and
            (PrevObj.Style.FrameWidth = Obj.Style.FrameWidth) and
            (PrevObj.Style.FrameColor = Obj.Style.FrameColor) then
            FrameTyp := FrameTyp - [ftLeft];
      end;

      if FrameTyp <> Obj.Style.FrameTyp then
      begin
        Style := TfrxIEMStyle.Create;
        Style.Assign(Obj.Style);
        Style.FrameTyp := FrameTyp;
        Obj.StyleIndex := AddStyleInternal(Style);
        Obj.Style := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex]);
      end;
    end;
end;

function TfrxIEMatrix.QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
var
  L, H, I: Integer;
  C: Extended;
begin
  Result := False;
  L := 0;
  H := aList.Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    C := TfrxIEMPos(aList[I]).Value - aPosition;
    if C < 0 then
      L := I + 1
    else begin
      H := I - 1;
      if C = 0 then begin
        Result := True;
        L := I
      end
    end
  end;
  Index := L
end;

procedure TfrxIEMatrix.OrderByCells;
var
  i, j, k, dx, dy: integer;
  curx, cury: Extended;
  obj: TfrxIEMObject;
begin
  OrderPosArray(FXPos, false);
  OrderPosArray(FYPos, true);
  for i := 0 to FIEMObjectList.Count - 1 do
  begin
    dx := 0; dy := 0;
    obj := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
    QuickFind(FXPos, Obj.Left, j);
    if j < FXPos.Count then
    begin
      TfrxIEMObjectList(FIEMObjectList[i]).x := j;
      curx := Obj.Left;
      k := j;
      while (Obj.Left + Obj.Width > curx) and (k < FXPos.Count - 1) do
      begin
        Inc(k);
        curx := TfrxIEMPos(FXPos[k]).Value;
        Inc(dx);
      end;
      TfrxIEMObjectList(FIEMObjectList[i]).dx := dx;
    end;
    QuickFind(FYPos, Obj.Top, j);
    if j < FYPos.Count then
    begin
      TfrxIEMObjectList(FIEMObjectList[i]).y := j;
      cury := Obj.Top;
      k := j;
      while (Obj.Top + Obj.Height > cury) and (k < FYPos.Count - 1) do
      begin
        Inc(k);
        cury := TfrxIEMPos(FYPos[k]).Value;
        Inc(dy);