unit kparams;
{
   Author:  Vesa Lappalainen
   Date:    30.12.1996
   Changes:
              +
   - yleinen muoto?


   Jos perit ja haluat erilaisen listan, niin kirjoita uudelleen esim:
     CreateParamList

   Jos laitetaan lomakkeelle komponenttina, niin silloin kutsu ohjelman
   käynnistyessä (esim. lomakkeen Loaded) CreateList

  One example hierarcy
  =====================
                  0-n
     TParamValue -----<> TParamList                                  IniPara.pas
          |                  ^
          |           1      |                                      ------------
          |         |----TKParamList
          |         |
          ^         |    TComponent
          |         |        ^
          |         ---<>TParams                                     KParams.pas
          |                  ^                                      ------------
          |                  |
     YasParamValue       TYasParams                                  KYasPar.pas
           *
           |
TModBus ---

}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IniPara;

type
  TKParamList = class(TParamList)
  public
    function NewParam(const name:string):TParamValue; override;
    procedure StoreEEPROM; override;
    procedure StoreRAM; override;
    function SaveAll: string; override;
  end;

type
  TParams = class(TComponent)
  private
    FValueIniName: String;
    FValueSection:String;
    FTypeIniName: String;
    FFormName:String;

    ParamForm : TFormParams; // Lukko ettei lomaketta ole 2 kertaa
    ParamList: TParamList;
    function GetModel: string;
  protected
    procedure SetValueIniName(s: string); virtual;
    procedure SetValueSection(s: string); virtual;
    procedure SetTypeIniName(s: string); virtual;
  public
    LastError : string;
    function CreateParamList(AOwner:TComponent): TParamList; virtual;
    destructor Destroy; override;
    function CreateList: string; virtual;
    function CreateList3(fname,typ,val,sec: string):string; virtual;
    constructor Create(AOwner: TComponent); override;
    procedure Edit; virtual;
    function NewParam(const name:string):TParamValue; virtual;
    function Get(const name:string):double;
    function GetIndex(const name:string):integer;
    function ReadValue(i:integer): double;
    function Value(i:integer): double;
    procedure WriteValue(i:integer;d:double);
    procedure WriteBit(i,b:integer;v:boolean);
    procedure SetBit(i,b:integer;v:boolean);
    function GetBit(i,b:integer):boolean;
    function ReadBit(i,b:integer):boolean;
    function FindParam(const name:string): TParamValue;
    function ReadValueByName(const name:string): Double;
    function GetParam(i:integer):TParamValue;
    property Param[i:integer]: TParamValue read GetParam;
    procedure StoreEEPROM; virtual;
    procedure StoreRAM; virtual;
  published
    property Params: TParamList read ParamList;
    property ValueIniName:string read FValueIniName write SetValueIniName;
    property ValueSection:string read FValueSection write SetValueSection;
    property TypeIniName:string read FTypeIniName write SetTypeIniName;
    property FormName:string read FFormName write FFormName;
    property Model : string read GetModel;
  public
  end;

type
  TAllParams = class (TList)
  private
    function GetParams(i:integer):TParams;
    function GetParamsIndex(const s:string):integer;
    function GetParamsByName(const s:string):TParams;
  public
    property Param[i:integer] : TParams read GetParams;
    property ParamByName[const s:string] : TParams read GetParamsByName;
    property ParamsIndex[const s:string] : integer read GetParamsIndex;
  end;

var AllParams:TAllParams; 

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Kave2000', [TParams]);
end;

{------------------------------------------------------------------------------}
function TKParamList.NewParam(const name:string):TParamValue; 
begin
  if ( Owner is TParams ) then
    Result := (Owner as TParams).NewParam(name)
  else Result := inherited NewParam(name);  
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TParams.Edit;
begin
  if ( ParamList = NIL ) then exit;
  if ParamForm <> NIL then begin ParamForm.Show; exit; end;
  ParamForm := TFormParams.Create3(self,@ParamForm,ParamList);
  if ParamForm = NIL then exit;
  ParamForm.Name := 'FormParam'+FormName;
  ParamForm.Caption := 'Params -'+FormName + ' - ' + Model;
  ParamForm.Show;
end;

{------------------------------------------------------------------------------}
constructor TParams.Create(AOwner: TComponent);
begin
  ParamList := NIL;
  inherited Create(AOwner);
end;

{------------------------------------------------------------------------------}
function TParams.CreateList3(fname,typ,val,sec: string):string;
begin
  TypeIniName := typ;
  ValueIniName := val;
  ValueSection := sec;
  FFormName := fname;
  Result := CreateList;
end;

{------------------------------------------------------------------------------}
destructor TParams.Destroy;
begin
  if ( ParamList <> NIL ) then begin
    ParamList.Free;
    ParamList := NIL;
  end;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
function TParams.CreateList: string;
begin
  Result := 'Error creating params ' + ValueIniName + '->' + ValueSection;
  ParamList := CreateParamList(self);
  if ( ParamList = NIL ) then exit;
  Result := ParamList.ReadParams(TypeIniName,ValueIniName,ValueSection);
end;

{------------------------------------------------------------------------------}
procedure TParams.SetValueIniName(s: string);
begin
  FValueIniName := s;
  if ( ParamList <> NIL ) then ParamList.ValueIniName := s;
end;

{------------------------------------------------------------------------------}
procedure TParams.SetValueSection(s: string);
begin
  FValueSection := s;
  if ( ParamList <> NIL ) then ParamList.ValueSection := s;
end;

{------------------------------------------------------------------------------}
procedure TParams.SetTypeIniName(s: string);
begin
  FTypeIniName := s;
  if ( ParamList <> NIL ) then ParamList.TypeIniName := s;
end;

{------------------------------------------------------------------------------}
function TParams.CreateParamList(AOwner:TComponent): TParamList;
begin
  Result := TKParamList.Create(AOwner);
end;

{------------------------------------------------------------------------------}
function TParams.NewParam(const name:string):TParamValue;
begin
  Result := TParamValue.Create;
end;

{------------------------------------------------------------------------------}
function TParams.Get(const name:string):double;
begin
  Result := 0;
  if ( ParamList = NIL ) then exit;
  Result := ParamList.GetValue(name);
end;

{------------------------------------------------------------------------------}
function TParams.GetIndex(const name:string):integer;
begin
  Result := 0;
  if ( ParamList = NIL ) then exit;
  Result := ParamList.GetIndex(name);
end;

{------------------------------------------------------------------------------}
function TParams.FindParam(const name:string): TParamValue;
begin
  Result := NIL;
  if ( ParamList = NIL ) then exit;
  Result := ParamList.FindParam(name);
end;

{------------------------------------------------------------------------------}
function TParams.ReadValue(i:integer): double;
begin
  Result := 0;
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  LastError := ParamList.RefreshValue(i);
  Result := ParamList.Value(i);
end;

{------------------------------------------------------------------------------}
function TParams.Value(i:integer): double;
begin
  Result := 0;
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  Result := ParamList.Value(i);
end;

{------------------------------------------------------------------------------}
procedure TParams.WriteValue(i:integer;d:double);
begin
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  LastError := ParamList.WriteValue(i,d);
end;

{------------------------------------------------------------------------------}
procedure TParams.WriteBit(i,b:integer;v:boolean);
begin
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  ParamList.WriteBit(i,b,v);
end;

{------------------------------------------------------------------------------}
procedure TParams.SetBit(i,b:integer;v:boolean);
begin
  if ( ParamList = NIL ) then exit;
  ParamList.SetBit(i,b,v);
end;

{------------------------------------------------------------------------------}
function TParams.GetBit(i,b:integer):boolean;
begin
  Result := false;
  if ( ParamList = NIL ) then exit;
  Result := ParamList.GetBit(i,b);
end;

{------------------------------------------------------------------------------}
function TParams.ReadBit(i,b:integer):boolean;
begin
  Result := false;
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  LastError := ParamList.RefreshValue(i);
  Result := ParamList.GetBit(i,b);
end;

{------------------------------------------------------------------------------}
function TParams.ReadValueByName(const name:string): Double;
var p : TParamValue;
begin
  Result := 0;
  LastError := 'No param!';
  if ( ParamList = NIL ) then exit;
  p := FindParam(name);
  if ( p = NIL ) then exit;
  LastError := p.RefreshValue;
  Result := p.value;
end;

function TParams.GetParam(i:integer):TParamValue;
begin
  Result := NIL;
  if ( ParamList = NIL ) then exit;
  Result := ParamList.PValue(i);
end;

{------------------------------------------------------------------------------}
{ TAllParams implementation                                                    }
{------------------------------------------------------------------------------}
function TAllParams.GetParams(i:integer):TParams;
begin
  Result := NIL;
  if ( ( i < 0 ) or ( Count <= i ) ) then exit;
  Result := Items[i];
end;

function TAllParams.GetParamsIndex(const s:string):integer;
var i:integer; p : TParams;
begin
  Result := -1;
  for i:=0 to Count-1 do begin
    p := Items[i]; //  as TYasParams;
    if ( not ( p is TParams ) ) then continue;
    if ( p.FormName = s ) then begin
      Result := i;
      Exit;
    end;
  end;
end;

function TAllParams.GetParamsByName(const s:string):TParams;
var i:integer;
begin
  Result := NIL;
  i := GetParamsIndex(s); if ( i < 0 ) then exit;
  Result := Items[i]; //  as TParams;
end;

{------------------------------------------------------------------------------}
{ AllParams Creation:                                                          }
{------------------------------------------------------------------------------}

function TParams.GetModel: string;
begin
  Result := ParamList.Model;
end;

procedure TParams.StoreEEPROM;
begin
//
end;

procedure TParams.StoreRAM;
begin
//
end;

procedure TKParamList.StoreEEPROM;
begin
  inherited;
  if ( Owner is TParams ) then TParams(Owner).StoreEEPROM;
end;

procedure TKParamList.StoreRAM;
begin
  inherited;
  if ( Owner is TParams ) then TParams(Owner).StoreRAM;
end;

function TKParamList.SaveAll: string;
begin
  Result := Inherited SaveAll;
  StoreEEPROM;
end;

initialization begin
  AllParams := TAllParams.Create;
  if ( not assigned(AllParams) ) then begin
    ShowMessage('Can''t create AllParams!');
    Halt;
  end;
end;

end.