获取多边形面积的函数 - 回复 "dacsd" 的问题
问题来源: http://www.cnblogs.com/del/archive/2008/07/09/1237697.html#1250073我曾经傻呵呵地这样做过: http://www.cnblogs.com/del/archive/2008/07/08/1238238.html#1249117
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} {获取多边形面积的函数} function GetPolygonArea(const pt: PPoint; const Count: Integer): Double; function LineSqr(const pt1,pt2: TPoint): Double; begin Result := (pt2.X - pt1.X) * (pt1.Y + pt2.Y) / 2; end; type ArrPt = array of TPoint; var i: Integer; begin Result := 0; for i := 0 to Count - 2 do Result := Result + LineSqr(ArrPt(pt)[i], ArrPt(pt)[i+1]); Result := Result + LineSqr(ArrPt(pt)[Count-1], ArrPt(pt)[0]); end; {测试1: 把窗体矩形当个多边形测试一下, 使用静态数组} procedure TForm1.Button1Click(Sender: TObject); var pts: array[0..3]of TPoint; Area1: Double; Area2: Integer; begin pts[0] := ClientRect.TopLeft; pts[1] := Point(0, ClientHeight); pts[2] := ClientRect.BottomRight; pts[3] := Point(ClientWidth, 0); {用上面的函数获取面积} Area1 := GetPolygonArea(@pts, Length(pts)); {用 宽*高 获取面积} Area2 := ClientWidth * ClientHeight; {对比显示两个结果} Text := Format('%f, %d', [Area1, Area2]); {没有问题} end; {测试2: 把窗体用对角线分隔的三角形当个多边形测试一下, 使用动态数组} procedure TForm1.Button2Click(Sender: TObject); var pts: array of TPoint; Area1: Double; Area2: Integer; begin SetLength(pts, 3); pts[0] := ClientRect.TopLeft; pts[1] := Point(0, ClientHeight); pts[2] := ClientRect.BottomRight; {用上面的函数获取面积} Area1 := GetPolygonArea(@pts[0], Length(pts)); {用 宽*高/2 获取面积} Area2 := ClientWidth * ClientHeight div 2; {对比显示两个结果} Text := Format('%f, %d', [Area1, Area2]); {没有问题} end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 206 ClientWidth = 339 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 136 Top = 72 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 136 Top = 112 Width = 75 Height = 25 Caption = 'Button2' TabOrder = 1 OnClick = Button2Click end endposted on 2008-07-10 01:01 万一 阅读(2664) 评论(11) 编辑 收藏