{------------------------------------------------------------------------------}
{
   Unit Name: extracmp
   Purpose  : Help to dynamically load components.
              Components are read from file.
   Author   : Vesa Lappalainen
   Date     : 10.3.1999
   Changed  : 29.09.2001/vl
    + VCL/CLX compiling (define const CLX)

   ToDo     :


Usage:
======
  Create component
    ex := TExtraComps.Create(self);
  and load the components
    ex.Read('Extra.ctr');

  Well before creating the component, register classes you are using:
  (for example in your units initialization section)

  initialization begin
    RegisterClass(TGroupBox);
    RegisterClass(TButton);
    RegisterClass(TPanel);
    RegisterClass(TListBox);
  end;


The file format:
================
; For every component there is a line telling where to create the component
; Format of the description line:
; "["Form["."ParentComp]["="[ComponentToChange][":"OwnerComponent]]"]"[";"][Comment]
;  if ParentComp        = ''       => ParentComp = Form
;  if ComponentToChange = ''       => new component created
;  if OwnerComponent    = ''       => no owner
;  if OwnerComponent    = 'Parent' => OwnerComponent := ParentComp
;
[Form1.GroupBox1=:Form1]      ; Parent component and  : Owner component
object Button0: TButton       ; Name and class   (Owner can be off)
  Left = 6                    ; Normal object properties
  Top = 50
  Caption = '&Mato'
end


[Form1=Panel1]                ; = Change properties of existing component
object Panel1: TPanel
    Caption = 'Wau'
    BevelWidth = 5
    BevelInner = bvLowered
    object GroupBox3: TGroupBox ; Inner components can be used
      Align = alLeft            ; Then the owner is the outer component
      Width = 20
      Caption = 'GroupBox3'
      TabOrder = 0
    end
end

[Application=:Parent] ; Create a new form under Application
object Form2: TForm
  Left = 0
...
end;

; Also including other files is supported:
#include "new2.ctr"

Warning:
========
 1) Be careful with the owners because some program might use
    Form.FindComponent and that finds only the components owned by the form.
 2) Be also careful with the creation order of the components.  Otherwise
    you may not be able to refer some component.

}
unit extracmp;

interface


uses SysUtils, Classes,
{$ifdef CLX}
  QControls,QForms,
{$else}
  Controls,Forms,
{$endif}
IniName;

function ReadExtraComponents(const filename:string; items:TList=nil; forms:TList=nil) : boolean;

type TExtraProcForForms = procedure (form:TForm) of object;
type TExtraProcForComps = procedure (comp:TComponent) of object;

//------------------------------------------------------------------------------
type  TExtraComps = class(TComponent)
private
  items : TList;
  forms : TList;
  FAutoLoad : boolean;
    FFileName: string;
    procedure SetFileName(const Value: string);
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  function add(newItem:TObject):boolean; virtual;
  function Read(const filename:string='') : boolean; virtual;
  procedure ForAllForms(f:TExtraProcForForms); virtual;
  procedure ForAllComps(f:TExtraProcForComps); virtual;
  procedure Loaded; override;
published
  property AutoLoad : boolean read FAutoLoad write FAutoLoad default false;
  property FileName : string read FFileName write SetFileName;
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------

procedure Register;

implementation
uses kstring,
{$ifdef CLX}
  QStdCtrls,QExtCtrls,
{$else}
  StdCtrls,ExtCtrls,
{$endif}
  inifiles;

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

//------------------------------------------------------------------------------
// TExtraComps
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
  constructor TExtraComps.Create(AOwner: TComponent);
  begin
    inherited;
    items := TList.Create;
    forms := TList.Create;
    FFileName := '';
  end;

  destructor TExtraComps.Destroy;
  begin
    forms.Free;
    items.Free;
    inherited;
  end;

  function TExtraComps.add(newItem:TObject):boolean;
  begin
    items.Add(Pointer(newItem));
    Result := true;
  end;

function TExtraComps.Read(const filename:string) : boolean;
var n : string;
begin
  n := filename;
  if ( n = '' ) then n := self.FileName;
  Result := ReadExtraComponents(GetIniName(n,'.ctr'), items, forms);
end;

procedure TExtraComps.ForAllForms(f:TExtraProcForForms);
var i:integer;
begin
  if ( forms = nil ) then exit;
  for i:=0 to forms.Count-1 do f(forms[i]);
end;

procedure TExtraComps.ForAllComps(f:TExtraProcForComps);
var i:integer;
begin
  if ( items = nil ) then exit;
  for i:=0 to items.Count-1 do f(items[i]);
end;

//------------------------------------------------------------------------------
// Helpper functions
//------------------------------------------------------------------------------

function FindComponent(var st:string; var form,comp : TComponent):Boolean;
var fname,cname:string; fcomp : TComponent;
begin
  comp := nil; form := nil;
  Result := false;
  Split2(st,'.',fname,cname);
  if ( st = '' ) then exit;
  if ( fname = 'nil' ) then begin Result := true; exit; end;
  if ( cname = 'Application' ) then begin comp := Application; Result := true; exit; end;
  if ( fname = 'Application' ) then form := Application
  else begin
    fcomp := Application.FindComponent(fname);
    if ( fcomp = nil ) or ( not (fcomp is TForm)) then exit;
    form := TForm(fcomp);
  end;
  if ( cname = fname ) or ( cname = '' ) then begin
    comp := form; Result := true;
    exit;
  end;
  comp := form.FindComponent(cname);
  if ( comp = nil ) then exit;
  Result := true;
end;

function FindParent(var st:string; var form:TComponent; var par : TWinControl):Boolean;
var comp:TComponent;
begin
  Result := false;
  if ( not FindComponent(st,form,comp) ) then exit;
  if ( form = nil ) and ( comp = nil ) then begin // if nil Form => OK
    par := nil; Result := true;
  end;
  if ( form = Application ) then begin // if nil Form => OK
    par := nil; Result := true;
  end;
  if ( comp = nil ) or (not (comp is TWinControl) ) then exit;
  par := TWinControl(comp);
  Result := true;
end;

function CmpStrChr(const s:string; c:char) : boolean;
begin
  Result := false;
  if ( Length(s) = 0 ) then exit;
  Result := ( s[1] = c );
end;


function ReadExtraComponents(const filename:string; items,forms:TList) : boolean;
var  strStream : TStringStream;
     memStream : TMemoryStream;
     Cursor:integer;
     ExtraCompStrings : TStringList;

  function CreateComp(ctl:TComponent; par:TWinControl; own:TComponent):TComponent;
  var c:TComponent;
  begin
  try
    try                                                 
      memStream.Seek(0,soFromBeginning);
      strStream.Seek(0,soFromBeginning);
      ObjectTextToBinary(strStream,memStream);
      memStream.Seek(0,soFromBeginning);
      c := memStream.ReadComponent(ctl);
    except
      c := ctl;
    end;
    Result := c;
    if ( c = nil ) then exit;
    if ( c is TControl ) then TControl(c).Parent := par;
    if ( ctl <> nil ) and ( ctl.Owner = own ) then exit;
    if ( own <> nil ) then own.InsertComponent(c);
  finally end;
    if ( c.Name = '' ) then c.Name := 'Kissa';
  end;

  function FindBeg : boolean;
  var incname : string;
  begin
    Result := true;
    while ( Cursor < ExtraCompStrings.Count ) do begin
      if ( CmpStrChr(ExtraCompStrings[Cursor],'[') ) then exit;
      if ( Pos('#include ',ExtraCompStrings[Cursor]) = 1 ) then begin
        incname := RemoveChars(Copy(ExtraCompStrings[Cursor],10,200),'"');
        try
          ReadExtraComponents(incname,items,forms);
        except end;   
      end;
      inc(Cursor);
    end;
    Result := false;

  end;

  function GetComp(var s:string) : boolean;
  // Moves lines from ExtraCompStrings to strStream starting from beg
  // and ending when line starting with = is encountered.
  var i:integer; st,comment:string;
  begin
    Result := false;
    strStream.Seek(0,soFromBeginning);
    if ( not FindBeg ) then exit;
    split2(ExtraCompStrings[Cursor],';',s,comment);
    i := Pos(']',s); if ( i > 0 ) then Delete(s,i,100);
    Delete(s,1,1);
    Result := true;
    inc(Cursor);
    while ( Cursor < ExtraCompStrings.Count ) do begin
      if ( CmpStrChr(ExtraCompStrings[Cursor],'[') ) then exit;
      if ( CmpStrChr(ExtraCompStrings[Cursor],'#') ) then exit;
      split2(ExtraCompStrings[Cursor],';',st,comment);
      strStream.WriteString(st+#13#10);
      inc(Cursor);
    end;

  end;

var  OldName,s,ParentSt, OwnerSt : string;
     form2,form:TComponent; par : TWinControl;
     own:TComponent;
     Parts : TStringList;
     ctl:TComponent;
     c : TComponent;
     i : integer;
begin
  Result := false;
  if ( filename = '' ) then exit;
try
  memStream := TMemoryStream.Create;
  strStream := TStringStream.Create(s);
  ExtraCompStrings := TStringList.Create;
  Parts := TStringList.Create;
  try
    ExtraCompStrings.LoadFromFile(filename);
  except
  end;
  if ( ExtraCompStrings.Count = 0 ) then exit;
  Cursor := 0;
  while GetComp(s) do begin
    Split(s,'=:',Parts);
    ParentSt := Parts[0];
    OldName := Parts[1];
    OwnerSt := Parts[2];
    if ( OwnerSt = 'Parent' ) then OwnerSt := ParentSt;
    if not ( FindParent(ParentSt,form,par) ) then continue;
    ctl := form.FindComponent(OldName);
    if ( ctl is TControl ) and ( Pos('.',ParentSt) = 0 ) then par := TControl(ctl).Parent;
    FindComponent(OwnerSt,form2,own);
    if ( own = nil ) then own := form;
    c := CreateComp(ctl,par,own);
    if ( c <> nil ) and ( items <> nil ) then items.add(c);
    if ( c <> nil ) and ( form is TForm ) and ( forms <> nil ) then begin
      i := forms.IndexOf(form);
      if ( i < 0 ) then forms.add(form);
    end;
  end;
finally
  memStream.Free;
  strStream.Free;
  ExtraCompStrings.Free;
  Parts.Free;
end;
end;


//------------------------------------------------------------------------------

//------------------------------------------------------------------------------


procedure TExtraComps.SetFileName(const Value: string);
begin
  FFileName := Value;
end;

procedure TExtraComps.Loaded;
begin
  if ( AutoLoad ) then Read(FileName); 
end;

end.