git-svn-id: https://192.168.0.254/svn/Componentes.Internos.GUISDK/trunk@7 e3f7d858-3362-1a4e-b49c-1b1bd96e4488
This commit is contained in:
parent
8e9aa18ad4
commit
dc4d20113d
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
Lib/D7/GUISDK_D7.bpl
Normal file
BIN
Lib/D7/GUISDK_D7.bpl
Normal file
Binary file not shown.
BIN
Lib/D7/GUISDK_D7.dcp
Normal file
BIN
Lib/D7/GUISDK_D7.dcp
Normal file
Binary file not shown.
BIN
Lib/D7/GUISDK_D7.dcu
Normal file
BIN
Lib/D7/GUISDK_D7.dcu
Normal file
Binary file not shown.
BIN
Lib/D7/uCustomEditor.dcu
Normal file
BIN
Lib/D7/uCustomEditor.dcu
Normal file
Binary file not shown.
BIN
Lib/D7/uCustomView.dcu
Normal file
BIN
Lib/D7/uCustomView.dcu
Normal file
Binary file not shown.
@ -1,7 +0,0 @@
|
||||
object CustomView: TCustomView
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 320
|
||||
Height = 240
|
||||
TabOrder = 0
|
||||
end
|
||||
BIN
Lib/D7/uGUIBase.dcu
Normal file
BIN
Lib/D7/uGUIBase.dcu
Normal file
Binary file not shown.
BIN
Lib/D7/uGUIUtils.dcu
Normal file
BIN
Lib/D7/uGUIUtils.dcu
Normal file
Binary file not shown.
@ -35,9 +35,9 @@ requires
|
||||
ccpack10;
|
||||
|
||||
contains
|
||||
uCustomView in '..\Sources\uCustomView.pas' {CustomView: TFrame},
|
||||
uCustomEditor in '..\Sources\uCustomEditor.pas' {CustomEditor},
|
||||
uGUIBase in '..\Sources\uGUIBase.pas',
|
||||
uGUIUtils in '..\Sources\uGUIUtils.pas';
|
||||
uCustomView in '..\Source\uCustomView.pas' {CustomView: TFrame},
|
||||
uCustomEditor in '..\Source\uCustomEditor.pas' {CustomEditor},
|
||||
uGUIBase in '..\Source\uGUIBase.pas',
|
||||
uGUIUtils in '..\Source\uGUIUtils.pas';
|
||||
|
||||
end.
|
||||
|
||||
@ -37,9 +37,9 @@ requires
|
||||
xmlrtl;
|
||||
|
||||
contains
|
||||
uCustomView in '..\Sources\uCustomView.pas',
|
||||
uCustomEditor in '..\Sources\uCustomEditor.pas',
|
||||
uGUIBase in '..\Sources\uGUIBase.pas',
|
||||
uGUIUtils in '..\Sources\uGUIUtils.pas';
|
||||
uCustomView in '..\Source\uCustomView.pas',
|
||||
uCustomEditor in '..\Source\uCustomEditor.pas',
|
||||
uGUIBase in '..\Source\uGUIBase.pas',
|
||||
uGUIUtils in '..\Source\uGUIUtils.pas';
|
||||
|
||||
end.
|
||||
|
||||
@ -92,9 +92,9 @@ ExeDescription=GUI SDK para Delphi 7
|
||||
[Directories]
|
||||
OutputDir=
|
||||
UnitOutputDir=..\Lib\D7
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
PackageDLLOutputDir=..\Lib\D7
|
||||
PackageDCPOutputDir=..\Lib\D7
|
||||
SearchPath=..\Source
|
||||
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;dclOfficeXP;CEToolsPkgd7;FR7;FRIBX7;Hydra_Core_D7;Hydra_RO_D7
|
||||
Conditionals=
|
||||
DebugSourceDirs=
|
||||
@ -135,31 +135,25 @@ ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[Excluded Packages]
|
||||
C:\Archivos de programa\Borland\Delphi7\Projects\Bpl\DJclVcl70.bpl=JEDI Code Library VCL package for Delphi 7
|
||||
C:\Archivos de programa\Borland\Delphi7\Projects\Bpl\DJcl70.bpl=JEDI Code Library RTL package for Delphi 7
|
||||
C:\WINDOWS\system32\fqb70.bpl=FastQueryBuilder 1.01
|
||||
C:\Archivos de programa\Borland\Delphi7\Projects\Bpl\dxPSCoreD7.bpl=ExpressPrinting System (core 3.1) by Developer Express Inc.
|
||||
C:\Archivos de programa\Borland\Delphi7\Projects\Bpl\dxComnD7.bpl=ExpressCommonLibrary by Developer Express Inc.
|
||||
C:\Archivos de programa\Borland\Delphi7\Projects\Bpl\dxBarDBNavD7.bpl=ExpressBars DBNavigator by Developer Express Inc.
|
||||
C:\Archivos de programa\RemObjects Software\Hydra\Dcu\D7\Hydra_Core_D7.bpl=RemObjects Hydra - Core Library
|
||||
C:\Archivos de programa\RemObjects Software\Hydra\Dcu\D7\Hydra_IDE_D7.bpl=RemObjects Hydra - IDE Integration
|
||||
C:\Archivos de programa\RemObjects Software\Hydra\Dcu\D7\Hydra_RO_D7.bpl=RemObjects Hydra - RemObjects SDK Integration Library
|
||||
c:\archivos de programa\borland\delphi7\Bin\designdgm70.bpl=Borland Module Diagram Editview
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
[HistoryLists\hlSearchPath]
|
||||
Count=11
|
||||
Item0=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;..\..\..\Base;..\..\..\Servidor
|
||||
Item1=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;D:\Proyectos\FactuGES (Arribas)\Codigo\Base;D:\Proyectos\FactuGES (Arribas)\Codigo\Modulos\Contactos\Cliente;D:\Proyectos\FactuGES (Arribas)\Codigo\Modulos\Contactos\Reglas
|
||||
Item2=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;D:\Proyectos\Componentes\GUISDK\Lib\D7;..\Servidor
|
||||
Item3=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug
|
||||
Item4=.
|
||||
Item5=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source;
|
||||
Item6=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source;..\Output
|
||||
Item7=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7
|
||||
Item8=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;..\
|
||||
Item9=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source
|
||||
Item10=http://delphi.hostmos.ru;C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7
|
||||
Count=13
|
||||
Item0=..\Source
|
||||
Item1=..\Lib\D7
|
||||
Item2=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;..\..\..\Base;..\..\..\Servidor
|
||||
Item3=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;D:\Proyectos\FactuGES (Arribas)\Codigo\Base;D:\Proyectos\FactuGES (Arribas)\Codigo\Modulos\Contactos\Cliente;D:\Proyectos\FactuGES (Arribas)\Codigo\Modulos\Contactos\Reglas
|
||||
Item4=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;D:\Proyectos\Componentes\GUISDK\Lib\D7;..\Servidor
|
||||
Item5=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug
|
||||
Item6=.
|
||||
Item7=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source;
|
||||
Item8=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source;..\Output
|
||||
Item9=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7
|
||||
Item10=$(DELPHI)\Lib\Debug;D:\PROYEC~1\COMPON~1\jcl\lib\D7\debug;..\
|
||||
Item11=C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7;C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source
|
||||
Item12=http://delphi.hostmos.ru;C:\Archivos de programa\RemObjects Software\Data Abstract for Delphi\Dcu\D7
|
||||
[HistoryLists\hlUnitOutputDirectory]
|
||||
Count=5
|
||||
Item0=..\Lib\D7
|
||||
@ -183,7 +177,7 @@ Item2=.
|
||||
Item3=..\Output
|
||||
Item4=..\
|
||||
[Exception Log]
|
||||
EurekaLog Version=501
|
||||
EurekaLog Version=519
|
||||
Activate=1
|
||||
Activate Handle=1
|
||||
Save Log File=1
|
||||
@ -334,19 +328,19 @@ mtDialog_CustomDataCaption0="Other"
|
||||
Count mtDialog_CustomDataHeader=1
|
||||
mtDialog_CustomDataHeader0="Other Information"
|
||||
Count mtDialog_OKButtonCaption=1
|
||||
mtDialog_OKButtonCaption0="&OK"
|
||||
mtDialog_OKButtonCaption0="%26OK"
|
||||
Count mtDialog_TerminateButtonCaption=1
|
||||
mtDialog_TerminateButtonCaption0="&Terminate"
|
||||
mtDialog_TerminateButtonCaption0="%26Terminate"
|
||||
Count mtDialog_RestartButtonCaption=1
|
||||
mtDialog_RestartButtonCaption0="&Restart"
|
||||
mtDialog_RestartButtonCaption0="%26Restart"
|
||||
Count mtDialog_DetailsButtonCaption=1
|
||||
mtDialog_DetailsButtonCaption0="&Details"
|
||||
mtDialog_DetailsButtonCaption0="%26Details"
|
||||
Count mtDialog_SendMessage=1
|
||||
mtDialog_SendMessage0="&Send this error via Internet"
|
||||
mtDialog_SendMessage0="%26Send this error via Internet"
|
||||
Count mtDialog_ScreenshotMessage=1
|
||||
mtDialog_ScreenshotMessage0="&Attach a Screenshot image"
|
||||
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
|
||||
Count mtDialog_CopyMessage=1
|
||||
mtDialog_CopyMessage0="&Copy to Clipboard"
|
||||
mtDialog_CopyMessage0="%26Copy to Clipboard"
|
||||
Count mtDialog_SupportMessage=1
|
||||
mtDialog_SupportMessage0="Go to the Support Page"
|
||||
Count mtLog_AppHeader=1
|
||||
@ -472,7 +466,7 @@ mtReproduceDialog_Caption0="Request"
|
||||
Count mtReproduceDialog_Request=1
|
||||
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
|
||||
Count mtReproduceDialog_OKButtonCaption=1
|
||||
mtReproduceDialog_OKButtonCaption0="&OK"
|
||||
mtReproduceDialog_OKButtonCaption0="%26OK"
|
||||
Count mtModules_Handle=1
|
||||
mtModules_Handle0="Handle"
|
||||
Count mtModules_Name=1
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
object CustomEditor: TCustomEditor
|
||||
Left = 486
|
||||
Top = 435
|
||||
Width = 518
|
||||
Height = 324
|
||||
Caption = 'CustomEditor'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnActivate = FormActivate
|
||||
OnClose = FormClose
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
end
|
||||
@ -1,319 +0,0 @@
|
||||
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 (csActionClient in Control.ControlStyle) and Control.Visible then
|
||||
Control.InitiateAction;
|
||||
|
||||
if Control is TWinControl then
|
||||
TraverseClients(TWinControl(Control));
|
||||
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.
|
||||
Binary file not shown.
@ -1,7 +0,0 @@
|
||||
object CustomView: TCustomView
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 320
|
||||
Height = 240
|
||||
TabOrder = 0
|
||||
end
|
||||
@ -1,244 +0,0 @@
|
||||
unit uCustomView;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, uGUIBase, DesignEditors;
|
||||
|
||||
type
|
||||
TCustomView = class(TFrame, ICustomView)
|
||||
private
|
||||
FOnGetModified: TOnGetModifiedEvent;
|
||||
FOnViewModified: TOnViewModifiedEvent;
|
||||
FReadOnly: Boolean;
|
||||
FOnCreate: TNotifyEvent;
|
||||
FOnDestroy: TNotifyEvent;
|
||||
FOnHide: TNotifyEvent;
|
||||
FOnShow: TNotifyEvent;
|
||||
procedure ShowEmbedded; overload;
|
||||
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
|
||||
protected
|
||||
FObserver: IObserver;
|
||||
function GetOnGetModified: TOnGetModifiedEvent;
|
||||
procedure SetOnGetModified(const Value : TOnGetModifiedEvent);
|
||||
function GetOnViewModified: TOnViewModifiedEvent;
|
||||
procedure SetOnViewModified(const Value : TOnViewModifiedEvent);
|
||||
procedure SetModified(const Value : Boolean); virtual;
|
||||
function GetModified: Boolean; virtual;
|
||||
function GetReadOnly: Boolean; virtual;
|
||||
function GetValid: Boolean; virtual;
|
||||
procedure Release;
|
||||
procedure SetReadOnly(Value: Boolean); virtual;
|
||||
procedure DoCreate; virtual;
|
||||
procedure DoDestroy; virtual;
|
||||
procedure DoHide; dynamic;
|
||||
procedure DoShow; dynamic;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
constructor CreateEmbedded(AOwner: TComponent; AParent: TWinControl);
|
||||
destructor Destroy; override;
|
||||
procedure ShowEmbedded(const AParent : TWinControl); overload; virtual;
|
||||
property Modified: Boolean read GetModified write SetModified;
|
||||
published
|
||||
property OnGetModified: TOnGetModifiedEvent read GetOnGetModified write
|
||||
SetOnGetModified;
|
||||
property OnViewModified: TOnViewModifiedEvent read GetOnViewModified write
|
||||
SetOnViewModified;
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
|
||||
property Valid: Boolean read GetValid;
|
||||
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
|
||||
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
|
||||
property OnHide: TNotifyEvent read FOnHide write FOnHide;
|
||||
property OnShow: TNotifyEvent read FOnShow write FOnShow;
|
||||
end;
|
||||
|
||||
TCustomViewClass = class of TCustomView;
|
||||
|
||||
TCustomViewModule = class(TCustomModule)
|
||||
public
|
||||
function Nestable: Boolean; override;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
{ TCustomView }
|
||||
|
||||
uses
|
||||
DesignIntf, uGUIUtils, RTLConsts;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterCustomModule(TCustomView, TCustomViewModule);
|
||||
end;
|
||||
|
||||
{
|
||||
********************************* TCustomView **********************************
|
||||
}
|
||||
procedure TCustomView.CMShowingChanged(var Message: TMessage);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
if Showing then
|
||||
begin
|
||||
// Put your OnShow logic here.
|
||||
// When this is called, the frame's window handle has already
|
||||
// been created, as have the handles for the controls on the
|
||||
// frame - so you can do most anything you need to do.
|
||||
if Assigned(FOnShow) then
|
||||
FOnShow(Self);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Put your OnHide logic here, but see the caveats below.
|
||||
if Assigned(FOnHide) then
|
||||
FOnHide(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomView.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FObserver := NIL;
|
||||
DoCreate;
|
||||
end;
|
||||
|
||||
constructor TCustomView.CreateEmbedded(AOwner: TComponent; AParent:
|
||||
TWinControl);
|
||||
begin
|
||||
Create(AOwner);
|
||||
Parent := AParent;
|
||||
Align := alClient;
|
||||
end;
|
||||
|
||||
destructor TCustomView.Destroy;
|
||||
begin
|
||||
DoDestroy;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomView.DoCreate;
|
||||
begin
|
||||
if Assigned(FOnCreate) then
|
||||
begin
|
||||
try
|
||||
FOnCreate(Self);
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomView.DoDestroy;
|
||||
begin
|
||||
if Assigned(FOnDestroy) then
|
||||
begin
|
||||
try
|
||||
FOnDestroy(Self);
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomView.DoHide;
|
||||
begin
|
||||
if Assigned(FOnHide) then
|
||||
begin
|
||||
try
|
||||
FOnHide(Self);
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomView.DoShow;
|
||||
begin
|
||||
if Assigned(FOnShow) then
|
||||
begin
|
||||
try
|
||||
FOnShow(Self);
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomView.GetModified: Boolean;
|
||||
begin
|
||||
Result := ControlIsModified(Self);
|
||||
if Assigned(FOnGetModified) then
|
||||
FOnGetModified(Self, Result);
|
||||
end;
|
||||
|
||||
function TCustomView.GetOnGetModified: TOnGetModifiedEvent;
|
||||
begin
|
||||
Result := FOnGetModified;
|
||||
end;
|
||||
|
||||
function TCustomView.GetOnViewModified: TOnViewModifiedEvent;
|
||||
begin
|
||||
Result := FOnViewModified;
|
||||
end;
|
||||
|
||||
function TCustomView.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result := FReadOnly;
|
||||
end;
|
||||
|
||||
function TCustomView.GetValid: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TCustomView.Release;
|
||||
begin
|
||||
Free;
|
||||
end;
|
||||
|
||||
procedure TCustomView.SetModified(const Value: Boolean);
|
||||
begin
|
||||
if Assigned(FOnViewModified) then
|
||||
FOnViewModified(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomView.SetOnGetModified(const Value: TOnGetModifiedEvent);
|
||||
begin
|
||||
FOnGetModified := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomView.SetOnViewModified(const Value: TOnViewModifiedEvent);
|
||||
begin
|
||||
FOnViewModified := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomView.SetReadOnly(Value: Boolean);
|
||||
begin
|
||||
FReadOnly := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomView.ShowEmbedded;
|
||||
begin
|
||||
Align := alClient;
|
||||
Show;
|
||||
end;
|
||||
|
||||
procedure TCustomView.ShowEmbedded(const AParent : TWinControl);
|
||||
begin
|
||||
Parent := AParent;
|
||||
ShowEmbedded;
|
||||
end;
|
||||
|
||||
{ TCustomViewModule }
|
||||
|
||||
function TCustomViewModule.Nestable: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
Binary file not shown.
@ -1,128 +0,0 @@
|
||||
unit uGUIBase;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Forms, Controls, Contnrs, Classes;
|
||||
|
||||
type
|
||||
TOnGetModifiedEvent = procedure (Sender: TObject; var Modified: Boolean) of object;
|
||||
TOnViewModifiedEvent = procedure (Sender: TObject) of object;
|
||||
|
||||
IEmbeddedable = interface(IInterface)
|
||||
['{A1668B17-B355-4688-A78A-B30AE3C8C81E}']
|
||||
procedure Release;
|
||||
procedure ShowEmbedded; overload;
|
||||
procedure ShowEmbedded(const AParent : TWinControl); overload;
|
||||
end;
|
||||
|
||||
IModificable = interface(IEmbeddedable)
|
||||
['{7F75A327-4ACC-4E4A-8B3D-21C1241DAFBF}']
|
||||
function GetModified: Boolean;
|
||||
procedure SetModified(const Value : Boolean);
|
||||
property Modified: Boolean read GetModified write SetModified;
|
||||
|
||||
function GetOnGetModified: TOnGetModifiedEvent;
|
||||
procedure SetOnGetModified(const Value : TOnGetModifiedEvent);
|
||||
property OnGetModified: TOnGetModifiedEvent read GetOnGetModified write
|
||||
SetOnGetModified;
|
||||
|
||||
function GetOnViewModified: TOnViewModifiedEvent;
|
||||
procedure SetOnViewModified(const Value : TOnViewModifiedEvent);
|
||||
property OnViewModified: TOnViewModifiedEvent read GetOnViewModified write
|
||||
SetOnViewModified;
|
||||
end;
|
||||
|
||||
IReadOnly = interface(IModificable)
|
||||
['{2549ECF9-270F-4F3C-9852-E488C518F590}']
|
||||
function GetReadOnly: Boolean;
|
||||
procedure SetReadOnly(Value: Boolean);
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
|
||||
end;
|
||||
|
||||
IValidable = interface(IReadOnly)
|
||||
['{A2562A5E-E3B2-4C1B-B8FE-13A410D8B3DB}']
|
||||
function GetValid: Boolean;
|
||||
property Valid: Boolean read GetValid;
|
||||
end;
|
||||
|
||||
IInstanceAware = interface(IValidable)
|
||||
['{B6B2676A-1D8E-4597-ADDB-43734508E6F5}']
|
||||
function GetInstance: TObject;
|
||||
function GetInstanceID: Integer;
|
||||
procedure SetInstanceID(Value: Integer);
|
||||
property InstanceID: Integer read GetInstanceID write SetInstanceID;
|
||||
end;
|
||||
|
||||
ICustomEditor = interface(IInstanceAware)
|
||||
['{07A3AB52-B2B0-4DE3-B470-379834BBE7DB}']
|
||||
end;
|
||||
|
||||
ICustomView = interface(IValidable)
|
||||
['{98192DE2-19C5-4DA5-B4F4-F2B3782DB6E2}']
|
||||
function CanFocus: Boolean;
|
||||
function Focused: Boolean;
|
||||
procedure SetFocus;
|
||||
procedure Update;
|
||||
end;
|
||||
|
||||
|
||||
IHostForm = interface(IInterface)
|
||||
['{2091401E-1F9C-4F05-8574-E9E0532780D1}']
|
||||
function GetWorkPanel: TWinControl;
|
||||
property WorkPanel: TWinControl read GetWorkPanel;
|
||||
procedure OnWorkPanelChanged(AEditor : ICustomEditor);
|
||||
procedure ShowEmbedded(AEditor : ICustomEditor);
|
||||
end;
|
||||
|
||||
|
||||
IGUIManager = interface(IInterface)
|
||||
['{D0A5D2CC-36E1-4C61-8D3B-B6D00EBA3278}']
|
||||
function FindInstance(const IID: TGUID): ICustomEditor;
|
||||
function GetActiveInstance: ICustomEditor;
|
||||
function GetActiveInstanceIndex: Integer;
|
||||
function GetInstance(Index : Integer): ICustomEditor;
|
||||
function GetWorkPanel: TWinControl;
|
||||
function RegisterInstance(AInstance : ICustomEditor): Boolean;
|
||||
procedure ReleaseInstance(AnInstance : ICustomEditor);
|
||||
procedure SetActiveInstance(Value: ICustomEditor);
|
||||
procedure SetActiveInstanceIndex(Value: Integer);
|
||||
procedure SetWorkPanel(const Value: TWinControl);
|
||||
property ActiveInstance: ICustomEditor read GetActiveInstance write
|
||||
SetActiveInstance;
|
||||
property ActiveInstanceIndex: Integer read GetActiveInstanceIndex write
|
||||
SetActiveInstanceIndex;
|
||||
property Instances[Index : Integer]: ICustomEditor read GetInstance;
|
||||
property WorkPanel: TWinControl read GetWorkPanel write SetWorkPanel;
|
||||
end;
|
||||
|
||||
IObservable = interface;
|
||||
TObserverEvent = procedure (AObject : IObservable) of object;
|
||||
IObserver = interface(IInterface)
|
||||
['{79175C66-8435-4F2F-A3E0-A53A24554A0E}']
|
||||
function GetOnNotifyObserver: TObserverEvent;
|
||||
function GetOnObserverAttached: TObserverEvent;
|
||||
function GetOnObserverDettached: TObserverEvent;
|
||||
procedure NotifyObserver(const AObject: IObservable);
|
||||
procedure ObserverAttached(AObject : IObservable);
|
||||
procedure ObserverDettached(AObject : IObservable);
|
||||
procedure SetOnNotifyObserver(AValue: TObserverEvent);
|
||||
procedure SetOnObserverAttached(AValue: TObserverEvent);
|
||||
procedure SetOnObserverDettached(AValue: TObserverEvent);
|
||||
property OnNotifyObserver: TObserverEvent read GetOnNotifyObserver write
|
||||
SetOnNotifyObserver;
|
||||
property OnObserverAttached: TObserverEvent read GetOnObserverAttached
|
||||
write SetOnObserverAttached;
|
||||
property OnObserverDettached: TObserverEvent read GetOnObserverDettached
|
||||
write SetOnObserverDettached;
|
||||
end;
|
||||
|
||||
IObservable = interface(IInterface)
|
||||
['{1FF0F081-CBBA-4728-8689-D6F506652E80}']
|
||||
procedure AddObserver(const AObserver: IObserver);
|
||||
procedure RemoveObserver(const AObserver: IObserver);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
Binary file not shown.
@ -1,51 +0,0 @@
|
||||
unit uGUIUtils;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Controls;
|
||||
|
||||
function ControlIsModified(AControl : TWinControl) : Boolean;
|
||||
procedure ResetModifiedControl(AControl : TWinControl);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StdCtrls, uGUIBase, uCustomView;
|
||||
|
||||
function ControlIsModified(AControl : TWinControl) : Boolean;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if AControl is TCustomEdit then
|
||||
Result := Result OR (AControl as TCustomEdit).Modified
|
||||
else
|
||||
if not Result then
|
||||
for i := 0 to AControl.ControlCount - 1 do
|
||||
begin
|
||||
if AControl.Controls[i] is TWinControl then
|
||||
Result := ControlIsModified((AControl.Controls[i] as TWinControl));
|
||||
|
||||
if Result then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure ResetModifiedControl(AControl : TWinControl);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if AControl is TCustomEdit then
|
||||
(AControl as TCustomEdit).Modified := False
|
||||
else
|
||||
for i := 0 to AControl.ControlCount - 1 do
|
||||
begin
|
||||
if AControl.Controls[i] is TWinControl then
|
||||
ResetModifiedControl((AControl.Controls[i] as TWinControl));
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user