Componentes.Terceros.CFPack/internal/4.1/1/Source/CustFrms.pas

{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       Custom Forms Pack (CFPack)                      }
{                                                       }
{       Copyright (c) 1997-99 Sergey Orlik              }
{                                                       }
{     Written by:                                       }
{       Sergey Orlik                                    }
{       product manager                                 }
{       Russia, C.I.S. and Baltic States (former USSR)  }
{       Inprise Moscow office                           }
{       Internet:  sorlik@inprise.ru                    }
{       www.geocities.com/SiliconValley/Way/9006/       }
{                                                       }
{*******************************************************}
{$I CFPDEF.INC}

{$IFDEF VER_CB}
  {$ObjExportAll On}
{$ENDIF}

unit CustFrms;

interface
uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DesignIntf, DesignEditors, TypInfo;

{ RegisterCustomFormClass
  Registers a new custom form or data module, i.e. descendant of TForm or TDataModule.
  All forms (data modules) registered with this procedure would be visible in the list
  of available ancestors in Custom Form Wizard. }

procedure RegisterCustomFormClass(CustFormBaseClass: TComponentClass);
procedure RegisterCustomFormClassAndModule(CustFormBaseClass: TComponentClass;
  CustModuleClass: TCustomModuleClass);

procedure GetCustomFormClasses(Proc: TGetStrProc);
function GetCustomFormUnit(const CustomFormClassName: string): string;
function GetCustomFormClass(const CustomFormClassName: string): TClass;

implementation

var
  CustomFormClassList: TStringList = nil;

procedure RegisterCustomFormClass(CustFormBaseClass: TComponentClass);
begin
  RegisterCustomFormClassAndModule(CustFormBaseClass, TCustomModule);
end;

procedure RegisterCustomFormClassAndModule(CustFormBaseClass: TComponentClass;
  CustModuleClass: TCustomModuleClass);
begin
  RegisterCustomModule(CustFormBaseClass, CustModuleClass);
  CustomFormClassList.AddObject(CustFormBaseClass.ClassName,TObject(CustFormBaseClass));
end;

procedure GetCustomFormClasses(Proc: TGetStrProc);
var
  i : integer;
begin
  for i:=0 to CustomFormClassList.Count-1 do
    Proc(CustomFormClassList[i]);
end;

function GetCustomFormUnit(const CustomFormClassName: string): string;
begin
  Result:=GetTypeData(PTypeInfo(TClass(CustomFormClassList.Objects[CustomFormClassList.IndexOf(CustomFormClassName)]).ClassInfo))^.UnitName;
end;

function GetCustomFormClass(const CustomFormClassName: string): TClass;
begin
  Result:=TClass(CustomFormClassList.Objects[CustomFormClassList.IndexOf(CustomFormClassName)]);
end;

procedure UnRegisterModuleCustomFormClasses(Module: HMODULE);
var
  I: Integer;
  M: TMemoryBasicInformation;
begin
  for I := CustomFormClassList.Count - 1 downto 0 do
  begin
    VirtualQuery(Pointer(CustomFormClassList.Objects[I]), M, SizeOf(M));
    if (Module = 0) or (HMODULE(M.AllocationBase) = Module) then
      CustomFormClassList.Delete(I);
  end;
end;

procedure ModuleUnload(Instance: Longint);
begin
  UnRegisterModuleCustomFormClasses(HMODULE(Instance));
end;

procedure CustomFormClassList_Initialize;
begin
  CustomFormClassList.AddObject('TForm',TObject(TForm));
  CustomFormClassList.AddObject('TDataModule',TObject(TDataModule));
end;

initialization
  AddModuleUnloadProc(ModuleUnload);
  CustomFormClassList:=TStringList.Create;
  CustomFormClassList_Initialize;
finalization
  UnRegisterModuleCustomFormClasses(HInstance);
  CustomFormClassList.Free;
  RemoveModuleUnloadProc(ModuleUnload);
end.