You are not logged in.
Hi Arnaud,
Thank you for a great library. Thank you for allowing me to contribute.
I found a bug in the TSQLRibbon.ChangeColorScheme() method in mORMotToolbar when ChangeColorScheme() is called with just the ColorScheme and no other parameters. An access violation is thrown on the line
if (Body<>nil) and Body.AdvOfficePagerStyler.InheritsFrom(TAdvOfficePagerOfficeStyler) then
TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style := TOfficePagerStyle(StatusBarStyler.Style);
The issue is that in this case the StatusBarStyler is nil
I propose a fix to the above line to:
if (Body <> nil) and Body.AdvOfficePagerStyler.InheritsFrom(TAdvOfficePagerOfficeStyler) then
TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style := TOfficePagerStyle(StatusStyle);
Full code for this method thus would be:
procedure TSQLRibbon.ChangeColorScheme(const ColorScheme: TToolBarStyle;
PanelStyler: TAdvPanelStyler; StatusBarStyler: TAdvOfficeStatusBarOfficeStyler;
CustomStyle: TMemoryStream);
var
PreviewStyle: TPreviewMenuStyle;
StatusStyle: TOfficeStatusBarStyle;
TBStyler: TAdvToolBarOfficeStyler;
i, curr: integer;
C: TComponent;
begin
if not fToolBar.ToolBarStyler.InheritsFrom(TAdvToolBarOfficeStyler) then
exit;
TBStyler := TAdvToolBarOfficeStyler(ToolBar.ToolBarStyler);
if TBStyler = nil then
exit;
TBStyler.Style := ColorScheme;
case ColorScheme of // bulky TMS styles don't match :(
bsCustom: begin
if CustomStyle <> nil then begin
CustomStyle.Seek(0, soFromBeginning);
CustomStyle.ReadComponent(TBStyler);
end;
PreviewStyle := AdvPreviewMenuStylers.psOffice2003Olive;
StatusStyle := AdvOfficeStatusBarStylers.psOffice2003Olive;
end;
bsOffice2007Silver: begin
PreviewStyle := AdvPreviewMenuStylers.psOffice2007Silver;
StatusStyle := AdvOfficeStatusBarStylers.psOffice2007Silver;
end;
bsOfficeXP: begin
PreviewStyle := AdvPreviewMenuStylers.psOfficeXP;
StatusStyle := AdvOfficeStatusBarStylers.psWindowsXP;
end;
bsWindowsVista .. high(TToolBarStyle): begin
PreviewStyle := TPreviewMenuStyle(ColorScheme);
StatusStyle := TOfficeStatusBarStyle(pred(ColorScheme));
end;
else begin
PreviewStyle := TPreviewMenuStyle(ColorScheme);
StatusStyle := TOfficeStatusBarStyle(ColorScheme);
end;
end;
if (PreviewMenu <> nil) and PreviewMenu.Styler.InheritsFrom(TAdvPreviewMenuOfficeStyler) then
TAdvPreviewMenuOfficeStyler(PreviewMenu.Styler).Style := PreviewStyle;
if StatusBarStyler <> nil then
StatusBarStyler.Style := StatusStyle;
if PanelStyler <> nil then
PanelStyler.Style := TToolBarStyleToPanel[ColorScheme];
TBStyler.CaptionAppearance.Assign(TBStyler.GroupAppearance.CaptionAppearance);
with TBStyler.GroupAppearance.TabAppearance do begin
TBStyler.PagerCaption.TextColor := TextColor;
TBStyler.PagerCaption.TextColorExtended := TextColorSelected;
end;
//** Change here
if (Body <> nil) and Body.AdvOfficePagerStyler.InheritsFrom(TAdvOfficePagerOfficeStyler) then
TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style := TOfficePagerStyle(StatusStyle);
// update colors for windows
for i := 0 to Application.ComponentCount - 1 do begin
C := Application.Components[i];
if C.InheritsFrom(TCustomForm) then
SetStyle(C, TBStyler); // will set style for all embedded components
end;
// update report colors on every ribbon page
curr := fToolBar.ActivePageIndex;
for i := 0 to high(Page) do
with Page[i] do begin
if Report <> nil then
Report.Color := TBStyler.QATAppearance.ColorTo;
if i = curr then
List.Invalidate; // repaint list first row with new colors
end;
if Form <> nil then
Form.Invalidate; // whole form redraw
end;
Offline
Nice catch.
Included as http://synopse.info/fossil/info/51e9c62af7
Offline