[maybe SOLVED] BUG in InputQuery if default colour for TForm and TPanel differ

[robert rozee]

The first offered patch seem to be too intrusive, the second one seem to be more in line with the rest of the theme in use

again, the screen captures you have provided are excellent! thank you very much for your help   :-)

the 'patch1' and 'patch2' images nicely show that it is important to include the extra line of code marked as "// backstop" so as to handle (what seems to be not uncommon) cases where TWSControlClass(WidgetSetClass).GetDefaultColor(Self, DefaultColorType) returns an error (clDefault), and in those cases to substitute in sensible colours. the need to handle this suggests that within the Lazarus IDE there are occasions where 'malformed' controls are being created - but that is something for investigation on another day.


cheers,
rob   :-)

[robert rozee]

I've bit digging into ws sources, some ws override GetDefaultColor() for some controls. Eg in Qt6 form handle have overriden GetDefaultColor() which returns clForm for brush, and clBtnText for text color, other ws also have some overrides (eg gtk3)

hi zeljko, are you the same person as Željan Rikalo (zeljan1) on GitLab? if so, then you'll have seen the merge request i posted there.

when i initially read your post above, i didn't pay much attention to it, but what you wrote is making more sense now. when you say "ws sources" and "some ws override", by 'ws' do you mean 'windowing system', 'windowing server', or something else? i am completely unfamiliar with the terminology and naming conventions used by the Lazarus developers. to be honest, i don't even have much understanding of the basics of object-oriented-programming - i just muddle my way through making best guesses until something works; a good portion of my workplace history involved test engineering, where working in the dark was often considered an advantage.

what do you think is the history behind TControl.GetDefaultColor? did it work once, a long time ago, then accidentally got broken followed by a widgetset-by-widgetset series of ad-hoc kludges over a period of years by folks who didn't even know that TControl.GetDefaultColor existed? indeed, it was only because of TRon mentioning GetRGBColorResolvingParent here: https://forum.lazarus.freepascal.org/index.php/topic,70139.msg549127.html#msg549127 that i stumbled upon it. with TControl.GetDefaultColor fixed, could all the overrides you mention now simply be removed?

if there is a discussion going on elsewhere, i would like to at least listen in on it. if nothing else, so i can step back knowing that wheels are in motion.


cheers,
rob   :-)

[robert rozee]

Result is always clDefault if widgetset does not implement GetDefaultColor(), that's why check is there. [...]

EXCEPT, as we are recursing upwards then we ONLY need the widgetset to have (fully) implemented GetDefaultColor() for the control at which we terminate the recursion. eg, consider the case of a TPanel sitting on a TForm: the Panel does not need to have a full implementation of GetDefaultColor() provided the Panel's colour is set to clDefault AND the Panel has ParentColor set TRUE, as in that case we skip right past the Panel and get our colour from the (parent) Form.

does this make sense?

it is 4:20am here. time to sleep!


cheers,
rob   :-)

[zeljko]

I've bit digging into ws sources, some ws override GetDefaultColor() for some controls. Eg in Qt6 form handle have overriden GetDefaultColor() which returns clForm for brush, and clBtnText for text color, other ws also have some overrides (eg gtk3)

hi zeljko, are you the same person as Željan Rikalo (zeljan1) on GitLab? if so, then you'll have seen the merge request i posted there.

when i initially read your post above, i didn't pay much attention to it, but what you wrote is making more sense now. when you say "ws sources" and "some ws override", by 'ws' do you mean 'windowing system', 'windowing server', or something else? i am completely unfamiliar with the terminology and naming conventions used by the Lazarus developers. to be honest, i don't even have much understanding of the basics of object-oriented-programming - i just muddle my way through making best guesses until something works; a good portion of my workplace history involved test engineering, where working in the dark was often considered an advantage.

what do you think is the history behind TControl.GetDefaultColor? did it work once, a long time ago, then accidentally got broken followed by a widgetset-by-widgetset series of ad-hoc kludges over a period of years by folks who didn't even know that TControl.GetDefaultColor existed? indeed, it was only because of TRon mentioning GetRGBColorResolvingParent here: https://forum.lazarus.freepascal.org/index.php/topic,70139.msg549127.html#msg549127 that i stumbled upon it. with TControl.GetDefaultColor fixed, could all the overrides you mention now simply be removed?

Yes, it's me, WS = WidgetSet (gtk2,win32,qt(4,5,6),cocoa,gtk3). Each of them need to implement GetDefaultColor(). Feel free to provide patches

[TRon]

Yes, it's me,

The widgetsetguru with many of the fixes made lately, I knew. Can't thank you enough for those.

Please forgive my ignorance, but does that imply this fix needs to be/go higher up (in the widgetset) instead at control implementation level ?

[zeljko]

Well, I don't have enough time now to study colors, but, what I know is clDefault = ask widgetset for real color value, so widgetset is the place to ask for colors for any control (if implemented).

[robert rozee]

hi TRon,
    did you do your testing with GTK2 under Linux? my details from "About Lazarus" are: Lazarus 3.6 (rev Unknown) FPC 3.2.2 x86_64-linux-gtk2. my Linux is Mint 22 with the XFCE Desktop. some testing also done with Lazarus 3.8.

is there anyone reading this that is (a) using QT 4, 5, or 6 with their Lazarus install, and (b) running with a Dark Desktop Theme? if so, and you are in a position to modify your lcl/include/control.inc by changing TControl.GetDefaultColor to read:

Code: Pascal  [Select][+][-]

1. function TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
2. const
3.   DefColors: array[TDefaultColorType] of TColor = (
4.   { dctBrush } clWindow,
5.   { dctFont  } clWindowText
6.   );
7. begin
8.   Result := TWSControlClass(WidgetSetClass).GetDefaultColor(Self, DefaultColorType);
9.   if (Self.Color = clDefault) and ParentColor and Assigned(Parent) then
10.       Result := Parent.GetDefaultColor(DefaultColorType)                   // recursion
11.   else
12.       if Result = clDefault then Result := DefColors[DefaultColorType]     // backstop
13. end;

... then can you please:
1. run up the Lazarus IDE and take a screen capture,
2. make the changes above and rebuild Lazarus with sudo make bigide,
3. run up the Lazarus IDE again and take a second screen capture.
4. finally post the two captured images to this thread, along with the information from the "About Lazarus" screen in the Lazarus IDE.

i need to know if changes made to function TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; in the file lcl/include/control.inc affect the visual appearance of the Lazarus IDE for widgetsets other than GTK2 - in particular QT4/5.

Well, I don't have enough time now to study colors, but, what I know is clDefault = ask widgetset for real color value, so widgetset is the place to ask for colors for any control (if implemented).

zeljko: if this were the case, then surely my changes to TControl.GetDefaultColor should not work? yet they do work, at least for GTK2. you are aware that there are TWO groups of functions called GetDefaultColor:
TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
and
TWSControlClass(WidgetSetClass).GetDefaultColor(Control, DefaultColorType);

the first, with a SINGLE parameter passed in (should) recurses up through a chain of controls until it finds one that does NOT have ParentColour set TRUE;
the second, that takes TWO parameters, is buried in the current widgetset (as far as i can tell) and returns a number between $80000001 (clBackGround) and $8000001F (clForm) that is itself an index into some sort of a 'master colour table' whose content has been retrieved from the Desktop Theme by the widgetset upon application startup.

[...] Feel free to provide patches

i have, see: https://gitlab.com/freepascal.org/lazarus/lazarus/-/merge_requests/452. Maxim Ganetsky (ganmax) has asked for your comment on it.
so far, i have not been convinced that the patch does not work, and am awaiting feedback on others who have tried it.


cheers,
rob   :-)

addendum: adding in the line "if DefaultColorType=dctBrush then writeln(IntToHex(Result))" after the line "Result :=TWSControlClass(WidgetSetClass)..." returns (for me, when running the Lazarus IDE and doing stuff) values of:
0x20000000    (indicating an error)
0x80000001    (clBackGround)
0x8000001F    (clForm)

[TRon]

hi TRon,
    did you do your testing with GTK2 under Linux? my details from "About Lazarus" are: Lazarus 3.6 (rev Unknown) FPC 3.2.2 x86_64-linux-gtk2. my Linux is Mint 22 with the XFCE Desktop. some testing also done with Lazarus 3.8.

Debian Bookworm semi-rolling GTK2 Linux/MATE. Posted images were done with Lazarus 4.0RC2 with and without using your suggested patches (3 images in total, no patch, first suggested patch and second suggested patch).

[robert rozee]

WidgetSet (gtk2,win32,qt(4,5,6),cocoa,gtk3). Each of them need to implement GetDefaultColor(). Feel free to provide patches

have just spent half the night digging through the sources to find existing places where GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; is already implemented. the results:

Code: Pascal  [Select][+][-]

1. lcl/widgetset/wsextctrls.pp:180:            class function             TWSNotebook.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
2. lcl/widgetset/wsextctrls.pp:344:            class function          TWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
3. lcl/widgetset/wsforms.pp:146:               class function  TWSScrollingWinControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
4. lcl/widgetset/wsforms.pp:197:               class function           TWSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
5. lcl/widgetset/wscontrols.pp:230:            class function              TWSControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
6. lcl/widgetset/wsstdctrls.pp:288:            class function             TWSGroupBox.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
7. lcl/widgetset/wsstdctrls.pp:700:            class function     TWSCustomStaticText.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
8. lcl/widgetset/wsstdctrls.pp:896:            class function        TWSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
9. lcl/widgetset/wscomctrls.pp:336:            class function             TWSTabSheet.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
10. lcl/widgetset/wscomctrls.pp:487:            class function            TWSStatusBar.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
11.  
12. lcl/interfaces/gtk/gtkwsforms.pp:445:       class function        TGtkWSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
13. lcl/interfaces/gtk2/gtk2wsextctrls.pp:244:  class function      TGtk2WSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
14. lcl/interfaces/gtk3/gtk3wsstdctrls.pp:1108: class function    TGtk3WSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
15. lcl/interfaces/gtk3/gtk3wsforms.pp:381:     class function       TGtk3WSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
16. lcl/interfaces/qt/qtwsextctrls.pp:183:      class function        TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
17. lcl/interfaces/qt5/qtwsextctrls.pp:182:     class function        TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
18. lcl/interfaces/qt6/qtwsextctrls.pp:182:     class function        TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
19.  
20. lcl/include/controlcanvas.inc:30:                 function          TControlCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
21. lcl/include/canvas.inc:648:                       function                 TCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;

with this being the full code:

Code: Pascal  [Select][+][-]

1. lcl/widgetset/wsextctrls.pp:180:class function TWSNotebook.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
2. lcl/widgetset/wsextctrls.pp-182-begin
3. lcl/widgetset/wsextctrls.pp-183-  Result:=DefBtnColors[ADefaultColorType];
4. lcl/widgetset/wsextctrls.pp-184-end;
5.  
6. --
7.  
8. lcl/widgetset/wsextctrls.pp:344:class function TWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
9. lcl/widgetset/wsextctrls.pp-345-begin
10. lcl/widgetset/wsextctrls.pp-346-  Result := DefBtnColors[ADefaultColorType];
11. lcl/widgetset/wsextctrls.pp-347-end;
12.  
13. --
14.  
15. lcl/widgetset/wsforms.pp:146:class function TWSScrollingWinControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
16. lcl/widgetset/wsforms.pp-148-const
17. lcl/widgetset/wsforms.pp-149-  DefColors: array[TDefaultColorType] of TColor = (
18. lcl/widgetset/wsforms.pp-150- { dctBrush } clForm,
19. lcl/widgetset/wsforms.pp-151- { dctFont  } clBtnText
20. lcl/widgetset/wsforms.pp-152-  );
21. lcl/widgetset/wsforms.pp-153-begin
22. lcl/widgetset/wsforms.pp-154-  Result := DefColors[ADefaultColorType];
23. lcl/widgetset/wsforms.pp-155-end;
24.  
25. --
26.  
27. lcl/widgetset/wsforms.pp:197:class function TWSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
28. lcl/widgetset/wsforms.pp-198-const
29. lcl/widgetset/wsforms.pp-199-  DefColors: array[TDefaultColorType] of TColor = (
30. lcl/widgetset/wsforms.pp-200- { dctBrush } clForm,
31. lcl/widgetset/wsforms.pp-201- { dctFont  } clBtnText
32. lcl/widgetset/wsforms.pp-202-  );
33. lcl/widgetset/wsforms.pp-203-begin
34. lcl/widgetset/wsforms.pp-204-  Result := DefColors[ADefaultColorType];
35. lcl/widgetset/wsforms.pp-205-end;
36.  
37. --
38.  
39. lcl/widgetset/wscontrols.pp:230:class function TWSControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
40. lcl/widgetset/wscontrols.pp-231-begin
41. lcl/widgetset/wscontrols.pp-232-  Result := clDefault;
42. lcl/widgetset/wscontrols.pp-233-end;
43.  
44. --
45.  
46. lcl/widgetset/wsstdctrls.pp:288:class function TWSGroupBox.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
47. lcl/widgetset/wsstdctrls.pp-290-begin
48. lcl/widgetset/wsstdctrls.pp-291-  Result:=DefBtnColors[ADefaultColorType];
49. lcl/widgetset/wsstdctrls.pp-292-end;
50.  
51. --
52.  
53. lcl/widgetset/wsstdctrls.pp:700:class function TWSCustomStaticText.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
54. lcl/widgetset/wsstdctrls.pp-702-begin
55. lcl/widgetset/wsstdctrls.pp-703-  Result:=DefBtnColors[ADefaultColorType];
56. lcl/widgetset/wsstdctrls.pp-704-end;
57.  
58. --
59.  
60. lcl/widgetset/wsstdctrls.pp:896:class function TWSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
61. lcl/widgetset/wsstdctrls.pp-897-begin
62. lcl/widgetset/wsstdctrls.pp-898-  Result := DefBtnColors[ADefaultColorType];
63. lcl/widgetset/wsstdctrls.pp-899-end;
64.  
65. --
66.  
67. lcl/widgetset/wscomctrls.pp:336:class function TWSTabSheet.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
68. lcl/widgetset/wscomctrls.pp-338-begin
69. lcl/widgetset/wscomctrls.pp-339-  Result:=DefBtnColors[ADefaultColorType];
70. lcl/widgetset/wscomctrls.pp-340-end;
71.  
72. --
73.  
74. lcl/widgetset/wscomctrls.pp:487:class function TWSStatusBar.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
75. lcl/widgetset/wscomctrls.pp-488-begin
76. lcl/widgetset/wscomctrls.pp-489-  Result := DefBtnColors[ADefaultColorType];
77. lcl/widgetset/wscomctrls.pp-490-end;
78.  
79. --------------------------------
80.  
81. lcl/interfaces/gtk/gtkwsforms.pp:445:class function TGtkWSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
82. lcl/interfaces/gtk/gtkwsforms.pp-447-begin
83. lcl/interfaces/gtk/gtkwsforms.pp-448-  if ADefaultColorType = dctFont then
84. lcl/interfaces/gtk/gtkwsforms.pp-449-    Result := clWindowText
85. lcl/interfaces/gtk/gtkwsforms.pp-450-  else
86. lcl/interfaces/gtk/gtkwsforms.pp-451-    Result := clForm;
87. lcl/interfaces/gtk/gtkwsforms.pp-452-end;
88.  
89. --
90.  
91. lcl/interfaces/gtk2/gtk2wsextctrls.pp:244:class function TGtk2WSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
92. lcl/interfaces/gtk2/gtk2wsextctrls.pp-246-const
93. lcl/interfaces/gtk2/gtk2wsextctrls.pp-247-  DefColors: array[TDefaultColorType] of TColor = (
94. lcl/interfaces/gtk2/gtk2wsextctrls.pp-248- { dctBrush } clBackground,
95. lcl/interfaces/gtk2/gtk2wsextctrls.pp-249- { dctFont } clBtnText
96. lcl/interfaces/gtk2/gtk2wsextctrls.pp-250-  );
97. lcl/interfaces/gtk2/gtk2wsextctrls.pp-251-begin
98. lcl/interfaces/gtk2/gtk2wsextctrls.pp-252-  Result := DefColors[ADefaultColorType];
99. lcl/interfaces/gtk2/gtk2wsextctrls.pp-253-end;
100.  
101. --
102.  
103. lcl/interfaces/gtk3/gtk3wsstdctrls.pp:1108:class function TGtk3WSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
104. lcl/interfaces/gtk3/gtk3wsstdctrls.pp-1109-begin
105. lcl/interfaces/gtk3/gtk3wsstdctrls.pp-1110-  Result := DefBtnColors[ADefaultColorType];
106. lcl/interfaces/gtk3/gtk3wsstdctrls.pp-1111-end;
107.  
108. --
109.  
110. lcl/interfaces/gtk3/gtk3wsforms.pp:381:class function TGtk3WSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
111. lcl/interfaces/gtk3/gtk3wsforms.pp-382-const
112. lcl/interfaces/gtk3/gtk3wsforms.pp-383-  DefColors: array[TDefaultColorType] of TColor = (
113. lcl/interfaces/gtk3/gtk3wsforms.pp-384- { dctBrush } clForm,
114. lcl/interfaces/gtk3/gtk3wsforms.pp-385- { dctFont  } clBtnText
115. lcl/interfaces/gtk3/gtk3wsforms.pp-386-  );
116. lcl/interfaces/gtk3/gtk3wsforms.pp-387-begin
117. lcl/interfaces/gtk3/gtk3wsforms.pp-388-  Result := DefColors[ADefaultColorType];
118. lcl/interfaces/gtk3/gtk3wsforms.pp-389-end;
119.  
120. --
121.  
122. lcl/interfaces/qt/qtwsextctrls.pp:183:class function TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
123. lcl/interfaces/qt/qtwsextctrls.pp-185-const
124. lcl/interfaces/qt/qtwsextctrls.pp-186-  DefColors: array[TDefaultColorType] of TColor = (
125. lcl/interfaces/qt/qtwsextctrls.pp-187- { dctBrush } clBackground,
126. lcl/interfaces/qt/qtwsextctrls.pp-188- { dctFont  } clBtnText
127. lcl/interfaces/qt/qtwsextctrls.pp-189-  );
128. lcl/interfaces/qt/qtwsextctrls.pp-190-begin
129. lcl/interfaces/qt/qtwsextctrls.pp-191-  Result := DefColors[ADefaultColorType];
130. lcl/interfaces/qt/qtwsextctrls.pp-192-end;
131.  
132. --
133.  
134. lcl/interfaces/qt5/qtwsextctrls.pp:182:class function TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
135. lcl/interfaces/qt5/qtwsextctrls.pp-184-const
136. lcl/interfaces/qt5/qtwsextctrls.pp-185-  DefColors: array[TDefaultColorType] of TColor = (
137. lcl/interfaces/qt5/qtwsextctrls.pp-186- { dctBrush } clBackground,
138. lcl/interfaces/qt5/qtwsextctrls.pp-187- { dctFont  } clBtnText
139. lcl/interfaces/qt5/qtwsextctrls.pp-188-  );
140. lcl/interfaces/qt5/qtwsextctrls.pp-189-begin
141. lcl/interfaces/qt5/qtwsextctrls.pp-190-  Result := DefColors[ADefaultColorType];
142. lcl/interfaces/qt5/qtwsextctrls.pp-191-end;
143.  
144. --
145.  
146. lcl/interfaces/qt6/qtwsextctrls.pp:182:class function TQtWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
147. lcl/interfaces/qt6/qtwsextctrls.pp-184-const
148. lcl/interfaces/qt6/qtwsextctrls.pp-185-  DefColors: array[TDefaultColorType] of TColor = (
149. lcl/interfaces/qt6/qtwsextctrls.pp-186- { dctBrush } clBackground,
150. lcl/interfaces/qt6/qtwsextctrls.pp-187- { dctFont  } clBtnText
151. lcl/interfaces/qt6/qtwsextctrls.pp-188-  );
152. lcl/interfaces/qt6/qtwsextctrls.pp-189-begin
153. lcl/interfaces/qt6/qtwsextctrls.pp-190-  Result := DefColors[ADefaultColorType];
154. lcl/interfaces/qt6/qtwsextctrls.pp-191-end;
155.  
156. --------------------------------
157.  
158. lcl/include/controlcanvas.inc:30:function TControlCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
159. lcl/include/controlcanvas.inc-31-begin
160. lcl/include/controlcanvas.inc-32-  if Assigned(FControl) then
161. lcl/include/controlcanvas.inc:33:    Result := FControl.GetDefaultColor(ADefaultColorType)
162. lcl/include/controlcanvas.inc-34-  else
163. lcl/include/controlcanvas.inc:35:    Result := inherited GetDefaultColor(ADefaultColorType);
164. lcl/include/controlcanvas.inc-36-end;
165.  
166. --
167.  
168. lcl/include/canvas.inc:648:function TCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
169. lcl/include/canvas.inc-649-begin
170. lcl/include/canvas.inc-650-  Result := clDefault;
171. lcl/include/canvas.inc-651-end;
172.  

it looks like a right hodgepodge, with someone having decided to pass in AControl with a view, perhaps, of being able to use it to better decide what text and background colours to use - perhaps they felt that operating down at the WidgetSet level they would have better access to the Desktop Theme colours. but up at the level of /lcl/include/control.inc one has this information available via GetSysColor() anyway, so i am perplexed.


zeljko: what sort of patches did you have in mind? for example, patching gtk2wsstdctrls.pp to bring TGtk2WSCustomLabel in line with the likes of TGtk2WSCustomPanel?

it seems to me far better to work on fixing the theme problems in just the one place, within /lcl/include/control.inc's version of GetSysColor() - which everything should be passing through - by just casing all the classes of TControl and using the 32-entry colour table available with GetSysColor().


cheers,
rob   :-)

[robert rozee]

and here is the code i had in mind:

Code: Pascal  [Select][+][-]

1. function TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
2.  
3.   function CMatch(Name:string; var Index:integer):boolean;
4.   begin
5.     if Name = 'TLabel'       then Index := 1 else
6.     if Name = 'TForm'        then Index := 2 else
7.     if Name = 'TPanel'       then Index := 3 else
8.     if Name = 'TSpeedButton' then Index := 4 else Index := 0;
9.     Result := (Index <> 0)
10.   end;
11.  
12. const                                                    { dctBrush }    { dctFont  }              // defaults: (clWindow, clWindowText)
13.   ThemeTable:array [0..4, TDefaultColorType] of TColor = ((clWindow,       clWindowText),          // no match found (default)
14.                                                           (clWindow,       clWindowText),          // TLabel
15.                                                           (clForm,         clBtnText),             // TForm
16.                                                           (clBackground,   clBtnText),             // TPanel
17.                                                           (clBtnFace,      clBtnText));            // TSpeedButton
18.   Level:integer = 0;
19. //First:TClass = TObject;
20. var AClass:TClass;
21.       I, J:integer;
22. begin
23.   inc(Level);
24. //if Level = 1 then First := Self.ClassType;
25.  
26.   if (Self.Color = clDefault) and ParentColor and Assigned(Parent)
27.     then Result := Parent.GetDefaultColor(DefaultColorType)                // recursion
28.   else
29.   begin
30.     J := 1;
31.     AClass := Self.ClassType;
32.     while (AClass <> nil) and not CMatch(AClass.ClassName, I) do begin AClass := AClass.ClassParent; inc(J)  end;
33.  
34.     Result := ThemeTable[I, DefaultColorType];
35.  
36.     if I <> 0 then writeln(I:8, J:8)
37.               else begin
38.                      writeln('@', GetTickCount64);
39.                      writeln('No class match found in list:');
40. //                   AClass := First;
41.                      AClass := Self.ClassType;
42.  
43.                      repeat
44.                        writeln('    ', AClass.ClassName);
45.                        AClass := AClass.ClassParent;
46.                      until AClass = nil;
47.                      writeln('-----------------------------')
48.                    end;
49.   end;
50.   dec(Level)
51. end;

modified: changed from printing out first class chain to printing  out last class chain - see 3 commented out lines. by luck, produced no change in output.

the code first recursively goes up the list of parent controls, looking for one that does not have ParentColor set true. then it walks the chain of classes until it finds one that it recognizes. it then grabs the relevant colour code from the corresponding slot in a predefined table (ThemeTable - probably not the best name). most importantly, it does NOT make use of calls to TWSControlClass(WidgetSetClass).GetDefaultColor(Self, DefaultColorType), which hopefully means that all the code associated with them can be deleted!

this code does, more-or-less, work. but the table of 'known' classes needs expanding upon. output of the ones that it can't resolve are printed out. three that stand out from running the Lazarus IDE are:

Code: [Select]

No class match found in list:
    TMessagesCtrl
    TCustomControl
    TWinControl
    TControl
    TLCLComponent
    TComponent
    TPersistent
    TObject
-----------------------------
No class match found in list:
    TComponentTreeView
    TCustomTreeView
    TCustomControl
    TWinControl
    TControl
    TLCLComponent
    TComponent
    TPersistent
    TObject
-----------------------------
No class match found in list:
    TIDESynEditor
    TSynEdit
    TCustomSynEdit
    TSynEditBase
    TCustomControl
    TWinControl
    TControl
    TLCLComponent
    TComponent
    TPersistent
    TObject
-----------------------------
does anyone know what the defaults for these should be?


cheers,
rob   :-)

[robert rozee]

it occurs that line 26 above is not quite right - and this hold for the original code that we are trying to fix.

the line:

Code: Pascal  [Select][+][-]

1.   if (Self.Color = clDefault) and ParentColor and Assigned(Parent)                                                     // single path for both dctBrush and dctFont

should be split into two sets of conditions, (1) for the value of DefaultColorType being dctBrush, or (2) value being dctFont:

Code: Pascal  [Select][+][-]

1.   if (DefaultColorType = dctBrush) and ((Self.Color = clDefault)      and ParentColor and Assigned(Parent)) or         // path -> dctBrush
2.      (DefaultColorType = dctFont) and  ((Self.Font.Color = clDefault) and ParentFont and Assigned(Parent))             // path -> dctFont

is it reasonable to say that if we are looking at the FONT colour, then we should be checking Self.Font.Color and ParentFont?

i've grown weary of this all, have better things to spend my time on. hopefully this thread might be useful (or at least interesting) to someone in a few years time when i'm gone.

BTW, many thanks to cdbc for showing me how to follow the chain of classes   

cheers,
rob   :-)