318 lines
7.9 KiB
ObjectPascal
318 lines
7.9 KiB
ObjectPascal
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;
|
||
|
||
implementation
|
||
|
||
{$R *.dfm}
|
||
|
||
uses
|
||
uGUIUtils;
|
||
|
||
{
|
||
******************************** 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<63>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.
|