How to set `ElevationRequired` for `TBitBtn`

280 Views Asked by At

I need to mark a TBitBtn (not TButton), that the button action requires elevation. I set ElevationRequired to True, but I do not get the shield icon.

To reproduce, place a TButton and a TBitBtn on a form:

procedure TForm1.FormCreate(Sender: TObject);
begin
    Button1.ElevationRequired := True;
    BitBtn1.ElevationRequired := True;
end;

Button1 is displayed with shield icon, BitBtn1 is not.

2

There are 2 best solutions below

3
Andreas Rejbrand On BEST ANSWER

This is not possible.

A VCL TBitBtn is an owner-drawn Win32 BUTTON control. You can see that here:

procedure TBitBtn.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

Hence, a TBitBtn is not drawn by Windows but manually by the Pascal code in Vcl.Buttons.pas. Specifically, TBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct) does the painting.

And here you can see that there is no mentioning of ElevationRequired.

Hence, TBitBtn doesn't support this.

In general, don't use TBitBtn; use TButton to get the native Win32 button.

0
yonojoy On

As ElevationRequired is not implemented for TBitBtn (see Andreas' answer). I ended up drawing the shield icon via this procedure (Vista+):

procedure MarkElevationRequired(ABitBtn: TBitBtn);
var
    Icon: TIcon;
begin
    Assert(Assigned(ABitBtn));
    //---
    try
        Icon := TIcon.Create;
        try
            Icon.Handle := GetSystemIcon(SIID_SHIELD, TSystemIconSize.Small); //see WinApi.ShellApi
            ABitBtn.Glyph.Assign(Icon);
        finally
            Icon.Free;
        end;
    except
        //CreateSystemIcon throws an exception for <WinVista
    end;
end;

with

/// Get system icon for SIID, see https://learn.microsoft.com/de-de/windows/win32/api/shellapi/ne-shellapi-shstockiconid
/// Works for Win Vista or better
/// see https://community.idera.com/developer-tools/b/blog/posts/using-windows-stock-icons-in-delphi
function GetSystemIcon(Id: integer; Size: TSystemIconSize = TSystemIconSize.Large;
  Overlay: Boolean = False; Selected: Boolean = False): HICON;
var
    Flags: Cardinal;
    SSII: TSHStockIconInfo;
    ResCode: HResult;
begin
    if not TOSVersion.Check(6, 0) then
      raise Exception.Create('SHGetStockIconInfo is only available in Win Vista or better.');

    case Size of
        TSystemIconSize.Large: Flags := SHGSI_ICON or SHGSI_LARGEICON;
        TSystemIconSize.Small: Flags := SHGSI_ICON or SHGSI_SMALLICON;
        TSystemIconSize.ShellSize: Flags := SHGSI_ICON or SHGSI_SHELLICONSIZE;
    end;

    if Selected then
      Flags := Flags OR SHGSI_SELECTED;
    if Overlay then
      Flags := Flags OR SHGSI_LINKOVERLAY;

    SSII.cbSize := SizeOf(SSII);
    ResCode := SHGetStockIconInfo(Id, Flags, SSII);

    if ResCode <> S_OK then
    begin
        if ResCode = E_INVALIDARG then
          raise Exception.Create(
            'The stock icon identifier [' + IntToStr(id) + '] is invalid')
        else
          raise Exception.Create(
            'Error calling GetSystemIcon: ' + IntToStr(ResCode));
    end
    else
      Result := SSII.hIcon;
end;