git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@63 05c56307-c608-d34a-929d-697000501d7a
322 lines
10 KiB
ObjectPascal
322 lines
10 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressPrinting System(tm) COMPONENT SUITE }
|
|
{ }
|
|
{ Copyright (C) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire coVisntents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND }
|
|
{ ALL ACCOMPANYING VCL CONTROLS AS PART OF AN }
|
|
{ EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxPSEngn;
|
|
|
|
interface
|
|
|
|
{$I cxVer.inc}
|
|
|
|
uses
|
|
dxPSESys, Classes, Graphics, SysUtils, dxPSGlbl, dxPSSngltn;
|
|
|
|
type
|
|
TdxPSEngine = class(TBasedxPSSingleton)
|
|
private
|
|
FDesignTimeRegistryPath: string;
|
|
FHelpFile: string;
|
|
FInitialDir: string;
|
|
FLookAndFeel: TdxPSLookAndFeel;
|
|
FRegistryPath: string;
|
|
FSaveFormsPosition: Boolean;
|
|
FUseNativeLookAndFeel: Boolean;
|
|
function GetAppName: string;
|
|
function GetRealRegistryPath: string;
|
|
function GetThemesEnabled: Boolean;
|
|
protected
|
|
procedure InitializeInstance; override;
|
|
public
|
|
class function Instance: TdxPSEngine; reintroduce; overload;
|
|
property AppName: string read GetAppName;
|
|
property DesignTimeRegistryPath: string read FDesignTimeRegistryPath;
|
|
property HelpFile: string read FHelpFile write FHelpFile;
|
|
property InitialDir: string read FInitialDir write FInitialDir;
|
|
property LookAndFeel: TdxPSLookAndFeel read FLookAndFeel write FLookAndFeel;
|
|
property RealRegistryPath: string read GetRealRegistryPath;
|
|
property RegistryPath: string read FRegistryPath write FRegistryPath;
|
|
property SaveFormsPosition: Boolean read FSaveFormsPosition write FSaveFormsPosition;
|
|
property ThemesEnabled: Boolean read GetThemesEnabled;
|
|
property UseNativeLookAndFeel: Boolean read FUseNativeLookAndFeel write FUseNativeLookAndFeel;
|
|
end;
|
|
|
|
TdxPSEngineController = class(TComponent)
|
|
private
|
|
FHelpFile: string;
|
|
FLookAndFeel: TdxPSLookAndFeel;
|
|
FRegistryPath: string;
|
|
FSaveFormsPosition: Boolean;
|
|
FUseNativeLookAndFeel: Boolean;
|
|
procedure SetHelpFile(const Value: string);
|
|
procedure SetLookAndFeel(Value: TdxPSLookAndFeel);
|
|
procedure SetRegistryPath(const Value: string);
|
|
procedure SetSaveFormsPosition(Value: Boolean);
|
|
procedure SetUseNativeLookAndFeel(Value: Boolean);
|
|
function IsCurrent: Boolean;
|
|
function IsDesigning: Boolean;
|
|
protected
|
|
procedure Loaded; override;
|
|
procedure InitializeEngine; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Activate;
|
|
published
|
|
property HelpFile: string read FHelpFile write SetHelpFile;
|
|
property LookAndFeel: TdxPSLookAndFeel read FLookAndFeel write SetLookAndFeel default pslfStandard;
|
|
property RegistryPath: string read FRegistryPath write SetRegistryPath;
|
|
property SaveFormsPosition: Boolean read FSaveFormsPosition write SetSaveFormsPosition default True;
|
|
property UseNativeLookAndFeel: Boolean read FUseNativeLookAndFeel write SetUseNativeLookAndFeel default True;
|
|
end;
|
|
|
|
function dxPSEngine: TdxPSEngine;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Forms, {$IFDEF DELPHI7} Themes, {$ENDIF} dxPSRes, dxPSUtl;
|
|
|
|
function dxPSEngine: TdxPSEngine;
|
|
begin
|
|
Result := TdxPSEngine.Instance;
|
|
end;
|
|
|
|
{ TdxPSEngine }
|
|
|
|
class function TdxPSEngine.Instance: TdxPSEngine;
|
|
begin
|
|
Result := inherited Instance as TdxPSEngine;
|
|
end;
|
|
|
|
procedure TdxPSEngine.InitializeInstance;
|
|
begin
|
|
inherited;
|
|
FDesignTimeRegistryPath := dxPSGlbl.sdxPSRegPathDesignTime;
|
|
FSaveFormsPosition := True;
|
|
if IsDesignTime then
|
|
LookAndFeel := pslfFlat;
|
|
FUseNativeLookAndFeel := True;
|
|
end;
|
|
|
|
function TdxPSEngine.GetAppName: string;
|
|
begin
|
|
Result := ChangeFileExt(ExtractFileName(Application.ExeName), '');
|
|
end;
|
|
|
|
function TdxPSEngine.GetRealRegistryPath: string;
|
|
begin
|
|
if IsDesignTime then
|
|
Result := DesignTimeRegistryPath
|
|
else
|
|
Result := RegistryPath;
|
|
end;
|
|
|
|
function TdxPSEngine.GetThemesEnabled: Boolean;
|
|
begin
|
|
{$IFDEF DELPHI7}
|
|
Result := ThemeServices.ThemesEnabled;
|
|
{$ELSE}
|
|
Result := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TdxPSEngineControllerList }
|
|
|
|
type
|
|
TdxPSEngineControllerList = class
|
|
private
|
|
FItems: TList;
|
|
function GetCount: Integer;
|
|
function GetActiveController: TdxPSEngineController;
|
|
procedure SetActiveController(Value: TdxPSEngineController);
|
|
public
|
|
destructor Destroy; override;
|
|
|
|
procedure Add(Value: TdxPSEngineController);
|
|
function IndexOf(Value: TdxPSEngineController): Integer;
|
|
procedure Remove(Value: TdxPSEngineController);
|
|
|
|
property ActiveController: TdxPSEngineController read GetActiveController write SetActiveController;
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
const
|
|
FEngineControllerList: TdxPSEngineControllerList = nil;
|
|
|
|
function dxPSEngineControllerList: TdxPSEngineControllerList;
|
|
begin
|
|
if FEngineControllerList = nil then
|
|
FEngineControllerList := TdxPSEngineControllerList.Create;
|
|
Result := FEngineControllerList;
|
|
end;
|
|
|
|
destructor TdxPSEngineControllerList.Destroy;
|
|
begin
|
|
FreeAndNil(FItems);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxPSEngineControllerList.Add(Value: TdxPSEngineController);
|
|
begin
|
|
if FItems = nil then FItems := TList.Create;
|
|
FItems.Add(Value);
|
|
end;
|
|
|
|
function TdxPSEngineControllerList.IndexOf(Value: TdxPSEngineController): Integer;
|
|
begin
|
|
if FItems <> nil then
|
|
Result := FItems.IndexOf(Value)
|
|
else
|
|
Result := -1
|
|
end;
|
|
|
|
procedure TdxPSEngineControllerList.Remove(Value: TdxPSEngineController);
|
|
begin
|
|
if IndexOf(Value) > -1 then
|
|
begin
|
|
FItems.Remove(Value);
|
|
if Count = 0 then FreeAndNil(FItems);
|
|
end;
|
|
end;
|
|
|
|
function TdxPSEngineControllerList.GetActiveController: TdxPSEngineController;
|
|
begin
|
|
if FItems <> nil then
|
|
Result := TdxPSEngineController(FItems[Count - 1])
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TdxPSEngineControllerList.GetCount: Integer;
|
|
begin
|
|
if FItems <> nil then
|
|
Result := FItems.Count
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TdxPSEngineControllerList.SetActiveController(Value: TdxPSEngineController);
|
|
begin
|
|
if (FItems <> nil) and (IndexOf(Value) < Count - 1) then
|
|
begin
|
|
FItems.Remove(Value);
|
|
FItems.Add(Value);
|
|
end;
|
|
end;
|
|
|
|
{ TdxPSEngineController }
|
|
|
|
constructor TdxPSEngineController.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FSaveFormsPosition := True;
|
|
FUseNativeLookAndFeel := True;
|
|
dxPSEngineControllerList.Add(Self);
|
|
end;
|
|
|
|
destructor TdxPSEngineController.Destroy;
|
|
begin
|
|
dxPSEngineControllerList.Remove(Self);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.Activate;
|
|
begin
|
|
dxPSEngineControllerList.ActiveController := Self;
|
|
end;
|
|
|
|
function TdxPSEngineController.IsCurrent: Boolean;
|
|
begin
|
|
Result := dxPSEngineControllerList.ActiveController = Self;
|
|
end;
|
|
|
|
function TdxPSEngineController.IsDesigning: Boolean;
|
|
begin
|
|
Result := csDesigning in ComponentState;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.Loaded;
|
|
begin
|
|
inherited;
|
|
if not IsDesigning and IsCurrent then InitializeEngine;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.InitializeEngine;
|
|
begin
|
|
dxPSEngine.HelpFile := HelpFile;
|
|
dxPSEngine.RegistryPath := RegistryPath;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.SetHelpFile(const Value: string);
|
|
begin
|
|
FHelpFile := Value;
|
|
if IsCurrent then
|
|
dxPSEngine.HelpFile := HelpFile;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.SetLookAndFeel(Value: TdxPSLookAndFeel);
|
|
begin
|
|
FLookAndFeel := Value;
|
|
if IsCurrent then
|
|
dxPSEngine.LookAndFeel := LookAndFeel;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.SetRegistryPath(const Value: string);
|
|
begin
|
|
FRegistryPath := Value;
|
|
if IsCurrent then
|
|
dxPSEngine.RegistryPath := RegistryPath;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.SetSaveFormsPosition(Value: Boolean);
|
|
begin
|
|
FSaveFormsPosition := Value;
|
|
if IsCurrent then
|
|
dxPSEngine.SaveFormsPosition := SaveFormsPosition;
|
|
end;
|
|
|
|
procedure TdxPSEngineController.SetUseNativeLookAndFeel(Value: Boolean);
|
|
begin
|
|
FUseNativeLookAndFeel := Value;
|
|
if IsCurrent then
|
|
dxPSEngine.UseNativeLookAndFeel := UseNativeLookAndFeel;
|
|
end;
|
|
|
|
initialization
|
|
|
|
finalization
|
|
FreeAndNil(FEngineControllerList);
|
|
|
|
end.
|