331 lines
7.7 KiB
ObjectPascal
331 lines
7.7 KiB
ObjectPascal
unit ConfigOptions;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, Contnrs, TypInfo, Graphics, Controls, Forms, StdCtrls,
|
|
ExtCtrls, Buttons;
|
|
|
|
type
|
|
TOptionControl = class;
|
|
|
|
TOptionList = class(TObject)
|
|
private
|
|
FItems: TObjectList;
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TOptionControl;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function Add(AOption: TOptionControl): TOptionControl;
|
|
|
|
property Count: Integer read GetCount;
|
|
property Items[Index: Integer]: TOptionControl read GetItem; default;
|
|
end;
|
|
|
|
TOptionControl = class(TObject)
|
|
public
|
|
function CreateControl: TControl; virtual; abstract;
|
|
end;
|
|
|
|
TOptionSpacer = class(TOptionControl)
|
|
public
|
|
function CreateControl: TControl; override;
|
|
end;
|
|
|
|
TOptionFrame = class(TOptionControl)
|
|
private
|
|
FFrame: TFrame;
|
|
public
|
|
constructor Create(AFrame: TFrame);
|
|
function CreateControl: TControl; override;
|
|
end;
|
|
|
|
TOption = class(TOptionControl)
|
|
private
|
|
FPropName: string;
|
|
FInstance: TObject;
|
|
FInfo: PPropInfo;
|
|
FCaption: string;
|
|
FHint: string;
|
|
function GetAsFloat: Double;
|
|
function GetAsInteger: Integer;
|
|
function GetAsString: string;
|
|
procedure SetAsFloat(const Value: Double);
|
|
procedure SetAsInteger(const Value: Integer);
|
|
procedure SetAsString(const Value: string);
|
|
function GetAsBoolean: Boolean;
|
|
procedure SetAsBoolean(const Value: Boolean);
|
|
public
|
|
constructor Create(AInstance: TObject; const APropName, ACaption, AHint: string);
|
|
|
|
property AsString: string read GetAsString write SetAsString;
|
|
property AsInteger: Integer read GetAsInteger write SetAsInteger;
|
|
property AsFloat: Double read GetAsFloat write SetAsFloat;
|
|
property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
|
|
|
|
property Instance: TObject read FInstance;
|
|
property PropName: string read FPropName;
|
|
property Caption: string read FCaption;
|
|
property Hint: string read FHint;
|
|
end;
|
|
|
|
TOptionCheckBox = class(TOption)
|
|
private
|
|
procedure EvClick(Sender: TObject);
|
|
public
|
|
function CreateControl: TControl; override;
|
|
end;
|
|
|
|
{ TOptionGroup = class(TOptionControl)
|
|
end;
|
|
|
|
TOptionRadioButton = class(TOption)
|
|
end;
|
|
|
|
TOptionEdit = class(TOption)
|
|
end;}
|
|
|
|
TOptionDirectoryEdit = class(TOption)
|
|
public
|
|
function CreateControl: TControl; override;
|
|
end;
|
|
|
|
{ TOptionDropDown = class(TOption)
|
|
end;
|
|
|
|
TOptionDropDownList = class(TOptionDropDown)
|
|
end;
|
|
|
|
TOptionButton = class(TOption)
|
|
end;
|
|
|
|
TOptionCheckListBox = class(TOption)
|
|
end;}
|
|
|
|
EOptionError = class(Exception);
|
|
|
|
implementation
|
|
|
|
uses
|
|
InstallerConsts, FrmeDirectoryEdit;
|
|
|
|
procedure InvalidOption(const PropName: string);
|
|
begin
|
|
raise EOptionError.CreateFmt(RsInvalidOptionProperty, [PropName]);
|
|
end;
|
|
|
|
{ TOptionList }
|
|
|
|
constructor TOptionList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TObjectList.Create;
|
|
end;
|
|
|
|
destructor TOptionList.Destroy;
|
|
begin
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TOptionList.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TOptionList.GetItem(Index: Integer): TOptionControl;
|
|
begin
|
|
Result := TOptionControl(FItems[Index]);
|
|
end;
|
|
|
|
function TOptionList.Add(AOption: TOptionControl): TOptionControl;
|
|
begin
|
|
FItems.Add(AOption);
|
|
Result := AOption;
|
|
end;
|
|
|
|
{ TOption }
|
|
|
|
constructor TOption.Create(AInstance: TObject; const APropName, ACaption, AHint: string);
|
|
begin
|
|
inherited Create;
|
|
FInstance := AInstance;
|
|
FPropName := APropName;
|
|
FInfo := GetPropInfo(Instance, PropName);
|
|
if not Assigned(FInfo) then
|
|
InvalidOption(PropName);
|
|
FCaption := ACaption;
|
|
FHint := AHint;
|
|
end;
|
|
|
|
function TOption.GetAsInteger: Integer;
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
Result := GetOrdProp(Instance, FInfo);
|
|
tkString, tkLString:
|
|
Result := StrToInt(GetStrProp(Instance, FInfo));
|
|
tkFloat:
|
|
Result := Trunc(GetFloatProp(Instance, FInfo));
|
|
tkWString:
|
|
Result := StrToInt(GetWideStrProp(Instance, FInfo));
|
|
else
|
|
InvalidOption(PropName);
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TOption.SetAsInteger(const Value: Integer);
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
SetOrdProp(Instance, FInfo, Value);
|
|
tkString, tkLString:
|
|
SetStrProp(Instance, FInfo, IntToStr(Value));
|
|
tkFloat:
|
|
SetFloatProp(Instance, FInfo, Value);
|
|
tkWString:
|
|
SetWideStrProp(Instance, FInfo, IntToStr(Value));
|
|
else
|
|
InvalidOption(PropName);
|
|
end;
|
|
end;
|
|
|
|
function TOption.GetAsFloat: Double;
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
Result := GetOrdProp(Instance, FInfo);
|
|
tkString, tkLString:
|
|
Result := StrToFloat(GetStrProp(Instance, FInfo));
|
|
tkFloat:
|
|
Result := GetFloatProp(Instance, FInfo);
|
|
tkWString:
|
|
Result := StrToFloat(GetWideStrProp(Instance, FInfo));
|
|
else
|
|
InvalidOption(PropName);
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TOption.SetAsFloat(const Value: Double);
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
SetOrdProp(Instance, FInfo, Trunc(Value));
|
|
tkString, tkLString:
|
|
SetStrProp(Instance, FInfo, FloatToStr(Value));
|
|
tkFloat:
|
|
SetFloatProp(Instance, FInfo, Value);
|
|
tkWString:
|
|
SetWideStrProp(Instance, FInfo, FloatToStr(Value));
|
|
else
|
|
InvalidOption(PropName);
|
|
end;
|
|
end;
|
|
|
|
function TOption.GetAsString: string;
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
Result := IntToStr(GetOrdProp(Instance, FInfo));
|
|
tkString, tkLString:
|
|
Result := GetStrProp(Instance, FInfo);
|
|
tkFloat:
|
|
Result := FloatToStr(GetFloatProp(Instance, FInfo));
|
|
tkWString:
|
|
Result := GetWideStrProp(Instance, FInfo);
|
|
else
|
|
InvalidOption(PropName);
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
procedure TOption.SetAsString(const Value: string);
|
|
begin
|
|
case FInfo.PropType^.Kind of
|
|
tkInteger, tkChar, tkEnumeration, tkWChar:
|
|
SetOrdProp(Instance, FInfo, StrToInt(Value));
|
|
tkString, tkLString:
|
|
SetStrProp(Instance, FInfo, Value);
|
|
tkFloat:
|
|
SetFloatProp(Instance, FInfo, StrToFloat(Value));
|
|
tkWString:
|
|
SetWideStrProp(Instance, FInfo, Value);
|
|
else
|
|
InvalidOption(PropName);
|
|
end;
|
|
end;
|
|
|
|
function TOption.GetAsBoolean: Boolean;
|
|
begin
|
|
Result := Boolean(AsInteger);
|
|
end;
|
|
|
|
procedure TOption.SetAsBoolean(const Value: Boolean);
|
|
begin
|
|
AsInteger := Integer(Value);
|
|
end;
|
|
|
|
{ TOptionSpacer }
|
|
|
|
function TOptionSpacer.CreateControl: TControl;
|
|
begin
|
|
Result := TPanel.Create(nil);
|
|
with TPanel(Result) do
|
|
begin
|
|
Height := 20;
|
|
Caption := '';
|
|
BevelInner := bvNone;
|
|
BevelOuter := bvNone;
|
|
end;
|
|
end;
|
|
|
|
{ TOptionFrame }
|
|
|
|
constructor TOptionFrame.Create(AFrame: TFrame);
|
|
begin
|
|
inherited Create;
|
|
FFrame := AFrame;
|
|
end;
|
|
|
|
function TOptionFrame.CreateControl: TControl;
|
|
begin
|
|
Result := FFrame;
|
|
end;
|
|
|
|
{ TOptionDirectoryEdit }
|
|
|
|
function TOptionDirectoryEdit.CreateControl: TControl;
|
|
var
|
|
Frame: TFrameDirectoryEdit;
|
|
begin
|
|
Frame := TFrameDirectoryEdit.Create(nil);
|
|
Frame.Option := Self;
|
|
Result := Frame;
|
|
end;
|
|
|
|
{ TOptionCheckBox }
|
|
|
|
function TOptionCheckBox.CreateControl: TControl;
|
|
var
|
|
cbx: TCheckBox;
|
|
begin
|
|
cbx := TCheckBox.Create(nil);
|
|
cbx.Caption := Caption;
|
|
cbx.Hint := Hint;
|
|
cbx.ShowHint := Hint <> '';
|
|
cbx.OnClick := EvClick;
|
|
cbx.Checked := AsBoolean;
|
|
Result := cbx;
|
|
end;
|
|
|
|
procedure TOptionCheckBox.EvClick(Sender: TObject);
|
|
begin
|
|
AsBoolean := (Sender as TCheckBox).Checked;
|
|
end;
|
|
|
|
end.
|