Стилизация потомка TCustomControl приводит к серым фоновым меткам - PullRequest
0 голосов
/ 19 февраля 2019

В следующем элементе управления я использую TLabel в качестве кнопок вверх и вниз.Когда я выбираю «Cobalt XEMedia» в качестве стиля проекта по умолчанию, эти метки отображаются на сером фоне.

«Windows», «Cobalt XEMedia» и «Obsidian»:

Windows Cobalt XEMedia Obsidian

Помогите нарисовать фон метки тем же цветом, что и форма (см. Рисунки):

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.
...