delphi – 如何创建一个对话框,如组件允许drop其他控件里面?
这是一个Firemonkey组件,但我可以看到大部分的组件基地是相同的VCL和FMX,所以如果你知道如何你在VCL分享你的知识,它可以最终的解决方案为我的情况。
我使用TPopup作为祖先。它对我来说很方便,因为它保持在窗体/框架上,我可以使用与父类相同的上下文/结构与LiveBindings连线,这对我非常方便。 我需要它的行为正是它的TPopup,作为一个容器。但我需要它看起来更好,有我的具体按钮(我已经创建了一些属性和自动化为我的软件里面) 问题是,我创建一些内部控件,如TLayouts,Tpanels和Tbuttons,使外观如下:(空) 其中的黑色区域是我想要放置的控件,如TEdit和其他人。 我已将所有内部创建的控件设置为Store = false,因此它不会存储在流系统上。这样做,当我放一个TEdit,例如,我得到的是这个(Tedit与aligned = top我需要这个): 但我期待这: 如果我改变Store = true我可以得到正确的效果,但所有的内部控件暴露在结构面板上,每次我保存窗体和重新打开一切都重复。暴露的内部组件对我来说不是问题,但是重复是,如果我关闭并打开组件10次,我将获得整个内部结构复制10次。 我将尝试显示一些与组件设计相关的代码: 类声明: [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid)] TNaharFMXPopup = class(TPopup,INaharControlAdapter,INaharControl) private protected FpnlMain : TPanel; FlytToolBar : TLayout; FbtnClose : TButton; FbtnSave : TButton; FbtnEdit : TButton; FpnlClientArea : TPanel; FlblTitle : TLabel; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; constructor Create: constructor TNaharFMXPopup.Create(AOwner: TComponent); begin inherited; FpnlMain := TPanel.Create(Self); FlblTitle := TLabel.Create(Self); FlytToolBar := TLayout.Create(Self); FbtnEdit := TButton.Create(Self); FpnlClientArea := TPanel.Create(Self); FbtnClose := TButton.Create(FlytToolBar); FbtnSave := TButton.Create(FlytToolBar); Height := 382; Placement := TPlacement.Center; StyleLookup := 'combopopupstyle'; Width := 300; ApplyControlsProp; end; 设置内部控件的属性: procedure TNaharFMXPopup.ApplyControlsProp; begin with FpnlMain do begin Parent := Self; Align := TAlignLayout.Client; StyleLookup := 'grouppanel'; TabOrder := 0; Margins.Bottom := 10; Margins.Left := 10; Margins.Right := 10; Margins.Top := 10; Stored := false; end; with FlblTitle do begin Parent := FpnlMain; Text := 'Título'; Align := TAlignLayout.Top; Height := 36; StyleLookup := 'flyouttitlelabel'; Stored := false; end; with FpnlClientArea do begin Parent := FpnlMain; Align := TAlignLayout.Client; StyleLookup := 'gridpanel'; TabOrder := 0; Margins.Bottom := 5; Margins.Left := 5; Margins.Right := 5; Margins.Top := 5; Stored := false; end; with FlytToolBar do begin Parent := FpnlMain; Align := TAlignLayout.Bottom; Height := 50; Stored := false; end; with FbtnClose do begin Parent := FlytToolBar; Text := 'Fecha'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 0; Width := 70; ModalResult := mrClose; Stored := false; end; with FbtnEdit do begin Parent := FlytToolBar; Text := '';//'Edita'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 1; Width := 70; ModalResult := mrContinue; Stored := false; Enabled := false; end; with FbtnSave do begin Parent := FlytToolBar; Text := 'Salva'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 2; Width := 70; ModalResult := mrOk; Stored := false; end; end; 加载: procedure TNaharFMXPopup.Loaded; begin inherited; ApplyControlsProp; SetEvents; end; 我试过以下与通知,试图使插入控件为我的intenal“clientarea” procedure TNaharFMXPopup.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opInsert) and (csDesigning in ComponentState) then begin if AComponent.Owner = self then if AComponent is TFmxObject then begin (AComponent as TFmxObject).Parent := FpnlClientArea; end; end; end; 但这没有改变。 我曾经问过类似的问题,但我不知道有很多事情创建这样的组件和答案我给了很少帮助,我缺少每个内部组件的父。 现在我试图真正显示我的需要在哪里:我需要放置在我的TPopup对话框中的控件,将是其中的ClientArea的父母。 解决方法
仔细看看单元FMX.TabControl中的TTabControl / TTabItem。这是你完美的例子,因为它基本上需要解决同样的问题。
以下函数是您需要覆盖的: procedure DoAddObject(const AObject: TFmxObject); override; 当控件添加到控件时调用。覆盖此函数,以便您的控件被添加到FpnlClientArea控件。你会得到类似的东西: procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject); // ... begin if (FpnlClientArea <> nil) and not AObject.Equals(FpnlClientArea) and not AObject.Equals(ResourceLink) then begin FpnlClientArea.AddObject(AObject); end else inherited; end; 确保AObject.Equals也排除了您的其他“未存储”控件。 如果没有DoAddObject覆盖,FMX TabControl将显示与您的组件当前相同的问题。 TPopup不打算接受控制。所以这需要更多的技巧。 unit NaharFMXPopup; interface uses System.UITypes,System.Variants,System.SysUtils,System.Classes,FMX.Types,FMX.Controls,FMX.Layouts,FMX.StdCtrls; type [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid)] TNaharFMXPopup = class(TPopup) private procedure ApplyControlsProp; protected FpnlMain : TPanel; FlytToolBar : TLayout; FbtnClose : TButton; FbtnSave : TButton; FbtnEdit : TButton; FpnlClientArea : TContent; // change to TContent. // For TPanel we'd have to call SetAcceptControls(False),// but that is not easily possible because that is protected FlblTitle : TLabel; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure DoAddObject(const AObject: TFmxObject); override; public procedure InternalOnClose(Sender: TObject); procedure InternalOnSave(Sender: TObject); procedure InternalOnEdit(Sender: TObject); constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetEvents; published end; implementation { TNaharFMXPopup } constructor TNaharFMXPopup.Create(AOwner: TComponent); begin inherited; FpnlMain := TPanel.Create(Self); FlblTitle := TLabel.Create(Self); FlytToolBar := TLayout.Create(Self); FbtnEdit := TButton.Create(Self); FpnlClientArea := TContent.Create(Self); // change to TContent FbtnClose := TButton.Create(FlytToolBar); FbtnSave := TButton.Create(FlytToolBar); Height := 382; Placement := TPlacement.Center; StyleLookup := 'combopopupstyle'; Width := 300; // A TPopup is not intended to accept controls // so we have to undo those restrictions: Visible := True; SetAcceptsControls(True); ApplyControlsProp; end; destructor TNaharFMXPopup.Destroy; begin inherited; end; procedure TNaharFMXPopup.ApplyControlsProp; begin with FpnlMain do begin Parent := Self; Align := TAlignLayout.Bottom; StyleLookup := 'grouppanel'; TabOrder := 0; Height := 50; Margins.Bottom := 10; Margins.Left := 10; Margins.Right := 10; Margins.Top := 10; Stored := false; end; with FpnlClientArea do begin Parent := Self; // we have to change this to Self (it refuses working if the parent is FPnlMain) Align := TAlignLayout.Client; Margins.Left := 3; Margins.Right := 3; Margins.Top := 3; Margins.Bottom := 3; Stored := false; end; with FlytToolBar do begin Parent := FpnlMain; Align := TAlignLayout.Bottom; Height := 50; Stored := false; end; with FbtnClose do begin Parent := FlytToolBar; Text := 'Close'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 0; Width := 70; ModalResult := mrClose; Stored := false; end; with FbtnEdit do begin Parent := FlytToolBar; Text := '';//'Edita'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 1; Width := 70; ModalResult := mrContinue; Stored := false; Enabled := false; end; with FbtnSave do begin Parent := FlytToolBar; Text := 'Save'; Align := TAlignLayout.Left; Height := 50; StyleLookup := 'tilebutton'; TabOrder := 2; Width := 70; ModalResult := mrOk; Stored := false; end; end; procedure TNaharFMXPopup.Loaded; begin inherited; ApplyControlsProp; // SetEvents; end; procedure TNaharFMXPopup.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; end; procedure TNaharFMXPopup.InternalOnClose(Sender: TObject); begin end; procedure TNaharFMXPopup.InternalOnEdit(Sender: TObject); begin end; procedure TNaharFMXPopup.InternalOnSave(Sender: TObject); begin end; procedure TNaharFMXPopup.SetEvents; begin FbtnClose.OnClick := InternalOnClose; FbtnSave.OnClick := InternalOnSave; FbtnEdit.OnClick := InternalOnEdit; end; procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject); begin //inherited; try commenting the block bellow and uncommenting this one //Exit; if (FpnlClientArea <> nil) and not AObject.Equals(FpnlClientArea) and not AObject.Equals(ResourceLink) and not AObject.Equals(FpnlMain) and not AObject.Equals(FlblTitle) and not AObject.Equals(FlytToolBar) and not AObject.Equals(FbtnEdit) and not AObject.Equals(FpnlClientArea) and not AObject.Equals(FbtnClose) and not AObject.Equals(FbtnSave) then begin FpnlClientArea.AddObject(AObject); end else inherited; end; end. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |