unit uCustomEditor; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, uGUIBase, uCustomView; type TCustomEditor = class(TForm, ICustomEditor) private FInstanceID: Integer; FOnGetModified: TOnGetModifiedEvent; FOnViewModified: TOnViewModifiedEvent; FReadOnly: Boolean; function FindHostForm : IHostForm; procedure ShowEmbedded(const AParent : TWinControl); overload; protected FViews: TInterfaceList; procedure UpdateActions; override; function GetInstanceID: Integer; function GetModified: Boolean; virtual; procedure SetModified(const Value : Boolean); virtual; function GetOnViewModified: TOnViewModifiedEvent; procedure SetOnViewModified(const Value : TOnViewModifiedEvent); function GetReadOnly: Boolean; virtual; function GetValid: Boolean; virtual; procedure SetInstanceID(Value: Integer); procedure SetReadOnly(Value: Boolean); virtual; function GetOnGetModified: TOnGetModifiedEvent; procedure SetOnGetModified(const Value: TOnGetModifiedEvent); public constructor Create(AOwner: TComponent); overload; override; destructor Destroy; override; function CreateView(const AViewClass : TCustomViewClass): IInterface; function FindView(const IID: TGUID): IInterface; function GetInstance: TObject; procedure ShowEmbedded; overload; function CloseQuery: Boolean; override; property Modified: Boolean read GetModified write SetModified; published property InstanceID: Integer read GetInstanceID write SetInstanceID; property ReadOnly: Boolean read GetReadOnly write SetReadOnly; property Valid: Boolean read GetValid; property OnGetModified: TOnGetModifiedEvent read GetOnGetModified write SetOnGetModified; end; TCustomEditorClass = class of TCustomEditor; procedure Register; implementation uses CustFrms, uGUIUtils; procedure Register; begin RegisterCustomFormClass(TCustomEditor); end; { ******************************** TCustomEditor ********************************* } constructor TCustomEditor.Create(AOwner: TComponent); begin // inherited CreateNew(AOwner); // initialize custom fields, etc., here FViews := TInterfaceList.Create; GlobalNameSpace.BeginWrite; try CreateNew(AOwner); if (ClassType <> TCustomEditor) and not (csDesigning in ComponentState) then begin Include(FFormState, fsCreating); try if not InitInheritedComponent(Self, TCustomEditor) then raise EResNotFound.CreateFmt('Error %s', [ClassName]); finally Exclude(FFormState, fsCreating); end; if OldCreateOrder then DoCreate; end; finally GlobalNameSpace.EndWrite; end; { GlobalNameSpace.BeginWrite; try if (ClassType <> TCustomEditor) and not (csDesigning in ComponentState) then begin if not InitInheritedComponent(Self, TCustomEditor) then raise Exception.Create('Error'); if OldCreateOrder and Assigned(OnCreate) then OnCreate(Self); end; finally GlobalNameSpace.EndWrite; end;} end; destructor TCustomEditor.Destroy; var i: Integer; begin for i := FViews.Count - 1 downto 0 do FViews.Delete(i); FreeAndNIL(FViews); inherited Destroy; end; function TCustomEditor.CreateView(const AViewClass : TCustomViewClass): IInterface; begin Result := FViews[FViews.Add(AViewClass.Create(Self))]; end; function TCustomEditor.FindView(const IID: TGUID): IInterface; var i: Integer; aObj: ICustomView; begin aObj := NIL; Result := NIL; for i := 0 to (FViews.Count - 1) do begin FViews.Items[i].QueryInterface(IID, aObj); if Assigned(aObj) then begin Result := aObj; Break; end; end; end; function TCustomEditor.GetInstance: TObject; begin Result := Self; end; function TCustomEditor.GetInstanceID: Integer; begin Result := FInstanceID; end; function TCustomEditor.GetModified: Boolean; begin Result := ControlIsModified(Self); if Assigned(FOnGetModified) then FOnGetModified(Self, Result); end; function TCustomEditor.GetReadOnly: Boolean; begin Result := FReadOnly; end; function TCustomEditor.GetValid: Boolean; var i: Integer; aObj: ICustomView; begin aObj := NIL; Result := True; for i := 0 to (FViews.Count - 1) do begin FViews.Items[i].QueryInterface(IValidable, aObj); if Assigned(aObj) then Result := Result AND aObj.Valid; if not Result then Break; end; end; procedure TCustomEditor.SetInstanceID(Value: Integer); begin FInstanceID := Value; end; procedure TCustomEditor.SetReadOnly(Value: Boolean); begin FReadOnly := Value; end; procedure TCustomEditor.ShowEmbedded; var AMainForm: IHostForm; begin AMainForm := NIL; if not Supports(Application.MainForm, IHostForm, AMainForm) then AMainForm := FindHostForm; if not Assigned(AMainForm) then raise Exception.Create('No se ha encontrado el formulario principal (ShowEmbedded)') else AMainForm.ShowEmbedded(Self) end; procedure TCustomEditor.ShowEmbedded(const AParent : TWinControl); begin Parent := AParent; Align := alClient; BorderIcons := []; BorderStyle := bsNone; Show; SetFocus; end; function TCustomEditor.GetOnGetModified: TOnGetModifiedEvent; begin Result := FOnGetModified; end; function TCustomEditor.GetOnViewModified: TOnViewModifiedEvent; begin Result := FOnViewModified; end; procedure TCustomEditor.SetOnGetModified(const Value: TOnGetModifiedEvent); begin FOnGetModified := Value; end; procedure TCustomEditor.SetOnViewModified(const Value: TOnViewModifiedEvent); begin FOnViewModified := Value; end; function TCustomEditor.CloseQuery: Boolean; var i: Integer; aIntf: IValidable; begin Result := inherited CloseQuery; if Result then for i := 0 to FViews.Count - 1 do begin FViews.Items[i].QueryInterface(IValidable, aIntf); if Assigned(aIntf) then begin Result := (Result and aIntf.Valid); if not Result then break; end; end; end; procedure TCustomEditor.SetModified(const Value: Boolean); begin if Value = False then ResetModifiedControl(Self); if Assigned(FOnViewModified) then FOnViewModified(Self); end; function TCustomEditor.FindHostForm: IHostForm; var i : integer; AMainForm : IHostForm; begin Result := NIL; for i := 0 to Application.ComponentCount do if Supports(Application.Components[i], IHostForm, AMainForm) then begin Result := AMainForm; Break; end; end; {------------------------------------------------------------------------------- Sobreescribo 'UpdateActions' por un fallo en Delphi que hace consumir mucha CPU cuando se usan acciones con formularios metidos uno dentro de otro. -------------------------------------------------------------------------------} procedure TCustomEditor.UpdateActions; var I: Integer; procedure TraverseClients(Container: TWinControl); var I: Integer; Control: TControl; begin Application.ProcessMessages; // <--- Modificación if Container.Showing then for I := 0 to Container.ControlCount - 1 do begin Control := Container.Controls[I]; if Assigned(Control) then begin if (csActionClient in Control.ControlStyle) and Control.Visible then Control.InitiateAction; if Control is TWinControl then TraverseClients(TWinControl(Control)); end; end; end; begin if (csDesigning in ComponentState) or not Showing then Exit; { Update form } InitiateAction; { Update main menu's top-most items } if Menu <> nil then for I := 0 to Menu.Items.Count - 1 do with Menu.Items[I] do if Visible then InitiateAction; { Update any controls } TraverseClients(Self); end; end.