iLIST1j

{
    Collection Component Base Unit
    Copyright TarnerDel 1997
}
unit DataCmpo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, Ole2, Comobj;

type
{ TDataComponent }
  TDataComponent = class(TComponent)
  protected
    procedure ReadState(Reader: TReader); override;
    function  GetChildOwner: TComponent; override;
    procedure GetChildren(Proc: TGetChildProc; 
                          Root: TComponent); override;
    function  GetOID: string;
    procedure ReaderError(Reader: TReader;
                          const Message: string;
                          var Handled: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    property OID: string read GetOID stored False;
  end;

{ TCollectionModule }
  TCollectionModule = class(TDataComponent)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

{ Alarm or not on error of property reading }
var SilentReadError: boolean;

implementation

{ TDataComponent }
constructor TDataComponent.Create(AOwner: TComponent);
var
  OLE2GUID: OLE2.TGUID;
  NameStr: string;
  IsCreateGUID: boolean;
begin
  inherited Create(AOwner);
  IsCreateGUID := True;
  if Owner <> nil then begin
    if (csLoading in Owner.ComponentState) then
      IsCreateGUID := False;
  end;
  if IsCreateGUID then begin
    if Failed( CoCreateGUID( OLE2GUID ) ) then
      raise Exception.Create('Connot Create GUID');
    NameStr := GUIDToString(System.TGUID(OLE2GUID));
    Name := 'N'+ Copy(NameStr,2,8) + Copy(NameStr,11,4) 
            + Copy(NameStr,16,4) + Copy(NameStr,21,4) 
            + Copy(NameStr,26,12);
  end;
end;

function TDataComponent.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TDataComponent.GetChildren(Proc: TGetChildProc;
                                     Root: TComponent);
var
  i: Integer;
  Compo: TComponent;
begin
  inherited GetChildren(Proc, Root);
  for i := 0 to ComponentCount - 1 do begin
    Compo := Components[i];
    Proc(Compo);
  end;
end;

function TDataComponent.GetOID;
begin
  Result := Name;
end;

procedure TDataComponent.ReadState;
var  Save: TReaderError;
begin
  Save := Reader.OnError;
  Reader.OnError := ReaderError;
  inherited ReadState(Reader);
  Reader.OnError := Save;
end;

procedure TDataComponent.ReaderError(Reader: TReader;
           const Message: string; var Handled: Boolean);
begin
  if not SilentReadError then begin
    MessageBeep(MB_ICONEXCLAMATION);
    MessageDlg(Message, mtWarning, [mbOK], 0);
  end;
  Handled := True;
end;

{ for global component referance }
// save original procedure
var OldFindGlobal: TFindGlobalComponent;
// List of CollectionModule
var CollectionModuleList: TList;

function FindGlobalComponent(const Name: string): 
        TComponent;
var
  i: integer;
begin
  if Assigned(OldFindGlobal) then begin
    Result := OldFindGlobal(Name);   // do original proc
    if Result <> nil then Exit;
  end;

  for i := 0 to CollectionModuleList.Count - 1 do
  begin
    Result := TComponent(CollectionModuleList.Items[i]);
    if CompareText(Name, Result.Name) = 0 then Exit;
  end;
  Result := nil;
end;

{ TCollectionModule }
constructor TCollectionModule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CollectionModuleList.Add(Self);
end;

destructor TCollectionModule.Destroy;
begin
  Destroying;
  RemoveFixupReferences(Self, '');
  CollectionModuleList.Remove(Self);
  inherited Destroy;
end;

initialization
begin
  SilentReadError := False;
  CollectionModuleList := TList.Create;
  OldFindGlobal := Classes.FindGlobalComponent;
  Classes.FindGlobalComponent := FindGlobalComponent;
end;

finalization
  CollectionModuleList.Free;

end.