frxexportmatrix.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

      if dx < 0 then
      begin
        dx := -dx;
        FObj.Left := FObj.Left - dx;
        DrawPosX := DrawPosX - dx;
      end;
      if Round(dy) = 0 then
        dy := 1;
      if dy < 0 then
      begin
        dy := -dy;
        FObj.Top := FObj.Top - dy;
        DrawPosY := DrawPosY - dy;
      end;
      FObj.Width := dx;
      FObj.Height := dy;
      FObj.Image := TBitmap.Create;
      FObj.Image.PixelFormat := pf24bit;
      FObj.Image.Height := Round(dy) + 1;
      FObj.Image.Width := Round(dx) + 1;
      TfrxView(Obj).Draw(FObj.Image.Canvas, 1, 1, -DrawPosX, -DrawPosY);
      if OldFrameWidth > 0 then
        Obj.Frame.Width := OldFrameWidth;
    end
  end;
  if FObj.Top + FObj.Height > FMaxHeight then
    FMaxHeight := FObj.Top + FObj.Height;
  if FObj.Left + FObj.Width > FMaxWidth then
    FMaxWidth := FObj.Left + FObj.Width;
  if FObj.Left < FMinLeft then
    FMinLeft := FObj.Left;
  if FObj.Top < FMinTop then
    FMinTop := FObj.Top;
  if (FObj.Left < FLeft) or (FLeft = 0) then
    FLeft := FObj.Left;
  if (FObj.Top < FTop) or (FTop = 0) then
    FTop := FObj.Top;
  AddPos(FXPos, FObj.Left);
  AddPos(FXPos, FObj.Left + FObj.Width);
  AddPos(FYPos, FObj.Top);
  AddPos(FYPos, FObj.Top + FObj.Height);
  AddInternalObject(FObj, 0, 0, 1, 1);
end;

procedure TfrxIEMatrix.AddDialogObject(Obj: TfrxReportComponent);
var
  FObj: TfrxIEMObject;
begin
  if Obj is TfrxDialogControl then
  begin
    FObj := TfrxIEMObject.Create;
    FObj.StyleIndex := 0;
    FObj.Style := nil;
    FObj.URL := '';
    FObj.Left := Obj.AbsLeft;
    FObj.Top := Obj.AbsTop;
    FObj.Width := Obj.Width;
    FObj.Height := Obj.Height;
    FObj.IsText := False;
    FObj.IsRichText := False;
    FObj.Link := Obj;
    if FObj.Top + FObj.Height > FMaxHeight then
      FMaxHeight := FObj.Top + FObj.Height;
    if FObj.Left + FObj.Width > FMaxWidth then
      FMaxWidth := FObj.Left + FObj.Width;
    if FObj.Left < FMinLeft then
      FMinLeft := FObj.Left;
    if FObj.Top < FMinTop then
      FMinTop := FObj.Top;
    AddPos(FXPos, FObj.Left);
    AddPos(FXPos, FObj.Left + FObj.Width);
    AddPos(FYPos, FObj.Top);
    AddPos(FYPos, FObj.Top + FObj.Height);
    AddInternalObject(FObj, 0, 0, 1, 1);
  end;
end;

procedure TfrxIEMatrix.AddPage(Orientation: TPrinterOrientation;
Width: Extended; Height: Extended; LeftMargin: Extended; TopMargin: Extended;
RightMargin: Extended; BottomMargin: Extended);
var
  Page: TfrxIEMPage;
begin
  FDeltaY := FMaxHeight;
  Page := TfrxIEMPage.Create;
  Page.Value := FMaxHeight;
  Page.Orientation := Orientation;
  Page.Width := Width;
  Page.Height := Height;
  Page.LeftMargin := LeftMargin;
  page.TopMargin := TopMargin;
  Page.RightMargin := LeftMargin;
  page.BottomMargin := TopMargin;
  FPages.Add(Page);
end;

procedure TfrxIEMatrix.AddPos(List: TList; Value: Extended);
var
  Pos: TfrxIEMPos;
  i, cnt: integer;
  Exist: Boolean;
begin
  Exist := False;
  if List.Count > MAX_POS_SEARCH_DEPTH then
    cnt := List.Count - MAX_POS_SEARCH_DEPTH
  else
    cnt := 0;
  for i := List.Count - 1 downto cnt do
    if TfrxIEMPos(List[i]).Value = Value then
    begin
      Exist := True;
      break;
    end;
  if not Exist then
  begin
    Pos := TfrxIEMPos.Create;
    Pos.Value := Value;
    List.Add(Pos);
  end;
end;

function TfrxIEMatrix.AddStyle(Obj: TfrxView): integer;
var
  Style: TfrxIEMStyle;
begin
  Style := TfrxIEMStyle.Create;
  if IsMemo(Obj) then
  begin
    if TfrxCustomMemoView(Obj).Highlight.Active and
       Assigned(TfrxCustomMemoView(Obj).Highlight.Font) then
    begin
      Style.Font.Assign(TfrxCustomMemoView(Obj).Highlight.Font);
      Style.Color := TfrxCustomMemoView(Obj).Highlight.Color;
    end else
    begin
      Style.Font.Assign(TfrxCustomMemoView(Obj).Font);
      Style.Color := TfrxCustomMemoView(Obj).Color;
    end;
    Style.HAlign := TfrxCustomMemoView(Obj).HAlign;
    Style.VAlign := TfrxCustomMemoView(Obj).VAlign;
    Style.LineSpacing := TfrxCustomMemoView(Obj).LineSpacing;
    Style.GapX := TfrxCustomMemoView(Obj).GapX;
    Style.GapY := TfrxCustomMemoView(Obj).GapY;
    Style.FrameTyp := TfrxCustomMemoView(Obj).Frame.Typ;
    Style.FrameWidth := TfrxCustomMemoView(Obj).Frame.Width;
    Style.FrameColor := TfrxCustomMemoView(Obj).Frame.Color;
    Style.FrameStyle := TfrxCustomMemoView(Obj).Frame.Style;
    Style.Rotation := TfrxCustomMemoView(Obj).Rotation;
  end
  else if IsLine(Obj) then
  begin
    Style.Color := Obj.Color;
    if Obj.Width = 0 then
      Style.FrameTyp := [ftLeft]
    else if Obj.Height = 0 then
      Style.FrameTyp := [ftTop]
    else  Style.FrameTyp := [];
    Style.FrameWidth := Obj.Frame.Width;
    Style.FrameColor := Obj.Frame.Color;
    Style.FrameStyle := Obj.Frame.Style;
    Style.Font.Name := 'Arial';
    Style.Font.Size := 1;
  end
  else if IsRect(Obj) then
  begin
    Style.Free;
    Result := -1;
    Exit;
  end
  else begin
    Style.Font.Assign(Obj.Font);
    Style.FrameTyp := [];
    Style.Color := Obj.Color;
    Style.FrameWidth := Obj.Frame.Width;
    Style.FrameColor := Obj.Frame.Color;
    Style.FrameStyle := Obj.Frame.Style;
    Style.FrameTyp := Obj.Frame.Typ;
  end;
  Result := AddStyleInternal(Style);
end;

function TfrxIEMatrix.AddStyleInternal(Style: TfrxIEMStyle): integer;
var
  i: integer;
  Style2: TfrxIEMStyle;
begin
  Result := -1;
  for i := 0 to FIEMStyleList.Count - 1 do
  begin
    Style2 := TfrxIEMStyle(FIEMStyleList[i]);
    if (Style.Font.Color = Style2.Font.Color) and
       (Style.Font.Name = Style2.Font.Name) and
       (Style.Font.Size = Style2.Font.Size) and
       (Style.Font.Style = Style2.Font.Style) and
       (Style.LineSpacing = Style2.LineSpacing) and
       (Style.GapX = Style2.GapX) and
       (Style.GapY = Style2.GapY) and
       (Style.HAlign = Style2.HAlign) and
       (Style.VAlign = Style2.VAlign) and
       (Style.FrameTyp = Style2.FrameTyp) and
       (Style.FrameWidth = Style2.FrameWidth) and
       (Style.FrameColor = Style2.FrameColor) and
       (Style.FrameStyle = Style2.FrameStyle) and
       (Style.Rotation = Style2.Rotation) and
       (Style.Color = Style2.Color) then
    begin
      Result := i;
      break;
    end;
  end;
  if Result = -1 then
  begin
    FIEMStyleList.Add(Style);
    Result := FIEMStyleList.Count - 1;
  end else
    Style.Free;
end;

procedure TfrxIEMatrix.Analyse;
var
  i, j, k: integer;
  dx, dy: integer;
  obj: TfrxIEMObjectList;
begin
  for i := 0 to FHeight - 1 do
    for j := 0 to FWidth - 1 do
    begin
      k := GetCell(j, i);
      if k <> -1 then
      begin
        obj := TfrxIEMObjectList(FIEMObjectList[k]);
        if not obj.Exist then
        begin
          FindRectArea(j, i, dx, dy);
          if (obj.x <> j) or (obj.y <> i) or
             (obj.dx <> dx) or (obj.dy <> dy) then
          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;
  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.LineSpacing := FOld.Style.LineSpacing;
    NewStyle.GapX := FOld.Style.GapX;
    NewStyle.GapY := FOld.Style.GapY;
    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;
  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