qexport4common.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

      Color := XLS_STANDARD_PALETTE[Integer(Format.Font.Color)];
      Style := [];
      if xfsBold in Format.Font.Style
        then Style := Style + [fsBold];
      if xfsItalic in Format.Font.Style
        then Style := Style + [fsItalic];
      if xfsStrikeOut in Format.Font.Style
        then Style := Style + [fsStrikeOut];
    end;

    case Format.Alignment.Horizontal of
      halGeneral,
      halLeft,
      halFill: X := 5;
      halCenter: X := (PaintBox.Width - PaintBox.Canvas.TextWidth(TXT)) div 2;
      halRight: X := PaintBox.Width - 5 - PaintBox.Canvas.TextWidth(TXT);
      else X := 0;
    end;

    case Format.Alignment.Vertical of
      valTop: Y := 5;
      valCenter: Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT)) div 2;
      valBottom: Y := PaintBox.Height - 5 - PaintBox.Canvas.TextHeight(TXT);
      else Y := 0;
    end;

    {$IFDEF WIN32}
    if Format.Font.Underline in [fulNone, fulSingle, fulSingleAccounting] then begin
      PaintBox.Canvas.Brush.Style := bsClear;
      PaintBox.Canvas.TextOut(X, Y, TXT);
    end;
    {$ENDIF}
    {$IFDEF LINUX}
      PaintBox.Canvas.Brush.Style := bsSolid; //bsClear;
      PaintBox.Canvas.TextOut(X, Y, TXT);
    {$ENDIF}

    // Underline
    {$IFDEF WIN32}
    if Format.Font.Underline <> fulNone then begin
      otm.otmSize := SizeOf(otm);
      GetOutlineTextMetrics(PaintBox.Canvas.Handle, otm.otmSize, @otm);
      USz := otm.otmsUnderscoreSize;
      UPz := otm.otmsUnderscorePosition;
      with PaintBox.Canvas do begin
        Pen.Color := Font.Color;
        Pen.Width := otm.otmsUnderscoreSize;
        if Format.Font.Underline in [fulDouble, fulDoubleAccounting] then begin
          case Format.Alignment.Vertical of
            valCenter:
              Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT) -
                USz - 1) div 2;
            valBottom: Y := PaintBox.Height - 5 -
              PaintBox.Canvas.TextHeight(TXT) - USz - 1;
          end;
          if Format.Alignment.Vertical in [valCenter, valBottom] then begin
            PaintBox.Canvas.Brush.Style := bsClear;
            PaintBox.Canvas.TextOut(X, Y, TXT);
          end;
        end;

        case Format.Font.Underline of
          fulSingle: begin
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz);
          end;
          fulSingleAccounting : begin
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
          end;
          fulDouble: begin
            MoveTo(X, Y + TextHeight(TXT) + Upz);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz);
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            LineTo(X + TextWidth(TXT), Y + TextHeight(TXT) + UPz + USz + 1);
          end;
          fulDoubleAccounting: begin
            XX := X;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz);

            X := XX;
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + USz * 4;
            MoveTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
            X := X + TextWidth(TXT) div 2 - USz * 2;
            LineTo(X, Y + TextHeight(TXT) + UPz + USz + 1);
          end;
        end;
      end;
    end
    {$ENDIF}
  end;

  procedure DrawBorderLine(X1, Y1, X2, Y2: integer; Border: TxlsBorder);
  begin
    with PaintBox.Canvas do begin
      Pen.Style := psSolid;
      Pen.Color := ColorByXLSColor(Border.Color);

      case Border.Style of
        bstThin, bstDashed, bstDotted,
        bstDouble, bstHair, bstDashDot,
        bstDashDotDot: Pen.Width := 1;

        bstMedium, bstMediumDashed,
        bstMediumDashDot, bstMediumDashDotDot,
        bstSlantedDashDot: Pen.Width := 2;

        bstThick: Pen.Width := 3;
      end;

      case Border.Style of
        bstThin,
        bstMedium,
        bstThick: begin
          MoveTo(X1, Y1);
          LineTo(X2, Y2);
        end;

        bstDashed,
        bstMediumDashed,
        bstDashDot,
        bstMediumDashDot,
        bstSlantedDashDot,
        bstDashDotDot,
        bstMediumDashDotDot: begin
          if X2 > X1 then
            while X2 - X1 > 5 do begin
              MoveTo(X1, Y1);
              if X2 > X1 then
                if X2 - X1 >= 10
                  then LineTo(X1 + 10, Y1)
                  else LineTo(X2, Y1);
              Inc(X1, 15);

              if Border.Style in [bstDashDot, bstMediumDashDot,
              bstSlantedDashDot, bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if X2 > X1 then
                  if X2 - X1 >= 2
                    then LineTo(X1 + 2, Y1)
                    else LineTo(X2, Y1);
                Inc(X1, 7);
              end;

              if Border.Style in [bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if X2 > X1 then
                  if X2 - X1 >= 2
                    then LineTo(X1 + 2, Y1)
                    else LineTo(X2, Y1);
                Inc(X1, 7);
              end;

            end;

          if Y2 > Y1 then
            while Y2 - Y1 > 5 do begin
              MoveTo(X1, Y1);
              if Y2 > Y1 then
                if Y2 - Y1 >= 10
                  then LineTo(X1, Y1 + 10)
                  else LineTo(X1, Y2);
              Inc(Y1, 15);

              if Border.Style in [bstDashDot, bstMediumDashDot,
              bstSlantedDashDot, bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if Y2 > Y1 then
                  if Y2 - Y1 >= 2
                    then LineTo(X1, Y1 + 2)
                    else LineTo(X1, Y2);
                Inc(Y1, 7);
              end;

              if Border.Style in [bstDashDotDot, bstMediumDashDotDot] then begin
                MoveTo(X1, Y1);
                if Y2 > Y1 then
                  if Y2 - Y1 >= 2
                    then LineTo(X1, Y1 + 2)
                    else LineTo(X1, Y2);
                Inc(Y1, 7);
              end;

            end;
        end;

        bstDotted,
        bstHair: begin
          if X2 > X1 then
            while X2 - X1 > 1 + Integer(Border.Style = bstDotted) do begin
              MoveTo(X1, Y1);
              if X2 - X1 >= 1 + Integer(Border.Style = bstDotted)
                then LineTo(X1 + 1 + Integer(Border.Style = bstDotted), Y1)
                else LineTo(X2, Y1);
              Inc(X1, 3 + 2 * Integer(Border.Style = bstDotted));
            end;

          if Y2 > Y1 then
            while Y2 - Y1 > 1 + Integer(Border.Style = bstDotted) do begin
              MoveTo(X1, Y1);
              if Y2 - Y1 >= 1 + Integer(Border.Style = bstDotted)
                then LineTo(X1, Y1 + 1 + Integer(Border.Style = bstDotted))
                else LineTo(X1, Y2);
              Inc(Y1, 3 + 2 * Integer(Border.Style = bstDotted));
            end;
        end;

        bstDouble: begin
          if X1 <> X2 then begin
            if X1 = Y1 then begin
              MoveTo(X1, Y1);
              LineTo(X2, Y2);
              MoveTo(X1, Y1 + 2);
              LineTo(X2, Y2 + 2);
            end
            else begin
              MoveTo(X1, Y1 - 2);
              LineTo(X2, Y2 - 2);
              MoveTo(X1, Y1);
              LineTo(X2, Y2);
            end;
          end;
          if Y1 <> Y2 then begin
            if X1 = Y1 then begin
              MoveTo(X1, Y1);
              LineTo(X2, Y2);
              MoveTo(X1 + 2, Y1);
              LineTo(X2 + 2, Y2);
            end
            else begin
              MoveTo(X1 - 2, Y1);
              LineTo(X2 - 2, Y2);
              MoveTo(X1, Y1);
              LineTo(X2, Y2);
            end;
          end;
        end;

      end;

    end;
  end;

  procedure DrawBorders;
  begin
    if Format.Borders.Top.Style <> bstNone then
      DrawBorderLine(2, 2, PaintBox.Width - 2, 2, Format.Borders.Top);
    if Format.Borders.Bottom.Style <> bstNone then
      DrawBorderLine(2, PaintBox.Height - 2, PaintBox.Width - 2,
        PaintBox.Height - 2, Format.Borders.Bottom);
    if Format.Borders.Left.Style <> bstNone then
      DrawBorderLine(2, 2, 2, PaintBox.Height - 2, Format.Borders.Left);
    if Format.Borders.Right.Style <> bstNone then
      DrawBorderLine(PaintBox.Width - 2, 2, PaintBox.Width - 2,
        PaintBox.Height - 2, Format.Borders.Right);
  end;

  procedure DrawPatterns;
  var
    X, Y: integer;
  begin
    X := 0;
    Y := 0;
    {$IFDEF LINUX}
    PaintBox.Canvas.Brush.Style := bsSolid;
    {$ENDIF}
    PaintBox.Canvas.Brush.Color := ColorByXLSColor(Format.Fill.Background);
    PaintBox.Canvas.FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
    PaintBox.Canvas.Pen.Width := 1;
    PaintBox.Canvas.Pen.Color := ColorByXLSColor(Format.Fill.Foreground);
    while Y <= PaintBox.Height - 4 do begin
      while X <= PaintBox.Width do begin
        DrawPattern(PaintBox.Canvas, Integer(Format.Fill.Pattern), X, Y);
        Inc(X, 4);
      end;
      Inc(Y, 4);
      X := 0;
    end
  end;

begin
  DrawPatterns;
  OutText;
  DrawBorders;
end;

procedure DrawRTFSample(PaintBox: TPaintBox; rtfStyle: TrtfStyle);
  procedure FillBackground;
  begin
    if rtfStyle.AllowBackground
      then  PaintBox.Canvas.Brush.Color := rtfStyle.BackgroundColor
      else  PaintBox.Canvas.Brush.Color := clWhite;
    PaintBox.Canvas.FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;

  procedure OutText;
  const
    TXT = 'Aa Zz';
  var
    H, W, X, Y: integer;
  begin
    with PaintBox.Canvas.Font do begin
      Name := rtfStyle.Font.Name;
      Size := rtfStyle.Font.Size;
      Charset := rtfStyle.Font.Charset;
      Color := rtfStyle.Font.Color;
      Style := rtfStyle.Font.Style;
    end;

    H := PaintBox.Canvas.TextHeight(TXT);
    W := PaintBox.Canvas.TextWidth(TXT);
    if H > PaintBox.Height then
      H := PaintBox.Height;
    if W > PaintBox.Width then
      W := PaintBox.Width;
//    X := 5;
    X := (PaintBox.Width - W) div 2;
    Y := (PaintBox.Height - H) div 2;

    if rtfStyle.AllowHighlight and
         (rtfStyle.HighlightColor <> rtfStyle.BackgroundColor) then begin
      PaintBox.Canvas.Brush.Color := rtfStyle.HighlightColor;
      PaintBox.Canvas.FillRect(Rect(X, Y, X + W, Y + H));
    end;

{    case Format.Alignment.Horizontal of
      halGeneral,
      halLeft,
      halFill: X := 5;
      halCenter: X := (PaintBox.Width - PaintBox.Canvas.TextWidth(TXT)) div 2;
      halRight: X := PaintBox.Width - 5 - PaintBox.Canvas.TextWidth(TXT);
      else X := 0;
    end;

    case Format.Alignment.Vertical of
      valTop: Y := 5;
      valCenter: Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT)) div 2;
      valBottom: Y := PaintBox.Height - 5 - PaintBox.Canvas.TextHeight(TXT);
      else Y := 0;
    end;}

    PaintBox.Canvas.TextOut(X, Y, TXT);

    //otm.otmSize := SizeOf(otm);
    //GetOutlineTextMetrics(PaintBox.Canvas.Handle, otm.otmSize, @otm);
  end;

begin
  FillBackground;
  OutText;
end;

procedure DrawPDFSample(PaintBox: TPaintBox; PDFFont: TFont);
  procedure FillBackground;
  begin
    PaintBox.Canvas.Brush.Color := clWhite;
    PaintBox.Canvas.FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;

  procedure OutText;
  const
    TXT = 'Aa Zz';
  var
    X, Y: integer;
  begin
    with PaintBox.Canvas.Font do begin
      Name := PDFFont.Name;
      Size := PDFFont.Size;
      Charset := PDFFont.Charset;
      Color := PDFFont.Color;
      Style := PDFFont.Style - [fsStrikeOut, fsUnderline];
    end;

    X := (PaintBox.Width - PaintBox.Canvas.TextWidth(TXT)) div 2;
    Y := (PaintBox.Height - PaintBox.Canvas.TextHeight(TXT)) div 2;

    PaintBox.Canvas.TextOut(X, Y, TXT);

  end;