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

improved color for gtk widgets from Darek

Browse Source 
git-svn-id: trunk@8625 -
This commit is contained in:
mattias 2006-01-26 20:53:59 +00:00
parent c474bf1958
commit 4b193a4407
11 changed files with 111 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -1709,6 +1709,7 @@ type
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
procedure PaintWindow(DC: HDC); override;
procedure FontChanged(Sender: TObject); override;
procedure SetColor(Value: TColor); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

7
lcl/include/customcontrol.inc
View File

@ -86,6 +86,13 @@ begin
inherited FontChanged(Sender);
end;
procedure TCustomControl.SetColor(Value: TColor);
begin
if Value=Color then exit;
inherited SetColor(Value);
Canvas.Color:=Color;
end;
{------------------------------------------------------------------------------
Method: TCustomControl.LMPaint
Params: Msg: The paint message

5
lcl/include/custompanel.inc
View File

@ -104,7 +104,10 @@ begin
Canvas.Frame3d(ARect, BevelWidth, BevelInner);
InflateRect(ARect, -1, -1);
end;
if Color<>clBtnFace then begin
Canvas.Brush.Color:=Color;
Canvas.FillRect(ARect);
end;
if Caption <> '' then begin
TS := Canvas.TextStyle;
TS.Alignment:= Alignment;

1
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -232,7 +232,6 @@ begin
TheWinControl.CNPreferredSizeChanged;
SetCursor(TheWinControl, crDefault);
ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
UpdateWidgetStyleOfControl(TheWinControl);
if TheWinControl is TCustomPage then
UpdateNotebookPageTab(nil,TheWinControl);

1
lcl/interfaces/gtk/gtkdef.pp
View File

@ -223,6 +223,7 @@ type
wwiNotOnParentsClientArea
);
TWidgetInfoFlags = set of TWidgetInfoFlag;
tGtkStateEnum = set of byte;
// Info needed by the API of a HWND (=Widget)
PWidgetInfo = ^TWidgetInfo;

14
lcl/interfaces/gtk/gtkint.pp
View File

@ -251,8 +251,15 @@ type
function gdkFunctionToROP2Mode(aFunction: TGdkFunction): Integer;
public
// for gtk specific components:
procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String; const AComponent: TComponent; const ASignalWidget: PGTKWidget; const ASignal: PChar); virtual;
procedure SetCallback(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject); virtual;
procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String;
const AComponent: TComponent;
const ASignalWidget: PGTKWidget;
const ASignal: PChar); virtual;
procedure SetWidgetColor(const AWidget : PGtkWidget;
const FGColor,BGColor : TColor;
const Mask : tGtkStateEnum);
procedure SetCallback(const AMsg: LongInt; const AGTKObject: PGTKObject;
const ALCLObject: TObject); virtual;
procedure SendPaintMessagesForInternalWidgets(AWinControl: TWinControl);
function LCLtoGtkMessagePending: boolean;virtual;
procedure SendCachedGtkMessages;virtual;
@ -265,7 +272,8 @@ type
procedure ShowHide(Sender : TObject);virtual;
// control functions for messages, callbacks
procedure HookSignals(const AGTKObject: PGTKObject; const ALCLObject: TObject); virtual; //hooks all signals for controls
procedure HookSignals(const AGTKObject: PGTKObject;
const ALCLObject: TObject); virtual; //hooks all signals for controls
public
// Application
procedure AppInit(var ScreenInfo: TScreenInfo); override;

50
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1315,6 +1315,56 @@ begin
else Accelerate(AComponent, ASignalWidget, Ord(AccelKey), 0, ASignal);
end;
procedure TGtkWidgetSet.SetWidgetColor(const AWidget: PGtkWidget;
const FGColor, BGColor: TColor; const Mask: tGtkStateEnum);
// Changes some colors of the widget style
// IMPORTANT:
// SystemColors like clBtnFace depend on the theme and widget class, so they
// must be read from the theme. But many gtk themes do not provide all colors
// and instead only provide bitmaps.
// Since we don't have good fallbacks yet, and many controls use SystemColors
// for Delphi compatibility: ignore SystemColors.
var
WindowStyle: PGtkStyle;
i: integer;
xfg,xbg: TGDKColor;
ChangeFGColor: Boolean;
ChangeBGColor: Boolean;
begin
ChangeFGColor:=((FGColor and SYS_COLOR_BASE)=0) and (FGColor<>clNone);
ChangeBGColor:=((BGColor and SYS_COLOR_BASE)=0) and (BGColor<>clNone);
if (not ChangeFGColor) and (not ChangeBGColor) then exit;
if (GTK_WIDGET_REALIZED(AWidget)) then begin
WindowStyle := gtk_style_copy(gtk_widget_get_style (AWidget));
end else begin
WindowStyle := gtk_style_copy(gtk_rc_get_style (AWidget));
end;
if (Windowstyle = nil) then begin
Windowstyle := gtk_style_new;
end;
//DebugLn('TGtkWidgetSet.SetWidgetColor ',GetWidgetDebugReport(AWidget),' ',hexstr(FGColor,8),' ',hexstr(BGColor,8));
//RaiseGDBException('');
if ChangeFGColor then begin
xfg:=AllocGDKColor(colorToRGB(FGColor));
for i := 0 to 4 do begin
if i in mask then begin
windowStyle^.fg[i]:=xfg;
end;
end;
end;
if ChangeBGColor then begin
xbg:=AllocGDKColor(colorToRGB(BGColor));
for i := 0 to 4 do begin
if i in mask then begin
windowStyle^.bg[i]:=xbg;
end;
end;
end;
gtk_widget_set_style(aWidget,windowStyle);
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.RealizeWidgetSize(Widget: PGtkWidget; NewWidth,

48
lcl/interfaces/gtk/gtkproc.inc
View File

@ -6519,31 +6519,6 @@ begin
end;
end;
procedure SetWidgetColor(aWidget : PGTKwidget; data : gpointer); cdecl;
begin
gtk_widget_set_style(aWidget,data);
if gtk_is_button(aWidget) or gtk_is_check_button(aWidget) then begin
gtk_container_foreach(pGtkContainer(aWidget),@SetWidgetColor,data);
end;
end;
procedure setWidgetBG(aColor: longint;var aWidget : pGTKWidget);
var
WindowStyle: PGtkStyle;
begin
windowStyle:=gtk_widget_get_style(aWidget);
windowstyle^.bg[0]:=AllocGDKColor(aColor);
SetWidgetColor(aWidget,windowStyle);
end;
procedure setWidgetFG(aColor: longint;var aWidget : pGTKWidget);
var
WindowStyle: PGtkStyle;
begin
windowStyle:=gtk_widget_get_style(aWidget);
windowstyle^.fg[0]:=AllocGDKColor(aColor);
SetWidgetColor(aWidget,windowStyle);
end;
{------------------------------------------------------------------------------
function GdkAtomToStr(const Atom: TGdkAtom): string;
@ -7610,22 +7585,6 @@ begin
else begin
Widget := MainWidget;
end;
// writeln('update ',longint(Widget),' color ',longint(aWinControl.Color),DbgSName(AWinControl));
if (AWinControl.Color<>clNone) then begin
if (csOpaque in AWinControl.ControlStyle)
and GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType) then exit;
if AWinControl.ColorIsStored
and ((AWinControl.Color and SYS_COLOR_BASE)=0) then begin
DebugLn('UpdateWidgetStyleOfControl ',DbgSName(AWinControl),' Color=',dbgs(AWinControl.Color));
setWidgetBG(AWinControl.Color,Widget);
end;
end;
if (AWinControl.Font.Color and SYS_COLOR_BASE)=0 then begin
DebugLn('UpdateWidgetStyleOfControl ',DbgSName(AWinControl),' Font.Color=',dbgs(AWinControl.Font.Color));
setWidgetFG(AWinControl.Font.Color,Widget);
end;
RCStyle:=nil;
FreeFontName:=false;
@ -7680,11 +7639,10 @@ begin
// set font color
// set font (currently only TCustomLabel)
if GtkWidgetIsA(Widget,gtk_label_get_type)
if (GtkWidgetIsA(Widget,gtk_label_get_type)
or GtkWidgetIsA(Widget,gtk_editable_get_type)
and ((AWinControl.Font.Name<>DefFontData.Name)
or (AWinControl.Font.Size<>0)
or (AWinControl.Font.Style<>[]))
or GtkWidgetIsA(Widget,gtk_check_button_get_type))
and (not AWinControl.Font.IsDefault)
then begin
// allocate font
FontHandle:=AWinControl.Font.Handle;

15
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -3954,7 +3954,7 @@ const GTKStrongShadowType: array[TBevelCut] of integer =
(GTK_SHADOW_NONE, GTK_SHADOW_ETCHED_IN, GTK_SHADOW_ETCHED_OUT, GTK_SHADOW_NONE);
var
Widget, ClientWidget: PGtkWidget;
//Widget, ClientWidget: PGtkWidget;
i : integer;
DCOrigin: TPoint;
TheStyle: PGtkStyle;
@ -3975,13 +3975,6 @@ begin
Result:= False;
exit;
end;
Widget:=PGtkWidget(TDeviceContext(DC).Wnd);
ClientWidget:=Widget;
if Widget<>nil then begin
ClientWidget:=GetFixedWidget(Widget);
if ClientWidget=nil then
ClientWidget:=Widget;
end;
AWindow:=Drawable;
DCOrigin:=GetDCOffset(TDeviceContext(DC));
Area.X:=ARect.Left+DCOrigin.X;
@ -3998,12 +3991,12 @@ begin
//'');
for i:= 1 to FrameWidth do begin
gtk_paint_shadow(TheStyle,
gtk_paint_shadow(theStyle,
AWindow, GTK_STATE_NORMAL,
ShadowType,
@Area,
ClientWidget,
'button',
{ClientWidget}nil,
{'button'}nil,
ARect.Left+DCOrigin.X, ARect.Top+DCOrigin.Y,
ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
// inflate the rectangle (! ARect will be returned to the user with this)

21
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -80,6 +80,8 @@ type
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure SetColor(const AWinControl: TWinControl); override;
end;
{ TGtkWSSpeedButton }
@ -369,6 +371,25 @@ begin
WidgetInfo^.CoreWidget, 'clicked');
end;
procedure TGtkWSBitBtn.SetColor(const AWinControl: TWinControl);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
Widget: PGTKWidget;
begin
if not AWinControl.HandleAllocated then exit;
Widget:= PGtkWidget(AWinControl.Handle);
WidgetInfo := GetWidgetInfo(Widget);
BitBtnInfo := WidgetInfo^.UserData;
GtkWidgetSet.SetWidgetColor(Widget, AWinControl.font.color, AWinControl.color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
if BitBtnInfo^.LabelWidget = nil then Exit;
GtkWidgetSet.SetWidgetColor(BitBtnInfo^.LabelWidget, AWinControl.font.color,
AWinControl.color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
end;
procedure TGtkWSBitBtn.UpdateLayout(const AInfo: PBitBtnWidgetInfo;
const ALayout: TButtonLayout; const AMargin: Integer);
begin

10
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -426,10 +426,18 @@ end;
procedure TGtkWSWinControl.SetColor(const AWinControl: TWinControl);
begin
if ((csOpaque in AWinControl.ControlStyle)
and GtkWidgetIsA(pGtkWidget(AWinControl.handle),GTKAPIWidget_GetType)) then
exit;
GtkWidgetSet.SetWidgetColor(pGtkWidget(AWinControl.handle),
AWinControl.font.color, AWinControl.color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
UpdateWidgetStyleOfControl(AWinControl);
end;
procedure TGtkWSWinControl.SetText(const AWinControl: TWinControl; const AText: string);
procedure TGtkWSWinControl.SetText(const AWinControl: TWinControl;
const AText: string);
procedure SetNotebookPageTabLabel;
var