mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-30 20:58:19 +02:00
f5718e9f06
This fixes a bunch of warnings when Gtk1 applications start. The fixes are on keyboard initialization (make a previously statically sized array dynamic as the old value wasn't long enough and disable an unnecessary warning about filling the VK table as the user can't do anything about it - nor we unless the whole thing is redesigned), module loading (this is a side effect of an environment variable collision between Gtk1, Gtk2 and Gtk3 - all of these use the GTK_MODULES variable to load some modules but since as of 2023 no distribution aside from Slackware comes with Gtk1, all of these warnings are bogus, so this patch temporarily cleans the environment variable before initializing Gtk and restores it later so that child processes can still access it) and passing NULL styles to gtk_style_copy (the previous code assumed the style retrieval functions always return a valid object, which is not the case).
81 lines
2.5 KiB
PHP
81 lines
2.5 KiB
PHP
{%MainUnit gtk1int.pp}
|
|
|
|
{******************************************************************************
|
|
TGtkWidgetSet
|
|
******************************************************************************
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
|
|
{$IFOPT C-}
|
|
// Uncomment for local trace
|
|
// {$C+}
|
|
// {$DEFINE ASSERT_IS_ON}
|
|
{$ENDIF}
|
|
|
|
function TGTK1WidgetSet.GetDeviceContextClass: TGtkDeviceContextClass;
|
|
begin
|
|
Result := TGtk1DeviceContext;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure SetWidgetFont
|
|
AWidget : PGtkWidget; const AFont: TFont
|
|
------------------------------------------------------------------------------}
|
|
procedure TGtk1WidgetSet.SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont);
|
|
var
|
|
WindowStyle: PGtkStyle;
|
|
FontGdiObject: PGdiObject;
|
|
|
|
begin
|
|
if GtkWidgetIsA(AWidget,GTKAPIWidget_GetType) then
|
|
Exit; // the GTKAPIWidget is self drawn, so no use to change the widget style.
|
|
|
|
if (GTK_WIDGET_REALIZED(AWidget)) then
|
|
WindowStyle := gtk_widget_get_style(AWidget)
|
|
else
|
|
WindowStyle := gtk_rc_get_style(AWidget);
|
|
|
|
if WindowStyle <> nil then
|
|
WindowStyle := gtk_style_copy(WindowStyle);
|
|
|
|
if (Windowstyle = nil) then
|
|
Windowstyle := gtk_style_new;
|
|
|
|
FontGdiObject := PGdiObject(AFont.Reference.Handle);
|
|
windowstyle^.font := Pointer(FontGdiObject^.GdiFontObject);
|
|
gtk_widget_set_style(aWidget, windowStyle);
|
|
end;
|
|
|
|
procedure TGtk1WidgetSet.SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String;
|
|
const AComponent: TComponent = nil; const ASignalWidget: PGTKWidget = nil;
|
|
const ASignal: PChar = nil);
|
|
var
|
|
Caption, Pattern: String;
|
|
CurText: PChar;
|
|
AccelKey: Char;
|
|
begin
|
|
Caption := ACaption;
|
|
LabelFromAmpersands(Caption, Pattern, AccelKey);
|
|
gtk_label_get(ALabel, @CurText);
|
|
if Caption <> StrPas(CurText) then
|
|
begin
|
|
gtk_label_set_text(ALabel, PChar(Caption));
|
|
gtk_label_set_pattern(ALabel, PChar(Pattern));
|
|
end;
|
|
|
|
if AComponent = nil then Exit;
|
|
if ASignalWidget = nil then Exit;
|
|
if ASignal = '' then Exit;
|
|
|
|
// update the Accelerator
|
|
if AccelKey = #0
|
|
then Accelerate(AComponent, ASignalWidget, GDK_VOIDSYMBOL, 0, ASignal)
|
|
else Accelerate(AComponent, ASignalWidget, Ord(AccelKey), 0, ASignal);
|
|
end;
|