lazarus/components/customform/custforms.pp

unit custforms;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, forms;

Type
  TCustomFormClass = Class of TCustomForm;
  { TCustomFormDescr }

  TCustomFormDescr = Class
  private
    FAuthor: String;
    FCaption: String;
    FCategory: String;
    FDescription: String;
    FFormClass: TCustomFormClass;
    FUnitName: String;
  public
    Constructor Create(AFormClass : TCustomFormClass);
    Constructor Create(AFormClass : TCustomFormClass; Const ACaption,ADescription,AUnit : String);
    Property FormClass : TCustomFormClass Read FFormClass Write FFormClass;
    Property Caption : String Read FCaption Write FCaption;
    Property Description : String Read FDescription Write FDescription;
    Property UnitName : String Read FUnitName Write FUnitName;
    Property Category : String Read FCategory Write FCategory;
    Property Author : String Read FAuthor Write FAuthor;
  end;

Procedure RegisterCustomForm(Descr : TCustomFormDescr);
Procedure RegisterCustomForm(AFormClass : TCustomFormClass);
Procedure RegisterCustomForm(AFormClass : TCustomFormClass; Const AUnitName : String);

Procedure Register;

implementation

uses projectintf,newitemintf,contnrs;

Const
  SAppFrameWork = 'Custom forms';
  SInstanceOf   = 'Create a new instance of %s';

{ TCustomFormDescr }

constructor TCustomFormDescr.Create(AFormClass: TCustomFormClass);

Var
  N,U : String;

begin
  N:=AFormClass.ClassName;
  U:=N;
  If (Upcase(U[1])='T') then
    Delete(U,1,1);
  Create(AFormClass,N,Format(SInstanceOf,[N]),U);
end;

constructor TCustomFormDescr.Create(AFormClass: TCustomFormClass;
  const ACaption, ADescription, AUnit: String);
begin
  FFormClass:=AFormClass;
  FCaption:=ACaption;
  FDescription:=ADescription;
  FUnitName:=AUnit;
  FCategory:=SAppFrameWork;
end;

// Registration code.

Type
  { TCustomFormFileDescriptor }
  TCustomFormFileDescriptor = Class(TFileDescPascalUnitWithResource)
  private
    FFormDescr: TCustomFormDescr;
  Public
    Constructor Create(ADescr : TCustomFormDescr);
    Property FormDescr : TCustomFormDescr Read FFormDescr;
    Function GetLocalizedName : String; override;
    Function GetLocalizedDescription : String; override;
    Function GetInterfaceUsesSection : String; override;
  end;

{ TCustomFormFileDescriptor }

constructor TCustomFormFileDescriptor.Create(ADescr: TCustomFormDescr);
begin
  Inherited Create;
  FFormDescr:=ADescr;
  ResourceClass:=FFormDescr.FFormClass;
  Name:=FFormDescr.Caption;
end;

function TCustomFormFileDescriptor.GetLocalizedName: String;
begin
  Result:=FFormDescr.Caption;
end;

function TCustomFormFileDescriptor.GetLocalizedDescription: String;
begin
  Result:=FFormDescr.Description;
  If (FFormDescr.Author<>'') then
    Result:=Result+LineEnding+'By '+FFormDescr.Author;
end;

function TCustomFormFileDescriptor.GetInterfaceUsesSection: String;
begin
  Result:=inherited GetInterfaceUsesSection;
  Result:=Result+',forms,'+FFormDescr.UnitName;
end;

Var
  CustomFormList : TObjectList;

Procedure RegisterCustomForm(Descr : TCustomFormDescr);

begin
  CustomFormList.Add(Descr);
end;

Procedure RegisterCustomForm(AFormClass : TCustomFormClass);

begin
  RegisterCustomForm(TCustomFormDescr.Create(AFormClass));
end;

Procedure RegisterCustomForm(AFormClass : TCustomFormClass; Const AUnitName : String);

Var
  D : TCustomFormDescr;

begin
  D:=TCustomFormDescr.Create(AFormClass);
  D.UnitName:=AUnitName;
  RegisterCustomForm(D);
end;


Procedure Register;

Var
  L : TStringList;
  I : Integer;
  D : TCustomFormDescr;
  
begin
  L:=TStringList.Create;
  Try
    L.Sorted:=True;
    L.Duplicates:=dupIgnore;
    For I:=0 to CustomFormList.Count-1 do
      L.Add(TCustomFormDescr(CustomFormList[i]).Category);
    For I:=0 to L.Count-1 do
      RegisterNewItemCategory(L[i]);
  Finally
    L.Free;
  end;
  For I:=0 to CustomFormList.Count-1 do
    begin
    D:=TCustomFormDescr(CustomFormList[i]);
    RegisterProjectFileDescriptor(TCustomFormFileDescriptor.Create(D),D.Category);
    end;
end;

Procedure InitCustomForms;

begin
  CustomFormList:=TObjectList.Create;
end;

Procedure DoneCustomForms;

begin
  FreeAndNil(CustomFormList);
end;

Initialization
  InitCustomForms;
Finalization
  DoneCustomForms;
end.