TPopupBoxとほぼ同じコードで見た目が違うのは何故でしょう (ID:151176)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

mamさん
いつも丁寧にアドバイス頂き有難うございます。
ソース例も頂き、とても感謝しております。確かに、継承元をTPopupBoxにすると三角マークは表示されますね。
今回は、ハードルが少し高いのですが、その上位クラスのTCustomButtonから派生してみました。理由としては、ItemIndexが変更された際に、別の処理を行いたいためです。
私の記述したコードは次の様な感じになります。

TMmPopupBox = class(TCustomButton)  // ←
  { Private 宣言 }
  private
    FItems: TStrings;
    FItemsEx: TStrings;
    FItemIndex: Integer;
    FItemIndexEx: Integer;
     ::: 略 :::
    procedure SetItemIndex(const Value: Integer);
  { public 宣言 }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  { published 宣言 }
  published
     ::: 略 :::
    property Items: TStrings read FItems write SetItems;
    property ItemsEx: TStrings read FItemsEx write SetItemsEx;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
     ::: 略 :::
  end;

procedure Register;

implementation

uses
  System.UIConsts, System.Masks, FMX.Platform, System.Math, System.Math.Vectors, FMX.Consts, FMX.Forms,
  FMX.Utils;

procedure Register;
begin
  RegisterComponents('Original', [TMmPopupBox]);
end;

TMmPopupBoxSettings = class (TTextSettingsInfo.TCustomTextSettings)
  public
    constructor Create(const AOwner: TPersistent); override;
  published
    property Font;
    property FontColor;
    property HorzAlign default TTextAlign.Center;
    property WordWrap default False;
  end;

{ TMmPopupBoxSettings }

constructor TMmPopupBoxSettings.Create(const AOwner: TPersistent);
begin
  inherited;
  HorzAlign := TTextAlign.Center;
  WordWrap := False;
end;

{ TMmPopupBox }

constructor TMmPopupBox.Create(AOwner: TComponent);
var
  PickerService: IFMXPickerService;
begin
  inherited;
  if TPlatformServices.Current.SupportsPlatformService(IFMXPickerService, PickerService) then
    FListPicker := PickerService.CreateListPicker;
{$IF Defined(IOS) OR Defined(ANDROID)}
  FDropDownKind := TDropDownKind.Native;
{$ELSE}
  FDropDownKind := TDropDownKind.Custom;
{$ENDIF}
  CanFocus := True;
  Height := 22;
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := DoItemsChanged;
  // 拡張
  FItemsEx := TStringList.Create;
  FPopup := TPopupMenu.Create(nil);
  FPopup.Stored := False;
  FPopup.Parent := Self;
  FItemIndex := -1;
  MinClipWidth := 14;
  MinClipHeight := 14;
  Text := '';
end;

destructor TMmPopupBox.Destroy;
begin
  FreeAndNil(FListPicker);
  FreeAndNil(FPopup);
  FreeAndNil(FItems);
  // 拡張
  FreeAndNil(FItemsEx);
  inherited;
end;

// ★拡張
procedure TMmPopupBox.SetItemsEx(const Value: TStrings);
begin
  // コードリスト設定
  FItemsEx.Assign(Value);
end;

procedure TMmPopupBox.SetItemIndex(const Value: Integer);
begin
  if FItemIndex <> Value then
  begin
    BeginUpdate;
    try
      if (Value >= 0) and (Value < Items.Count) then
      begin
        inherited Text := Items[Value];
        FItemIndex := Value;
        // 拡張
        if FItemIndexEx <> Value then
          ItemIndexEx := Value;
      end
      else
      begin
        inherited Text := '';
        FItemIndex := -1;
      end;
      Change;
    finally
      EndUpdate;
    end;
    DoChanged;
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る