darekM napisał(a):
I forget about patch
Hi
I try to investigate why setcolor in form don't work (in Linux+GTK)
in simple program
I found why its not work, but there are many changes in source,
all diff in mail
I've added gtk_widget_unrealize to ReleaseDC (its cause assertion
error gtk_widget_get_parent, I know where bun i don't know how its
repair)
remove set of fPixelsPerInch in CreateWND , change it to
GetPixelsPerInch (has to change every invoke off fPixelsPerInch to
property
remove UpdateWidgetStyleOfControl from event realize and realizeafter
(they fired and do nothing)
I don't know gtk too much, I only try
Regards
Darek
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
Index: lcl/interfaces/gtk/gtkproc.inc
===================================================================
--- lcl/interfaces/gtk/gtkproc.inc (wersja 8136)
+++ lcl/interfaces/gtk/gtkproc.inc (kopia robocza)
@@ -6477,6 +6477,42 @@
function IndexOfStyle(aStyle: TLazGtkStyle): integer;
@@ -7496,6 +7575,9 @@
FontHandle: HFONT;
FreeFontName: boolean;
FreeFontSetName: boolean;
procedure CreateRCStyle;
begin
@@ -7533,14 +7615,19 @@
MainWidget:=PGtkWidget(AWinControl.Handle);
FixWidget:=GetFixedWidget(MainWidget);
Widget := FixWidget
else begin
Widget := MainWidget;
end;
RCStyle:=nil;
FreeFontName:=false;
@@ -7563,7 +7650,8 @@
if (csOpaque in AWinControl.ControlStyle)
and GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType) then exit;
- NewColor:=TColorToTGDKColor(AWinControl.Color);
+ NewColor:=AllocGDKColor(AWinControl.Color);
CreateRCStyle;
RCStyle^.bg[GTK_STATE_NORMAL]:=NewColor;
@@ -7646,6 +7734,14 @@
//DebugLn('UpdateWidgetStyleOfControl Apply Modifications
',AWinControl.Name,' ',GetWidgetClassName(Widget));
gtk_widget_modify_style(Widget,RCStyle);
if FreeFontName then begin
{$ifdef gtk1}
g_free(RCStyle^.font_name);
Index: lcl/interfaces/gtk/gtkwinapi.inc
===================================================================
--- lcl/interfaces/gtk/gtkwinapi.inc (wersja 8136)
+++ lcl/interfaces/gtk/gtkwinapi.inc (kopia robocza)
@@ -7449,13 +7449,19 @@
function TGtkWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
aDC, pSavedDC: TDeviceContext;
+ clientWidget : pGtkWidget;
begin
//DebugLn('[TGtkWidgetSet.ReleaseDC] ',DbgS(DC,8),' ',FDeviceContexts.Count);
Assert(False, Format('trace:> [TGtkWidgetSet.ReleaseDC] DC:0x%x', [DC]));
Result := 0;
-
if {(hWnd <> 0) and} (DC <> 0)
then begin
+ if hwnd<>0 then begin
+ ClientWidget := GetFixedWidget(pgtkwidget(hwnd));
+
+ writeln('release dc',longint(clientWidget));
+ gtk_widget_unrealize(ClientWidget);
+ end;
if FDeviceContexts.Contains(Pointer(DC))
then begin
aDC := TDeviceContext(DC);
Index: lcl/interfaces/gtk/gtkcallback.inc
===================================================================
--- lcl/interfaces/gtk/gtkcallback.inc (wersja 8136)
+++ lcl/interfaces/gtk/gtkcallback.inc (kopia robocza)
@@ -153,8 +153,8 @@
end;
end;
- if (TObject(Data) is TWinControl) then
- UpdateWidgetStyleOfControl(TWinControl(Data));
+// if (TObject(Data) is TWinControl) then
+// UpdateWidgetStyleOfControl(TWinControl(Data));
if not (csDesigning in TComponent(Data).ComponentState) then
RealizeAccelerator(TComponent(Data),Widget);
@@ -235,7 +235,7 @@
TheWinControl.CNPreferredSizeChanged;
SetCursor(TheWinControl, crDefault);
ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
- UpdateWidgetStyleOfControl(TheWinControl);
+// UpdateWidgetStyleOfControl(TheWinControl);
if TheWinControl is TCustomPage then
UpdateNotebookPageTab(nil,TheWinControl);
Index: lcl/interfaces/gtk/gtkobject.inc
===================================================================
--- lcl/interfaces/gtk/gtkobject.inc (wersja 8136)
+++ lcl/interfaces/gtk/gtkobject.inc (kopia robocza)
@@ -5027,6 +5027,50 @@
gtk_widget_show(Result);
end;
{------------------------------------------------------------------------------
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp (wersja 8136)
+++ lcl/forms.pp (kopia robocza)
@@ -394,6 +394,7 @@
procedure CloseModal;
procedure DoCreate;
procedure DoDestroy;
+ function GetPixelsPerInch:LongInt;
procedure IconChanged(Sender: TObject);
function IsKeyPreviewStored: boolean;
procedure SetActive(AValue: Boolean);
@@ -536,7 +537,7 @@
property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnWindowStateChange: TNotifyEvent
read fOnWindowStateChange write fOnWindowStateChange;
- property PixelsPerInch: Longint read FPixelsPerInch write FPixelsPerInch
stored False;
+ property PixelsPerInch: Longint read GetPixelsPerInch write FPixelsPerInch
stored False default -1;
property Position: TPosition read FPosition write SetPosition default
poDesigned;
property RestoredLeft: integer read FRestoredLeft;
property RestoredTop: integer read FRestoredTop;
Index: lcl/include/wincontrol.inc
===================================================================
--- lcl/include/wincontrol.inc (wersja 8136)
+++ lcl/include/wincontrol.inc (kopia robocza)
@@ -3993,7 +3993,7 @@
begin
if not HandleAllocated then
//Assert(False, Format('Trace:[TWinControl.GetHandle] %s(%s)', [ClassNAme,
Name]))
- ;
+
HandleNeeded;
Result := FHandle;
end;
@@ -4666,6 +4666,10 @@
DebugLn('WriteClientRect ',Prefix,' ',Name,':',ClassName,'
r=',r.Right,',',r.Bottom);
end;}
begin
//DebugLn('[TWinControl.CreateWnd] START ',Name,':',Classname);
if (csDestroying in ComponentState)
@@ -4702,6 +4706,7 @@
end;
FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params);
if not HandleAllocated then
RaiseGDBException('Handle creation failed creating '+DbgSName(Self));
//debugln('TWinControl.CreateWnd ',DbgSName(Self));
@@ -4722,6 +4727,8 @@
Exclude(FWinControlFlags, wcfCreatingHandle);
end;
Include(FWinControlFlags, wcfCreatingChildHandles);
try
//DebugLn('[TWinControl.CreateWnd] ',Name,':',ClassName,'
',Left,',',Top,',',Width,',',Height);
Index: lcl/include/customform.inc
===================================================================
--- lcl/include/customform.inc (wersja 8136)
+++ lcl/include/customform.inc (kopia robocza)
@@ -1610,14 +1610,38 @@
Creates the interface object.
------------------------------------------------------------------------------}
-procedure TCustomForm.CreateWnd;
+function tCustomForm.GetPixelsPerInch:LongInt;
var
DC: HDC;
ParentForm: TCustomForm;
+
begin
+ if fPixelsPerInch=-1 then begin
+ if Parent=nil then begin
+ TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
+ DC:=GetDC(Handle);
+ FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
+ ReleaseDC(Handle,DC);
+ end else begin
+ ParentForm:=GetParentForm(Self);
+ if ParentForm<>nil then begin
+ FPixelsPerInch:=ParentForm.PixelsPerInch;
+ end;
+ end;
+ end else result:=fPixelsPerInch;
+
+end;
+
+
+procedure TCustomForm.CreateWnd;
+//var
+// DC: HDC;
+// ParentForm: TCustomForm;
+begin
//DebugLn('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd;
+ (*
if Parent=nil then begin
TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
@@ -1630,6 +1654,8 @@
FPixelsPerInch:=ParentForm.PixelsPerInch;
end;
end;
+ *)
+// TWSCustomFormClass(WidgetSetClass).setcolor(Self);
Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded');
if FMenu <> nil then
Index: lcl/widgetset/wscontrols.pp
===================================================================
--- lcl/widgetset/wscontrols.pp (wersja 8136)
+++ lcl/widgetset/wscontrols.pp (kopia robocza)
@@ -145,6 +145,7 @@
begin
// For now default to the old creation routines
Result := WidgetSet.CreateComponent(AWinControl);
end;
procedure TWSWinControl.DestroyHandle(const AWinControl: TWinControl);
