View Issue Details

IDProjectCategoryView StatusLast Update
0025507LazarusLCLpublic2014-01-18 09:33
Reportercorpsman Assigned ToZeljan Rikalo  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformLinuxOSKubuntu 
Product Version1.3 (SVN) 
Target Version1.2.0 
Summary0025507: canvas.polygon in TPaintbox overwrites const array
DescriptionOnly on Linux, if you execute the attached programm, on each invalidate, the triangle moves (delta is the top, left coordinate from the paintbox).

If you use form1.canvas the problem does not happen.
Steps To ReproduceExecute the Program, click the invalidate button

The triangle should stay in place, but does not.
Tagscanvas, polygon, TPaintbox
Fixed in Revision43719
LazTarget-
WidgetsetGTK 2
Attached Files

Activities

corpsman

2014-01-08 21:19

reporter  

bug.zip (2,299 bytes)

Bart Broersma

2014-01-09 02:46

developer   ~0072321

Last edited: 2014-01-09 02:47

View 2 revisions

function TGtk2WidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer;
  Winding: boolean): boolean;
var
  DevCtx: TGtkDeviceContext absolute DC;

  i: integer;
  PointArray: PGDKPoint;
  Tmp, RGN : hRGN;
  ClipRect : TRect;
  DCOrigin: TPoint;
  OldNumPts: integer;
begin
  if not IsValidDC(DC) then Exit(False);

  if NumPts <= 0 then Exit(True);
  
  DCOrigin := DevCtx.Offset;
  OldNumPts := NumPts;

  // create the PointsArray, which is a copy of Points moved by the DCOrigin
  // only if needed
  if (DevCtx.IsNullPen and (DevCtx.IsNullBrush or Winding)) then
    PointArray := nil
  else
  begin
    GetMem(PointArray, SizeOf(TGdkPoint) * (NumPts + 1)); // +1 for return line
    for i := 0 to NumPts - 1 do
    begin
      if DevCtx.HasTransf then
        Points[I] := DevCtx.TransfPointIndirect(Points[I]);
      PointArray[i].x := Points[i].x + DCOrigin.X;
      PointArray[i].y := Points[i].y + DCOrigin.Y;
    end;

Points is a pointer to the array of TPoints.
So changing Points[I] in fact changes the content of the origianl array of TPoints (pol in Unit1).

However if you change this to
    begin
      CurPoint := Points[I];
      if DevCtx.HasTransf then
        CurPoint := DevCtx.TransfPointIndirect(CurPoint);
      PointArray[i].x := CurPoint.x + DCOrigin.X;
      PointArray[i].y := CurPoint.y + DCOrigin.Y;
    end;

then the background is painted correctly, but outline is still displaced by the ofsett of the PaintBox

Bart Broersma

2014-01-09 02:49

developer   ~0072322

Last edited: 2014-01-09 03:00

View 2 revisions

Unrelated, but should

    begin
      CurPoint := Points[I];
      if DevCtx.HasTransf then
        CurPoint := DevCtx.TransfPointIndirect(CurPoint);
      PointArray[i].x := CurPoint.x + DCOrigin.X;
      PointArray[i].y := CurPoint.y + DCOrigin.Y;
    end;

be

    begin
      CurPoint := Points[I];
      if DevCtx.HasTransf then
        CurPoint := DevCtx.TransfPointIndirect(CurPoint)
      else
      begin
        CurPoint.x := CurPoint.x + DCOrigin.X;
        CurPoint.y := CurPoint.y + DCOrigin.Y;
      end;
      PointArray[i].x := CurPoint.x;
      PointArray[i].y := CurPoint.y;
    end;

Bart Broersma

2014-01-09 16:17

developer   ~0072335

We need a copy of the original points and do transformations on them instead.
The transformed points are used in drawing the outline (as a PGDKPoint parameter) and in the drawing of the interior (as a PPoint parameter).

I attached a possible fix.

Bart Broersma

2014-01-09 16:19

developer  

gtk2.polygon.diff (2,222 bytes)   
Index: lcl/interfaces/gtk2/gtk2winapi.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapi.inc	(revision 43495)
+++ lcl/interfaces/gtk2/gtk2winapi.inc	(working copy)
@@ -6694,18 +6694,25 @@
   Winding: boolean): boolean;
 var
   DevCtx: TGtkDeviceContext absolute DC;
-
   i: integer;
   PointArray: PGDKPoint;
   Tmp, RGN : hRGN;
   ClipRect : TRect;
   DCOrigin: TPoint;
   OldNumPts: integer;
+  CurPoint: types.TPoint;
+  ThePoints: array of types.TPoint;
+  PThePoints: PPoint;
 begin
   if not IsValidDC(DC) then Exit(False);
 
   if NumPts <= 0 then Exit(True);
-  
+
+  //Create a copy of the points so we can freely alter them
+  SetLength(ThePoints, NumPts);
+  for i := 0 to NumPts do ThePoints[i] := Points[i];
+  PThePoints := @ThePoints[0];
+
   DCOrigin := DevCtx.Offset;
   OldNumPts := NumPts;
 
@@ -6719,9 +6726,9 @@
     for i := 0 to NumPts - 1 do
     begin
       if DevCtx.HasTransf then
-        Points[I] := DevCtx.TransfPointIndirect(Points[I]);
-      PointArray[i].x := Points[i].x + DCOrigin.X;
-      PointArray[i].y := Points[i].y + DCOrigin.Y;
+        ThePoints[I] := DevCtx.TransfPointIndirect(ThePoints[I]);
+      PointArray[i].x := ThePoints[I].x + DCOrigin.X;
+      PointArray[i].y := ThePoints[I].y + DCOrigin.Y;
     end;
 
     if (Points[NumPts-1].X <> Points[0].X) or
@@ -6745,7 +6752,7 @@
       Tmp := CreateEmptyRegion;
       GetClipRGN(DC, Tmp);
       // apply new clipping
-      RGN := CreatePolygonRgn(Points, OldNumPts, LCLType.Winding);
+      RGN := CreatePolygonRgn(PThePoints, OldNumPts, LCLType.Winding);
       ExtSelectClipRGN(DC, RGN, RGN_AND);
       DeleteObject(RGN);
       GetClipBox(DC, @ClipRect);
@@ -6761,7 +6768,7 @@
       gdk_draw_polygon(DevCtx.Drawable, DevCtx.GC, 1, PointArray, NumPts);
     end;
   end;
-    
+
   // draw outline
   if not DevCtx.IsNullPen
   then begin
@@ -6772,10 +6779,11 @@
   {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
 
   if PointArray <> nil then FreeMem(PointArray);
-
+  SetLength(ThePoints,0);
   Result := True;
 end;
 
+
 function TGtk2WidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
 var
   DevCtx: TGtkDeviceContext absolute DC;
gtk2.polygon.diff (2,222 bytes)   

Bart Broersma

2014-01-09 16:20

developer   ~0072336

Zeljan, can you review the patch?

Zeljan Rikalo

2014-01-11 22:20

developer   ~0072376

@Bart, it's not good. That patch crashes gtk2 when eg. drawing TShape.Shape triangle (not every time but most of trials are crash). No time to investigate atm. Just add TShape to this example and one combobox. Fill combo items with TShapeType and set TShape.Shape to rectangle. In OnChange of combobox just change shape .... and you'll see.

Bart Broersma

2014-01-12 01:12

developer   ~0072378

Can't test right now, but this is probably wrong in my patch
+ for i := 0 to NumPts do ThePoints[i] := Points[i];

This could explain the crashes (I'm writing behind the length of ThePoints, and reading behind the length of Points).

Should be
+ for i := 0 to NumPts - 1 do ThePoints[i] := Points[i];

Zeljan Rikalo

2014-01-12 11:15

developer   ~0072379

Then fix patch please.

Bart Broersma

2014-01-12 13:37

developer  

gtk2.polygon-2.diff (2,302 bytes)   
Index: lcl/interfaces/gtk2/gtk2winapi.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapi.inc	(revision 43495)
+++ lcl/interfaces/gtk2/gtk2winapi.inc	(working copy)
@@ -6694,18 +6694,25 @@
   Winding: boolean): boolean;
 var
   DevCtx: TGtkDeviceContext absolute DC;
-
   i: integer;
   PointArray: PGDKPoint;
   Tmp, RGN : hRGN;
   ClipRect : TRect;
   DCOrigin: TPoint;
   OldNumPts: integer;
+  CurPoint: types.TPoint;
+  ThePoints: array of types.TPoint;
+  PThePoints: PPoint;
 begin
   if not IsValidDC(DC) then Exit(False);
 
   if NumPts <= 0 then Exit(True);
-  
+
+  //Create a copy of the points so we can freely alter them
+  SetLength(ThePoints, NumPts);
+  for i := 0 to NumPts - 1 do ThePoints[i] := Points[i];
+  PThePoints := @ThePoints[0];
+
   DCOrigin := DevCtx.Offset;
   OldNumPts := NumPts;
 
@@ -6719,9 +6726,9 @@
     for i := 0 to NumPts - 1 do
     begin
       if DevCtx.HasTransf then
-        Points[I] := DevCtx.TransfPointIndirect(Points[I]);
-      PointArray[i].x := Points[i].x + DCOrigin.X;
-      PointArray[i].y := Points[i].y + DCOrigin.Y;
+        ThePoints[I] := DevCtx.TransfPointIndirect(ThePoints[I]);
+      PointArray[i].x := ThePoints[I].x + DCOrigin.X;
+      PointArray[i].y := ThePoints[I].y + DCOrigin.Y;
     end;
 
     if (Points[NumPts-1].X <> Points[0].X) or
@@ -6745,7 +6752,7 @@
       Tmp := CreateEmptyRegion;
       GetClipRGN(DC, Tmp);
       // apply new clipping
-      RGN := CreatePolygonRgn(Points, OldNumPts, LCLType.Winding);
+      RGN := CreatePolygonRgn(PThePoints, OldNumPts, LCLType.Winding);
       ExtSelectClipRGN(DC, RGN, RGN_AND);
       DeleteObject(RGN);
       GetClipBox(DC, @ClipRect);
@@ -6761,7 +6768,7 @@
       gdk_draw_polygon(DevCtx.Drawable, DevCtx.GC, 1, PointArray, NumPts);
     end;
   end;
-    
+
   // draw outline
   if not DevCtx.IsNullPen
   then begin
@@ -6772,10 +6779,11 @@
   {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
 
   if PointArray <> nil then FreeMem(PointArray);
-
+  SetLength(ThePoints,0);
   Result := True;
 end;
 
+
 function TGtk2WidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
 var
   DevCtx: TGtkDeviceContext absolute DC;
gtk2.polygon-2.diff (2,302 bytes)   

Zeljan Rikalo

2014-01-12 20:14

developer   ~0072393

Please test and close if ok.
This is candidate for merging into 1.2

Issue History

Date Modified Username Field Change
2014-01-08 21:19 corpsman New Issue
2014-01-08 21:19 corpsman File Added: bug.zip
2014-01-08 21:22 corpsman Tag Attached: canvas
2014-01-08 21:22 corpsman Tag Attached: paintbox
2014-01-08 21:22 corpsman Tag Attached: polygon
2014-01-08 21:22 corpsman Tag Detached: paintbox
2014-01-08 21:23 corpsman Tag Attached: TPaintbox
2014-01-09 02:46 Bart Broersma Note Added: 0072321
2014-01-09 02:47 Bart Broersma Note Edited: 0072321 View Revisions
2014-01-09 02:49 Bart Broersma Note Added: 0072322
2014-01-09 03:00 Bart Broersma Note Edited: 0072322 View Revisions
2014-01-09 16:17 Bart Broersma Note Added: 0072335
2014-01-09 16:19 Bart Broersma File Added: gtk2.polygon.diff
2014-01-09 16:20 Bart Broersma LazTarget => -
2014-01-09 16:20 Bart Broersma Note Added: 0072336
2014-01-09 16:20 Bart Broersma Assigned To => Zeljan Rikalo
2014-01-09 16:20 Bart Broersma Status new => assigned
2014-01-09 16:20 Bart Broersma Target Version => 1.2.0
2014-01-11 22:20 Zeljan Rikalo Note Added: 0072376
2014-01-11 22:20 Zeljan Rikalo Status assigned => feedback
2014-01-12 01:12 Bart Broersma Note Added: 0072378
2014-01-12 01:14 Bart Broersma Status feedback => assigned
2014-01-12 11:15 Zeljan Rikalo Note Added: 0072379
2014-01-12 12:06 Bart Broersma File Added: gtk2.polygon-2.diff
2014-01-12 13:37 Bart Broersma File Deleted: gtk2.polygon-2.diff
2014-01-12 13:37 Bart Broersma File Added: gtk2.polygon-2.diff
2014-01-12 20:14 Zeljan Rikalo Fixed in Revision => 43719
2014-01-12 20:14 Zeljan Rikalo Note Added: 0072393
2014-01-12 20:14 Zeljan Rikalo Status assigned => resolved
2014-01-12 20:14 Zeljan Rikalo Resolution open => fixed