paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-23 13:04:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

Gtk3: set background color. Patch by Anton Kavalenka. issue #41348

Browse Source
This commit is contained in:
zeljan1 2025-01-25 21:59:24 +01:00
parent d121ba841e
commit 375aee0658
1 changed files with 26 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
lcl/interfaces/gtk3/gtk3widgets.pas
View File

@ -805,6 +805,7 @@ type
function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override; function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
function EatArrowKeys(const {%H-}AKey: Word): Boolean; override; function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
public public
procedure DoBeforeLCLPaint; override;
procedure OffsetMousePos(APoint: PPoint); override; procedure OffsetMousePos(APoint: PPoint); override;
procedure InitializeWidget; override; procedure InitializeWidget; override;
function getViewport: PGtkViewport; override; function getViewport: PGtkViewport; override;
@ -8263,6 +8264,31 @@ begin
Result := False; Result := False;
end; end;
procedure TGtk3CustomControl.DoBeforeLCLPaint;
var
DC: TGtk3DeviceContext;
NColor: TColor;
begin
inherited DoBeforeLCLPaint;
if not Visible then
exit;
DC := TGtk3DeviceContext(Context);
NColor := LCLObject.Color;
if (NColor <> clNone) and (NColor <> clDefault) then
begin
DC.CurrentBrush.Color := ColorToRGB(NColor);
DC.fillRect(0, 0, LCLObject.Width, LCLObject.Height);
end;
if BorderStyle <> bsNone then
begin
DC.CurrentPen.Color := ColorToRGB(clBtnShadow); // not sure what color to use here?
DC.drawRect(0, 0, LCLObject.Width, LCLObject.Height, False, True);
end;
end;
procedure TGtk3CustomControl.OffsetMousePos(APoint: PPoint); procedure TGtk3CustomControl.OffsetMousePos(APoint: PPoint);
var var
Hadjustment, Vadjustment: PGtkAdjustment; Hadjustment, Vadjustment: PGtkAdjustment;