delover
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
{*******************************************************}
{ Modified: $Date: 2009/10/16 17:37:30, +0500 $xpin }
{*******************************************************}
unit Unit1;
{$I ..\Lib\jedi.inc}
interface
uses
Classes, Forms;
type
{ TSymbiosisProfile }
TSymbiosisProfile = class
private
FOnExit: TNotifyEvent;
FOnInitialize: TNotifyEvent;
FOnRun: TNotifyEvent;
procedure DoExit(Sender: TObject);
procedure DoInitialize(Sender: TObject);
public
constructor Create;
property OnExit: TNotifyEvent read FOnExit write FOnExit;
property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
property OnRun: TNotifyEvent read FOnRun write FOnRun;
end;
{ TApplicationHelper }
TApplicationHelper = class helper
{$IFDEF COMPILER11}(TApplicationHelper){$ENDIF} for TApplication
private
{$IFDEF CIL}
procedure _Initialize; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
{$ENDIF}
procedure _Run; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
public
{$IFDEF CIL}
procedure Initialize;
{$ENDIF}
procedure Run;
end;
function SymbiosisProfile: TSymbiosisProfile;
//Log intf
// IExceptionRTLTracking = interface(IInterface)
// ['{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
// function Active: Boolean;
// function HandleException(Strings: TObject; Options: Integer): Boolean;
// procedure Start;
// procedure Stop;
// end;
//Log include on exception stack
// JDBG_AddressOffset = 2;
implementation
uses
SysUtils;
//{$IFNDEF CIL}
// pinDeclInta,
//{$ENDIF}
// pinDeclares;
var
FProjectSymbiosisProfile: TSymbiosisProfile;
function SymbiosisProfile: TSymbiosisProfile;
begin
if not Assigned(FProjectSymbiosisProfile) then
FProjectSymbiosisProfile := TSymbiosisProfile.Create;
Result := FProjectSymbiosisProfile;
end;
{ TSymbiosisProfile }
constructor TSymbiosisProfile.Create;
begin
inherited Create;
OnInitialize := DoInitialize;
OnExit := DoExit;
end;
procedure TSymbiosisProfile.DoExit(Sender: TObject);
//var
// Intf: IInterface;
begin
// if Supports(BindingRTLServices, IExceptionRTLTracking, Intf) then
// begin
// IExceptionRTLTracking(Intf).Stop;
// Intf := nil;
// end;
end;
procedure TSymbiosisProfile.DoInitialize(Sender: TObject);
//var
// Intf: IInterface;
begin
// if Supports(BindingRTLServices, IExceptionRTLTracking, Intf) then
// begin
// IExceptionRTLTracking(Intf).Start;
// Intf := nil;
// end;
end;
{ TApplicationHelper }
{$IFDEF CIL}
procedure TApplicationHelper.Initialize;
begin
_Initialize;
with SymbiosisProfile do
if Assigned(OnInitialize) then OnInitialize(Application);
end;
{$ENDIF}
procedure TApplicationHelper.Run;
begin
with SymbiosisProfile do
begin
if Assigned(OnRun) then OnRun(Application);
_Run;
if Assigned(OnExit) then OnExit(Application);
end;
end;
{$IFDEF CIL}
procedure TApplicationHelper._Initialize;
begin
inherited Initialize;
end;
{$ENDIF}
procedure TApplicationHelper._Run;
begin
inherited Run;
end;
{$IFNDEF CIL}
var
SaveInitProc: Pointer = nil;
SaveExitProc: Pointer = nil;
procedure InitProf;
begin
if SaveInitProc <> nil then TProcedure(SaveInitProc);
with SymbiosisProfile do
if Assigned(OnInitialize) then OnInitialize(Application);
end;
procedure FinalizeProf;
begin
ExitProc := SaveExitProc;
FreeAndNil(FProjectSymbiosisProfile);
end;
{$ENDIF}
initialization
{$IFNDEF CIL}
SaveInitProc := InitProc;
InitProc := @InitProf;
SaveExitProc := ExitProc;
ExitProc := @FinalizeProf;
{$ELSE}
finalization
FreeAndNil(FProjectSymbiosisProfile);
{$ENDIF}
end.
|
|
Всего записей: 1395 | Зарегистр. 25-06-2007 | Отправлено: 08:54 15-10-2009 | Исправлено: delover, 16:23 16-10-2009 |
|
