[erledigt] Brush Style bsImage funktioniert nur einmal

Antworten
Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

[erledigt] Brush Style bsImage funktioniert nur einmal

Beitrag von Michl »

Servus,

weiß jemand, warum unter Linux GTK2 und QT (andere Widgetsets habe ich bisher nicht getestet) nur einmal die Zuweisung des Bitmaps funktioniert? Unter Windows funktioniert es, wie es soll:

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
var
  LRandomColor: Integer;
begin
  if Assigned(FBitmap) then FBitmap.Free;
  LRandomColor := Random($FFFFFF);
  FBitmap := TBitmap.Create;
  FBitmap.SetSize(2, 2);
  FBitmap.Canvas.Pixels[0, 0] := clBlack;
  FBitmap.Canvas.Pixels[0, 1] := LRandomColor;
  FBitmap.Canvas.Pixels[1, 0] := LRandomColor;
  FBitmap.Canvas.Pixels[0, 0] := clBlack;
  Invalidate;
end;

...

procedure TForm1.FormPaint(Sender: TObject);
begin
  if not Assigned(FBitmap) then Exit;
  Canvas.Brush.Style := bsImage;
  Canvas.Brush.Bitmap := FBitmap;
  Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end;  
Testbeispiel anbei.
Dateianhänge
TestBackGroundBitmap.zip
(1.94 KiB) 111-mal heruntergeladen
Zuletzt geändert von Michl am So 24. Jan 2021, 21:37, insgesamt 1-mal geändert.

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Brush Style bsImage funktioniert nur einmal

Beitrag von wennerer »

Hallo Michl,
warum es nicht geht weiß ich leider nicht (da reicht mein Wissen nicht). Aber in der Reihenfolge geht es bei mir (hab es in einer Stable gemacht). Ich hoffe das bringt dich etwas weiter.

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FPCanvas, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FBitmap: TBitmap;

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  LRandomColor: Integer;
begin
  //if assigned(FBitmap) then freeandnil(FBitmap); //Hier gehts nicht
  LRandomColor := Random($FFFFFF);
  FBitmap := TBitmap.Create;
  FBitmap.SetSize(20,20);
  FBitmap.Canvas.Brush.Color:=clWhite;
  FBitmap.Canvas.FillRect(0,0,width,height);
  FBitmap.Canvas.Brush.Color:=LRandomColor;
  FBitmap.Canvas.Ellipse(5,5,15,15);


  Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBitmap := nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 if assigned(FBitmap) then freeandnil(FBitmap);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if not Assigned(FBitmap) then Exit;
  Canvas.Brush.Bitmap := nil;
  //Canvas.Brush.Style := bsSolid;  kein Unterschied
  //canvas.Brush.Style := bsImage;  kein Unterschied
  Canvas.Brush.Bitmap := FBitmap ;
  Canvas.FillRect(0, 0, ClientWidth, ClientHeight) ;
  if assigned(FBitmap) then freeandnil(FBitmap);   //hier gehts
end;

end.
Viele Grüße
Bernd
Dateianhänge
project1.zip
(126.89 KiB) 101-mal heruntergeladen

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Brush Style bsImage funktioniert nur einmal

Beitrag von Michl »

Hallo Bernd,

danke fürs Testen!

Zumindest scheine ich da nichts per se übersehen zu haben.

Da das Control, was letztlich diese Möglichkeit benötigt, dynamisch erstellt wird, erzeuge ich es nun halt neu, wenn man die Farbe ändert - das geht.

Werde mal schauen, woran das liegt oder einen Bugreport erstellen.

Nachmal danke und viele Grüße

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: [erledigt] Brush Style bsImage funktioniert nur einmal

Beitrag von Michl »

-

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

Antworten