Skip to content

BCComboBox sizing #261

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
circular17 wants to merge 2 commits into
base: dev-bgracontrols
Choose a base branch
from
Open

BCComboBox sizing #261

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
9e0a9bf
(josh fix) update button and list size, measure font on listbox canvas
circular17 Jan 31, 2026
815bec9
handle high DPI scaling with Scaled property
circular17 Feb 1, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
126 changes: 73 additions & 53 deletions bcbutton.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -91,8 +91,9 @@ TCustomBCButton = class(TBCStyleGraphicControl)
FFlipArrow: boolean;
FActiveButt: TBCButtonStyle;
FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
FCanvasScale: Single;
FCanvasScale, FRenderScale: Single;
FCanvasScaleMode: TBCCanvasScaleMode;
FScaled: boolean;
FGlyphAlignment: TBCAlignment;
FGlyphOldPlacement: boolean;
FGlyphScale: single;
Expand Down Expand Up @@ -217,6 +218,7 @@ TCustomBCButton = class(TBCStyleGraphicControl)
function GetDebugText: string; override;
{$ENDIF}
function GetStyleExtension: string; override;
procedure ComputeScaling;
procedure DrawControl; override;
procedure RenderControl; override;
property BGRANormal: TBGRABitmapEx read GetBGRANormal;
Expand All @@ -226,6 +228,7 @@ TCustomBCButton = class(TBCStyleGraphicControl)
property AutoSizeExtraVertical: integer read AutoSizeExtraY;
property AutoSizeExtraHorizontal: integer read AutoSizeExtraX;
property CanvasScaleMode: TBCCanvasScaleMode read FCanvasScaleMode write SetCanvasScaleMode default csmAuto;
property Scaled: boolean read FScaled write FScaled default false;
property StateNormal: TBCButtonState read FStateNormal write SetBCButtonStateNormal;
property StateHover: TBCButtonState read FStateHover write SetBCButtonStateHover;
property StateClicked: TBCButtonState read FStateClicked
Expand Down Expand Up @@ -307,6 +310,8 @@ TBCButton = class(TCustomBCButton)
property StateNormal;
property BorderSpacing;
property CanvasScaleMode;
{ Whether the component is DPI aware }
property Scaled;
property Caption;
property Color;
property Constraints;
Expand Down Expand Up @@ -642,8 +647,8 @@ procedure TCustomBCButton.CalculateGlyphSize(out NeededWidth, NeededHeight: inte
begin
if Assigned(FGlyph) and not FGlyph.Empty then
begin
NeededWidth := ceil(FGlyph.Width * FGlyphScale);
NeededHeight := ceil(FGlyph.Height * FGlyphScale);
NeededWidth := ceil(FGlyph.Width * FGlyphScale * FRenderScale);
NeededHeight := ceil(FGlyph.Height * FGlyphScale * FRenderScale);
end
else
if Assigned(FImages) then
Expand Down Expand Up @@ -692,7 +697,9 @@ function TCustomBCButton.GetButtonRect: TRect;

function TCustomBCButton.GetDropDownWidth(AFull: boolean): integer;
begin
Result := FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width);
Result := round(
(FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width))
* FRenderScale / FCanvasScale);
end;

function TCustomBCButton.GetGlyph: TBitmap;
Expand All @@ -719,7 +726,7 @@ procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);
if Assigned(FGlyph) and not FGlyph.Empty then
begin
ABitmap := FGlyph;
AScale := FCanvasScale * FGlyphScale;
AScale := FRenderScale * FGlyphScale;
end else
if Assigned(FImages) and (FImageIndex > -1) and (FImageIndex < FImages.Count) then
begin
Expand All @@ -729,7 +736,7 @@ procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);
AScale := 1;
{$ELSE}
FImages.GetBitmapRaw(FImageIndex, result);
ABitmap := AScale;
AScale := Screen.PixelsPerInch / 96 * FCanvasScale;
{$ENDIF}
end else
begin
Expand Down Expand Up @@ -758,17 +765,18 @@ procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);
if (csCreating in ControlState) or IsUpdating or (ABGRA = nil) then
Exit;

if FCanvasScale <> 1 then

if FRenderScale <> 1 then
begin
scaledState := TBCButtonState.Create(nil);
scaledState.Assign(AState);
scaledState.Scale(FCanvasScale, false);
scaledState.Scale(FRenderScale, false);
scaledRounding := TBCRounding.Create(nil);
scaledRounding.Assign(Rounding);
scaledRounding.Scale(FCanvasScale);
scaledRounding.Scale(FRenderScale);
scaledRoundingDropDown := TBCRounding.Create(nil);
scaledRoundingDropDown.Assign(RoundingDropDown);
scaledRoundingDropDown.Scale(FCanvasScale);
scaledRoundingDropDown.Scale(FRenderScale);
freeScaled := true;
end
else
Expand All @@ -778,9 +786,9 @@ procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);
scaledRoundingDropDown := RoundingDropDown;
freeScaled := false;
end;
scaledArrowSize := round(DropDownArrowSize * FCanvasScale);
scaledGlyphMargin := round(GlyphMargin * FCanvasScale);
scaledInnerMargin := round(InnerMargin * FCanvasScale);
scaledArrowSize := round(DropDownArrowSize * FRenderScale);
scaledGlyphMargin := round(GlyphMargin * FRenderScale);
scaledInnerMargin := round(InnerMargin * FRenderScale);

ABGRA.NeedRender := False;

Expand Down Expand Up @@ -820,26 +828,27 @@ procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);

// Click offset for text and glyph
if FClickOffset and (AState = FStateClicked) then
r.Offset(round(1 * FCanvasScale), round(1 * FCanvasScale));
r.Offset(round(1 * FRenderScale), round(1 * FRenderScale));

// DropDown arrow
if FDropDownArrow and (FStyle <> bbtDropDown) then
begin
r_a := r;
r_a.Left := r_a.Right - round(FDropDownWidth * FCanvasScale);
r_a.Left := r_a.Right - round(FDropDownWidth * FRenderScale);
if FFlipArrow then
RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badUp,
scaledState.FontEx.Color)
else
RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badDown,
scaledState.FontEx.Color);
Dec(R.Right, round(FDropDownWidth * FCanvasScale));
Dec(R.Right, round(FDropDownWidth * FRenderScale));
end;

GetActualGlyph(g, gScale);
if FShowCaption then actualCaption := self.Caption else actualCaption := '';
r_g := ComputeGlyphPosition(r, g, GlyphAlignment, scaledGlyphMargin, actualCaption,
scaledState.FontEx, GlyphOldPlacement, gScale);

if FTextApplyGlobalOpacity then
begin
{ Drawing text }
Expand Down Expand Up @@ -880,7 +889,7 @@ procedure TCustomBCButton.RenderState(ABGRA: TBGRABitmapEx;
AState: TBCButtonState; const ARect: TRect; ARounding: TBCRounding);
begin
RenderBackgroundAndBorder(ARect, AState.FBackground, TBGRABitmap(ABGRA),
ARounding, AState.FBorder, round(FInnerMargin * FCanvasScale));
ARounding, AState.FBorder, round(FInnerMargin * FRenderScale));
end;

procedure TCustomBCButton.OnChangeGlyph(Sender: TObject);
Expand Down Expand Up @@ -1183,35 +1192,36 @@ procedure TCustomBCButton.CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
var
// AWidth: integer;
gh,gw: integer;
gh, gw, gm: integer;
actualCaption: TCaption;
horizAlign, relHorizAlign: TAlignment;
vertAlign, relVertAlign: TTextLayout;
glyphHorzMargin, glyphVertMargin: integer;
tw, th, availW: integer;
canvasScale: single;
scaledFont: TBCFont;
ownScaledFont: Boolean;
begin
if (Parent = nil) or (not Parent.HandleAllocated) then
Exit;

ComputeScaling;

FLastBorderWidth := FStateNormal.Border.Width;
CalculateGlyphSize(gw, gh);
gm := round(GlyphMargin * FRenderScale);

// more precise computation of font with Retina scaling
canvasScale := GetCanvasScaleFactor;
if (canvasScale <> 1) and FShowCaption then
// and DPI aware computation
if (FRenderScale <> 1) and FShowCaption then
begin
scaledFont := TBCFont.Create(nil);
scaledFont.Assign(FStateNormal.FontEx);
scaledFont.Scale(canvasScale, false);
scaledFont.Scale(FRenderScale, false);
ownScaledFont := true;
end else
begin
scaledFont := FStateNormal.FontEx;
ownScaledFont := false;
canvasScale := 1;
end;

if GlyphOldPlacement then
Expand All @@ -1226,19 +1236,17 @@ procedure TCustomBCButton.CalculatePreferredSize(
if FShowCaption then
begin
CalculateTextSize(Caption, scaledFont, PreferredWidth, PreferredHeight);
PreferredWidth := ceil(PreferredWidth/canvasScale);
PreferredHeight := ceil(PreferredHeight/canvasScale);
end;

// Extra pixels for DropDown
if Style = bbtDropDown then
if FDropDownPosition in [bdpBottom] then
Inc(PreferredHeight, GetDropDownWidth)
Inc(PreferredHeight, round(GetDropDownWidth * FCanvasScale))
else
Inc(PreferredWidth, GetDropDownWidth);
Inc(PreferredWidth, round(GetDropDownWidth * FCanvasScale));

if (Style = bbtButton) and FDropDownArrow then
Inc(PreferredWidth, FDropDownArrowSize);// GetDropDownWidth);
Inc(PreferredWidth, round(FDropDownArrowSize * FRenderScale));


//if (FGlyph <> nil) and (not FGlyph.Empty) then
Expand All @@ -1252,63 +1260,63 @@ procedure TCustomBCButton.CalculatePreferredSize(
end
else
begin
Inc(PreferredWidth, gw + FGlyphMargin);
Inc(PreferredWidth, gw + gm);
if gh > PreferredHeight then
PreferredHeight := gh;
end;
end;

// Extra pixels for AutoSize
Inc(PreferredWidth, AutoSizeExtraX);
Inc(PreferredHeight, AutoSizeExtraY);
Inc(PreferredWidth, round(AutoSizeExtraX * FRenderScale));
Inc(PreferredHeight, round(AutoSizeExtraY * FRenderScale));
end else
begin
if ShowCaption then actualCaption := Caption else actualCaption := '';
PreferredWidth := round(InnerMargin);
PreferredHeight := round(InnerMargin);
PreferredWidth := round(InnerMargin * FRenderScale);
PreferredHeight := round(InnerMargin * FRenderScale);
case FStyle of
bbtDropDown:
case FDropDownPosition of
bdpBottom: inc(PreferredHeight, GetDropDownWidth(False));
else{bdpLeft} inc(PreferredWidth, GetDropDownWidth(False));
bdpBottom: inc(PreferredHeight, round(GetDropDownWidth(False) * FCanvasScale));
else{bdpLeft} inc(PreferredWidth, round(GetDropDownWidth(False) * FCanvasScale));
end;
else{bbtButton} if FDropDownArrow then
inc(PreferredWidth, FDropDownWidth);
inc(PreferredWidth, round(FDropDownWidth * FRenderScale));
end;
inc(PreferredWidth, FStateNormal.Border.Width);
inc(PreferredHeight, FStateNormal.Border.Width);
inc(PreferredWidth, round(FStateNormal.Border.Width * FRenderScale));
inc(PreferredHeight, round(FStateNormal.Border.Width * FRenderScale));

if actualCaption='' then
begin
inc(PreferredWidth,gw);
inc(PreferredHeight,gh);
if gw>0 then inc(PreferredWidth, GlyphMargin*2);
if gh>0 then inc(PreferredHeight, GlyphMargin*2);
if gw>0 then inc(PreferredWidth, gm*2);
if gh>0 then inc(PreferredHeight, gm*2);
end else
begin
GetGlyphActualLayout(actualCaption, FStateNormal.FontEx, GlyphAlignment, GlyphMargin,
GetGlyphActualLayout(actualCaption, scaledFont, GlyphAlignment, gm,
horizAlign, vertAlign, relHorizAlign, relVertAlign, glyphHorzMargin, glyphVertMargin);
availW := 65535;
if (Align in [alTop,alBottom]) and (Parent <> nil) then
availW := Parent.ClientWidth - PreferredWidth;
availW := round((Parent.ClientWidth - BorderSpacing.Left - BorderSpacing.Right) * FCanvasScale - PreferredWidth);
CalculateTextSizeEx(actualCaption, scaledFont, tw, th, availW);
tw := ceil(tw/canvasScale);
th := ceil(th/canvasScale);

if (tw<>0) and FStateNormal.FontEx.WordBreak then inc(tw);
if (tw<>0) and scaledFont.WordBreak then inc(tw);
if vertAlign<>relVertAlign then
begin
inc(PreferredWidth, max(gw+2*GlyphMargin,tw));
inc(PreferredHeight, GlyphMargin+gh+th);
inc(PreferredWidth, max(gw+2*gm,tw));
inc(PreferredHeight, gm+gh+th);
end
else
begin
inc(PreferredWidth, GlyphMargin+gw+tw);
inc(PreferredHeight, max(gh+2*GlyphMargin,th));
inc(PreferredWidth, gm+gw+tw);
inc(PreferredHeight, max(gh+2*gm,th));
end;
end;
end;
if ownScaledFont then scaledFont.Free;
PreferredWidth:= ceil(PreferredWidth / FCanvasScale);
PreferredHeight := ceil(PreferredHeight / FCanvasScale);
end;

class function TCustomBCButton.GetControlClassDefaultSize: TSize;
Expand Down Expand Up @@ -1848,16 +1856,28 @@ function TCustomBCButton.GetDebugText: string;

{$ENDIF}

procedure TCustomBCButton.DrawControl;
var
bgra: TBGRABitmapEx;
r: TRect;
procedure TCustomBCButton.ComputeScaling;
begin
// Scaling relative to screen coordinates
if (CanvasScaleMode = csmFullResolution) or
((CanvasScaleMode = csmAuto) and not Assigned(OnAfterRenderBCButton)) then
FCanvasScale := GetCanvasScaleFactor
else FCanvasScale := 1;

// Scaling relative to DPI and or screen coordinates
if Scaled then
FRenderScale := (Screen.PixelsPerInch / GetDesignTimePPI(self)) * FCanvasScale
else
FRenderScale := FCanvasScale;
end;

procedure TCustomBCButton.DrawControl;
var
bgra: TBGRABitmapEx;
r: TRect;
begin
ComputeScaling;

// If style is without dropdown button or state of each button
// is the same (possible only for msNone) or static button then
// we can draw whole BGRABitmap
Expand Down
Loading