View Issue Details

IDProjectCategoryView StatusLast Update
0036709LazarusLCLpublic2020-03-12 08:32
Reportershiraishi Assigned ToJuha Manninen  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformGTK2OSLinux 
Product Version2.1 (SVN) 
Summary0036709: GTK2: TCanvas.Polygon ignores Brush.Color on non-default Brush.Style.
DescriptionGTK2:
On for Lazarus 2.1.0(SVN) , 2.0.6, and 1.8.4,
TCanvas.Polygon ignores Brush.Color when non-default Brush.Style assigned,
On Lazarus 1.6.4, drawn rightly.
Steps To Reproduceunit Unit1;

{$mode objfpc}{$H+}

interface
                       

uses
  Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, Buttons;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
{ TForm1 }
const
  p1:TPoint=(x:1;y:1);
  p2:TPoint=(x:199;y:1);
  p3:TPoint=(x:100;y:160);

procedure TForm1.FormCreate(Sender: TObject);
begin
   with image1.canvas do
  begin
     Pen.Color := clWhite;
     Rectangle(0, 0, Image1.Width, Image1.Height);

     Pen.Color:=clred ;
     Brush.Style:=TBrushStyle(4);
     Brush.Color:=clred ;
     Polygon([p1,p2,p3]) ;
  end;
end;

end.
Additional Informationprobably not depend on 32 bit or 64 bit.
Same issue in 0034414
TagsNo tags attached.
Fixed in Revisionr62743
LazTarget-
WidgetsetGTK 2, QT, QT5
Attached Files

Relationships

related to 0034414 resolvedDmitry Boyarintsev TCanvas.Polygon ignores Brush.Color on non-default Brush.Style 

Activities

shiraishi

2020-02-18 05:33

reporter  

unit1.lfm (294 bytes)   
object Form1: TForm1
  Left = 776
  Height = 167
  Top = 180
  Width = 209
  Caption = 'Form1'
  ClientHeight = 167
  ClientWidth = 209
  OnCreate = FormCreate
  LCLVersion = '1.6.4.0'
  object Image1: TImage
    Left = 4
    Height = 160
    Top = 3
    Width = 200
  end
end
unit1.lfm (294 bytes)   
unit1.pas (746 bytes)   
unit Unit1;

{$mode objfpc}{$H+}

interface


uses
  Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, Buttons;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}


{ TForm1 }
const
  p1:TPoint=(x:1;y:1);
  p2:TPoint=(x:199;y:1);
  p3:TPoint=(x:100;y:160);

procedure TForm1.FormCreate(Sender: TObject);
begin
   with image1.canvas do
  begin
     Pen.Color := clWhite;
     Rectangle(0, 0, Image1.Width, Image1.Height);

     Pen.Color:=clred ;
     Brush.Style:=TBrushStyle(4);
     Brush.Color:=clred ;
     Polygon([p1,p2,p3]) ;
  end;
end;

end.

unit1.pas (746 bytes)   
project1.lpr (380 bytes)   
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

project1.lpr (380 bytes)   
Lazarus 1.6.4.png (3,284 bytes)   
Lazarus 1.6.4.png (3,284 bytes)   
Lazarus 2.1.0.png (4,065 bytes)   
Lazarus 2.1.0.png (4,065 bytes)   

Juha Manninen

2020-02-18 16:27

developer   ~0121161

Last edited: 2020-02-18 16:30

View 2 revisions

The related issue 0034414 says:
 "On Mac Carbon(32bit), Windows(both 32bit and 64bit) and Linux 32bit, this goes correctly."
I guess Linux 32bit means GTK2 widgetset. Was the information wrong or did this feature break after you wrote 0034414? In that case which revision broke it?

CudaText man

2020-02-19 22:23

reporter   ~0121168

I attach the full project.
Juha, can you make cloned issue for Qt and Qt5 ? it has the same fault.

CudaText man

2020-02-19 22:24

reporter   ~0121169

Seems GTK2 don't have Brush.Style at all? I dont see here "Style"
gtk2def.pp

  TGDIObject = record
    RefCount: integer; // see ReleaseGDIObject, ReferenceGDIObject
    DCCount: integer; // number of DeviceContexts using this GDIObject
    Shared: Boolean; // stock or system object which skips DeleteObject calls
    Owner: TGtkDeviceContext;
    {$ifdef TraceGdiCalls}
    StackAddrs: TCallBacksArray;
    {$endif}
    Next: PGDIObject; // 'Next' is used by the internal mem manager
    case GDIType: TGDIType of
      gdiBitmap: (
        ..
      );
      gdiBrush: (
        // ToDo: add bitmap mask
        IsNullBrush: Boolean;
        GDIBrushColor: TGDIColor;
        GDIBrushFill: TGdkFill;
        GDIBrushPixMap: PGdkPixmap;
      );                                

Juha Manninen

2020-02-20 15:26

developer   ~0121176

> Juha, can you make cloned issue for Qt and Qt5 ? it has the same fault.

I added those widgetsets into this report.

shiraishi

2020-02-24 02:17

reporter   ~0121209

On Qt, the result is right.
Qt-Lazarus2.1.0r62657.png (4,047 bytes)   
Qt-Lazarus2.1.0r62657.png (4,047 bytes)   

shiraishi

2020-03-10 06:37

reporter   ~0121520

It's good on both Qt and Qt5.

Anton Kavalenka

2020-03-10 13:08

reporter  

gtk2devicecontext.diff (788 bytes)   
--- /home/anton/net/prj/.projects/lazarus/lcl/interfaces/gtk2/gtk2devicecontext.inc	2019-06-18 16:58:55.000000000 +0300
+++ /projects/lazarus/lcl/interfaces/gtk2/gtk2devicecontext.inc	2020-03-10 15:04:38.863109920 +0300
@@ -1073,7 +1073,7 @@
     //invert background / foreground colors to match Windows.FillRect behavior
     //with a 1bit bitmap pattern brush (bit set -> back color, bit unset -> text color)
     EnsureGCColor(HDC(Self), dccCurrentTextColor, False, True);
-    EnsureGCColor(HDC(Self), dccCurrentBackColor, False, False);
+    EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);
     gdk_gc_set_stipple(GC, CurrentBrush^.GDIBrushPixmap);
     //use GDK_OPAQUE_STIPPLED to draw both background and foreground color
     gdk_gc_set_fill(GC, GDK_OPAQUE_STIPPLED);
gtk2devicecontext.diff (788 bytes)   

Anton Kavalenka

2020-03-10 13:08

reporter   ~0121532

Last edited: 2020-03-10 15:28

View 2 revisions

Looks like slightly different flags make the things better under GTK2

Juha Manninen

2020-03-11 23:36

developer   ~0121561

I applied the patch. Thanks.

Issue History

Date Modified Username Field Change
2020-02-18 05:33 shiraishi New Issue
2020-02-18 05:33 shiraishi File Added: unit1.lfm
2020-02-18 05:33 shiraishi File Added: unit1.pas
2020-02-18 05:33 shiraishi File Added: project1.lpr
2020-02-18 05:33 shiraishi File Added: Lazarus 1.6.4.png
2020-02-18 05:33 shiraishi File Added: Lazarus 2.1.0.png
2020-02-18 16:21 Juha Manninen Relationship added related to 0034414
2020-02-18 16:27 Juha Manninen Note Added: 0121161
2020-02-18 16:30 Juha Manninen Note Edited: 0121161 View Revisions
2020-02-19 22:23 CudaText man File Added: tst-canvas-brush-style-not-std.zip
2020-02-19 22:23 CudaText man Note Added: 0121168
2020-02-19 22:24 CudaText man Note Added: 0121169
2020-02-20 15:25 Juha Manninen LazTarget => -
2020-02-20 15:25 Juha Manninen Widgetset GTK 2 => GTK 2, QT, QT5
2020-02-20 15:26 Juha Manninen Note Added: 0121176
2020-02-24 02:17 shiraishi File Added: Qt-Lazarus2.1.0r62657.png
2020-02-24 02:17 shiraishi Note Added: 0121209
2020-03-10 06:37 shiraishi Note Added: 0121520
2020-03-10 13:08 Anton Kavalenka File Added: gtk2devicecontext.diff
2020-03-10 13:08 Anton Kavalenka File Added: Здымак экрана, 2020-03-10 15-07-37.png
2020-03-10 13:08 Anton Kavalenka Note Added: 0121532
2020-03-10 15:28 Anton Kavalenka Note Edited: 0121532 View Revisions
2020-03-10 17:05 Juha Manninen Assigned To => Juha Manninen
2020-03-10 17:05 Juha Manninen Status new => assigned
2020-03-11 23:36 Juha Manninen Status assigned => resolved
2020-03-11 23:36 Juha Manninen Resolution open => fixed
2020-03-11 23:36 Juha Manninen Fixed in Revision => r62743
2020-03-11 23:36 Juha Manninen Widgetset GTK 2, QT, QT5 => GTK 2, QT, QT5
2020-03-11 23:36 Juha Manninen Note Added: 0121561