📄 vpdfwmf.pas

📁 生成PDF文档的控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  if TextContinue then SetFontColor;
end;

procedure TVPDFWmf.VEMRSETTEXTALIGN(Data: PEMRSelectClipPath);
begin
  SetTextAlign(DContext, Data^.iMode);
  case Data^.iMode and (TA_LEFT or ta_Right or ta_center) of
    TA_LEFT: HorMode := vhjLeft;
    TA_RIGHT: HorMode := vhjRight;
    TA_CENTER: HorMode := vhjCenter;
  end;
  case Data^.iMode and (TA_Top or ta_BaseLine or ta_Bottom) of
    TA_TOP: VertMode := vvjUp;
    TA_BOTTOM: VertMode := vvjDown;
    TA_BASELINE: VertMode := vvjCenter;
  end;
  UpdatePos := (Data^.iMode and TA_UPDATECP = TA_UPDATECP);
end;

procedure TVPDFWmf.VEMRPOLYBEZIER(Data: PEMRPolyline);
var
  I: Integer;
begin
  if Data^.cptl >= 4 then
  begin
    FPage.MoveTo(ScaleX(Data^.aptl[0].x), ScaleY(Data^.aptl[0].y));
    for I := 1 to (Data^.cptl - 1) div 3 do
      FPage.CurvetoC(ScaleX(Data^.aptl[1 + (I - 1) * 3].x),
        ScaleY(Data^.aptl[1 + (I - 1) * 3].y),
          ScaleX(Data^.aptl[1 + (I - 1) * 3 + 1].x),
        ScaleY(Data^.aptl[1 + (I - 1) * 3 + 1].y),
          ScaleX(Data^.aptl[1 + (I - 1) * 3 + 2].x),
        ScaleY(Data^.aptl[1 + (I - 1) * 3 + 2].y));
    if not PathContinue then StrokeOrPath;
  end;
end;

procedure TVPDFWmf.VEMRPOLYBEZIER16(Data: PEMRPolyline16);
var
  I: Integer;
begin
    if Data^.cpts >= 4 then
    begin
      FPage.MoveTo(ScaleX(Data^.apts[0].x), ScaleY(Data^.apts[0].y));
      for I := 1 to (Data^.cpts - 1) div 3 do
      FPage.CurvetoC(ScaleX(Data^.apts[1 + (I - 1) * 3].x),
          ScaleY(Data^.apts[1 + (I - 1) * 3].y),
          ScaleX(Data^.apts[1 + (I - 1) * 3 + 1].x),
          ScaleY(Data^.apts[1 + (I - 1) * 3 + 1].y),
          ScaleX(Data^.apts[1 + (I - 1) * 3 + 2].x),
          ScaleY(Data^.apts[1 + (I - 1) * 3 + 2].y));
      if not PathContinue then StrokeOrPath;
    end;
  end;

procedure TVPDFWmf.VEMRPOLYBEZIERTO(Data: PEMRPolyline);
var
  I: Integer;
begin
    if Data^.cptl >= 3 then
    begin
      if not PathContinue then
        FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
      for I := 1 to (Data^.cptl) div 3 do
      begin
        FPage.CurveToC(ScaleX(Data^.aptl[(I - 1) * 3].x), ScaleY(Data^.aptl[(I
            - 1) * 3].y), ScaleX(Data^.aptl[(I - 1) * 3 + 1].x), ScaleY(Data^.aptl[(I
            - 1) * 3 + 1].y), ScaleX(Data^.aptl[(I - 1) * 3 + 2].x),
            ScaleY(Data^.aptl[(I - 1) * 3 + 2].y));
        CurrentVal := Point(Data^.aptl[(I - 1) * 3 + 2].x, Data^.aptl[(I - 1) * 3 + 2].y);
      end;
      if not PathContinue then StrokeOrPath;
    end;
end;

procedure TVPDFWmf.VEMRPOLYBEZIERTO16(Data: PEMRPolyline16);
var
  I: Integer;
begin
    if Data^.cpts >= 3 then
    begin
      if not PathContinue then FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
      for I := 1 to Data^.cpts div 3 do
      begin
        FPage.CurvetoC(ScaleX(Data^.apts[(i - 1) * 3].x), ScaleY(Data^.apts[(i - 1) * 3].y),
          ScaleX(Data^.apts[(i - 1) * 3 + 1].x), ScaleY(Data^.apts[(i - 1) * 3 + 1].y),
            ScaleX(Data^.apts[(i - 1) * 3 + 2].x), ScaleY(Data^.apts[(i - 1) * 3 + 2].y));
        CurrentVal := Point(Data^.apts[(i - 1) * 3 + 2].x, Data^.apts[(i - 1) * 3 + 2].y);
      end;
      if not PathContinue then StrokeOrPath;
    end;
end;

procedure TVPDFWmf.VEMRPOLYDRAW(Data: PEMRPolyDraw);
var
  PLView: PByteArray;
  WCurrPnt: TPoint;
  NCrank: Cardinal;
begin
    if not PathContinue then FPage.NewPath;
    FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
    WCurrPnt := CurrentVal;
    PLView := @(Data^.aptl[Data^.cptl]);
    NCrank := 0;
    while NCrank < Data^.cptl do
    begin
      if PLView[NCrank] = PT_MOVETO then
      begin
        WCurrPnt.x := Data^.aPTL[NCrank].x;
        WCurrPnt.y := Data^.aPTL[NCrank].y;
        FPage.MoveTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
        Inc(NCrank);
        CurrentVal := WCurrPnt;
      end
      else if (PLView[NCrank] and PT_LINETO) <> 0 then
      begin
        FPage.LineTo(ScaleX(Data^.aPTL[NCrank].x), ScaleY(Data^.aPTL[NCrank].y));
        Inc(NCrank);
        CurrentVal := Point(Data^.aPTL[NCrank].x, Data^.aPTL[NCrank].y);
        if (PLView[NCrank] and PT_ClOSEFIGURE) <> 0 then
        begin
          FPage.LineTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
          CurrentVal := WCurrPnt;
        end;
      end
      else if (PLView[NCrank] and PT_BEZIERTO) <> 0 then
      begin
        FPage.CurvetoC(ScaleX(Data^.aPTL[NCrank].x), ScaleY(Data^.aPTL[NCrank].y),
          ScaleX(Data^.aPTL[NCrank + 1].x), ScaleY(Data^.aPTL[NCrank + 1].y),
          ScaleX(Data^.aPTL[NCrank + 2].x), ScaleY(Data^.aPTL[NCrank + 2].y));
        CurrentVal := Point(Data^.aPTL[NCrank + 2].x, Data^.aPTL[NCrank + 2].y);
        Inc(NCrank, 3);
        if (PLView[NCrank] and PT_ClOSEFIGURE) <> 0 then
        begin
          FPage.LineTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
          CurrentVal := WCurrPnt;
        end;
      end
    end;
    if not PathContinue then StrokeOrPath;
end;

procedure TVPDFWmf.VEMRPOLYDRAW16(Data: PEMRPolyDraw16);
var
  I: Integer;
  PLView: PByteArray;
  WCurrPnt: TPoint;
  NCrank: Cardinal;
begin
    if not PathContinue then FPage.NewPath;
    FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
    WCurrPnt := CurrentVal;
    PLView := @(Data^.apts[Data^.cpts]);
    NCrank := 0;
    I := 0;
    while NCrank < Data^.cpts do
    begin
      if PLView[I] = PT_MOVETO then
      begin
        WCurrPnt.x := Data^.aPTs[NCrank].x;
        WCurrPnt.y := Data^.aPTs[NCrank].y;
        FPage.MoveTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
        Inc(NCrank);
        CurrentVal := WCurrPnt;
      end
      else if (PLView[I] and PT_LINETO) <> 0 then
      begin
        FPage.LineTo(ScaleX(Data^.aPTs[NCrank].x), ScaleY(Data^.aPTs[NCrank].y));
        Inc(NCrank);
        CurrentVal := Point(Data^.aPTS[NCrank].x, Data^.aPTs[NCrank].y);
        if (PLView[I] and PT_ClOSEFIGURE) <> 0 then
        begin
          FPage.LineTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
          CurrentVal := WCurrPnt;
        end;
      end
      else if (PLView[I] and PT_BEZIERTO) <> 0 then
      begin
        FPage.CurvetoC(ScaleX(Data^.aPTs[NCrank].x), ScaleY(Data^.aPTs[NCrank].y),
          ScaleX(Data^.aPTs[NCrank + 1].x), ScaleY(Data^.aPTs[NCrank + 1].y),
          ScaleX(Data^.aPTs[NCrank + 2].x), ScaleY(Data^.aPTs[NCrank + 2].y));
        CurrentVal := Point(Data^.aPTs[NCrank + 2].x, Data^.aPTs[NCrank + 2].y);
        Inc(NCrank, 3);
        if (PLView[I] and PT_ClOSEFIGURE) <> 0 then
        begin
          FPage.LineTo(ScaleX(WCurrPnt.x), ScaleY(WCurrPnt.y));
          CurrentVal := WCurrPnt;
        end;
      end
      else Inc(NCrank);
    end;
    if not PathContinue then StrokeOrPath;
end;

procedure TVPDFWmf.VEMRPOLYGON(Data: PEMRPolyline);
var
  I: Integer;
begin
    if Data^.cptl > 0 then
    begin
      FPage.NewPath;
      FPage.MoveTo(ScaleX(Data^.aptl[0].x), ScaleY(Data^.aptl[0].y));
      for I := 1 to Data^.cptl - 1 do
      begin
        FPage.LineTo(ScaleX(Data^.aptl[i].x), ScaleY(Data^.aptl[I].y));
      end;
      if ( not PathContinue ) then
      begin
        FPage.ClosePath;
        FSOrPath;
      end;
    end;
end;

procedure TVPDFWmf.VEMRPOLYGON16(Data: PEMRPolyline16);
var
  I: Integer;
begin
  if Data^.cpts > 0 then
  begin
    FPage.NewPath;
    FPage.MoveTo(ScaleX(Data^.apts[0].x), ScaleY(Data^.apts[0].y));
    for I := 1 to Data^.cpts - 1 do
    begin
      FPage.LineTo(ScaleX(Data^.apts[I].x), ScaleY(Data^.apts[I].y));
    end;
    if not PathContinue then
    begin
      FPage.ClosePath;
      FSOrPath;
    end;
  end;
end;

procedure TVPDFWmf.VEMRPOLYLINE(Data: PEMRPolyline);
var
  I: Integer;
begin
  if Data^.cptl > 0 then
  begin
    FPage.NewPath;
    FPage.MoveTo(ScaleX(Data^.aptl[0].x), ScaleY(Data^.aptl[0].y));
    for I := 1 to Data^.cptl - 1 do
    begin
      FPage.LineTo(ScaleX(Data^.aptl[I].x), ScaleY(Data^.aptl[I].y));
    end;
    if not PathContinue then StrokeOrPath;
  end;
end;

procedure TVPDFWmf.VEMRPOLYLINE16(Data: PEMRPolyline16);
var
  I: Integer;
begin
  if Data^.cpts > 0 then
  begin
    FPage.NewPath;
    FPage.MoveTo(ScaleX(Data^.apts[0].x), ScaleY(Data^.apts[0].y));
    for I := 1 to Data^.cpts - 1 do
    begin
      FPage.LineTo(ScaleX(Data^.apts[I].x), ScaleY(Data^.apts[I].y));
    end;
    if not PathContinue then StrokeOrPath;
  end;
end;

procedure TVPDFWmf.VEMRPOLYLINETO(Data: PEMRPolyline);
var
  I: Integer;
begin
  if Data^.cptl > 0 then
  begin
    if not PathContinue then
    begin
      FPage.NewPath;
      FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
    end;
    for I := 0 to Data^.cptl - 1 do
    begin
      FPage.LineTo(ScaleX(Data^.aptl[I].x), ScaleY(Data^.aptl[I].y));
    end;
    if not PathContinue then StrokeOrPath;
    CurrentVal := Point(Data^.aptl[Data^.cptl - 1].x, Data^.aptl[Data^.cptl - 1].y);
  end;
end;

procedure TVPDFWmf.VEMRPOLYLINETO16(Data: PEMRPolyline16);
var
  I: Integer;
begin
  if Data^.cpts > 0 then
  begin
    if not PathContinue then
    begin
      FPage.NewPath;
      FPage.MoveTo(ScaleX(CurrentVal.x), ScaleY(CurrentVal.y));
    end;
    for I := 0 to Data^.cpts - 1 do
    begin
      FPage.LineTo(ScaleX(Data^.apts[I].x), ScaleY(Data^.apts[I].y));
    end;
    if not PathContinue then StrokeOrPath;
    CurrentVal := Point(Data^.apts[Data^.cpts - 1].x,
      Data^.apts[Data^.cpts - 1].y);
  end;
end;

procedure TVPDFWmf.VEMRPOLYPOLYGON(Data: PEMRPolyPolyline);
var
  I, J: Integer;
  SCrank: Integer;
  CrankLen: Integer;
  PlLine: PPolyLine;
begin
    FPage.NewPath;
    SCrank := SizeOf(TEMRPolyPolyline) - SizeOf(TPoint) + SizeOf(dword) * (Data^.nPolys - 1);
    PlLine := Displace(Data, SCrank);
    SCrank := 0;
    for J := 0 to Data^.nPolys - 1 do
    begin
      FPage.MoveTo(ScaleX(PlLine[SCrank].X), ScaleY(PlLine[SCrank].Y));
      CrankLen := SCrank;
      Inc(SCrank);
      for I := 1 to Data^.aPolyCounts[J] - 1 do
      begin
        FPage.LineTo(ScaleX(PlLine[SCrank].X), ScaleY(PlLine[SCrank].Y));
        Inc(SCrank);
      end;
      FPage.LineTo(ScaleX(PlLine[CrankLen].X), ScaleY(PlLine[CrankLen].Y));
    end;
    FSOrPath;
end;

procedure TVPDFWmf.VEMRPOLYPOLYGON16(Data: PEMRPolyPolyline16);
var
  I, J: Integer;
  SCrank: Integer;
  CrankLen: Integer;
  PlLine: PSmallPolyLine;
begin
    FPage.NewPath;
    SCrank := SizeOf(TEMRPolyPolyline16) - SizeOf(TSmallPoint) + SizeOf(dword) * (Data^.nPolys - 1);
    PlLine := Displace(Data, SCrank);
    SCrank := 0;
    for J := 0 to Data^.nPolys - 1 do
    begin
      FPage.MoveTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
      CrankLen := SCrank;
      Inc(SCrank);
      for I := 1 to Data^.aPolyCounts[J] - 1 do
      begin
        FPage.LineTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
        Inc(SCrank);
      end;
      FPage.LineTo(ScaleX(PlLine[CrankLen].x), ScaleY(PlLine[CrankLen].y));
    end;
    FSOrPath;
end;

procedure TVPDFWmf.VEMRPOLYPOLYLINE(Data: PEMRPolyPolyline);
var
  I, J: Integer;
  SCrank: Integer;
  PlLine: PPolyLine;
begin
    FPage.NewPath;
    SCrank := SizeOf(TEMRPolyPolyline) - SizeOf(TPoint) + SizeOf(dword) *
      (Data^.nPolys - 1);
    PlLine := Displace(Data, SCrank);
    SCrank := 0;
    for J := 0 to Data^.nPolys - 1 do
    begin
      FPage.MoveTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
      Inc(SCrank);
      for I := 1 to Data^.aPolyCounts[J] - 1 do
      begin
        FPage.LineTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
        Inc(SCrank);
      end;
    end;
    if not PathContinue then StrokeOrPath;
end;

procedure TVPDFWmf.VEMRPOLYPOLYLINE16(Data: PEMRPolyPolyline16);
var
  I, J: Integer;
  SCrank: Integer;
  PlLine: PSmallPolyLine;
begin
  FPage.NewPath;
  SCrank := SizeOf(TEMRPolyPolyline16) - SizeOf(TSmallPoint) + SizeOf(dword) * (Data^.nPolys - 1);
  PlLine := Displace(Data, SCrank);
  SCrank := 0;
  for J := 0 to Data^.nPolys - 1 do
  begin
    FPage.MoveTo(ScaleX(PlLine[SCrank].x), ScaleY(PlLine[SCrank].y));
    Inc(SCrank);
    for I := 1 to Data^.aPolyCounts[J] - 1 do
💿 文件大小 4552 K
👤 上传用户 ylchsj521
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#文档 #控件
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -