0

In a following control I use TLabel as up and down buttons. When I choose "Cobalt XEMedia" as a default project style, these labels are drawn with a gray background.

"Windows", "Cobalt XEMedia" and "Obsidian":

Windows Cobalt XEMedia Obsidian

Please help to draw the label background with the same color as the form (see pictures):

Cobalt XEMedia Ok Obsidian Ok

unit UI.UpDownEdit;

interface

uses
  Vcl.Controls, Vcl.StdCtrls, System.Classes;

type
  TUpDownEdit = class(TCustomControl)
  private
    _upButton: TLabel;
    _downButton: TLabel;
    _edit: TEdit;
    _loop: Boolean;
    _maxValue: Integer;
    _minValue: Integer;
    _minDigits: Byte;
    procedure _downButtonClick(Sender: TObject);
    procedure _upButtonClick(Sender: TObject);
    procedure _editEnter(Sender: TObject);
    procedure _setLoop(const Value: Boolean);
    procedure _setMaxValue(const Value: Integer);
    procedure _setMinValue(const Value: Integer);
    function _getValue(): Integer;
    procedure _checkRange;
    procedure _valueToEdit(v: Integer);
    function _constrainValue(v: Integer): Integer;
    procedure _editKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure _stepUp();
    procedure _stepDown();
    procedure _setMinDigits(const Value: Byte);
  protected
    procedure Resize(); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  published
    property MinValue: Integer read _minValue write _setMinValue;
    property MaxValue: Integer read _maxValue write _setMaxValue;
    property Loop: Boolean read _loop write _setLoop;
    property MinDigits: Byte read _minDigits write _setMinDigits;
  end;

procedure Register();

implementation

uses
  Vcl.Dialogs, System.SysUtils, System.UITypes, Winapi.Windows;

procedure Register();
begin
  System.Classes.RegisterComponents('UI', [TUpDownEdit]);
end;

{ TUpDownEdit }

constructor TUpDownEdit.Create(AOwner: TComponent);
begin
  inherited;
  Width := 100;
  Height := 100;

  _minValue := 0;
  _maxValue := 100;
  _minDigits := 1;

  _upButton := TLabel.Create(Self);
  _upButton.Parent := Self;
  _upButton.Align := alTop;
  _upButton.Alignment := taCenter;
  _upButton.Caption := '▲';
  _upButton.Font.Size := 20;
  _upButton.OnClick := _upButtonClick;

  _edit := TEdit.Create(Self);
  _edit.Parent := Self;
  _edit.Align := alClient;
  _edit.Font.Size := 20;
  _edit.Alignment := taCenter;
  _edit.TabOrder := 1;
  _edit.OnEnter := _editEnter;
  _edit.OnKeyDown := _editKeyDown;

  _downButton := TLabel.Create(Self);
  _downButton.Parent := Self;
  _downButton.Align := alBottom;
  _downButton.Alignment := taCenter;
  _downButton.Caption := '▼';
  _downButton.Font.Size := 20;
  _downButton.OnClick := _downButtonClick;

  _valueToEdit(0);
end;

destructor TUpDownEdit.Destroy();
begin
  FreeAndNil(_upButton);
  FreeAndNil(_downButton);
  FreeAndNil(_edit);
  inherited;
end;

procedure TUpDownEdit._editKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    vkUp: begin Key := 0; _stepUp(); end;
    vkDown: _stepDown();
    vkRight:
      begin
        keybd_event(VK_TAB, 0, 0, 0);
        keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0);
      end;
    vkLeft:
      begin
        keybd_event(VK_SHIFT, 0, 0, 0);
        keybd_event(VK_TAB, 0, 0, 0);
        keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0);
        keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
      end;
  end;
end;

procedure TUpDownEdit.Resize();
begin
  inherited;
  _upButton.Height := ClientHeight div 3;
  _downButton.Height := ClientHeight div 3;
end;

procedure TUpDownEdit._stepUp();
var
  ev: Integer;
begin
  ev := _getValue();
  Inc(ev);
  _valueToEdit(_constrainValue(ev));
end;

procedure TUpDownEdit._stepDown();
var
  ev: Integer;
begin
  ev := _getValue();
  Dec(ev);
  _valueToEdit(_constrainValue(ev));
end;

procedure TUpDownEdit._upButtonClick(Sender: TObject);
begin
  _stepUp();
end;

procedure TUpDownEdit._downButtonClick(Sender: TObject);
begin
  _stepDown();
end;

procedure TUpDownEdit._editEnter(Sender: TObject);
begin
  //_edit.SelectAll();
end;

function TUpDownEdit._getValue(): Integer;
begin
  if TryStrToInt(_edit.Text, Result) then Exit();
  _valueToEdit(0);
  Result := 0;
end;

procedure TUpDownEdit._valueToEdit(v: Integer);
begin
  _edit.Text := Format('%.*d',[_minDigits, v]);
end;

procedure TUpDownEdit._setLoop(const Value: Boolean);
begin
  _loop := Value;
  _checkRange();
end;

procedure TUpDownEdit._setMaxValue(const Value: Integer);
begin
  _maxValue := Value;
  _checkRange();
end;

procedure TUpDownEdit._setMinDigits(const Value: Byte);
begin
  _minDigits := Value;
  if _minDigits < 1 then _minDigits := 1;
  _checkRange();
end;

procedure TUpDownEdit._setMinValue(const Value: Integer);
begin
  _minValue := Value;
  _checkRange();
end;

function TUpDownEdit._constrainValue(v: Integer): Integer;
begin
  if v < _minValue then if _loop then v := _maxValue else v := _minValue;
  if v > _maxValue then if _loop then v := _minValue else v := _maxValue;
  Result := v;
end;

procedure TUpDownEdit._checkRange();
begin
  _valueToEdit(_constrainValue(_getValue()));
end;

end.
Paul
  • 25,812
  • 38
  • 124
  • 247
  • You need to ste the `Transparent` property your dynamically created Labels to True. – SilverWarior Feb 19 '19 at 14:19
  • 1
    @SilverWarior: Unfortunately setting `Transparent` to `True` does not help. – Paul Feb 19 '19 at 14:22
  • 1
    Is it possible that the grey areas are the rest of your `TUpDownEdit` that is not covered by either a label or the edit? Try setting `ParentBackground` of `TUpDownEdit` to `True`. – nil Feb 19 '19 at 14:41
  • @nil: Thank you!. Setting `ParentBackground` of `TUpDownEdit` to `True` has helped! By the way, `Transparent` of `TLabel` is `True` by default. What now? Should I create a Style Hook for TUpDownEdit ? – Paul Feb 19 '19 at 14:48

0 Answers0