------------------------------------------------------------------
1.多角形面積計算...Polygonにより作成された多角形の面積
2.楕円の面積計算...Ellipseにより作成された楕円の面積
3.楕円の円周計算...Ellipseにより作成された楕円の円周長さ

[関数作成についてのお礼]
  1,2.では FLabo(わいわいｱﾙｺﾞﾘｽﾞﾑ検討会)にて、
      簡単毛虫取氏 一言居士氏,is0586氏に お世話になりました。
  3.  では、物理ﾌｫｰﾗﾑの BLIZZARD氏にたびたびお世話になりました。
      また、この関数は、Fermion氏の数値積分(蔵にあります)
      を使用させてもらいますので、あわせて お礼申し上げます。

------------------------------------------------------------------
     計算関数ｿｰｽｺｰﾄﾞ
------------------------------------------------------------------
1.多角形面積計算
  var
    PointArray: array[1..100] of TPoint;  // 適当に
    PN:  Integer;               // PointArray内に設定した有効角数

  function CalPMns: Extended;
  var
    N: Integer;
    X1,X2: Integer;
  begin
    Result := 0;
    for N := 1 to PN do
      begin
        if N = 1  then
                X1 := PointArray[PN].X
           else X1 := PointArray[N-1].X;
        if N = PN then
                X2 := PointArray[1].X
           else X2 := PointArray[N+1].X;
        Result := Result + ((X1 - X2) * PointArray[N].Y) / 2;
      end;
   {計算結果..絶対値に変更}
    Result := Abs(Result);
  end;

2.楕円の面積計算 ... ついでです。(^^);
  var
    W,H: Double;      //楕円に外接する長方形のｻｲｽﾞをｾｯﾄ

  function CalEmns(W,H: Double): Extended;  
    Result := W * H * Pi / 4;
  end;

3.楕円の円周計算
   円弧の1/4 の長さ計算して、結果を 4倍しています。
   また、傾き無限となる対策のため、分割して数値積分を使用しています。
   精度は ｼﾝﾌﾟｿﾝの数値積分(繰返し回数=100)で満足できます。

  var
    W,H:   Double;    // 楕円に外接する長方形ｻｲｽﾞ/2 をｾｯﾄ
    W2,H2: Double;    // 単なる計算用ﾜｰｸ.. W*W,H*Hを設定。

  {被積分関数の定義.. Fermion氏作 数値積分用}
  function F1(X: Extended): Extended;
  var
    X2,A,B: Extended;
  begin
    Result := 0;
    X2 := X * X;
    A  := W2 * W2 - W2 * X2;
    if A <> 0 then                // NEC PC98対策用です。
      try
        B := W2 * W2 - (W2 - H2) * X2;
        Result := Sqrt(B / A);
      except
        Result := 0;
      end;
  end;

  {F1の関数の W,Hを入れ替えています。}
  function F2(X: Extended): Extended;
  var
    X2,A,B: Extended;        
  begin
    Result := 0;
    X2 := X * X;
    A  := H2 * H2 - H2 * X2;
    if A <> 0 then                // NEC PC98対策用です。
      try
        B := H2 * H2 - (H2 - W2) * X2;
        Result := Sqrt(B / A);
      except
        Result := 0;
      end;
  end;

  {楕円円周長さ計算本体... 数値積分をCallするだけです}
  function CalELen(W,H: Double): Extended;
  begin
    W2 := W * W;
    H2 := H * H;
    if (ｼﾝﾌﾟｿﾝ計算法) then
      Result := (4 * SimpIntegral(F1,0,W/Sqrt(2),100)
               + 4 * SimpIntegral(F2,0,H/Sqrt(2),100));
    if (ﾙｼﾞｬﾝﾄﾞﾙ・ｶﾞｳｽ計算法) then
      Result := (4 * LGIntegral(F1,0,W/Sqrt(2))
               + 4 * LGIntegral(F2,0,H/Sqrt(2)));
  end;

                 草薙いっぺいﾃﾞｼﾀ(GBE02547)  97/12/27(土)


Original document by 草薙いっぺい    氏 ID:(GBE02547)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。