お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"面積 & 円周計算法(3例)"




------------------------------------------------------------------
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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum