Componentes.Terceros.DevExp.../internal/x.42/2/ExpressPrinting System/Sources/dxPSEngn.pas

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.