spkToolbar: Fix too large checkboxes and radiobuttons in Ubuntu or Windows at >= 120 ppi (issue #0026037)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3650 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-13 19:04:19 +00:00
parent ff5dba6c66
commit 966611fcfe
2 changed files with 17 additions and 7 deletions

View File

@ -387,7 +387,7 @@ end;
implementation
uses
LCLIntf, IntfGraphics, Math, Themes;
types, LCLIntf, IntfGraphics, Math, Themes;
{ TSpkGUITools }
@ -2909,16 +2909,21 @@ const
var
R: TRect;
w: Integer;
sz: TSize;
te: TThemedElementDetails;
begin
w := GetSystemMetrics(SM_CYMENUCHECK);
R := Bounds(x, y, w, w);
if ThemeServices.ThemesEnabled then begin
te := ThemeServices.GetElementDetails(THEMED_FLAGS[AStyle, AState, ACheckboxState]);
sz := ThemeServices.GetDetailSize(te);
R := Bounds(x, y, sz.cx, sz.cy);
InflateRect(R, 1, 1);
ThemeServices.DrawElement(ACanvas.Handle, te, R);
end else
end else begin
w := GetSystemMetrics(SM_CYMENUCHECK);
R := Bounds(x, y, w, w);
DrawFrameControl(
ACanvas.Handle, R, DFC_BUTTON, UNTHEMED_FLAGS[AStyle, AState]);
end;
end;
end.

View File

@ -79,7 +79,7 @@ type
implementation
uses
LCLType, LCLIntf, Math,
LCLType, LCLIntf, Math, Themes,
SpkGraphTools, spkt_Const, spkt_Tools, spkt_Pane;
@ -228,6 +228,7 @@ var
FontColor: TColor;
x, y: Integer;
h: Integer;
te: TThemedElementDetails;
begin
if FToolbarDispatch = nil then
exit;
@ -296,12 +297,16 @@ begin
end;
// Checkbox
h := GetSystemMetrics(SM_CYMENUCHECK);
if ThemeServices.ThemesEnabled then begin
te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal);
h := ThemeServices.GetDetailSize(te).cy;
end else
h := GetSystemMetrics(SM_CYMENUCHECK);
if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then
x := FButtonRect.Left + SMALLBUTTON_HALF_BORDER_WIDTH + SMALLBUTTON_PADDING
else
x := FButtonRect.Left + SMALLBUTTON_BORDER_WIDTH + SMALLBUTTON_PADDING;
y := FButtonRect.top + (FButtonRect.height - h) div 2;
y := FButtonRect.Top + (FButtonRect.Height - h) div 2;
TGUITools.DrawCheckbox(
ABuffer.Canvas,