Problem mit CreatePolygonRgn(...

[Sven]

Ich verwende CreatePolygonRgn und PtInRegion um Mausklicks in einem polygonal begrenzten Raum abfragen zu können.
Dies ist der Quelltextauszug

Code:

handle := CreatePolygonRgn(tp[0], High(tp), 1);

   if handle ] 0 then begin

     if SelectObject(BCAD.imgCAD.Canvas.Handle, handle) ] 0 then

     begin

        if PtInRegion(handle, p.x, p.y) then begin

        ...

tp ist dabei ein dynamisches Array vom Typ TPoint.
Mein Problem ist, daß der erste Aufruf noch korrekt funktioniert. Falls ich das Prog jedoch mit der Kompilereinstellung RangeCheck kompiliere, bekomme ich beim zweiten Durchlauf eine Exception. Das Handle gebe ich später mit DeleteObject(handle) wieder frei.

Wer kann helfen?

Sven

Nachtrag
Wenn ich ein statisches Array verwende habe ich dasselbe Problem.
Die Exception ist vom Typ RangeCheckError

[Thomas Stutz]

Hi,

Ich kann leider dein Problem anhand des Quelltextauszuges nicht
erkennen aber so was funktioniert bei mir:


[font size=2 face="Courier New"][font color="#000000"]procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
type
  PPointArray = ^TPointArray;
  TPointArray = array[0..MaxInt div SizeOf(TPoint) - 1] of TPoint;
var
  Rgn: HRGN;
  Pa: PPointArray;
begin
  GetMem(Pa, SizeOf(TPoint) * 3);
  try
    Pa[0] := Point(0, 0);
    Pa[1] := Point(80, 200);
    Pa[2] := Point(200, 80);
    Rgn := CreatePolygonRgn(Pa[0], 3, WINDING);
    try
      Canvas.Brush.Color := clGreen;
      FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);
      if PtInRegion(Rgn, X, Y) then ShowMessage('ja');
    finally
      DeleteObject(Rgn);
    end;
  finally
    FreeMem(Pa);
  end;
end;
[/font][/font]

[Rainer]

Was machst Du denn da wo die Punkte stehen?

Sowas funktioniert ohne Probleme:

[font size=2 face="Courier New"][font color="#000000"]var
  points: array of TPoint;

[font color="#000080"]{$R+}

[/font]procedure TForm1.FormCreate(Sender: TObject);
begin
  SetLength(points, 4);
  points[0].x := 1;
  points[0].y := 1;
  points[1].x := 145;
  points[1].y := 245;
  points[2].x := 245;
  points[2].y := 200;
  points[3].x := 1;
  points[3].y := 25;
  Image1.Canvas.Polygon(points);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  h: THandle;
begin
  h := CreatePolygonRgn(points[0], Length(points), 1);
  try
    if PtInRegion(h, x, y) then
    begin
      ShowMessage('huhu');
    end;
  finally
    DeleteObject(h);
  end;
end;
[/font][/font]
Edit: Das nächste Mal schau ich, ob in der Zwischenzeit nicht schon wer was geschrieben hat :-)

[Sven]

Hallo Rainer,

ähnlich Deinem zweiten Beispiel ist es bei mir. Ein dyn. Array of TPoint, allerdings local definiert.
Ich habe auch schon das ...High(tp), 1); gegen Length(tp) ausgestauscht.
Keine Änderung.
Was mir aber auffällt, bei meinem Prog, daß die RangeCheckError nicht unbedingt nach dem zweiten Mal, sondern evtl auch erst nach dem vierten oder fünften Mal auftritt.