hgecurve.pas

完整的Delphi游戏开发控件

unit HGECurve;
(*
** hge Curve routine
** Extension to the HGE engine
** Extension added by DraculaLin
** This extension is NOT part of the original HGE engine.
*)

interface
uses
  Types, Math, HGEDef, HGE;

type
  TBezierPoints  = Array[0..3] of TPoint;
  TBezierPoints2 = TPoint4;
  function BezierPoints(const OriginPoint, DestPoint, C1Point, C2Point: TPoint): TBezierPoints; overload;
  function BezierPoints(const OriginPoint, DestPoint, C1Point, C2Point: TPoint2): TBezierPoints2; overload;
  procedure PolyLine(const Points: Array of TPoint; const Color: Cardinal; BlendMode: Integer); overload;
  procedure PolyLine(const Points: Array of TPoint; const Color0, Color1: Cardinal; BlendMode: Integer); overload;
  procedure PolyLine(const Points: Array of TPoint2; const Color: Cardinal; BlendMode: Integer); overload;
  procedure PolyLine(const Points: Array of TPoint2; const Color1, Color2: Cardinal; Blendmode: Integer); overload;
  procedure BezierCurve(BezierPoints: TBezierPoints; Steps: Integer; const LineColor: Cardinal; BlendMode: Integer); overload;
  procedure BezierCurve(BezierPoints: TBezierPoints2; Steps: Integer; const LineColor: Cardinal; Blendmode: Integer); overload;
  procedure BezierCurve(const BezierPoints: TBezierPoints; const Steps: Integer; const LineColor1, LineColor2: Cardinal; Blendmode: Integer); overload;
  procedure BezierCurve(const BezierPoints: TBezierPoints2; const Steps: Integer; const LineColor1, LineColor2: Cardinal; Blendmode: Integer ); overload;
  procedure CubicCurve(const Points: Array of TPoint; Steps: Cardinal; const LineColor: Cardinal; Blendmode: Integer); overload;
  procedure CubicCurve(const Points: Array of TPoint2; Steps: Cardinal; const LineColor: Cardinal; Blendmode: Integer); overload;
  procedure RoundPolygon(Verts: Array of TPoint; const Dist: Integer; const LineColor: Cardinal; Blendmode: Integer; Coeff: Double = 0.5); overload;
  procedure RoundPolygon(Verts: Array of TPoint2; const Dist: Integer; const LineColor: Cardinal; Blendmode: Integer; Coeff: Double = 0.5); overload;

implementation
var
 FHGE: IHGE=nil;


function BezierPoints(const OriginPoint, DestPoint, C1Point, C2Point: TPoint): TBezierPoints;
begin
  Result[0] := OriginPoint;
  Result[1] := C1Point;
  Result[2] := C2Point;
  Result[3] := DestPoint;
end;

function BezierPoints(const OriginPoint, DestPoint, C1Point, C2Point: TPoint2): TBezierPoints2;
begin
  Result[0] := OriginPoint;
  Result[1] := C1Point;
  Result[2] := C2Point;
  Result[3] := DestPoint;
end;

function DisplaceRB(Color: Cardinal): Cardinal; register;
asm
 mov ecx, eax
 mov edx, eax
 and eax, 0FF00FF00h
 and edx, 0000000FFh
 shl edx, 16
 or eax, edx
 mov edx, ecx
 shr edx, 16
 and edx, 0000000FFh
 or eax, edx
end;

function BlendPixels(Px0, Px1: Longword; Alpha: Integer): Longword; stdcall;
asm
 pxor mm7, mm7

 mov eax, 0FFFFFFFFh
 movd mm6, eax
 punpcklbw mm6, mm7    // MM6 -> 255,255,255,255 (words)

 mov eax, 01010101h
 movd mm0, eax
 punpcklbw mm0, mm7    // MM0 -> 1, 1, 1, 1 (words)

 paddusw mm6, mm0      // MM6 -> 256,256,256,256 (words)

 mov eax, Alpha
 and eax, 0FFh
 mov ecx, eax
 shl ecx, 8
 or  eax, ecx
 shl ecx, 8
 or  eax, ecx
 shl ecx, 8
 or eax, ecx

 movd mm2, eax
 punpcklbw mm2, mm7    // MM2 -> alpha,alpha,alpha

 movd mm0, Px0
 movd mm1, Px1

 punpcklbw mm0, mm7
 punpcklbw mm1, mm7

 pmullw mm0, mm2
 psrlw mm0, 8

 psubusw mm6, mm2

 pmullw mm1, mm6
 psrlw mm1, 8

 paddusw mm0, mm1
 packuswb  mm0, mm7

 movd eax, mm0

 emms

 mov Result, eax
end;


procedure PolyLine(const Points: Array of TPoint; const Color: Cardinal; BlendMode: Integer);
var
  I: Integer;
  PSource, PDest: TPoint2;
  Col: Cardinal;
begin
  // (1) Check condition.
  if (Length(Points) < 2) then Exit;

  // (2) Calculate displaced color value (for DX).
  Col := DisplaceRB(Color);

  // (3) Render lines.
  for I := Low(Points) to (High(Points) - 1) do
  begin
    PSource := Point2(Points[i].x, Points[i].y);
    PDest := Point2(Points[I + 1].x, Points[I + 1].y);

    FHGE.Line2Color(PSource.X,PSource.Y, PDest.X,PDest.Y, Col, Col, BlendMode);
  end;
end;

procedure PolyLine(const Points: Array of TPoint2; const Color: Cardinal; Blendmode: Integer);
var
  I: Integer;
  Col: Cardinal;
begin
  // (1) Check condition.
  if (Length(Points) < 2) then Exit;

  // (2) Calculate displaced color walue (for DX).
  Col := DisplaceRB(Color);

  // (3) Render lines.  
  for I := Low(Points) to (High(Points) - 1) do
    FHGE.Line2Color(Points[i].X,Points[i].Y, Points[I + 1].X, Points[I + 1].X, Col, Col, BlendMode);
end;

procedure PolyLine(const Points: array of TPoint; const Color0, Color1: Cardinal; BlendMode: Integer);
var
  I, Len: Integer;
  PSource, PDest: TPoint;
begin
  Len := Length(Points);

  // (1) Check conditions.
  if (Len < 2) then Exit;

  // (2) Render lines for point to point.
  for I := Low(Points) to (High(Points) - 1) do
  begin
    PSource := Points[i];
    PDest := Points[I + 1];
    FHGE.Line2Color(PSource.X, PSource.Y,PDest.X, PDest.Y,
      DisplaceRB(BlendPixels(Color0, Color1, (I * 255) div (Len - 1))),
      DisplaceRB(BlendPixels(Color0, Color1, ((I + 1) * 255) div (Len - 1))), BlendMode);
  end;
end;

procedure PolyLine(const Points: array of TPoint2; const Color1, Color2: Cardinal; BlendMode: Integer);
var
  I, Len: Integer;
begin
  Len := Length(Points);

  // (1) Check conditions.
  if (Len < 2) then Exit;

  // (2) Render lines from point to point.
  for I := Low(Points) to (High(Points) - 1) do
  begin
    FHGE.Line2Color(Points[i].X,Points[i].Y, Points[I + 1].X, Points[I + 1].Y,
      DisplaceRB(BlendPixels(Color1, Color2, (I * 255) div (Len - 1))),
      DisplaceRB(BlendPixels(Color1, Color2, ((I + 1) * 255) div (Len - 1))), BlendMode);
  end;
end;

procedure BezierCurve(BezierPoints: TBezierPoints; Steps: Integer; const LineColor: Cardinal; BlendMode: Integer);
var
  I: Integer;
  o, pos: TPoint2;
  Col: Cardinal;
begin
  // (1) Set first point to "o".
  o := Point2(BezierPoints[0].X, BezierPoints[0].Y);

  // (2) Calculate displaced color value (for DX).
  Col := DisplaceRB(LineColor);

  for I := 0 to (Steps - 1) do
  begin
    // (3) Calculate point position for "I" step.
    pos := Point2(Power(1 - I / Steps, 3) * BezierPoints[0].X + 3 * I / Steps *
      Power(1 - I / Steps, 2) * BezierPoints[1].X + 3 * Power(I / Steps, 2) *
      (1 - I / Steps) * BezierPoints[2].X + Power(I / Steps, 3) *
      BezierPoints[3].X, Power(1 - I / Steps, 3) * BezierPoints[0].Y + 3 * 
      I / Steps * Power(1 - I / Steps, 2) * BezierPoints[1].Y + 3 *
      Power(I / Steps, 2) * (1 - I / Steps) * BezierPoints[2].Y +
     Power(I / Steps, 3) * BezierPoints[3].Y);

    // (4) Render line.
    FHGE.Line2Color(o.X,o.Y, pos.X,pos.Y, Col, Col, Blendmode);

    // (5) Save "pos" in "o" for next step.
    o := pos;
  end;
end;

procedure BezierCurve(BezierPoints: TBezierPoints2; Steps: Integer; const LineColor: Cardinal; BlendMode: Integer);
var
  I: Integer;
  o, pos: TPoint2;
  Col: Cardinal;
begin
  // (1) Set first point to "o".
  o := BezierPoints[0];

  // (2) Calculate displaced color value (for DX).
  Col := DisplaceRB(LineColor);

  for I := 0 to (Steps - 1) do
  begin
    // (3) Calculate point position for "I" step.
    pos := Point2(Power(1 - I / Steps, 3) * BezierPoints[0].X + 3 * I / Steps *
      Power(1 - I / Steps, 2) * BezierPoints[1].X + 3 *
      Power(I / Steps, 2) * (1 - I / Steps) * BezierPoints[2].X +
      Power(I / Steps, 3) * BezierPoints[3].X, 
      Power(1 - I / Steps, 3) * BezierPoints[0].Y + 3 * I / Steps *
      Power(1 - I / Steps, 2) * BezierPoints[1].Y + 3 *
      Power(I / Steps, 2) * (1 - I / Steps) * BezierPoints[2].Y +
      Power(I / Steps, 3) * BezierPoints[3].Y);

    // (4) Render calculated line.
    FHGE.Line2Color(o.X,o.Y, pos.X,pos.Y, Col, Col, BlendMode);

    // (5) Save "pos" to "o" for next step.
    o := pos;
  end;
end;