この発言は
#00786　裏目小僧        さんの多角形の内と外の判定
に対するコメントです

この発言に対し以下のコメントが寄せられています

#00789　裏目小僧        さん　Int32x32To64のインラインasm版





#ご覧下さっている方も居るようなので(8番会議室 #09063)調子に乗って、

  点 x,y と n多角形 ptを与えて 
  多角形の内側かどうかと同時に使う事が多い、指定した線分の上かどうか
  の判定方法です。帰り値が -1 なら線分の上ではないです。でなければ、
  帰り値の配列番号上の線分の上に居ます。
   

function PolygonNear(x,y,n:integer;pt:array of TPoint):Integer;
var i,x0,y0,x1,y1:integer;
var rx,ry,dx,dy,dlen,slen:LongInt; //D4ならInt64として下さい
begin
pt[n]:=pt[0];
 for i:=0 to n-1 do begin
  with pt[i  ] do begin  x0:=x;  y0:=y;  end;
    rx:= x -x0;
    ry:= y -y0;
  with pt[i+1] do begin  x1:=x;  y1:=y;  end;
    dx:= x1-x0;
    dy:= y1-y0;
     if dx>0 then  begin   {クリッピン判断。線分の入る箱にあるかどうか}
         if rx<0  then continue; {箱になければ次の判定に飛ぶ}
         if rx>dx then continue;
       end else begin
         if rx>0  then continue;
         if rx<dx then continue;
       end;
      if dy>0 then begin
         if ry<0  then continue;
         if ry>dy then continue;
       end else begin
         if ry>0  then continue;
         if ry<dy then continue;
       end;
    dlen:=abs(rx*dy-ry*dx)    ;
     dx:=abs(dx);  dy:=abs(dy);
     if dx>dy then slen:=dx*2+dy
            else   slen:=dy*2+dx;  {距離は約２ピクセルに調整しています}
      if dlen < slen then    begin  Result:=i;  exit; end; {発見した}
   end;
  Result:= -1;                                             {なかった}
 end;

｢解説｣ クリッピング判定を先にしてから線分迄の距離を計算しています。
   割算やルートを実際に計算すると遅いので
   dlen=線分迄の距離*線分の長さ として 
   slen=線分の長さx2=2*��(dx*dx+dy*dy);の近似値
   を求めて比較しています。
   データ精度とピクセルとが違う場合は、slenをその比率倍する必要がある
   のは当然です。

｢使用例｣他は前回と同じで MouseMoveだけ変更

var oldcc:integer; //
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var cc,typ:integer;
begin
  if n>0 then
   begin
    cc :=  PolygonNear(x,y,n,pt);
   if oldcc<>cc then begin      {判定結果が前回と違ってたら}
     Canvas.Pen.Color:=clRed;   {線を赤で塗る}
     if cc>=0 then begin
      with pt[cc  ] do Canvas.MoveTo (x,y);
      with pt[cc+1] do Canvas.LineTo (x,y);
     end;
     Canvas.Pen.Color:=clBlack; {前の線を黒で塗って戻す}
     if Oldcc>=0 then begin
      with pt[Oldcc  ] do Canvas.MoveTo (x,y);
      with pt[Oldcc+1] do Canvas.LineTo (x,y);
     end;
    Oldcc:=cc;
   end;
  end;
end;

Original document by 裏目小僧        氏 ID:(GGA03463)

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