vpdfwmf.pas

生成PDF文档的控件

    begin
      FPage.LineTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
      Inc(SCrank);
    end;
  end;
  if not PathContinue then StrokeOrPath;
end;

procedure TVPDFWmf.VEMRANGLEARC(Data: PEMRAngleArc);
begin
  FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
  FPage.LineTo(ScaleX(Data^.ptlCenter.x + cos(Data^.eStartAngle * Pi / 180) *
    Data^.nRadius), ScaleY(Data^.ptlCenter.y -
    sin(Data^.eStartAngle * Pi / 180) * Data^.nRadius));
  FPage.Ellipse(ScaleX(data^.ptlCenter.x - Integer(Data^.nRadius)),
    ScaleY(data^.ptlCenter.y - Integer(Data^.nRadius)),
    ScaleX(Integer(Data^.nRadius * 2)), ScaleY(Integer(Data^.nRadius * 2)));
  CurrentVal := Point(Round(Data^.ptlCenter.x + cos((Data^.eStartAngle +
    Data^.eSweepAngle) * Pi / 180) * Data^.nRadius),
    Round(Data^.ptlCenter.y - sin((Data^.eStartAngle + Data^.eSweepAngle) *
    Pi / 180) * Data^.nRadius));
  if not PathContinue then
    StrokeOrPath;
end;

procedure TVPDFWmf.VEMRARC(Data: PEMRArc);
begin
  if (not IsCounterClockwise) then
    FPage.DrawArc(ScaleX(Data^.rclBox.Left), ScaleY(Data^.rclBox.Top),
      ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
      ScaleX(Data^.ptlStart.x), ScaleY(Data^.ptlStart.y),
      ScaleX(Data^.ptlEnd.x),
      ScaleY(Data^.ptlEnd.y))
  else
    FPage.DrawArc(ScaleX(Data^.rclBox.Left), ScaleY(Data^.rclBox.Top),
      ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
      ScaleX(Data^.ptlEnd.x), ScaleY(Data^.ptlEnd.y),
      ScaleX(Data^.ptlStart.x),
      ScaleY(Data^.ptlStart.y));
  if not PathContinue then StrokeOrPath;
end;

procedure TVPDFWmf.VEMRARCTO(Data: PEMRArc);
var
  CenterX, CenterY: Extended;
  RadiusX, RadiusY: Extended;
  StartAngle, EndAngle: Extended;

  procedure Exchange(var Left, Right: Integer);
  var
    Middle: Integer;
  begin
    Middle := Left;
    Left := Right;
    Right := Middle;
  end;

begin
  FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
  if not IsCounterClockwise then
  begin
    Exchange(Data^.ptlStart.x, Data^.ptlEnd.x);
    Exchange(Data^.ptlStart.y, Data^.ptlEnd.y);
  end;
  CenterX := (Data^.rclBox.Left + Data^.rclBox.Right) / 2;
  CenterY := (Data^.rclBox.Top + Data^.rclBox.Bottom) / 2;
  RadiusX := abs(Data^.rclBox.Left - Data^.rclBox.Right) / 2;
  RadiusY := abs(Data^.rclBox.Top - Data^.rclBox.Bottom) / 2;
  if RadiusX < 0 then RadiusX := 0;
  if RadiusY < 0 then RadiusY := 0;
  StartAngle := ArcTan2(-(Data^.ptlStart.y - CenterY) * RadiusX,
    (Data^.ptlStart.x - CenterX) * RadiusY);
  EndAngle := ArcTan2(-(Data^.ptlEnd.y - CenterY) * RadiusX,
    (Data^.ptlEnd.x - CenterX) * RadiusY);
  FPage.LineTo(ScaleX(CenterX + RadiusX * cos(StartAngle)), ScaleY(CenterY -
    RadiusY *
    sin(StartAngle)));
  FPage.DrawArc(ScaleX(Data^.rclBox.Left), ScaleY(Data^.rclBox.Top),
    ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
    ScaleX(Data^.ptlStart.x), ScaleY(Data^.ptlStart.y),
    ScaleX(Data^.ptlEnd.x),
    ScaleY(Data^.ptlEnd.y));
  CurrentVal := Point(round(CenterX + RadiusX * cos(EndAngle)), Round(CenterY
    - RadiusY * sin(StartAngle)));
  if not PathContinue then StrokeOrPath;
end;


procedure TVPDFWmf.VEMRPIE(Data: PEMRPie);
begin
  FPage.DrawPie(ScaleX(Data^.rclBox.Left), ScaleY(Data^.rclBox.Top),
    ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
    ScaleX(Data^.ptlStart.x), ScaleY(Data^.ptlStart.y),
    ScaleX(Data^.ptlEnd.x),
    ScaleY(Data^.ptlEnd.y));
  if not PathContinue then FSOrPath;
end;

procedure TVPDFWmf.VEMRELLIPSE(Data: PEMREllipse);
begin
  FPage.FMEllipse(ScaleX(data^.rclBox.Left), ScaleY(Data^.rclBox.Top),
    ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom));
  if not PathContinue then
    if (CurrentPen.lopnWidth <> 0) and (CurrentPen.lopnStyle <> ps_null) then
      if not IsNullBrush then FPage.FillAndStroke
      else FPage.Stroke
    else if not IsNullBrush then FPage.Fill
    else FPage.NewPath;
end;

procedure TVPDFWmf.VEMRRECTANGLE(Data: PEMREllipse);
begin
  if (data^.rclBox.Left = data^.rclBox.Right) or (data^.rclBox.Top = data^.rclBox.Bottom) then
  begin
    FPage.NewPath;
    Exit;
  end;
  FPage.MFRectangle(ScaleX(data^.rclBox.Left), ScaleY(data^.rclBox.Top),
    ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom));
  if (not PathContinue ) then
    if (CurrentPen.lopnWidth <> 0) and (CurrentPen.lopnStyle <> ps_null) then
      if not IsNullBrush then FPage.FillAndStroke
      else FPage.Stroke
    else if not IsNullBrush then FPage.Fill
    else FPage.NewPath;
end;

procedure TVPDFWmf.VEMRCHORD(Data: PEMRChord);
var
  StartPoint: TVPDFCurrPoint;
begin
  if IsCounterClockwise then
    StartPoint := FPage.DrawArc(ScaleX(Data^.rclBox.Left),
      ScaleY(Data^.rclBox.Top),
      ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
      ScaleX(Data^.ptlStart.x), ScaleY(Data^.ptlStart.y),
      ScaleX(Data^.ptlEnd.x),
      ScaleY(Data^.ptlEnd.y))
  else
    StartPoint := FPage.DrawArc(ScaleX(Data^.rclBox.Left),
      ScaleY(Data^.rclBox.Top),
      ScaleX(Data^.rclBox.Right), ScaleY(Data^.rclBox.Bottom),
      ScaleX(Data^.ptlEnd.x), ScaleY(Data^.ptlEnd.y),
      ScaleX(Data^.ptlStart.x),
      ScaleY(Data^.ptlStart.y));
  FPage.LineTo(ScaleX(StartPoint.x), ScaleY(StartPoint.y));
  if not PathContinue then
    FSOrPath;
end;

procedure TVPDFWmf.VEMREXTTEXTOUT(Data: PEMRExtTextOut);
var
  I: Integer;
  X, Y: Extended;
  WXScal, WYScal: Extended;
  TextStr: AnsiString;
  TxtPLace: String;
  TextData: Pointer;
  TextSize: Extended;
  LOffsetX: PINT;
  SOffsetX: PINT;
  RotAngle: Extended;
  TXLen: Extended;
  RestoreClip: Boolean;
  IsCLOP: Boolean;
  TextLen: Integer;
  KGlyphs: PWordArray;
  GlyphArray: array of Word;
  Combined: boolean;
  IsGlyphs: Boolean;
  TextGCP: tagGCP_RESULTS;
  CodePage: Integer;
  FntCharset: TFontCharset;
begin
  RestoreClip := False;
  FPage.TopTextPosition := true;
  IsGlyphs := Data^.emrtext.fOptions and ETO_GLYPH_INDEX <> 0;
  if not PathContinue then
  begin
    if (Data^.emrtext.fOptions and ETO_CLIPPED <> 0) or
      (Data^.emrtext.fOptions and ETO_OPAQUE <> 0) or BKMode then
    begin
      IsCLOP := True;
      if (Data^.emrtext.fOptions and ETO_Clipped <> 0) and
        (Data^.emrtext.nChars <> 0) then
      begin
        if IsCliped then
        begin
          RestoreClip := True;
          FPage.GStateRestore;
        end;
        FPage.GStateSave;
        FPage.NewPath;
        if ((Data^.emrtext.fOptions and ETO_OPAQUE <> 0) or BKMode) and
          (Data^.emrtext.rcl.Right - Data^.emrtext.rcl.Left > 0) and
          (Data^.emrtext.rcl.Bottom - Data^.emrtext.rcl.Top > 0) then
          IsCLOP := False;
        if not IsCLOP then MFSetBKColor;
        FPage.MFRectangle(ScaleX(Data^.emrtext.rcl.Left),
          ScaleY(Data^.emrtext.rcl.Top),
          ScaleX(Data^.emrtext.rcl.Right),
          ScaleY(Data^.emrtext.rcl.Bottom));
        FPage.Clip;
        if not IsCLOP then FPage.Fill
        else FPage.NewPath;
      end;
      if IsCLOP and ((Data^.emrtext.fOptions and ETO_OPAQUE <> 0) or BKMode)
        and (Data^.emrtext.rcl.Right - Data^.emrtext.rcl.Left > 0) and
        (Data^.emrtext.rcl.Bottom - Data^.emrtext.rcl.Top > 0) then
      begin
        MFSetBKColor;
        FPage.NewPath;
        FPage.MFRectangle(ScaleX(Data^.emrtext.rcl.Left),
          ScaleY(Data^.emrtext.rcl.Top),
          ScaleX(Data^.emrtext.rcl.Right),
          ScaleY(Data^.emrtext.rcl.Bottom));
        FPage.Fill;
      end;
    end;
  end;
  TextLen := Data^.emrtext.nChars;
  KGlyphs := Displace(Data, Data^.emrtext.offString);
  if TextLen <> 0 then
  begin
    SetFontColor;
    ActivateCurrentFont;
    if Data^.emrtext.offDx <> 0 then
      LOffsetX := Displace(Data, Data^.emrtext.offDx)
    else LOffsetX := nil;
    if Data^.emr.iType = EMR_EXTTEXTOUTW then
    begin
      Combined := False;
      if not IsGlyphs then
      begin
        for i := 0 to Data^.emrtext.nChars - 1 do
          if (KGlyphs[i] >= $0300) and (KGlyphs[i] <= $036F) then
          begin
            Combined := true;
            break;
          end;
      end;
      if Combined then
      begin
        if WTransform then
        begin
          FillChar(TextGCP, SizeOf(TextGCP), 0);
          TextGCP.lStructSize := SizeOf(TextGCP);
          TextGCP.nGlyphs := TextLen;
          TextGCP.nMaxFit := TextLen;
          SetLength(GlyphArray, TextLen);
          TextGCP.lpGlyphs := @GlyphArray[0];
{$IFDEF VXVERSION}
          if GetCharacterPlacementW(DContext, @KGlyphs[0], LongBool(TextLen), LongBool(0),
{$ELSE}
          if GetCharacterPlacementW(DContext, @KGlyphs[0], TextLen, 0,
{$ENDIF}
            TextGCP, GCP_DIACRITIC or GCP_GLYPHSHAPE or GCP_REORDER) <> 0 then
          begin
            if TextLen <> Integer(TextGCP.nGlyphs) then
            begin
              TextLen := TextGCP.nGlyphs;
              LOffsetX := nil;
              KGlyphs := PWORDArray(TextGCP.lpGlyphs);
            end;
          end;
        end
        else
        begin
          if CurrentFont.lfCharSet = DEFAULT_CHARSET then
          begin
            FntCharset := GetDefFontCharSet;
          end
          else
          begin
            FntCharset := CurrentFont.lfCharSet;
          end;
          case FntCharset of
            EASTEUROPE_CHARSET: CodePage := 1250;
            RUSSIAN_CHARSET: CodePage := 1251;
            GREEK_CHARSET: CodePage := 1253;
            TURKISH_CHARSET: CodePage := 1254;
            BALTIC_CHARSET: CodePage := 1257;
            VIETNAMESE_CHARSET: CodePage := 1258;
            SHIFTJIS_CHARSET: CodePage := 932;
            129: CodePage := 949;
            CHINESEBIG5_CHARSET: CodePage := 950;
            GB2312_CHARSET: CodePage := 936;
          else
            CodePage := 1252;
          end;
          I := WideCharToMultiByte(CodePage, 0, @KGlyphs[0], TextLen, nil, 0,
            nil, nil);
          if I <> 0 then
          begin
            SetLength(TextStr, I);
            I := WideCharToMultiByte(CodePage, 0, @KGlyphs[0], TextLen, @TextStr[1], I, nil, nil);
            if I <> 0 then
            begin
              FillChar(TextGCP, SizeOf(TextGCP), 0);
              TextGCP.lStructSize := SizeOf(TextGCP);
              TextGCP.nGlyphs := I;
              TextGCP.nMaxFit := I;
              SetLength(GlyphArray, I);
              TextGCP.lpGlyphs := @GlyphArray[0];
              TxtPLace := String(TextStr);
{$IFDEF VXVERSION}
              if GetCharacterPlacement(DContext, PChar(TxtPLace), LongBool(I), LongBool(0),
{$ELSE}
              if GetCharacterPlacement(DContext, PChar(TxtPLace), I, 0,
{$ENDIF}
                TextGCP, GCP_DIACRITIC or GCP_GLYPHSHAPE or
                GCP_REORDER) <> 0 then
              begin
                if I <> Integer(TextGCP.nGlyphs) then
                begin
                  TextLen := TextGCP.nGlyphs;
                  LOffsetX := nil;
                  KGlyphs := PWORDArray(TextGCP.lpGlyphs);
                end;
              end;
            end;
          end;
        end;
      end;
    end
    else
    begin
      SetLength(TextStr, Data^.emrtext.nChars);
      TextData := Displace(Data, Data^.emrtext.offString);
      Move(TextData^, TextStr[1], Data^.emrtext.nChars);
    end;
    if LOffsetX <> nil then
    begin
      TextSize := 0;
      for i := 0 to TextLen - 1 do
      begin
        TextSize := TextSize + LOffsetX^;
        Inc(LOffsetX);
      end;
      TextSize := TextSize * ZoomX;
    end
    else TextSize := Data^.emrtext.rcl.Right - Data^.emrtext.rcl.Left;
    if UpdatePos then
    begin
      X := CurrentVal.X;
      Y := CurrentVal.Y;
      if CurrentFont.lfEscapement <> 0 then
      begin
        CurrentVal.X := CurrentVal.X + round(TextSize *
          cos(CurrentFont.lfEscapement * Pi /
          1800));
        CurrentVal.Y := CurrentVal.Y - round(TextSize *
          sin(CurrentFont.lfEscapement * Pi /
          1800));
      end
      else CurrentVal.X := CurrentVal.X + round(TextSize);
    end
    else
    begin
      X := Data^.emrtext.ptlReference.X;
      Y := Data^.emrtext.ptlReference.Y;
    end;
    if CurrentFont.lfEscapement = 0 then
    begin
      case VertMode of
        vvjCenter:
          begin
            Y := ScaleY(Y) - FPage.TextHeight('Xg');
            FPage.TopTextPosition := false;
          end;
        vvjDown: Y := ScaleY(Y) - FPage.TextHeight('Xg');
      else Y := ScaleY(Y);
      end;
        case HorMode of
          vhjRight: x := ScaleX(X - TextSize);
          vhjCenter: x := ScaleX(X - TextSize / 2);
        else X := ScaleX(X);
      end;
    end
    else
    begin
      if (VertMode = vvjUp) and (HorMode = vhjLeft) then
      begin
        Y := ScaleY(Y, true);
        X := ScaleX(X, true);
      end
      else
      begin
        case VertMode of
          vvjCenter: WYScal := MetaCanvas.TextHeight('X');
          vvjDown: WYScal := MetaCanvas.TextHeight('Xg');
        else WYScal := 0;
        end;
        case HorMode of
          vhjRight: WXScal := TextSize;
          vhjCenter: WXScal := TextSize / 2;
        else WXScal := 0;
        end;