いつもお聞きしてばかりで申し訳ございません。
Delphi11.3のFMXで新たにコンポーネントを作成しています。
機能としてはTPopupBoxを少し拡張し、コードのリストを保持したいと思い、FItemsEx: TStrings;とそのプロパティに対するセッターを設けました。
その他にも機能追加しようと思っているのですが、はじめの一歩として上の通りとしています。
派生元はTPopupBoxと同様にTCustomButtonとし、TPopupBoxのソースをそのまま移植しています。
ビルド、インストールも問題なく実行でき、パレットにTMmPopupBoxというものが表示されました。
早速フォーム上に、作成したコンポーネントを配置してみましたところ、何故かTPopupBoxとは見た目が異なります。具体的にはコンポーネントの右側にポップアップ出来ますよー的なマーク(ｖ)が表示されないのです。
因みにクリックするときちんとポップアップはされます。
何かヒントがございましたらお教え頂けませんでしょうか。どうぞよろしくお願い致します。
問題点が見えてこないので質問ですが
デザイン時に元からあるPopupBoxを配置すると
上下の三角マークが付くけど
自分で同じように作ったPopupBoxにはその表示がない
ということでしょうか？
だとしたら派生元のTCustomButtonがデザイン時に描画されているので
そこを自身で作成する必要があるかも
私はXE10.2 Tokyoなので、環境が違いますが、以下の手順でコンポーネントを登録してみたのですが、問題なく動きます。
不思議ですね。
(1)まず、各ファイルを保存するディレクトリを作成しておきます。
私は以下のディレクトリを作成しました。
Delphiのバージョンやユーザー名によって、適宜ディレクトリ名は設定してください。
C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox
(2)[ツール|オプション]
環境オプション→Delphiオプション→ライブラリ→ライブラリパス
の右にある[...]ボタンをクリックし、(1)のパスを追加しました。
(3)［コンポーネント｜コンポーネントの新規作成...］を選択すると、
［コンポーネントの新規作成］ウィザードが開きます。ウィザードに従います。
FireMonky for Delphi(F)」を選択→次へ
TPopupBox」を選択→次へ
クラス名「TCustomPopupBox」
ユニット名「C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox\UCustomPopupBox.pas」
検索パス「C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox」
→次へ
「新規パッケージへのインストール」を選択→次へ
パッケージ名「C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox\CustomPopupBox.dpk」
→完了
「C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox\UCustomPopupBox.pas」
で保存
確認ダイアログが表示されたら「はい」をクリック
(4)新規作成されたプロジェクト グループを保存
IDEの右上にある［プロジェクト マネージャ］のProjectGrpup1を右クリックして、
［プロジェクト グループに名前を付けて保存...］を選択し
「C:\Users\[ユーザー名]\Documents\Embarcadero\Studio\19.0\lib\CustomPopupBox\GCustomPopupBox.groupproj」
で保存しました。
(5)IDEの右上にある［プロジェクト マネージャ］のContains→UCustomPopupBox.pasをダブルクリックしてソースを表示
ソースコードを以下のように変更します。
unit UCustomPopupBox;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.ExtCtrls;
type
TCustomPopupBox = class(TPopupBox)
private
{ Private 宣言 }
FItemsEx: TStrings;
procedure SetItemsEx(Value:TStrings);
protected
{ Protected 宣言 }
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published 宣言 }
property ItemsEx:TStrings read FItemsEx write SetItemsEx;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TCustomPopupBox]);
end;
{ TCustomPopupBox }
constructor TCustomPopupBox.Create(AOwner: TComponent);
begin
inherited;
FItemsEx:=TStringList.Create;
end;
destructor TCustomPopupBox.Destroy;
begin
FItemsEx.Free;
inherited;
end;
procedure TCustomPopupBox.SetItemsEx(Value: TStrings);
begin
FItemsEx.Assign(Value);
end;
end.
(6)IDEの右上にある［プロジェクト マネージャ］のCustomPopupBox.bplを右クリック→コンパイル
(7)IDEの右上にある［プロジェクト マネージャ］のCustomPopupBox.bplを右クリック→インストール
(8)ここでテスト用プロジェクトをプロジェクトグループに追加作成しても構いません
プロジェクトグループを右クリックして「新規プロジェクトを追加」をクリックします。
［新規作成］ダイアログ ボックスで、
［Delphi プロジェクト｜マルチデバイス アプリケーション｜空のアプリケーション］を選択します。
このプロジェクトでテストします。
takeさん
はい、仰る通りTPopupBoxを配置すると上下の三角マークが付きますが、私が作成したコンポーネントにはそれが付かないのです。
そして、TEditの様にボタンが選択できる状態ではないので、やはりカスタムスタイル設定しないとならないのでしょうか。。。
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;
今回はコードを設定したらTPopupBoxの値も連動して変わり、TPopupBoxの値を選択し直すとコードの値も連動して変わるという様な事を実現したくて、TCustomButtonから継承してしまいました。スタイルが難し過ぎて未だ理解し切れていないのですが、標準のコンポーネントには幾つかのスタイルが割当たっているのではないかと感じます。
三角マークを手早く出すには、StyleLookupプロパティにPopupBoxStyleと入力するのが良さそうですね。一旦、この方法で先へ進もうと思います。
また、何か良き情報がございましたら、是非アドバイス頂けますと幸いでございます。
かなり昔に少し作っただけなので失念していますが
デザインとしてフォーム上に自作コンポーネントを置いて描画されるのは
その自作コンポーネントが実際に動作して自身で描画が行われていたからだと思います
自作コンポーネントによっては published宣言された値を
オブジェクトインスペクタから変えると
実際に表示が変わる物もあるかと思いますが
それは自分自身で描画しています
>TCustomButtonから派生
失礼しました。間違えていました。
しかしながら、クラスヘルパーを使えば、TPopupBoxからの派生でも
より短いソースコードで可能かもしれないです。
はずしていたらすいません。
unit UCustomPopupBox;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.ExtCtrls, FMX.Pickers
,FMX.Menus;
type
//クラスヘルパー
TPopupBoxHelper=class helper for TPopupBox
function GetItemIndexHelper():Integer;
procedure SetItemIndexHelper(Value:Integer);
end;
TCustomPopupBox = class(TPopupBox)
private
{ Private 宣言 }
FItemsEx: TStrings;
FItemIndexEx:Integer;
procedure SetItemsEx(Value:TStrings);
procedure FSetItemIndex(const Value: Integer);
function FGetItemIndex: Integer;
protected
{ Protected 宣言 }
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published 宣言 }
property ItemsEx:TStrings read FItemsEx write SetItemsEx;
property ItemIndexEx:Integer read FItemIndexEx write FItemIndexEx;
property ItemIndex: Integer read FGetItemIndex write FSetItemIndex default -1;
end;
procedure Register;
implementation
uses
System.UIConsts, System.Masks, FMX.Platform, System.Math, System.Math.Vectors, FMX.Consts, FMX.Forms,
FMX.Utils, System.RTTI;
procedure Register;
begin
RegisterComponents('Samples', [TCustomPopupBox]);
end;
{ TPopupBoxHelper }
function TPopupBoxHelper.GetItemIndexHelper: Integer;
begin
with self do result:=FItemIndex;
end;
procedure TPopupBoxHelper.SetItemIndexHelper(Value: Integer);
begin
with self do SetItemIndex(Value);
end;
{ TCustomPopupBox }
constructor TCustomPopupBox.Create(AOwner: TComponent);
begin
inherited;
FItemsEx:=TStringList.Create;
FItemIndexEx:=-1;
end;
destructor TCustomPopupBox.Destroy;
begin
FItemsEx.Free;
inherited;
end;
function TCustomPopupBox.FGetItemIndex: Integer;
begin
//TPopupBoxのプライベート変数から取り出す
Result:=GetItemIndexHelper();
end;
procedure TCustomPopupBox.FSetItemIndex(const Value: Integer);
begin
//TPopupBoxのプライベートメソッドを呼び出す
SetItemIndexHelper(Value);
if FItemIndexEx<>Value then FItemIndexEx:=Value;
end;
procedure TCustomPopupBox.SetItemsEx(Value: TStrings);
begin
FItemsEx.Assign(Value);
end;
end.
takeさん、mamさん
お忙しいところご意見頂きまして本当に有難うございます。
また、mamさんがご提示くださったクラスヘルパーという物が未だ理解できていないので、先ずはこちらを調べております。
Delphi大好きなのですが勉強不足ですみません（汗）
TCustomButtonを継承するよりもTPopupBoxを継承する方が遥かに楽なので、引用させて頂きたいと思います。
また、ご報告申し上げます。
TPopupBoxA = class(TPopupBox)
end;
TPopupBoxB = class(TCustomButton)
end;
TPopupBoxC = class(TCustomButton) //TPopupBox をまるまるコピー
private
で
TPopupBoxA のみ Ｖ が表示される
スタイルの編集するとわかるけど V はスタイルで表示されているので
＞三角マークを手早く出すには、StyleLookupプロパティにPopupBoxStyleと入力するのが良さそうですね。一旦、この方法で先へ進もうと思います。
これしかないよね
AAAAAさん
有難うございます。
最終的には、mamさんに教えて頂きましたクラスヘルパーを使わせて頂き次の様なコードになりました。
使い方としては、
・デザイン時に名称表示用のItemsとコード設定用のItemsExを設定します
・データベースから取得した値（コード）でPopupBoxの表示名称を設定する際は、TextEx := '1';などと設定する事で対応する名称が表示されます
・PopuoBoxで選択した名称に対するコードを取り出す場合はTextExを参照します
※DoEndUpdateをオーバーライドしていますが、これでベストかは自信がないです（汗）
unit MmPopupBox;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.ExtCtrls;
type
// クラスヘルパー（Privateメソッドは扱える様になる模様）
TPopupBoxHelper=class helper for TPopupBox
function GetItemIndexHelper():Integer;
procedure SetItemIndexHelper(Value:Integer);
end;
// TMmPopupBoxクラス
TMmPopupBox = class(TPopupBox)
private
FItemsEx: TStrings;
FItemIndexEx: Integer;
FTextEx: String;
{ Private 宣言 }
procedure SetItemsEx(Value: TStrings);
procedure SetTextEx(Value: String);
procedure DoEndUpdate; override;
protected
{ Protected 宣言 }
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property ItemIndexEx: Integer read FItemIndexEx write FItemIndexEx;
published
{ Published 宣言 }
property ItemsEx: TStrings read FItemsEx write SetItemsEx;
property TextEx: String read FTextEx write SetTextEx;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Original', [TMmPopupBox]);
end;
{ TPopupBoxHelper }
function TPopupBoxHelper.GetItemIndexHelper: Integer;
begin
with self do result := FItemIndex;
end;
procedure TPopupBoxHelper.SetItemIndexHelper(Value: Integer);
begin
with self do SetItemIndex(Value);
end;
{ TMmPopupBox }
{-------------------------------------------------------------------------------
■ コンストラクタ
-------------------------------------------------------------------------------}
constructor TMmPopupBox.Create(AOwner: TComponent);
begin
inherited;
// 拡張
FItemsEx := TStringList.Create;
FItemIndexEx := -1;
end;
{-------------------------------------------------------------------------------
■ デストラクタ
-------------------------------------------------------------------------------}
destructor TMmPopupBox.Destroy;
begin
FreeAndNil(FItemsEx);
inherited;
end;
{-------------------------------------------------------------------------------
■ 変更完了時のVirtualメソッドをオーバーライド
@summary PopupBoxで選択された後のインデックスを取得し、コードテキストも取得
-------------------------------------------------------------------------------}
procedure TMmPopupBox.DoEndUpdate;
begin
inherited;
if ItemIndexEx <> ItemIndex then
begin
FItemIndexEx := ItemIndex;
FTextEx := ItemsEx[FItemIndexEx];
end;
end;
{-------------------------------------------------------------------------------
■ ItemsEx（コード用拡張Items）の設定
-------------------------------------------------------------------------------}
procedure TMmPopupBox.SetItemsEx(Value: TStrings);
begin
FItemsEx.Assign(Value);
end;
{-------------------------------------------------------------------------------
■ TextEx（コード用拡張Text）プロパティの設定
@summary コードテキストからインデックスを取得しPopupBoxの表示内容も書き替え
-------------------------------------------------------------------------------}
procedure TMmPopupBox.SetTextEx(Value: String);
begin
// Valueと現在のコード(TextEx)が異なる場合
if Value <> FTextEx then
begin
FTextEx := Value;
FItemIndexEx := ItemsEx.IndexOf(Value);
SetItemIndexHelper(FItemIndexEx);
end;
end;
end.
お蔭様で上記の通り概ね目的の物が出来ました。
xx区分など選択肢の少ない物は今回作成したTPopupBoxで良いと思います。結構な数の選択肢があるものですから、私には重宝する物になりそうです。
アドバイスを頂きました方々には、いつも貴重な情報を公開頂きまして本当に感謝しております。