1
0
mirror of https://bitbucket.org/Dennis07/lina-components.git synced 2024-11-24 08:02:12 +02:00
lina-components/Source/uFrmCtrls.pas
Dennis07 7a08ff2791 Version 1.0 DEV 1.12d
Signed-off-by: Dennis07 <den.goehlert@t-online.de>
2015-02-01 22:49:52 +01:00

1849 lines
51 KiB
ObjectPascal

unit uFrmCtrls;
//////////////////////////////////////
/// Lina Form Controls Unit ///
/// **************************** ///
/// (c) 2014 Dennis Göhlert a.o. ///
//////////////////////////////////////
{$IFNDEF MSWINDOWS}
{$IFDEF WARN_INCOMPATIBLEOS}
{$MESSAGE ERROR 'The "uFrmCtrls" unit is only available under MS-Windows OS'}
{$ENDIF}
{$ENDIF}
interface
uses
{ Standard-Units }
SysUtils, Classes, Controls, Windows, Forms, StdCtrls, ComCtrls, ExtCtrls,
Graphics, Dialogs,
{ Andere Package-Units }
uBase, uSysTools, uSysCtrls, uWebCtrls;
type
{ Fehlermeldungen }
EInvalidParamChar = class(Exception);
EParamNotFound = class(Exception);
EInvalidParamIdentifier = class(Exception);
EInvalidParamFormat = class(Exception);
type
{ Hilfsklassen }
TSplashScreenMode = (ssmDefault,ssmModal);
TSplashScreenAnimation = (ssaNone,ssaShallow);
TProgressBarManagerMode = (pmmNone,pmmBattery,pmmDownload);
TListBoxManagerMode = (lmmNone,lmmEdit,lmmComboBox);
type
{ Ereignisse }
TSplashScreenCreateEvent = procedure(Sender: TObject) of object;
TSplashScreenDestroyEvent = procedure(Sender: TObject) of object;
TSplashScreenShowEvent = procedure(Sender: TObject) of object;
TSplashScreenHideEvent = procedure(Sender: TObject) of object;
TSplashScreenChangeEvent = procedure(Sender: TObject) of object;
TSplashScreenTimerEvent = procedure(Sender: TObject) of object;
TComponentManagerUpdateEvent = procedure(Sender: TObject) of object;
TParamDefinerUpdateEvent = procedure(Sender: TObject) of object;
type
{ Hauptklassen }
{ TSplash... }
TSplashObject = class(TPersistent)
private
{ Private-Deklarationen }
SplashScreenVisible: Boolean;
public
{ Public-Deklarationen }
constructor Create;
destructor Destroy; override;
end;
TSplashForm = class(TSplashObject)
private
{ Private-Deklarationen }
FormObject: TForm;
{ Methoden }
function GetBorderStyle: TFormBorderStyle;
procedure SetBorderStyle(Value: TFormBorderStyle);
function GetBorderIcons: TBorderIcons;
procedure SetBorderIcons(Value: TBorderIcons);
function GetLeft: Integer;
procedure SetLeft(Value: Integer);
function GetTop: Integer;
procedure SetTop(Value: Integer);
function GetWidth: Integer;
procedure SetWidth(Value: Integer);
function GetHeight: Integer;
procedure SetHeight(Value: Integer);
function GetAlign: TAlign;
procedure SetAlign(Value: TAlign);
function GetAlphaBlend: Boolean;
procedure SetAlphaBlend(Value: Boolean);
function GetAlphaBlendValue: Byte;
procedure SetAlphaBlendValue(Value: Byte);
function GetCaption: TCaption;
procedure SetCaption(Value: TCaption);
function GetColor: TColor;
procedure SetColor(Value: TColor);
function GetEnabled: Boolean;
procedure SetEnabled(Value: Boolean);
function GetWindowState: TWindowState;
procedure SetWindowState(Value: TWindowState);
function GetPosition: TPosition;
procedure SetPosition(Value: TPosition);
function GetCursor: TCursor;
procedure SetCursor(Value: TCursor);
public
{ Public-Deklarationen }
constructor Create;
destructor Destroy; override;
published
{ Published-Deklarationen }
property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons default [];
property Left: Integer read GetLeft write SetLeft default 0;
property Top: Integer read GetTop write SetTop default 0;
property Width: Integer read GetWidth write SetWidth default 600;
property Height: Integer read GetHeight write SetHeight default 400;
property Align: TAlign read GetAlign write SetAlign default alNone;
property AlphaBlend: Boolean read GetAlphaBlend write SetAlphaBlend default False;
property AlphaBlendValue: Byte read GetAlphaBlendValue write SetAlphaBlendValue default 255;
property Caption: TCaption read GetCaption write SetCaption;
property Color: TColor read GetColor write SetColor default clBtnFace;
property Enabled: Boolean read GetEnabled write SetEnabled default True;
property WindowState: TWindowState read GetWindowState write SetWindowState default wsNormal;
property Position: TPosition read GetPosition write SetPosition default poScreenCenter;
property Cursor: TCursor read GetCursor write SetCursor default crHourGlass;
end;
TSplashProgressBar = class(TSplashObject)
private
{ Private-Deklarationen }
ProgressBarObject: TProgressBar;
{ Methoden }
function GetLeft: Integer;
procedure SetLeft(Value: Integer);
function GetTop: Integer;
procedure SetTop(Value: Integer);
function GetWidth: Integer;
procedure SetWidth(Value: Integer);
function GetHeight: Integer;
procedure SetHeight(Value: Integer);
function GetVisible: Boolean;
procedure SetVisible(Value: Boolean);
function GetPosition: Integer;
procedure SetPosition(Value: Integer);
function GetMax: Integer;
procedure SetMax(Value: Integer);
function GetMin: Integer;
procedure SetMin(Value: Integer);
function GetAlign: TAlign;
procedure SetAlign(Value: TAlign);
function GetBackgroundColor: TColor;
procedure SetBackgroundColor(Value: TColor);
function GetBarColor: TColor;
procedure SetBarColor(Value: TColor);
function GetState: TProgressBarState;
procedure SetState(Value: TProgressBarState);
function GetStyle: TProgressBarStyle;
procedure SetStyle(Value: TProgressBarStyle);
function GetSmooth: Boolean;
procedure SetSmooth(Value: Boolean);
function GetSmoothReverse: Boolean;
procedure SetSmoothReverse(Value: Boolean);
function GetMarqueeInterval: Integer;
procedure SetMarqueeInterval(Value: Integer);
function GetStep: Integer;
procedure SetStep(Value: Integer);
public
{ Public-Deklarationen }
constructor Create;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Left: Integer read GetLeft write SetLeft default 250;
property Top: Integer read GetTop write SetTop default 250;
property Width: Integer read GetWidth write SetWidth default 100;
property Height: Integer read GetHeight write SetHeight default 50;
property Visible: Boolean read GetVisible write SetVisible default True;
property Position: Integer read GetPosition write SetPosition default 0;
property Max: Integer read GetMax write SetMax default 100;
property Min: Integer read GetMin write SetMin default 0;
property Align: TAlign read GetAlign write SetAlign default alNone;
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor default clDefault;
property BarColor: TColor read GetBarColor write SetBarColor default clDefault;
property State: TProgressBarState read GetState write SetState default pbsNormal;
property Style: TProgressBarStyle read GetStyle write SetStyle default pbstNormal;
property Smooth: Boolean read GetSmooth write SetSmooth default False;
property SmoothReverse: Boolean read GetSmoothReverse write SetSmoothReverse default False;
property MarqueeInterval: Integer read GetMarqueeInterval write SetMarqueeInterval default 10;
property Step: Integer read GetStep write SetStep default 10;
end;
TSplashImage = class(TSplashObject)
private
{ Private-Deklarationen }
ImageObject: TImage;
{ Methoden }
function GetVisible: Boolean;
procedure SetVisible(Value: Boolean);
function GetTransparent: Boolean;
procedure SetTransparent(Value: Boolean);
function GetPicture: TPicture;
procedure SetPicture(Value: TPicture);
public
{ Public-Deklarationen }
constructor Create;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Visible: Boolean read GetVisible write SetVisible default True;
property Transparent: Boolean read GetTransparent write SetTransparent default False;
property Picture: TPicture read GetPicture write SetPicture;
end;
TSplashTimer = class(TSplashObject)
private
{ Private-Deklarationen }
TimerObject: TTimer;
FEnabled: Boolean;
{ Methoden }
procedure SetEnabled(Value: Boolean);
function GetInterval: Cardinal;
procedure SetInterval(Value: Cardinal);
public
{ Public-Deklarationen }
constructor Create;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Enabled: Boolean read FEnabled write SetEnabled default False;
property Interval: Cardinal read GetInterval write SetInterval default 1000;
end;
TSplashScreen = class(TComponent)
private
{ Private-Deklarationen }
AnimationTimerShow: TTimer;
AnimationTimerHide: TTimer;
FAbout: TComponentAbout;
FSplashForm: TSplashForm;
FSplashProgressBar: TSplashProgressBar;
FSplashImage: TSplashImage;
FSplashTimer: TSplashTimer;
FDisplayTime: Cardinal;
FAutoShow: Boolean;
FMode: TSplashScreenMode;
FAnimation: TSplashScreenAnimation;
FAnimationSpeed: Byte;
FVisible: Boolean;
{ Ereignisse }
FCreateEvent: TSplashScreenCreateEvent;
FDestroyEvent: TSplashScreenDestroyEvent;
FShowEvent: TSplashScreenShowEvent;
FHideEvent: TSplashScreenHideEvent;
FChangeEvent: TSplashScreenChangeEvent;
FTimerEvent: TSplashScreenTimerEvent;
{ Methoden }
procedure SetVisible(Value: Boolean);
procedure SetSplashForm(Value: TSplashForm);
procedure SetSplashProgressBar(Value: TSplashProgressBar);
procedure SetSplashImage(Value: TSplashImage);
procedure SetSplashTimer(Value: TSplashTimer);
procedure AnimationTimerShowTimer(Sender: TObject);
procedure AnimationTimerHideTimer(Sender: TObject);
procedure FormObjectShow(Sender: TObject);
procedure FormObjectHide(Sender: TObject);
procedure TimerObjectTimer(Sender: TObject);
protected
{ Protected-Deklarationen }
procedure Refresh; //Vorberaitung (benutzerdefinierte Werte)
procedure Reset; //Vorbereitung (standardmäßige Werte)
public
{ Public-Deklarationen }
property Visible: Boolean read FVisible write SetVisible;
constructor Create(AOwnder: TComponent); override;
destructor Destroy; override;
procedure ApplyChanges; //Änderungen übernehmen
procedure Show; //Anzeigen
procedure Hide; //Verstecken (schließen)
published
{ Published-Deklarationen }
{ Ereignisse }
property OnCreate: TSplashScreenCreateEvent read FCreateEvent write FCreateEvent;
property OnDestroy: TSplashScreenDestroyEvent read FDestroyEvent write FDestroyEvent;
property OnShow: TSplashScreenShowEvent read FShowEvent write FShowEvent;
property OnHide: TSplashScreenHideEvent read FHideEvent write FHideEvent;
property OnChange: TSplashScreenChangeEvent read FChangeEvent write FChangeEvent;
property OnTimer: TSplashScreenTimerEvent read FTimerEvent write FTimerEvent;
{ Eigenschaften }
property About: TComponentAbout read FAbout;
property SplashForm: TSplashForm read FSplashForm write SetSplashForm;
property SplashProgressBar: TSplashProgressBar read FSplashProgressBar write SetSplashProgressBar;
property SplashImage: TSplashImage read FSplashImage write SetSplashImage;
property SplashTimer: TSplashTimer read FSplashTimer write SetSplashTimer;
property DisplayTime: Cardinal read FDisplayTime write FDisplayTime default 2000;
property AutoShow: Boolean read FAutoShow write FAutoShow default False;
property Mode: TSplashScreenMode read FMode write FMode default ssmDefault;
property Animation: TSplashScreenAnimation read FAnimation write FAnimation default ssaNone;
property AnimationSpeed: Byte read FAnimationSpeed write FAnimationSpeed default 10;
end;
{ T...Manager }
TComponentManager = class(TComponent)
private
{ Private-Deklarationen }
FAbout: TComponentAbout;
{ Ereignisse }
FUpdateEvent: TComponentManagerUpdateEvent;
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Update; virtual;
published
{ Published-Deklarationen }
{ Ereignisse }
property OnUpdate: TComponentManagerUpdateEvent read FUpdateEvent write FUpdateEvent;
{ Eigenschaften }
property About: TComponentAbout read FAbout;
end;
TProgressBarManager = class(TComponentManager)
private
{ Private-Deklarationen }
FTarget: TProgressBar;
FSourceBattery: TBattery;
FSourceDownload: TDownload;
FMode: TProgressBarManagerMode;
{ Methoden }
procedure SetTarget(Value: TProgressBar);
procedure SetSourceBattery(Value: TBattery);
procedure SetSourceDownload(Value: TDownload);
procedure SetMode(Value: TProgressBarManagerMode);
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Update; override;
published
{ Published-Deklarationen }
property Target: TProgressBar read FTarget write SetTarget;
property SourceBattery: TBattery read FSourceBattery write SetSourceBattery;
property SourceDownload: TDownload read FSourceDownload write SetSourceDownload;
property Mode: TProgressBarManagerMode read FMode write SetMode default pmmNone;
end;
TListBoxManager = class(TComponentManager)
private
{ Private-Deklarationen }
FilteredList: TFilteredStringList;
FTarget: TListBox;
FSourceEdit: TEdit;
FSourceComboBox: TComboBox;
FMode: TListBoxManagerMode;
FFilterOptions: TStringFilterOptions;
{ Methoden }
procedure SetTarget(Value: TListBox);
procedure SetSourceEdit(Value: TEdit);
procedure SetSourceComboBox(Value: TComboBox);
procedure SetMode(Value: TListBoxManagerMode);
procedure SetFilterOptions(Value: TStringFilterOptions);
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Update; override;
procedure LoadList;
published
{ Published-Deklarationen }
property Target: TListBox read FTarget write SetTarget;
property SourceEdit: TEdit read FSourceEdit write SetSourceEdit;
property SourceComboBox: TComboBox read FSourceComboBox write SetSourceComboBox;
property Mode: TListBoxManagerMode read FMode write SetMode default lmmNone;
property FilterOptions: TStringFilterOptions read FFilterOptions write SetFilterOptions default [sfoCaseSensitive,sfoForceTrim,sfoDefaultVisible];
end;
{ TParam... }
TParamFormat = class(TPersistent)
private
{ Private-Deklarationen }
FPrefix: String;
FSuffix: String;
FSeparator: String;
{ Methoden }
procedure SetPrefix(Value: String);
procedure SetSuffix(Value: String);
procedure SetSeparator(Value: String);
public
{ Public-Deklarationen }
constructor Create; overload;
constructor Create(APrefix,ASeparator,ASuffix: String); overload;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Prefix: String read FPrefix write SetPrefix;
property Suffix: String read FSuffix write SetSuffix;
property Separator: String read FSeparator write SetSeparator;
end;
TParamReference = class(TCollectionItem)
private
{ Private-Deklarationen }
FDefaultValue: String;
FIdentifier: String;
FConnector: PString;
FFormat: TParamFormat;
{ Methoden }
procedure SetIdentifier(Value: String);
function GetFormat: TParamFormat;
procedure SetFormat(Value: TParamFormat);
public
{ Public-Deklarationen }
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Update;
function AsText(UseDefVal: Boolean = False): String;
{ Eigenschaften }
property Connector: PString read FConnector write FConnector;
published
{ Published-Deklarationen }
property DefaultValue: String read FDefaultValue write FDefaultValue;
property Identifier: String read FIdentifier write SetIdentifier;
property Format: TParamFormat read GetFormat write SetFormat;
end;
TParamReferences = class(TCollection);
TParamDefiner = class(TComponent)
private
{ Private-Deklarationen }
FAbout: TComponentAbout;
FReferences: TParamReferences;
{ Ereignisse }
FUpdateEvent: TParamDefinerUpdateEvent;
{ Methoden }
procedure SetReferences(Value: TParamReferences);
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Update;
published
{ Published-Deklarationen }
{ Ereignisse }
property OnUpdate: TParamDefinerUpdateEvent read FUpdateEvent write FUpdateEvent;
{ Eigenschaften }
property About: TComponentAbout read FAbout;
property References: TParamReferences read FReferences write SetReferences;
end;
{ ShowMessage-Varianten }
procedure ShowMessageVal(const Msg: Integer); overload;
procedure ShowMessageVal(const Msg: Extended); overload;
{ String-Aus-Parameter-Methoden }
function StringFromParam(Ident,Value: String; Format: TParamFormat): String;
function StringFromParamRef(ParamRef: TParamReference; UseDefVal: Boolean = True): String;
function StringFromParams(Idents,Values: TStrings; Format: TParamFormat): String;
{ Sonstige }
procedure SetTaskBarVisibe(const Value: Boolean);
procedure ListParams(var OutList: TStrings);
procedure Register;
const
{ Meta-Daten }
SplashScreenComponent_Name = 'SplashScreen';
SplashScreenComponent_Version = 1.0;
SplashScreenComponent_Copyright = 'Copyright © 2014';
SplashScreenComponent_Author = 'Dennis Göhlert a.o.';
ProgressBarManagerComponent_Name = 'ProgressBarManager';
ProgressBarManagerComponent_Version = 1.0;
ProgressBarManagerComponent_Copyright = 'Copyright © 2014';
ProgressBarManagerComponent_Author = 'Dennis Göhlert a.o.';
ListBoxManagerComponent_Name = 'ListBoxManager';
ListBoxManagerComponent_Version = 1.0;
ListBoxManagerComponent_Copyright = 'Copyright © 2014';
ListBoxManagerComponent_Author = 'Dennis Göhlert a.o.';
ParamDefinerComponent_Name = 'ParamDefiner';
ParamDefinerComponent_Version = 1.0;
ParamDefinerComponent_Copyright = 'Copyright © 2014';
ParamDefinerComponent_Author = 'Dennis Göhlert a.o.';
implementation
procedure Register;
begin
RegisterComponents(ComponentsPage,[TSplashScreen,TProgressBarManager,TListBoxManager,TParamDefiner]);
end;
procedure ShowMessageVal(const Msg: Integer);
begin
ShowMessage(IntToStr(Msg));
end;
procedure ShowMessageVal(const Msg: Extended);
begin
ShowMessage(FloatToStr(Msg));
end;
function StringFromParam(Ident,Value: String; Format: TParamFormat): String;
var
TmpStr: String;
Index: Integer;
RequireQuotes: Boolean;
begin
Result := '';
TmpStr := Format.Prefix + Ident + Format.Separator + Value + Format.Suffix;
RequireQuotes := False;
for Index := 1 to Length(TmpStr) do
begin
if TmpStr[Index] in Spaces then
begin
RequireQuotes := True;
end;
if TmpStr[Index] in ['''','"'] then
begin
raise EInvalidParamChar.Create('Invalid character at position: ' + IntToStr(Index));
end;
end;
if RequireQuotes = True then
begin
Result := '"' + TmpStr + '"';
end else
begin
Result := TmpStr;
end;
end;
function StringFromParamRef(ParamRef: TParamReference; UseDefVal: Boolean = True): String;
var
Value: String;
begin
if UseDefVal = True then
begin
Value := ParamRef.DefaultValue;
end else
begin
Value := ParamRef.Connector^;
end;
Result := StringFromParam(ParamRef.Identifier,Value,ParamRef.Format);
end;
function StringFromParams(Idents,Values: TStrings; Format: TParamFormat): String;
var
TmpStr: String;
Index: Integer;
begin
Result := '';
for Index := 0 to Idents.Count do
begin
if Index > 0 then
begin
TmpStr := TmpStr + ' ';
end;
TmpStr := TmpStr + StringFromParam(Idents.Strings[Index],Values[Index],Format);
end;
Result := TmpStr;
end;
procedure SetTaskBarVisibe(const Value: Boolean);
begin
if Value = True then
begin
ShowWindow(Application.Handle,SW_HIDE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) and not WS_EX_TOOLWINDOW or WS_EX_APPWINDOW);
ShowWindow(Application.Handle,SW_SHOW);
end else
begin
ShowWindow(Application.Handle,SW_SHOW);
SetWindowLong(Application.Handle,GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) and not WS_EX_TOOLWINDOW or WS_EX_APPWINDOW);
ShowWindow(Application.Handle,SW_HIDE);
end;
end;
procedure ListParams(var OutList: TStrings);
var
Index: Integer;
begin
OutList.Clear;
for Index := 0 to ParamCount do
begin
OutList.Add(ParamStr(Index));
end;
end;
{ ----------------------------------------------------------------------------
TSplashObject
---------------------------------------------------------------------------- }
constructor TSplashObject.Create;
begin
inherited;
SplashScreenVisible := False;
end;
destructor TSplashObject.Destroy;
begin
//...
inherited;
end;
{ ----------------------------------------------------------------------------
TSplashForm
---------------------------------------------------------------------------- }
constructor TSplashForm.Create;
begin
FormObject := TForm.Create(nil);
FormObject.Visible := False;
end;
destructor TSplashForm.Destroy;
begin
FormObject.Close;
FormObject.Free;
inherited;
end;
function TSplashForm.GetBorderStyle: TFormBorderStyle;
begin
Result := FormObject.BorderStyle;
end;
procedure TSplashForm.SetBorderStyle(Value: TFormBorderStyle);
begin
FormObject.BorderStyle := Value;
end;
function TSplashForm.GetBorderIcons: TBorderIcons;
begin
Result := FormObject.BorderIcons;
end;
procedure TSplashForm.SetBorderIcons(Value: TBorderIcons);
begin
FormObject.BorderIcons := Value;
end;
function TSplashForm.GetLeft: Integer;
begin
Result := FormObject.Left;
end;
procedure TSplashForm.SetLeft(Value: Integer);
begin
FormObject.Left := Value;
end;
function TSplashForm.GetTop: Integer;
begin
Result := FormObject.Top;
end;
procedure TSplashForm.SetTop(Value: Integer);
begin
FormObject.Top := Value;
end;
function TSplashForm.GetWidth: Integer;
begin
Result := FormObject.Width;
end;
procedure TSplashForm.SetWidth(Value: Integer);
begin
FormObject.Width := Value;
end;
function TSplashForm.GetHeight: Integer;
begin
Result := FormObject.Height;
end;
procedure TSplashForm.SetHeight(Value: Integer);
begin
FormObject.Height := Value;
end;
function TSplashForm.GetAlign: TAlign;
begin
Result := FormObject.Align;
end;
procedure TSplashForm.SetAlign(Value: TAlign);
begin
FormObject.Align := Value;
end;
function TSplashForm.GetAlphaBlend: Boolean;
begin
Result := FormObject.AlphaBlend;
end;
procedure TSplashForm.SetAlphaBlend(Value: Boolean);
begin
FormObject.AlphaBlend := Value;
end;
function TSplashForm.GetAlphaBlendValue: Byte;
begin
Result := FormObject.AlphaBlendValue;
end;
procedure TSplashForm.SetAlphaBlendValue(Value: Byte);
begin
FormObject.AlphaBlendValue := Value;
end;
function TSplashForm.GetCaption: TCaption;
begin
Result := FormObject.Caption;
end;
procedure TSplashForm.SetCaption(Value: TCaption);
begin
FormObject.Caption := Value;
end;
function TSplashForm.GetColor: TColor;
begin
Result := FormObject.Color;
end;
procedure TSplashForm.SetColor(Value: TColor);
begin
FormObject.Color := Value;
end;
function TSplashForm.GetEnabled: Boolean;
begin
Result := FormObject.Enabled;
end;
procedure TSplashForm.SetEnabled(Value: Boolean);
begin
FormObject.Enabled := Value;
end;
function TSplashForm.GetWindowState: TWindowState;
begin
Result := FormObject.WindowState;
end;
procedure TSplashForm.SetWindowState(Value: TWindowState);
begin
FormObject.WindowState := Value;
end;
function TSplashForm.GetPosition: TPosition;
begin
Result := FormObject.Position;
end;
procedure TSplashForm.SetPosition(Value: TPosition);
begin
FormObject.Position := Value;
end;
function TSplashForm.GetCursor: TCursor;
begin
Result := FormObject.Cursor;
end;
procedure TSplashForm.SetCursor(Value: TCursor);
begin
FormObject.Cursor := Value;
end;
{ ----------------------------------------------------------------------------
TSplashProgressBar
---------------------------------------------------------------------------- }
constructor TSplashProgressBar.Create;
begin
ProgressBarObject := TProgressBar.Create(nil);
end;
destructor TSplashProgressBar.Destroy;
begin
ProgressBarObject.Free;
inherited;
end;
function TSplashProgressBar.GetLeft: Integer;
begin
Result := ProgressBarObject.Left;
end;
procedure TSplashProgressBar.SetLeft(Value: Integer);
begin
ProgressBarObject.Left := Value;
end;
function TSplashProgressBar.GetTop: Integer;
begin
Result := ProgressBarObject.Top;
end;
procedure TSplashProgressBar.SetTop(Value: Integer);
begin
ProgressBarObject.Top := Value;
end;
function TSplashProgressBar.GetWidth: Integer;
begin
Result := ProgressBarObject.Width;
end;
procedure TSplashProgressBar.SetWidth(Value: Integer);
begin
ProgressBarObject.Width := Value;
end;
function TSplashProgressBar.GetHeight: Integer;
begin
Result := ProgressBarObject.Height;
end;
procedure TSplashProgressBar.SetHeight(Value: Integer);
begin
ProgressBarObject.Height := Value;
end;
function TSplashProgressBar.GetVisible: Boolean;
begin
Result := ProgressBarObject.Visible;
end;
procedure TSplashProgressBar.SetVisible(Value: Boolean);
begin
ProgressBarObject.Visible := Value;
end;
function TSplashProgressBar.GetPosition: Integer;
begin
Result := ProgressBarObject.Position;
end;
procedure TSplashProgressBar.SetPosition(Value: Integer);
begin
ProgressBarObject.Position := Value;
end;
function TSplashProgressBar.GetMax: Integer;
begin
Result := ProgressBarObject.Max;
end;
procedure TSplashProgressBar.SetMax(Value: Integer);
begin
ProgressBarObject.Max := Value;
end;
function TSplashProgressBar.GetMin: Integer;
begin
Result := ProgressBarObject.Min;
end;
procedure TSplashProgressBar.SetMin(Value: Integer);
begin
ProgressBarObject.Min := Value;
end;
function TSplashProgressBar.GetAlign: TAlign;
begin
Result := ProgressBarObject.Align;
end;
procedure TSplashProgressBar.SetAlign(Value: TAlign);
begin
ProgressBarObject.Align := Value;
end;
function TSplashProgressBar.GetBackgroundColor: TColor;
begin
Result := ProgressBarObject.BackgroundColor;
end;
procedure TSplashProgressBar.SetBackgroundColor(Value: TColor);
begin
ProgressBarObject.BackgroundColor := Value;
end;
function TSplashProgressBar.GetBarColor: TColor;
begin
Result := ProgressBarObject.BarColor;
end;
procedure TSplashProgressBar.SetBarColor(Value: TColor);
begin
ProgressBarObject.BarColor := Value;
end;
function TSplashProgressBar.GetState: TProgressBarState;
begin
Result := ProgressBarObject.State;
end;
procedure TSplashProgressBar.SetState(Value: TProgressBarState);
begin
ProgressBarObject.State := Value;
end;
function TSplashProgressBar.GetStyle: TProgressBarStyle;
begin
Result := ProgressBarObject.Style;
end;
procedure TSplashProgressBar.SetStyle(Value: TProgressBarStyle);
begin
ProgressBarObject.Style := Value;
end;
function TSplashProgressBar.GetSmooth: Boolean;
begin
Result := ProgressBarObject.Smooth;
end;
procedure TSplashProgressBar.SetSmooth(Value: Boolean);
begin
ProgressBarObject.Smooth := Value;
end;
function TSplashProgressBar.GetSmoothReverse: Boolean;
begin
Result := ProgressBarObject.SmoothReverse;
end;
procedure TSplashProgressBar.SetSmoothReverse(Value: Boolean);
begin
ProgressBarObject.SmoothReverse := Value;
end;
function TSplashProgressBar.GetMarqueeInterval: Integer;
begin
Result := ProgressBarObject.MarqueeInterval;
end;
procedure TSplashProgressBar.SetMarqueeInterval(Value: Integer);
begin
ProgressBarObject.MarqueeInterval := Value;
end;
function TSplashProgressBar.GetStep: Integer;
begin
Result := ProgressBarObject.Step;
end;
procedure TSplashProgressBar.SetStep(Value: Integer);
begin
ProgressBarObject.Step := Value;
end;
{ ----------------------------------------------------------------------------
TSplashImage
---------------------------------------------------------------------------- }
constructor TSplashImage.Create;
begin
ImageObject := TImage.Create(nil);
Picture := TPicture.Create;
ImageObject.Align := alClient;
ImageObject.Stretch := True;
end;
destructor TSplashImage.Destroy;
begin
//Picture.Free; Keine Ahrnung, wieso das hier automatisch wieder freigegeben wird (??)
ImageObject.Free;
inherited;
end;
function TSplashImage.GetVisible: Boolean;
begin
Result := ImageObject.Visible;
end;
procedure TSplashImage.SetVisible(Value: Boolean);
begin
ImageObject.Visible := Value;
end;
function TSplashImage.GetTransparent: Boolean;
begin
Result := ImageObject.Transparent;
end;
procedure TSplashImage.SetTransparent(Value: Boolean);
begin
ImageObject.Transparent := Value;
end;
function TSplashImage.GetPicture: TPicture;
begin
Result := ImageObject.Picture;
end;
procedure TSplashImage.SetPicture(Value: TPicture);
begin
ImageObject.Picture.Assign(Value);
end;
{ ----------------------------------------------------------------------------
TSplashTimer
---------------------------------------------------------------------------- }
constructor TSplashTimer.Create;
begin
TimerObject := TTimer.Create(nil);
TimerObject.Enabled := False;
end;
destructor TSplashTimer.Destroy;
begin
TimerObject.Enabled := False;
TimerObject.Free;
inherited;
end;
procedure TSplashTimer.SetEnabled(Value: Boolean);
begin
FEnabled := Value;
if SplashScreenVisible = True then
begin
TimerObject.Enabled := Value;
end;
end;
function TSplashTimer.GetInterval: Cardinal;
begin
Result := TimerObject.Interval;
end;
procedure TSplashTimer.SetInterval(Value: Cardinal);
begin
TimerObject.Interval := Value;
end;
{ ----------------------------------------------------------------------------
TSplashScreen
---------------------------------------------------------------------------- }
constructor TSplashScreen.Create(AOwnder: TComponent);
begin
inherited;
FDisplayTime := 2000;
FAutoShow := False;
FMode := ssmDefault;
FAnimation := ssaNone;
FAnimationSpeed := 10;
FVisible := False;
FAbout := TComponentAbout.Create(SplashScreenComponent_Name,SplashScreenComponent_Version,SplashScreenComponent_Copyright,SplashScreenComponent_Author);
FSplashForm := TSplashForm.Create;
FSplashForm.FormObject.OnShow := FormObjectShow;
FSplashForm.FormObject.OnHide := FormObjectHide;
FSplashTimer := TSplashTimer.Create;
FSplashTimer.TimerObject.OnTimer := TimerObjectTimer;
FSplashProgressBar := TSplashProgressBar.Create;
FSplashImage := TSplashImage.Create;
FSplashTimer := TSplashTimer.Create;
{ Parents richtig setzen }
SplashProgressBar.ProgressBarObject.Parent := SplashForm.FormObject;
SplashImage.ImageObject.Parent := SplashForm.FormObject;
{ AnimationTimer... }
AnimationTimerShow := TTimer.Create(Self);
AnimationTimerShow.OnTimer := AnimationTimerShowTimer;
AnimationTimerShow.Enabled := False;
AnimationTimerShow.Interval := 50;
AnimationTimerHide := TTimer.Create(Self);
AnimationTimerHide.OnTimer := AnimationTimerHideTimer;
AnimationTimerHide.Enabled := False;
AnimationTimerHide.Interval := 50;
Reset;
if Assigned(OnCreate) then
begin
OnCreate(Self);
end;
{ Erst NACHDEM fertig erstellt wurde und OnCreate-Event ausgeführt wurde... }
if AutoShow = True then
begin
Show;
end;
end;
destructor TSplashScreen.Destroy;
begin
if Assigned(OnDestroy) then
begin
OnDestroy(Self);
end;
FAbout.Free;
FSplashProgressBar.Free;
FSplashImage.Free;
FSplashTimer.Free;
FSplashForm.Free;
//ProgressBarObject.Free; _
//ImageObject.Free; |
//TimerObject.Free; |____\ Automatisch
//AnimationTimerShow.Free; | / freigegeben
//AnimationTimerHide.Free; _|
inherited;
end;
procedure TSplashScreen.Show;
begin
SplashTimer.TimerObject.Enabled := SplashTimer.FEnabled;
if Mode = ssmModal then
begin
SplashForm.FormObject.ShowModal;
end else
begin
SplashForm.FormObject.Show;
end;
if Animation = ssaShallow then
begin
SplashForm.FormObject.AlphaBlend := True;
SplashForm.FormObject.AlphaBlendValue := 0;
AnimationTimerHide.Enabled := False;
AnimationTimerShow.Enabled := True;
end;
FVisible := True;
SplashForm.FormObject.BringToFront;
SplashForm.SplashScreenVisible := True;
SplashProgressBar.SplashScreenVisible := True;
SplashImage.SplashScreenVisible := True;
SplashTimer.SplashScreenVisible := True;
if Assigned(OnShow) then
begin
OnShow(Self);
end;
end;
procedure TSplashScreen.Hide;
begin
SplashTimer.TimerObject.Enabled := False;
if Animation = ssaNone then
begin
SplashForm.FormObject.Hide;
end else
begin
if Animation = ssaShallow then
begin
SplashForm.FormObject.AlphaBlend := True;
AnimationTimerShow.Enabled := False;
AnimationTimerHide.Enabled := True;
end;
end;
FVisible := False;
SplashForm.SplashScreenVisible := False;
SplashProgressBar.SplashScreenVisible := False;
SplashImage.SplashScreenVisible := False;
SplashTimer.SplashScreenVisible := False;
if Assigned(OnHide) then
begin
OnHide(Self);
end;
end;
procedure TSplashScreen.FormObjectShow(Sender: TObject);
begin
Visible := True;
end;
procedure TSplashScreen.FormObjectHide(Sender: TObject);
begin
Visible := False;
end;
procedure TSplashScreen.TimerObjectTimer(Sender: TObject);
begin
if Assigned(OnTimer) then
begin
OnTimer(Self);
end;
end;
procedure TSplashScreen.ApplyChanges;
begin
{ "Refresh;" ist nicht public, deswegen hier eine Referenz.
Falls beim übernehmen der Änderungen noch sonstige Dinge getan werden
müssen, können diese hier definiert werden. }
Refresh;
end;
procedure TSplashScreen.Refresh;
begin
{ TSplashForm -> TForm }
SplashForm.FormObject.BorderStyle := SplashForm.BorderStyle;
SplashForm.FormObject.BorderIcons := SplashForm.BorderIcons;
SplashForm.FormObject.Left := SplashForm.Left;
SplashForm.FormObject.Top := SplashForm.Top;
SplashForm.FormObject.Width := SplashForm.Width;
SplashForm.FormObject.Height := SplashForm.Height;
SplashForm.FormObject.Align := SplashForm.Align;
SplashForm.FormObject.AlphaBlend := SplashForm.AlphaBlend;
SplashForm.FormObject.AlphaBlendValue := SplashForm.AlphaBlendValue;
SplashForm.FormObject.Caption := SplashForm.Caption;
SplashForm.FormObject.Color := SplashForm.Color;
SplashForm.FormObject.Enabled := SplashForm.Enabled;
SplashForm.FormObject.WindowState := SplashForm.WindowState;
SplashForm.FormObject.Position := SplashForm.Position;
SplashForm.FormObject.Cursor := SplashForm.Cursor;
{ TSplashProgressBar -> TProgressBar }
SplashProgressBar.ProgressBarObject.Left := SplashProgressBar.Left;
SplashProgressBar.ProgressBarObject.Top := SplashProgressBar.Top;
SplashProgressBar.ProgressBarObject.Width := SplashProgressBar.Width;
SplashProgressBar.ProgressBarObject.Height := SplashProgressBar.Height;
SplashProgressBar.ProgressBarObject.Visible := SplashProgressBar.Visible;
SplashProgressBar.ProgressBarObject.Position := SplashProgressBar.Position;
SplashProgressBar.ProgressBarObject.Max := SplashProgressBar.Max;
SplashProgressBar.ProgressBarObject.Min := SplashProgressBar.Min;
SplashProgressBar.ProgressBarObject.Cursor := SplashForm.FormObject.Cursor;
SplashProgressBar.ProgressBarObject.Align := SplashProgressBar.Align;
SplashProgressBar.ProgressBarObject.BackgroundColor := SplashProgressBar.BackgroundColor;
SplashProgressBar.ProgressBarObject.BarColor := SplashProgressBar.BarColor;
SplashProgressBar.ProgressBarObject.State := SplashProgressBar.State;
SplashProgressBar.ProgressBarObject.Style := SplashProgressBar.Style;
SplashProgressBar.ProgressBarObject.Smooth := SplashProgressBar.Smooth;
SplashProgressBar.ProgressBarObject.SmoothReverse := SplashProgressBar.SmoothReverse;
SplashProgressBar.ProgressBarObject.MarqueeInterval := SplashProgressBar.MarqueeInterval;
SplashProgressBar.ProgressBarObject.Step := SplashProgressBar.Step;
{ TSplashImage -> TImage }
SplashImage.ImageObject.Visible := SplashImage.Visible;
SplashImage.ImageObject.Transparent := SplashImage.Transparent;
SplashImage.ImageObject.Picture := SplashImage.Picture;
{ TSplashTimer -> TTimer }
SplashTimer.TimerObject.Enabled := SplashTimer.Enabled;
SplashTimer.TimerObject.Interval := SplashTimer.Interval;
end;
procedure TSplashScreen.Reset;
begin
{ TSplashForm }
SplashForm.BorderStyle := bsNone;
SplashForm.BorderIcons := [];
SplashForm.Left := 0;
SplashForm.Top := 0;
SplashForm.Width := 600;
SplashForm.Height := 400;
SplashForm.Align := alNone;
SplashForm.AlphaBlend := False;
SplashForm.AlphaBlendValue := 255;
SplashForm.Color := clBtnFace;
SplashForm.Enabled := True;
SplashForm.WindowState := wsNormal;
SplashForm.Position := poScreenCenter;
SplashForm.Cursor := crHourGlass;
{ TSplashProgressBar }
SplashProgressBar.Left := 250;
SplashProgressBar.Top := 250;
SplashProgressBar.Width := 100;
SplashProgressBar.Height := 50;
SplashProgressBar.Visible := True;
SplashProgressBar.Position := 0;
SplashProgressBar.Max := 100;
SplashProgressBar.Min := 0;
SplashProgressBar.Align := alNone;
SplashProgressBar.BackgroundColor := clDefault;
SplashProgressBar.BarColor := clDefault;
SplashProgressBar.State := pbsNormal;
SplashProgressBar.Style := pbstNormal;
SplashProgressBar.Smooth := False;
SplashProgressBar.SmoothReverse := False;
SplashProgressBar.MarqueeInterval := 10;
SplashProgressBar.Step := 10;
{ TSplashImage }
SplashImage.Visible := True;
SplashImage.Transparent := False;
{ TSplashTimer }
SplashTimer.Enabled := False;
SplashTimer.Interval := 1000;
if Assigned(OnChange) then
begin
OnChange(Self);
end;
end;
procedure TSplashScreen.SetVisible(Value: Boolean);
begin
if Value = True then
begin
if SplashForm.FormObject.Visible = False then
begin
Show;
end;
end else
begin
if SplashForm.FormObject.Visible = True then
begin
Hide;
end;
end;
end;
procedure TSplashScreen.SetSplashForm(Value: TSplashForm);
begin
FSplashForm.Assign(Value);
if Assigned(OnChange) then
begin
OnChange(Self);
end;
end;
procedure TSplashScreen.SetSplashProgressBar(Value: TSplashProgressBar);
begin
FSplashProgressBar.Assign(Value);
if Assigned(OnChange) then
begin
OnChange(Self);
end;
end;
procedure TSplashScreen.SetSplashImage(Value: TSplashImage);
begin
FSplashImage.Assign(Value);
if Assigned(OnChange) then
begin
OnChange(Self);
end;
end;
procedure TSplashScreen.SetSplashTimer(Value: TSplashTimer);
begin
FSplashTimer.Assign(Value);
if Assigned(OnChange) then
begin
OnChange(Self);
end;
end;
procedure TSplashScreen.AnimationTimerShowTimer(Sender: TObject);
begin
if Animation = ssaShallow then
begin
if SplashForm.FormObject.AlphaBlendValue < SplashForm.AlphaBlendValue then
begin
if SplashForm.AlphaBlendValue - SplashForm.FormObject.AlphaBlendValue < AnimationSpeed then
begin
SplashForm.FormObject.AlphaBlendValue := SplashForm.FormObject.AlphaBlendValue + (SplashForm.AlphaBlendValue - SplashForm.FormObject.AlphaBlendValue);
end else
begin
SplashForm.FormObject.AlphaBlendValue := SplashForm.FormObject.AlphaBlendValue + AnimationSpeed;
end;
end else
begin
AnimationTimerShow.Enabled := False;
SplashForm.FormObject.AlphaBlend := SplashForm.AlphaBlend;
end;
end;
end;
procedure TSplashScreen.AnimationTimerHideTimer(Sender: TObject);
begin
if Animation = ssaShallow then
begin
if SplashForm.FormObject.AlphaBlendValue > 0 then
begin
if SplashForm.FormObject.AlphaBlendValue < AnimationSpeed then
begin
SplashForm.FormObject.AlphaBlendValue := SplashForm.FormObject.AlphaBlendValue - SplashForm.FormObject.AlphaBlendValue;
end else
begin
SplashForm.FormObject.AlphaBlendValue := SplashForm.FormObject.AlphaBlendValue - AnimationSpeed;
end;
end else
begin
AnimationTimerHide.Enabled := False;
SplashForm.FormObject.AlphaBlend := SplashForm.AlphaBlend;
SplashForm.FormObject.Hide;
end;
end;
end;
{ ----------------------------------------------------------------------------
TComponentManager
---------------------------------------------------------------------------- }
constructor TComponentManager.Create(AOwner: TComponent);
begin
inherited;
//...
end;
destructor TComponentManager.Destroy;
begin
//...
inherited;
end;
procedure TComponentManager.Update;
begin
if Assigned(OnUpdate) then
begin
OnUpdate(Self);
end;
end;
{ ----------------------------------------------------------------------------
TProgressBarManager
---------------------------------------------------------------------------- }
constructor TProgressBarManager.Create(AOwner: TComponent);
begin
inherited;
FAbout := TComponentAbout.Create(ProgressBarManagerComponent_Name,ProgressBarManagerComponent_Version,ProgressBarManagerComponent_Copyright,ProgressBarManagerComponent_Author);
FMode := pmmNone;
Update;
end;
destructor TProgressBarManager.Destroy;
begin
FAbout.Free;
inherited;
end;
procedure TProgressBarManager.Update;
begin
if Assigned(Target) = False then
begin
Exit;
end;
if Mode <> pmmNone then
begin
if (Mode = pmmBattery) and (Assigned(SourceBattery) = False)
or (Mode = pmmDownload) and (Assigned(SourceDownload) = False) then
begin
Exit;
end;
end;
if Mode = pmmBattery then
begin
Target.Position := (Target.Max div 100) * SourceBattery.GetBatteryPercent;
end;
if Mode = pmmDownload then
begin
Target.Position := (Target.Max div 100) * SourceDownload.GetProgressPercent;
end;
inherited;
end;
procedure TProgressBarManager.SetTarget(Value: TProgressBar);
begin
FTarget := Value;
Update;
end;
procedure TProgressBarManager.SetSourceBattery(Value: TBattery);
begin
FSourceBattery := Value;
if Mode = pmmBattery then
begin
Update;
end;
end;
procedure TProgressBarManager.SetSourceDownload(Value: TDownload);
begin
FSourceDownload := Value;
if Mode = pmmDownload then
begin
Update;
end;
end;
procedure TProgressBarManager.SetMode(Value: TProgressBarManagerMode);
begin
FMode := Value;
Update;
end;
{ ----------------------------------------------------------------------------
TListBoxManager
---------------------------------------------------------------------------- }
constructor TListBoxManager.Create(AOwner: TComponent);
begin
inherited;
FAbout := TComponentAbout.Create(ListBoxManagerComponent_Name,ListBoxManagerComponent_Version,ListBoxManagerComponent_Copyright,ListBoxManagerComponent_Author);
FMode := lmmNone;
FFilterOptions := [sfoCaseSensitive,sfoForceTrim,sfoDefaultVisible];
FilteredList := TFilteredStringList.Create;
Update;
end;
destructor TListBoxManager.Destroy;
begin
FAbout.Free;
FilteredList.Free;
inherited;
end;
procedure TListBoxManager.Update;
begin
if Assigned(Target) = False then
begin
Exit;
end;
if Mode <> lmmNone then
begin
if (Mode = lmmEdit) and (Assigned(SourceEdit) = False)
or (Mode = lmmComboBox) and (Assigned(SourceComboBox) = False) then
begin
Exit;
end;
end;
if Mode = lmmEdit then
begin
FilteredList.Filter := SourceEdit.Text;
end;
if Mode = lmmComboBox then
begin
FilteredList.Filter := SourceComboBox.Text;
end;
Target.Items.Assign(FilteredList.FilteredStrings);
inherited;
end;
procedure TListBoxManager.LoadList;
begin
if Assigned(Target) then
begin
FilteredList.Assign(Target.Items);
end;
end;
procedure TListBoxManager.SetTarget(Value: TListBox);
begin
FTarget := Value;
LoadList;
Update;
end;
procedure TListBoxManager.SetSourceEdit(Value: TEdit);
begin
FSourceEdit := Value;
if Mode = lmmEdit then
begin
Update;
end;
end;
procedure TListBoxManager.SetSourceComboBox(Value: TComboBox);
begin
FSourceComboBox := Value;
if Mode = lmmComboBox then
begin
Update;
end;
end;
procedure TListBoxManager.SetMode(Value: TListBoxManagerMode);
begin
FMode := Value;
Update;
end;
procedure TListBoxManager.SetFilterOptions(Value: TStringFilterOptions);
begin
FilteredList.FilterOptions := Value;
FFilterOptions := Value;
Update;
end;
{ ----------------------------------------------------------------------------
TParamFormat
---------------------------------------------------------------------------- }
constructor TParamFormat.Create;
begin
inherited;
//...
end;
constructor TParamFormat.Create(APrefix,ASeparator,ASuffix: String);
begin
Create;
Prefix := APrefix;
Separator := ASeparator;
Suffix := ASuffix;
end;
destructor TParamFormat.Destroy;
begin
//...
inherited;
end;
procedure TParamFormat.SetPrefix(Value: String);
var
Index: Integer;
begin
for Index := 1 to Length(Value) do
begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Prefix"');
end;
end;
FPrefix := Value;
end;
procedure TParamFormat.SetSuffix(Value: String);
var
Index: Integer;
begin
for Index := 1 to Length(Value) do
begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Suffix"');
end;
end;
FSuffix := Value;
end;
procedure TParamFormat.SetSeparator(Value: String);
var
Index: Integer;
begin
for Index := 1 to Length(Value) do
begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Seperator"');
end;
end;
FSeparator := Value;
end;
{ ----------------------------------------------------------------------------
TParamReference
---------------------------------------------------------------------------- }
constructor TParamReference.Create(Collection: TCollection);
begin
inherited;
FFormat := TParamFormat.Create;
FIdentifier := ClassName + IntToStr(ID);
end;
destructor TParamReference.Destroy;
begin
FConnector := nil;
FFormat.Free;
inherited;
end;
function TParamReference.GetFormat: TParamFormat;
begin
Result := FFormat;
end;
procedure TParamReference.SetFormat(Value: TParamFormat);
begin
FFormat.Assign(Value);
end;
procedure TParamReference.SetIdentifier(Value: String);
var
Index: Integer;
begin
if Length(Value) > 0 then
begin
for Index := 1 to Length(Value) do
begin
if (Value[Index] in Spaces) or (Value[Index] in [#34,#39]) then
begin
raise EInvalidParamIdentifier.Create('"' + Value + '" is not a valid identifier value');
end;
end;
end else
begin
raise EInvalidParamIdentifier.Create('"' + Value + '" is not a valid identifier value');
end;
FIdentifier := Value;
end;
procedure TParamReference.Update;
var
Value: String;
ParamIndex: Integer;
ParamItem: String;
CharIndex: Integer;
InPrefix: Boolean;
InSep: Boolean;
InDef: Boolean;
InSuffix: Boolean;
begin
Connector^ := DefaultValue;
Value := '';
for ParamIndex := 1 to ParamCount do
begin
InPrefix := True;
InSuffix := False;
InSep := False;
InDef := False;
ParamItem := ParamStr(ParamIndex);
CharIndex := 1;
while CharIndex <= Length(ParamItem) do
begin
//[X----]
if InPrefix = True then
begin
if Length(Format.Prefix) = 0 then
begin
InPrefix := False;
Continue;
end;
if ParamItem[CharIndex] = Format.Prefix[CharIndex] then
begin
if CharIndex = Length(Format.Prefix) then
begin
InPrefix := False;
end;
end else
begin
Break;
end;
end else
begin
//[----X]
if InSuffix = True then
begin
if (ParamItem[CharIndex] = Format.Suffix[CharIndex - Length(Format.Prefix + Identifier + Format.Separator + Value)]) then
begin
if CharIndex = Length(ParamItem) then
begin
//--> EXIT <--
Connector^ := Value;
Exit;
end;
end else
begin
Break;
end;
end else
//Identifier [ InIdent := not (InPrefix or InSuffix) ]
begin
//[--X--]
if InSep = True then
begin
if Length(Format.Separator) = 0 then
begin
InSep := False;
InDef := True;
Continue;
end;
if ParamItem[CharIndex] = Format.Separator[CharIndex - Length(Format.Prefix + Identifier)] then
begin
if CharIndex = Length(Format.Prefix + Identifier + Format.Separator) then
begin
InSep := False;
InDef := True;
end;
end else
begin
Break;
end;
end else
begin
//[---X-]
if InDef = True then
begin
Value := Value + ParamItem[CharIndex];
if CharIndex = Length(ParamItem) - Length(Format.Suffix) then
begin
InDef := False;
InSuffix := True;
if Length(Format.Suffix) = 0 then
begin
//--> EXIT <--
Connector^ := Value;
Exit;
end;
end;
end else
begin
//[-X---]
if ParamItem[CharIndex] = Identifier[CharIndex - Length(Format.Prefix)] then
begin
if CharIndex = Length(Identifier + Format.Prefix) then
begin
InSep := True;
end;
end else
begin
Break;
end;
end;
end;
end;
end;
Inc(CharIndex);
//While (CharIndex)
end;
//For (ParamIndex)
end;
raise EParamNotFound.Create('Parameter "' + Identifier + '" not found');
end;
function TParamReference.AsText(UseDefVal: Boolean = False): String;
begin
Result := StringFromParamRef(Self,UseDefVal);
end;
{ ----------------------------------------------------------------------------
TParamDefiner
---------------------------------------------------------------------------- }
constructor TParamDefiner.Create;
begin
inherited;
FAbout := TComponentAbout.Create(ParamDefinerComponent_Name,ParamDefinerComponent_Version,ParamDefinerComponent_Copyright,ParamDefinerComponent_Author);
FReferences := TParamReferences.Create(TParamReference);
end;
destructor TParamDefiner.Destroy;
begin
FAbout.Free;
FReferences.Free;
inherited;
end;
procedure TParamDefiner.SetReferences(Value: TParamReferences);
begin
FReferences := Value;
end;
procedure TParamDefiner.Update;
var
Index: Integer;
begin
if References.Count > 0 then
begin
try
for Index := 0 to References.Count - 1 do
begin
(References.Items[Index] as TParamReference).Update;
end;
finally
if Assigned(OnUpdate) = True then
begin
OnUpdate(Self);
end;
end;
end;
end;
end.