frxpdffile.pas

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

    if Parent.FCompressed then
    begin
      if Parent.Protection then
        CryptStream(TmpPageStream, Stream, Parent.FEncKey, id)
      else
        Stream.CopyFrom(TmpPageStream, 0);
      WriteLn(Stream, '');
    end else
      if Parent.Protection then
        CryptStream(TmpPageStream2, Stream, Parent.FEncKey, id)
      else
        Stream.CopyFrom(TmpPageStream2, 0);
  finally
    TmpPageStream2.Free;
    TmpPageStream.Free;
  end;
  WriteLn(Stream, 'endstream');
  WriteLn(Stream, 'endobj');
end;

function TfrxPDFPage.CodepageByCharset(const Charset: Integer): Integer;
var
  i: Integer;
begin
  if Charset = DEFAULT_CHARSET then
    i := FDefFontCharSet
  else
    i := CharSet;
  case i of
    EASTEUROPE_CHARSET:   Result := 1250;
    RUSSIAN_CHARSET:      Result := 1251;
    GREEK_CHARSET:        Result := 1253;
    TURKISH_CHARSET:      Result := 1254;
    HEBREW_CHARSET:       Result := 1255;
    ARABIC_CHARSET:       Result := 1256;
    BALTIC_CHARSET:       Result := 1257;
    VIETNAMESE_CHARSET:   Result := 1258;
    JOHAB_CHARSET:        Result := 1361;
    THAI_CHARSET:         Result := 874;
    SHIFTJIS_CHARSET:     Result := 932;
    GB2312_CHARSET:       Result := 936;
    HANGEUL_CHARSET:      Result := 949;
    CHINESEBIG5_CHARSET:  Result := 950;
    SYMBOL_CHARSET:       Result := 42;
    OEM_CHARSET:          Result := CP_OEMCP;
  else
    Result := 1252;
  end;
end;

procedure TfrxPDFPage.AddObject(const Obj: TfrxView);
var
  FontIndex: Integer;
  x, y, dx, dy, fdx, fdy, PGap, FCharSpacing, ow, oh: Extended;
  i, iz: Integer;
  Jpg: TJPEGImage;
  s: AnsiString;
  su: WideString;
  Lines: TWideStrings;
  TempBitmap: TBitmap;
  OldFrameWidth: Extended;
  TempColor: TColor;
  Left, Right, Top, Bottom, Width, Height, BWidth, BHeight: String;
  FUnderlineSize: Double;
  FRealBounds: TfrxRect;
  FLineHeight: Extended;
  FTextHeight: Extended;
  FHeightWoMargin: Extended;
  FTextWidth: Extended;
  alpha, cosa, sina, rx, ry: Extended;

  function GetLeft(const Left: Extended): Extended;
  begin
    Result := FMarginLeft + Left * PDF_DIVIDER
  end;

  function GetTop(const Top: Extended): Extended;
  begin
    Result := FHeightWoMargin - Top * PDF_DIVIDER
  end;

  function GetVTextPos(const Top: Extended; const Height: Extended;
    const Text: String; const Align: TfrxVAlign; const Line: Integer = 0;
    const Count: Integer = 1): Extended;
  var
    i: Integer;
  begin
    if Line <= Count then
      i := Line
    else
      i := 0;
    if Align = vaBottom then
      Result := Top + Height - FLineHeight * (Count - i - 1)
    else if Align = vaCenter then
      Result := Top + (Height - (FLineHeight * Count)) / 2 + FLineHeight * (i + 1)
    else
      Result := Top + FLineHeight * i + FTextHeight;
  end;

  function GetHTextPos(const Left: Extended; const Width: Extended; const CharSpacing: Extended; const Text: String;
    const Align: TfrxHAlign): Extended;
  begin
    if (Align = haLeft) or (Align = haBlock) then
      Result := Left
    else begin
      FBMP.Canvas.Lock;
      try
        FBMP.Canvas.Font.Assign(frxDrawText.Canvas.Font);
        FTextWidth := FBMP.Canvas.TextWidth(Text) / FDivider + Length(Text) * CharSpacing;
      finally
        FBMP.Canvas.Unlock;
      end;
      if Align = haCenter then
        Result := Left + (Width - FTextWidth) / 2
      else
        Result := Left + Width - FTextWidth;
    end;
  end;

  function GetPDFColor(const Color: TColor): String;
  var
    TheRgbValue : TColorRef;
  begin
    if Color = clBlack then
      Result := '0 0 0'
    else if Color = clWhite then
      Result := '1 1 1'
    else if Color = FLastColor then
      Result := FLastColorResult
    else begin
      TheRgbValue := ColorToRGB(Color);
      Result:= frFloat2Str(Byte(TheRGBValue) / 255) + ' ' +
        frFloat2Str(Byte(TheRGBValue shr 8) / 255) + ' ' +
        frFloat2Str(Byte(TheRGBValue shr 16) / 255);
      FLastColor := Color;
      FLastColorResult := Result;
    end;
  end;

  procedure MakeUpFrames;
  begin
    if (Obj.Frame.Typ <> []) and (Obj.Frame.Color <> clNone) then
    begin
      Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
        frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10);
      if Obj.Frame.Typ = [ftTop, ftRight, ftBottom, ftLeft] then
        Write(OutStream, Left + ' ' + Top + ' m'#13#10 + Right + ' ' + Top + ' l'#13#10 +
          Right + ' ' + Bottom + ' l'#13#10 + Left + ' ' + Bottom + ' l'#13#10 +
          Left + ' ' + Top + ' l'#13#10's'#13#10)
      else
      begin
        if ftTop in Obj.Frame.Typ then
          Write(OutStream, Left + ' ' + Top + ' m'#13#10 + Right + ' ' + Top + ' l'#13#10'S'#13#10);
        if ftRight in Obj.Frame.Typ then
          Write(OutStream, Right + ' ' + Top + ' m'#13#10 + Right + ' ' + Bottom + ' l'#13#10'S'#13#10);
        if ftBottom in Obj.Frame.Typ then
          Write(OutStream, Left + ' ' + Bottom + ' m'#13#10 + Right + ' ' + Bottom + ' l'#13#10'S'#13#10);
        if ftLeft in Obj.Frame.Typ then
          Write(OutStream, Left + ' ' + Top + ' m'#13#10 + Left + ' ' + Bottom + ' l'#13#10'S'#13#10);
      end;
    end;
  end;

  function HTMLTags(const View: TfrxCustomMemoView): Boolean;
  begin
    if View.AllowHTMLTags then
      Result := FParent.HTMLTags and (Pos('<' ,View.Memo.Text) > 0)
    else
      Result := False;
  end;

  function TruncReturns(const Str: WideString): WideString;
  var
    l: Integer;
  begin
    l := Length(Str);
    if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
      Result := Copy(Str, 1, l - 2)
    else
      Result := Str;
  end;

  function CheckOutPDFChars(const Str: WideString): WideString;
  var
    i: Integer;
  begin
    Result := '';
    for i := 1 to Length(Str) do
      if Str[i] = '\' then
        Result := Result + '\\'
      else if Str[i] = '(' then
        Result := Result + '\('
      else if Str[i] = ')' then
        Result := Result + '\)'
      else
        Result := Result + Str[i];
  end;

  function Str2RTL(const Str: WideString): WideString;
  var
    DC: HDC;
{$IFDEF Delphi10}
    GCP: TGCPResultsW;
{$ELSE}
    GCP: TGCPResults;
{$ENDIF}
    buffer: WideString;
    len: Integer;
  begin
    len := Length(Str);
    SetLength(buffer, Len);
    DC := GetDc(0);
    try
{$IFDEF Delphi10}
      GCP.lStructSize := SizeOf(TGCPResultsW);
{$ELSE}
      GCP.lStructSize := SizeOf(TGCPResults);
{$ENDIF}
      GCP.lpOutString := Pointer(buffer);
      GCP.lpOrder := nil;
      GCP.lpDx := nil;
      GCP.lpCaretPos := nil;
      GCP.lpClass := nil;
      GCP.lpGlyphs := nil;
      GCP.nGlyphs := len;
      GCP.nMaxFit := 0;
{$IFNDEF Delphi7}
      GetCharacterPlacementW(DC, pointer(Str), LongBool(len), LongBool(512), GCP, GCP_REORDER or GCP_DIACRITIC);
{$ELSE}
  {$IFDEF Delphi9}
    {$IFDEF Delphi10}
      GetCharacterPlacementW(DC, pointer(Str), len, 512, GCP, DWORD(GCP_REORDER or GCP_DIACRITIC));
    {$ELSE}
      GetCharacterPlacementW(DC, pointer(Str), LongBool(len), LongBool(512), GCP, GCP_REORDER or GCP_DIACRITIC);
    {$ENDIF}
  {$ELSE}
      GetCharacterPlacementW(DC, pointer(Str), len, 512, GCP, GCP_REORDER or GCP_DIACRITIC);
  {$ENDIF}
{$ENDIF}
      buffer := Copy(buffer, 1, len);
    finally
      ReleaseDc(0, DC);
    end;
    Result := buffer;
  end;

  procedure DrawArrow(Obj: TfrxCustomLineView; x1, y1, x2, y2: Extended);
  var
    k1, a, b, c, D: Double;
    xp, yp, x3, y3, x4, y4, ld, wd: Extended;
  begin
    wd := Obj.ArrowWidth * PDF_DIVIDER;
    ld := Obj.ArrowLength * PDF_DIVIDER;
    if abs(x2 - x1) > 0 then
    begin
      k1 := (y2 - y1) / (x2 - x1);
      a := Sqr(k1) + 1;
      b := 2 * (k1 * ((x2 * y1 - x1 * y2) / (x2 - x1) - y2) - x2);
      c := Sqr(x2) + Sqr(y2) - Sqr(ld) + Sqr((x2 * y1 - x1 * y2) / (x2 - x1)) -
        2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1);
      D := Sqr(b) - 4 * a * c;
      xp := (-b + Sqrt(D)) / (2 * a);
      if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then
        xp := (-b - Sqrt(D)) / (2 * a);
      yp := xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1);
      if y2 <> y1 then
      begin
        x3 := xp + wd * sin(ArcTan(k1));
        y3 := yp - wd * cos(ArcTan(k1));
        x4 := xp - wd * sin(ArcTan(k1));
        y4 := yp + wd * cos(ArcTan(k1));
      end
      else
      begin
        x3 := xp; y3 := yp - wd;
        x4 := xp; y4 := yp + wd;
      end;
    end
    else
    begin
      xp := x2;
      yp := y2 - ld;
      if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then
        yp := y2 + ld;
      x3 := xp - wd; y3 := yp;
      x4 := xp + wd; y4 := yp;
    end;
    WriteLn(OutStream, frFloat2Str(x3) + ' ' + frFloat2Str(y3) + ' m'#13#10 +
      frFloat2Str(x2) + ' ' + frFloat2Str(y2) + ' l'#13#10 +
      frFloat2Str(x4) + ' ' + frFloat2Str(y4) + ' l');
    if Obj.ArrowSolid then
      WriteLn(OutStream, '1 j'#13#10 + GetPDFColor(Obj.Frame.Color) + ' rg'#13#10'b')
    else
      WriteLn(OutStream, 'S');
  end;

begin
  FHeightWoMargin := FHeight - FMarginTop;
  Left := frFloat2Str(GetLeft(Obj.AbsLeft));
  Top := frFloat2Str(GetTop(Obj.AbsTop));
  Right := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width));
  Bottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height));
  Width := frFloat2Str(Obj.Width * PDF_DIVIDER);
  Height := frFloat2Str(Obj.Height * PDF_DIVIDER);

  OldFrameWidth := 0;
  // Text
  if (Obj is TfrxCustomMemoView){ and (TfrxCustomMemoView(Obj).Rotation = 0)} and
     (TfrxCustomMemoView(Obj).BrushStyle in [bsSolid, bsClear]) and
     (not HTMLTags(TfrxCustomMemoView(Obj))) then
  begin
    // save clip to stack
    Write(OutStream, 'q'#13#10);
    Write(OutStream,  frFloat2Str(GetLeft(Obj.AbsLeft - Obj.Frame.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.Width)) + ' ' +
      frFloat2Str((Obj.Width + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' ' + frFloat2Str((Obj.Height + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' re'#13#10'W'#13#10'n'#13#10);
    ow := Obj.Width - Obj.Frame.ShadowWidth;
    oh := Obj.Height - Obj.Frame.ShadowWidth;
    // Shadow
    if Obj.Frame.DropShadow then
    begin
      Width := frFloat2Str(ow * PDF_DIVIDER);
      Height := frFloat2Str(oh * PDF_DIVIDER);
      Right := frFloat2Str(GetLeft(Obj.AbsLeft + ow));
      Bottom := frFloat2Str(GetTop(Obj.AbsTop + oh));
      s := AnsiString(GetPDFColor(Obj.Frame.ShadowColor));
      Write(OutStream, s + ' rg'#13#10 + s + ' RG'#13#10 +
        AnsiString(frFloat2Str(GetLeft(Obj.AbsLeft + ow)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
        frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' ' + frFloat2Str(oh * PDF_DIVIDER) + ' re'#13#10'B'#13#10 +
        frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Frame.ShadowWidth)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
        frFloat2Str(ow * PDF_DIVIDER) + ' ' + frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' re'#13#10'B'#13#10));
    end;
    if TfrxCustomMemoView(Obj).Highlight.Active and
       Assigned(TfrxCustomMemoView(Obj).Highlight.Font) then
    begin
      Obj.Font.Assign(TfrxCustomMemoView(Obj).Highlight.Font);
      Obj.Color := TfrxCustomMemoView(Obj).Highlight.Color;
    end;
    if Obj.Color <> clNone then
      Write(OutStream, GetPDFColor(Obj.Color) + ' rg'#13#10 + Left + ' ' + Bottom + ' ' +
        Width + ' ' + Height + ' re'#13#10'f'#13#10);
    // Frames
    MakeUpFrames;
{$IFDEF Delphi10}
    Lines := TfrxWideStrings.Create;
{$ELSE}
    Lines := TWideStrings.Create;
{$ENDIF}
    Lines.Text := TfrxCustomMemoView(Obj).WrapText(True);
    if Lines.Count > 0 then
    begin
      FontIndex := Parent.AddFont(Obj.Font);
      Write(OutStream, '/F' + IntToStr(TfrxPDFFont(Parent.FFonts[FontIndex]).Index - 1) +
        ' ' + IntToStr(Obj.Font.Size) + ' Tf'#13#10);
      if Obj.Font.Color <> clNone then
        TempColor := Obj.Font.Color
      else
        TempColor := clBlack;
      Write(OutStream, GetPDFColor(TempColor) + ' rg'#13#10);
      FCharSpacing := TfrxCustomMemoView(Obj).CharSpacing * PDF_DIVIDER;
      if TfrxCustomMemoView(Obj).CharSpacing <> 0 then
        Write(OutStream, frFloat2Str(FCharSpacing) + ' Tc'#13#10);

      pdfCS.Enter;
      try
        frxDrawText.SetFont(TfrxCustomMemoView(Obj).Font);
        frxDrawText.SetGaps(0, 0, TfrxCustomMemoView(Obj).LineSpacing);
        FLineHeight := frxDrawText.LineHeight;
        FTextHeight := frxDrawText.TextHeight;
        // Underlines by FuxMedia
        if TfrxCustomMemoView(Obj).Underlines then
        begin
          iz := Trunc(Obj.Height / FLineHeight);
          for i:= 0 to iz do
          begin
            y := GetTop(GetVTextPos(Obj.AbsTop + TfrxCustomMemoView(Obj).GapY + 1,
              Obj.Height - TfrxCustomMemoView(Obj).GapY * 2,
              'XYZ', TfrxCustomMemoView(Obj).VAlign, i, iz));
            Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
              frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
              Left + ' ' + frFloat2Str(y) + ' m'#13#10 +
              Right + ' ' + frFloat2Str(y) + ' l'#13#10'S'#13#10);
          end;
        end;
        // output lines of memo
        FUnderlineSize := Obj.Font.Size * 0.12;