frxexportmatrix.pas

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

  else FObj.Left := 0;
  if Obj.AbsTop >= 0 then
    FObj.Top := FDeltaY + Obj.AbsTop
  else FObj.Top := FDeltaY;
  FObj.Width := Obj.Width;
  FObj.Height := Obj.Height;
  if IsMemo(Obj) then
  begin
    // Memo
    if (FDeleteHTMLTags and TfrxCustomMemoView(Obj).AllowHTMLTags) or FWrap then
      FObj.Memo.Text := TfrxCustomMemoView(Obj).WrapText(True)
    else
      FObj.Memo := TfrxCustomMemoView(Obj).Memo;
    if not FDeleteHTMLTags then
      FObj.HTMLTags := TfrxCustomMemoView(Obj).AllowHTMLTags;
    {if TfrxCustomMemoView(Obj).Font.Charset <> DEFAULT_CHARSET then}
    if TfrxCustomMemoView(Obj).Font.Charset = OEM_CHARSET then
      FObj.Memo.Text := AnsiToUnicode(OemToStr(_UnicodeToAnsi(FObj.Memo.Text, OEM_CHARSET)), DEFAULT_CHARSET);
        {FObj.Memo.Text := AnsiToUnicode(FObj.Memo.Text, TfrxCustomMemoView(Obj).Font.Charset)
      else}
    FObj.IsText := True;
    FObj.IsRichText := False;
    FObj.RTL := TfrxCustomMemoView(Obj).RTLReading;
  end
  else if (Obj.ClassName = 'TfrxRichView') and (FRichText) then
  begin
    // Rich
    FObj.IsText := True;
    FObj.IsRichText := True;
    FObj.Memo.Text := AnsiToUnicode(AnsiString(Obj.GetComponentText), DEFAULT_CHARSET);
  end
  else if IsLine(Obj) then
  begin
    // Line
    FObj.IsText := True;
    FObj.IsRichText := False;
    if FObj.Left > (FObj.Left + FObj.Width) then
    begin
      FObj.Left := FObj.Left + FObj.Width;
      FObj.Width := -FObj.Width;
    end;
    if FObj.Top > (FObj.Top + Obj.Height) then
    begin
      FObj.Top := FObj.Top + FObj.Height;
      FObj.Height := -FObj.Height;
    end;
    if FObj.Width = 0 then
      FObj.Width := 1;
    if FObj.Height = 0 then
      FObj.Height := 1;
  end
  else if IsRect(Obj) then
  begin
    if Obj.Color = clNone then
    begin
      // Rect as lines
      Line := TfrxCustomLineView.Create(nil);
      Line.Name := 'Line';
      Line.Frame.Assign(Obj.Frame);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop;
      Line.Width := Obj.Width;
      Line.Height := 0;
      AddObject(Line);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop;
      Line.Width := 0;
      Line.Height := Obj.Height;
      AddObject(Line);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop + Obj.Height;
      Line.Width := Obj.Width;
      Line.Height := 0;
      AddObject(Line);
      Line.Left := Obj.AbsLeft + Obj.Width;
      Line.Top := Obj.AbsTop;
      Line.Width := 0;
      Line.Height := Obj.Height;
      AddObject(Line);
      Line.Free;
    end else
    begin
      // Rect as memo
      Memo := TfrxCustomMemoView.Create(nil);
      Memo.Frame.Assign(Obj.Frame);
      Memo.Name := 'Rect';
      Memo.Color := Obj.Color;
      Memo.Left := Obj.AbsLeft;
      Memo.Top := Obj.AbsTop;
      Memo.Width := Obj.Width;
      Memo.Height := Obj.Height;
      Memo.Frame.Typ := [ftLeft, ftTop, ftRight, ftBottom];
      Memo.Font.Size := 1;
      AddObject(Memo);
      Memo.Free;
    end;
    FObj.Free;
    Exit;
  end
  else begin
    // Bitmap
    if (not ((Obj.Name = '_pagebackground') and (not FBackImage))) and FImages and (Obj.ClassName <> 'TfrxGradientView') then
    begin
      if (Obj.Frame.Typ <> []) and (Obj.Frame.Width > 0) then
      begin
        OldFrameWidth := Obj.Frame.Width;
        Obj.Frame.Width := 0;
      end;
      FObj.IsText := False;
      FObj.IsRichText := False;

      FRealBounds := Obj.GetRealBounds;
      dx := FRealBounds.Right - FRealBounds.Left;
      dy := FRealBounds.Bottom - FRealBounds.Top;

      if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
        fdx := 0
      else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
        fdx := (dx - Obj.Width)
      else
        fdx := (dx - Obj.Width) / 2;

      if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
        fdy := 0
      else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
        fdy := (dy - Obj.Height)
      else
        fdy := (dy - Obj.Height) / 2;

      DrawPosX := Obj.AbsLeft - fdx;
      DrawPosY := Obj.AbsTop - fdy;
      FObj.Left := FObj.Left - fdx;
      FObj.Top := FObj.Top - fdy;

      if Round(dx) = 0 then
        dx := 1;
      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;
      if FEMFPictures then
      begin
        FObj.Metafile.Height := Round(dy);
        FObj.Metafile.Width := Round(dx);
        FObj.MetafileCanvas := TMetafileCanvas.Create(FObj.Metafile, 0);
        try
          if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
            Obj.Frame.Width := OldFrameWidth;
          TfrxView(Obj).Draw(FObj.MetafileCanvas,  1,  1, -DrawPosX, -DrawPosY);
          if OldFrameWidth > 0 then
            Obj.Frame.Width := OldFrameWidth;
        finally
          FObj.MetafileCanvas.Free;
        end;
      end
      else
      begin
        FObj.Image := TBitmap.Create;
        FObj.Image.PixelFormat := pf24bit;
        FObj.Image.Height := Round(dy) + 1;
        FObj.Image.Width := Round(dx) + 1;
        if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
          Obj.Frame.Width := OldFrameWidth;
        TfrxView(Obj).Draw(FObj.Image.Canvas, 1, 1, -DrawPosX, -DrawPosY);
        if OldFrameWidth > 0 then
          Obj.Frame.Width := OldFrameWidth;
      end;
    end
  end;

  if (Obj.Parent <> nil) and ((FHeader <> nil) or (FFooter <> nil)) then
  begin
    FObj.Header := Obj.Parent = FHeader;
    FObj.Footer := Obj.Parent = FFooter;
  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 := RightMargin;
  page.BottomMargin := BottomMargin;
  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;
  MObj: TfrxCustomMemoView;
begin
  Style := TfrxIEMStyle.Create;
  if IsMemo(Obj) then
  begin
    MObj := TfrxCustomMemoView(Obj);
    if MObj.Highlight.Active and
       Assigned(MObj.Highlight.Font) then
    begin
      Style.Font.Assign(MObj.Highlight.Font);
      if FDotMatrix then
        Style.Font.Size := DOT_MATRIX_FONT_SIZE;
      Style.Color := MObj.Highlight.Color;
    end else
    begin
      Style.Font.Assign(MObj.Font);
      if FDotMatrix then
        Style.Font.Size := DOT_MATRIX_FONT_SIZE;
      Style.Color := MObj.Color;
    end;
    Style.DisplayFormat := MObj.DisplayFormat;
    Style.HAlign := MObj.HAlign;
    Style.VAlign := MObj.VAlign;
    Style.LineSpacing := MObj.LineSpacing;
    Style.GapX := MObj.GapX;
    Style.GapY := MObj.GapY;
    if MObj.Font.Charset = 1 then
      Style.Charset := GetFontCharset(MObj.Font)
    else
      Style.Charset := MObj.Font.Charset;
    Style.CharSpacing := MObj.CharSpacing;
    Style.ParagraphGap := MObj.ParagraphGap;
    Style.WordBreak := MObj.WordBreak;
    Style.FrameTyp := MObj.Frame.Typ;
    Style.FrameWidth := MObj.Frame.Width;
    Style.FrameColor := MObj.Frame.Color;
    Style.FrameStyle := MObj.Frame.Style;
    Style.Rotation := MObj.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);
    if FDotMatrix then
      Style.Font.Size := DOT_MATRIX_FONT_SIZE;
    Style.Color := Obj.Color;
    Style.FrameWidth := Obj.Frame.Width;
    Style.FrameColor := Obj.Frame.Color;
    Style.FrameStyle := Obj.Frame.Style;
    if Obj is TfrxCustomLineView then
      Style.FrameTyp := []
    else
      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.Size = Style2.Font.Size) and
       (Style.HAlign = Style2.HAlign) and
       (Style.VAlign = Style2.VAlign) and
       (Style.Font.Color = Style2.Font.Color) and
       (Style.Font.Name = Style2.Font.Name) and
       (Style.Font.Style = Style2.Font.Style) and
       (Style.FrameTyp = Style2.FrameTyp) and
       (Style.FrameWidth = Style2.FrameWidth) and
       (Style.FrameColor = Style2.FrameColor) and
       (Style.FrameStyle = Style2.FrameStyle) and
       (Style.Color = Style2.Color) and
       (Style.DisplayFormat.Kind = Style2.DisplayFormat.Kind) and
       (Style.DisplayFormat.DecimalSeparator = Style2.DisplayFormat.DecimalSeparator) and
       (Style.DisplayFormat.FormatStr = Style2.DisplayFormat.FormatStr) and
       (Style.LineSpacing = Style2.LineSpacing) and
       (Style.GapX = Style2.GapX) and
       (Style.GapY = Style2.GapY) and
       (Style.ParagraphGap = Style2.ParagraphGap) and
       (Style.CharSpacing = Style2.CharSpacing) and
       (Style.Charset = Style2.Charset) and
       (Style.WordBreak = Style2.WordBreak) and
       (Style.Rotation = Style2.Rotation) and
       (Style.BrushStyle = Style2.BrushStyle) 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