added Michael VCs packages to create project templates and customforms for the IDE

git-svn-id: trunk@7454 -
This commit is contained in:
mattias 2005-07-30 11:56:08 +00:00
parent 7e26e15592
commit 9ad79b53ed
19 changed files with 1783 additions and 0 deletions

18
.gitattributes vendored
View File

@ -62,6 +62,14 @@ components/codetools/resourcecodetool.pas svneol=native#text/pascal
components/codetools/sourcechanger.pas svneol=native#text/pascal
components/codetools/sourcelog.pas svneol=native#text/pascal
components/codetools/stdcodetools.pas svneol=native#text/pascal
components/customform/custforms.pp svneol=native#text/plain
components/customform/demo/appform.pas svneol=native#text/plain
components/customform/demo/appforms.lpk svneol=native#text/plain
components/customform/demo/appforms.pas svneol=native#text/plain
components/customform/demo/dbappform.pas svneol=native#text/plain
components/customform/demo/regappforms.pp svneol=native#text/plain
components/customform/lazcustforms.lpk svneol=native#text/plain
components/customform/lazcustforms.pas svneol=native#text/plain
components/fpcunit/fpcunittestrunner.lpk svneol=native#text/pascal
components/fpcunit/fpcunittestrunner.pas svneol=native#text/pascal
components/fpcunit/guitestrunner.lfm svneol=native#text/plain
@ -182,6 +190,16 @@ components/printers/win32/winprinters.inc svneol=native#text/pascal
components/printers/win32/winprinters_h.inc svneol=native#text/pascal
components/printers/win32/winutilprn.pas svneol=native#text/pascal
components/printers/win32/winutilprnconst.inc svneol=native#text/pascal
components/projecttemplates/frmtemplatesettings.lfm svneol=native#text/plain
components/projecttemplates/frmtemplatesettings.lrs svneol=native#text/plain
components/projecttemplates/frmtemplatesettings.pas svneol=native#text/plain
components/projecttemplates/frmtemplatevariables.lfm svneol=native#text/plain
components/projecttemplates/frmtemplatevariables.lrs svneol=native#text/plain
components/projecttemplates/frmtemplatevariables.pas svneol=native#text/plain
components/projecttemplates/idetemplateproject.pp svneol=native#text/plain
components/projecttemplates/projecttemplates.pp svneol=native#text/plain
components/projecttemplates/projtemplates.lpk svneol=native#text/plain
components/projecttemplates/projtemplates.pas svneol=native#text/plain
components/rtticontrols/baseicon.png -text svneol=unset#image/png
components/rtticontrols/examples/example1.lfm svneol=native#text/plain
components/rtticontrols/examples/example1.lrs svneol=native#text/pascal

View File

@ -0,0 +1,185 @@
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.

View File

@ -0,0 +1,93 @@
unit AppForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, forms;
Type
TInitFormAt = (ifaShow,ifaCreate,ifaActivate);
{ TAppForm }
TAppForm = Class(TCustomForm)
private
FAfterInit: TNotifyEvent;
FBeforeInit: TNotifyEvent;
FInitAt: TInitFormAt;
Procedure InitForm;
Protected
Procedure DoInitForm; virtual;
Public
Constructor Create(AOwner : TComponent); override;
Procedure DoShow; override;
Procedure Activate; override;
Published
// New properties
Property InitAt : TInitFormAt Read FInitAt Write FinitAt default ifaShow;
Property BeforeInitForm : TNotifyEvent Read FBeforeInit Write FBeforeInit;
Property AfterInitForm : TNotifyEvent Read FAfterInit Write FAfterInit;
// TCustomForm properties that we allow to edit in the IDE.
property Caption;
property ActiveControl;
property BorderStyle;
property Color;
property FormStyle;
property OnClose;
property OnCloseQuery;
property OnCreate;
property OnDeactivate;
property OnDestroy;
property OnHide;
property OnShow;
property ParentFont;
property PixelsPerInch;
property PopupMenu;
end;
implementation
uses custforms;
{ TAppForm }
procedure TAppForm.InitForm;
begin
If Assigned(BeforeInitForm) then
BeforeInitForm(Self);
DoInitForm;
If Assigned(AfterInitForm) then
AfterInitForm(Self);
end;
procedure TAppForm.DoInitForm;
begin
// Do nothing yet.
end;
constructor TAppForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if (InitAt=ifaCreate) then
InitForm;
end;
procedure TAppForm.DoShow;
begin
If InitAt=ifaShow then
InitForm;
inherited DoShow;
end;
procedure TAppForm.Activate;
begin
if (InitAt=ifaShow) then
InitForm;
inherited Activate;
end;
end.

View File

@ -0,0 +1,60 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="appforms"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Demo package which shows the use of the lazcustforms package.
It registers 2 custom forms (TAppForm and TDBAppForm)"/>
<License Value="LGPL"/>
<Version Major="1"/>
<Files Count="3">
<Item1>
<Filename Value="appform.pas"/>
<UnitName Value="AppForm"/>
</Item1>
<Item2>
<Filename Value="dbappform.pas"/>
<UnitName Value="dbappform"/>
</Item2>
<Item3>
<Filename Value="regappforms.pp"/>
<UnitName Value="regappforms"/>
</Item3>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="4">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="LazCustForms"/>
</Item2>
<Item3>
<PackageName Value="IDEIntf"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item4>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,20 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit appforms;
interface
uses
AppForm, dbappform, regappforms, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('appforms', @Register);
end.

View File

@ -0,0 +1,80 @@
unit dbappform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB, AppForm;
Type
TDatasetActionEvent = Procedure(Dataset : TDataset; DoAction : Boolean) of Object;
{ TDBAppForm }
TDBAppForm = Class(TAppForm)
private
FAfterOpen: TNotifyEvent;
FBeforeOpen: TNotifyEvent;
FOnOpenDataset: TDatasetActionEvent;
FOpenDatasets: Boolean;
Procedure OpenAllDatasets;
Protected
Procedure DoInitForm; override;
Procedure DoOpenDatasets; virtual;
Published
Property OpenDatasets : Boolean Read FOpenDatasets Write FOpenDatasets;
Property BeforeOpenDatasets : TNotifyEvent Read FBeforeOpen Write FBeforeOpen;
Property AfterOpenDatasets : TNotifyEvent Read FAfterOpen Write FAfterOpen;
Property OnOpenDataset : TDatasetActionEvent Read FOnOpenDataset Write FOnOpenDataset;
end;
implementation
uses
custforms;
{ TDBAppForm }
procedure TDBAppForm.OpenAllDatasets;
begin
If Assigned(BeforeOpenDatasets) then
BeforeOpenDatasets(Self);
DoOpenDatasets;
If Assigned(AfterOpenDatasets) then
AfterOpenDatasets(Self);
end;
procedure TDBAppForm.DoInitForm;
begin
inherited DoInitForm;
If OpenDatasets then
OpenAllDatasets;
end;
procedure TDBAppForm.DoOpenDatasets;
Var
I : Integer;
D : TDataset;
B : Boolean;
begin
For I:=0 to ComponentCount-1 do
begin
If Components[i] is TDataset then
begin
D:=TDataset(Components[i]);
B:=True;
If Assigned(OnOpenDataset) then
OnOpenDataset(D,B);
If B then
D.Open;
end;
end;
end;
end.

View File

@ -0,0 +1,26 @@
unit regappforms;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, appform, dbappform;
procedure RegisterAppForms;
implementation
uses custforms;
procedure RegisterAppForms;
begin
RegisterCustomForm(TCustomFormDescr.Create(TAppForm));
RegisterCustomForm(TCustomFormDescr.Create(TDBAppForm));
end;
initialization
RegisterAppForms;
end.

View File

@ -0,0 +1,50 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="LazCustForms"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Package to integrate custom forms in the Lazarus IDE"/>
<License Value="LGPL"/>
<Version Major="1"/>
<Files Count="1">
<Item1>
<Filename Value="custforms.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="custforms"/>
</Item1>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="IDEIntf"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit LazCustForms;
interface
uses
custforms, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('custforms', @custforms.Register);
end;
initialization
RegisterPackage('LazCustForms', @Register);
end.

View File

@ -0,0 +1,59 @@
object TemplateSettingsForm: TTemplateSettingsForm
Caption = 'Project templates settings'
ClientHeight = 127
ClientWidth = 400
PixelsPerInch = 90
Position = poDesktopCenter
HorzScrollBar.Page = 399
VertScrollBar.Page = 126
Left = 470
Height = 127
Top = 175
Width = 400
object Label1: TLabel
AutoSize = False
BorderSpacing.OnChange = nil
Caption = '&Directory with templates:'
Color = clNone
FocusControl = DETemplates
Layout = tlCenter
Left = 8
Height = 24
Top = 16
Width = 160
end
object BOK: TButton
BorderSpacing.OnChange = nil
Caption = '&OK'
Default = True
ModalResult = 1
OnClick = BOKClick
TabOrder = 0
Left = 296
Height = 25
Top = 96
Width = 91
end
object BCancel: TButton
BorderSpacing.OnChange = nil
Cancel = True
Caption = '&Cancel'
TabOrder = 1
Left = 192
Height = 25
Top = 96
Width = 96
end
object DETemplates: TDirectoryEdit
ButtonWidth = 23
NumGlyphs = 1
BorderSpacing.OnChange = nil
TabOrder = 2
BorderSpacing.OnChange = nil
TabOrder = 2
Left = 8
Height = 23
Top = 41
Width = 360
end
end

View File

@ -0,0 +1,20 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TTemplateSettingsForm','FORMDATA',[
'TPF0'#21'TTemplateSettingsForm'#20'TemplateSettingsForm'#7'Caption'#6#26'Pro'
+'ject templates settings'#12'ClientHeight'#2''#11'ClientWidth'#3#144#1#13'P'
+'ixelsPerInch'#2'Z'#8'Position'#7#15'poDesktopCenter'#18'HorzScrollBar.Page'
+#3#143#1#18'VertScrollBar.Page'#2'~'#4'Left'#3#214#1#6'Height'#2''#3'Top'#3
+#175#0#5'Width'#3#144#1#0#6'TLabel'#6'Label1'#8'AutoSize'#8#22'BorderSpacing'
+'.OnChange'#13#7'Caption'#6#26'&Directory with templates:'#5'Color'#7#6'clNo'
+'ne'#12'FocusControl'#7#11'DETemplates'#6'Layout'#7#8'tlCenter'#4'Left'#2#8#6
+'Height'#2#24#3'Top'#2#16#5'Width'#3#160#0#0#0#7'TButton'#3'BOK'#22'BorderSp'
+'acing.OnChange'#13#7'Caption'#6#3'&OK'#7'Default'#9#11'ModalResult'#2#1#7'O'
+'nClick'#7#8'BOKClick'#8'TabOrder'#2#0#4'Left'#3'('#1#6'Height'#2#25#3'Top'#2
+'`'#5'Width'#2'['#0#0#7'TButton'#7'BCancel'#22'BorderSpacing.OnChange'#13#6
+'Cancel'#9#7'Caption'#6#7'&Cancel'#8'TabOrder'#2#1#4'Left'#3#192#0#6'Height'
+#2#25#3'Top'#2'`'#5'Width'#2'`'#0#0#14'TDirectoryEdit'#11'DETemplates'#11'Bu'
+'ttonWidth'#2#23#9'NumGlyphs'#2#1#22'BorderSpacing.OnChange'#13#8'TabOrder'#2
+#2#22'BorderSpacing.OnChange'#13#8'TabOrder'#2#2#4'Left'#2#8#6'Height'#2#23#3
+'Top'#2')'#5'Width'#3'h'#1#0#0#0
]);

View File

@ -0,0 +1,54 @@
unit frmtemplatesettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, EditBtn, ProjectTemplates;
type
{ TTemplateSettingsForm }
TTemplateSettingsForm = class(TForm)
BOK: TButton;
BCancel: TButton;
DETemplates: TDirectoryEdit;
Label1: TLabel;
procedure BOKClick(Sender: TObject);
private
{ private declarations }
FTemplates : TProjectTemplates;
procedure SetTemplates(const AValue: TProjectTemplates);
public
{ public declarations }
Property Templates : TProjectTemplates Read FTemplates Write SetTemplates;
end;
var
TemplateSettingsForm: TTemplateSettingsForm;
implementation
{ TTemplateSettingsForm }
procedure TTemplateSettingsForm.BOKClick(Sender: TObject);
begin
If (Templates.TemplateDir<>DETemplates.Directory) then
FTemplates.Initialize(DETemplates.Directory);
end;
procedure TTemplateSettingsForm.SetTemplates(const AValue: TProjectTemplates);
begin
FTemplates:=AValue;
DEtemplates.Directory:=Ftemplates.TemplateDir;
end;
initialization
{$I frmtemplatesettings.lrs}
end.

View File

@ -0,0 +1,129 @@
object ProjectVariablesForm: TProjectVariablesForm
Caption = 'New project from template'
ClientHeight = 328
ClientWidth = 499
OnShow = ProjectVariablesFormShow
PixelsPerInch = 90
Position = poDesktopCenter
HorzScrollBar.Page = 498
VertScrollBar.Page = 327
Left = 431
Height = 328
Top = 501
Width = 499
object Label1: TLabel
Alignment = taRightJustify
AutoSize = False
BorderSpacing.OnChange = nil
Caption = '&Name for new project:'
Color = clNone
Layout = tlCenter
Left = 8
Height = 23
Top = 16
Width = 131
end
object Label2: TLabel
Alignment = taRightJustify
AutoSize = False
BorderSpacing.OnChange = nil
Caption = 'Create in &directory:'
Color = clNone
Layout = tlCenter
Left = 8
Height = 22
Top = 48
Width = 131
end
object PDescription: TPanel
Anchors = [akTop, akLeft, akRight]
BorderSpacing.OnChange = nil
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'This project contains some additional variables. Please provide values for these variables'
ClientHeight = 58
ClientWidth = 485
FullRepaint = False
TabOrder = 0
Left = 8
Height = 58
Top = 80
Width = 485
end
object SGVariables: TStringGrid
Anchors = [akTop, akLeft, akRight, akBottom]
AutoFillColumns = True
BorderSpacing.OnChange = nil
ColCount = 3
DefaultColWidth = 120
FixedColor = clBtnFace
GridLineWidth = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goAlwaysShowEditor, goDblClickAutoSize, goSmoothScroll]
RowCount = 5
ScrollBars = ssAutoBoth
VisibleColCount = 2
VisibleRowCount = 4
Left = 10
Height = 140
Top = 144
Width = 483
end
object BOK: TButton
Anchors = [akRight, akBottom]
BorderSpacing.OnChange = nil
Caption = '&OK'
Default = True
ModalResult = 1
OnClick = BOKClick
TabOrder = 1
Left = 411
Height = 25
Top = 292
Width = 75
end
object BCancel: TButton
Anchors = [akRight, akBottom]
BorderSpacing.OnChange = nil
Cancel = True
Caption = '&Cancel'
ModalResult = 2
TabOrder = 2
Left = 323
Height = 25
Top = 292
Width = 75
end
object EProjectName: TEdit
Anchors = [akTop, akLeft, akRight]
BorderSpacing.OnChange = nil
TabOrder = 3
Left = 152
Height = 23
Top = 16
Width = 237
end
object DEProject: TDirectoryEdit
ButtonWidth = 23
NumGlyphs = 1
Anchors = [akTop, akLeft, akRight]
BorderSpacing.OnChange = nil
TabOrder = 4
Anchors = [akTop, akLeft, akRight]
BorderSpacing.OnChange = nil
TabOrder = 4
Left = 152
Height = 23
Top = 48
Width = 317
end
object BConfig1: TButton
BorderSpacing.OnChange = nil
Caption = 'C&onfigure...'
OnClick = BConfig1Click
TabOrder = 5
Left = 10
Height = 25
Top = 292
Width = 94
end
end

View File

@ -0,0 +1,44 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TProjectVariablesForm','FORMDATA',[
'TPF0'#21'TProjectVariablesForm'#20'ProjectVariablesForm'#7'Caption'#6#25'New'
+' project from template'#12'ClientHeight'#3'H'#1#11'ClientWidth'#3#243#1#6'O'
+'nShow'#7#24'ProjectVariablesFormShow'#13'PixelsPerInch'#2'Z'#8'Position'#7
+#15'poDesktopCenter'#18'HorzScrollBar.Page'#3#242#1#18'VertScrollBar.Page'#3
+'G'#1#4'Left'#3#175#1#6'Height'#3'H'#1#3'Top'#3#245#1#5'Width'#3#243#1#0#6'T'
+'Label'#6'Label1'#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#22'BorderS'
+'pacing.OnChange'#13#7'Caption'#6#22'&Name for new project:'#5'Color'#7#6'cl'
+'None'#6'Layout'#7#8'tlCenter'#4'Left'#2#8#6'Height'#2#23#3'Top'#2#16#5'Widt'
+'h'#3#131#0#0#0#6'TLabel'#6'Label2'#9'Alignment'#7#14'taRightJustify'#8'Auto'
+'Size'#8#22'BorderSpacing.OnChange'#13#7'Caption'#6#21'Create in &directory:'
+#5'Color'#7#6'clNone'#6'Layout'#7#8'tlCenter'#4'Left'#2#8#6'Height'#2#22#3'T'
+'op'#2'0'#5'Width'#3#131#0#0#0#6'TPanel'#12'PDescription'#7'Anchors'#11#5'ak'
+'Top'#6'akLeft'#7'akRight'#0#22'BorderSpacing.OnChange'#13#10'BevelInner'#7#8
+'bvRaised'#10'BevelOuter'#7#9'bvLowered'#7'Caption'#6'ZThis project contains'
+' some additional variables. Please provide values for these variables'#12'C'
+'lientHeight'#2':'#11'ClientWidth'#3#229#1#11'FullRepaint'#8#8'TabOrder'#2#0
+#4'Left'#2#8#6'Height'#2':'#3'Top'#2'P'#5'Width'#3#229#1#0#0#11'TStringGrid'
+#11'SGVariables'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#15
+'AutoFillColumns'#9#22'BorderSpacing.OnChange'#13#8'ColCount'#2#3#15'Default'
+'ColWidth'#2'x'#10'FixedColor'#7#9'clBtnFace'#13'GridLineWidth'#2#0#7'Option'
+'s'#11#15'goFixedVertLine'#15'goFixedHorzLine'#10'goVertLine'#10'goHorzLine'
+#13'goRangeSelect'#11'goColSizing'#9'goEditing'#18'goAlwaysShowEditor'#18'go'
+'DblClickAutoSize'#14'goSmoothScroll'#0#8'RowCount'#2#5#10'ScrollBars'#7#10
+'ssAutoBoth'#15'VisibleColCount'#2#2#15'VisibleRowCount'#2#4#4'Left'#2#10#6
+'Height'#3#140#0#3'Top'#3#144#0#5'Width'#3#227#1#0#0#7'TButton'#3'BOK'#7'Anc'
+'hors'#11#7'akRight'#8'akBottom'#0#22'BorderSpacing.OnChange'#13#7'Caption'#6
+#3'&OK'#7'Default'#9#11'ModalResult'#2#1#7'OnClick'#7#8'BOKClick'#8'TabOrder'
+#2#1#4'Left'#3#155#1#6'Height'#2#25#3'Top'#3'$'#1#5'Width'#2'K'#0#0#7'TButto'
+'n'#7'BCancel'#7'Anchors'#11#7'akRight'#8'akBottom'#0#22'BorderSpacing.OnCha'
+'nge'#13#6'Cancel'#9#7'Caption'#6#7'&Cancel'#11'ModalResult'#2#2#8'TabOrder'
+#2#2#4'Left'#3'C'#1#6'Height'#2#25#3'Top'#3'$'#1#5'Width'#2'K'#0#0#5'TEdit'
+#12'EProjectName'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#22'BorderSpa'
+'cing.OnChange'#13#8'TabOrder'#2#3#4'Left'#3#152#0#6'Height'#2#23#3'Top'#2#16
+#5'Width'#3#237#0#0#0#14'TDirectoryEdit'#9'DEProject'#11'ButtonWidth'#2#23#9
+'NumGlyphs'#2#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#22'BorderSpaci'
+'ng.OnChange'#13#8'TabOrder'#2#4#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
+#0#22'BorderSpacing.OnChange'#13#8'TabOrder'#2#4#4'Left'#3#152#0#6'Height'#2
+#23#3'Top'#2'0'#5'Width'#3'='#1#0#0#7'TButton'#8'BConfig1'#22'BorderSpacing.'
+'OnChange'#13#7'Caption'#6#13'C&onfigure...'#7'OnClick'#7#13'BConfig1Click'#8
+'TabOrder'#2#5#4'Left'#2#10#6'Height'#2#25#3'Top'#3'$'#1#5'Width'#2'^'#0#0#0
]);

View File

@ -0,0 +1,124 @@
unit frmTemplateVariables;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Grids, ProjectTemplates, Buttons, StdCtrls, EditBtn, frmTemplateSettings;
type
{ TProjectVariablesForm }
TProjectVariablesForm = class(TForm)
BConfig1: TButton;
BOK: TButton;
BCancel: TButton;
DEProject: TDirectoryEdit;
EProjectName: TEdit;
Label1: TLabel;
Label2: TLabel;
PDescription: TPanel;
SGVariables: TStringGrid;
procedure BConfig1Click(Sender: TObject);
procedure BOKClick(Sender: TObject);
procedure ProjectVariablesFormShow(Sender: TObject);
private
FSChanged: Boolean;
FTemplates: TProjectTemplates;
{ private declarations }
FVariables : TStrings;
function GetProjectDir: String;
function GetProjectName: String;
procedure SetVariables(const AValue: TStrings);
public
{ public declarations }
Property Templates : TProjectTemplates Read FTemplates Write FTemplates;
Property ProjectName : String Read GetProjectName;
Property ProjectDir : String Read GetProjectDir;
Property Variables : TStrings Read FVariables Write SetVariables;
Property SettingsChanged: Boolean Read FSChanged Write FSChanged;
end;
var
ProjectVariablesForm: TProjectVariablesForm;
implementation
ResourceString
SVariable = 'Variable';
SValue = 'Value';
SDescription = 'Description';
{ TProjectVariablesForm }
procedure TProjectVariablesForm.ProjectVariablesFormShow(Sender: TObject);
begin
SGVariables.Cells[0,0]:=SVariable;
SGVariables.Cells[1,0]:=SValue;
SGVariables.Cells[2,0]:=SDescription;
end;
procedure TProjectVariablesForm.BOKClick(Sender: TObject);
Var
N,V : String;
I : Integer;
begin
For I:=0 to FVariables.Count-1 do
begin
FVariables.GetNameValue(I,N,V);
V:=SGVariables.Cells[1,I+1];
FVariables[i]:=N+'='+V;
end;
end;
procedure TProjectVariablesForm.BConfig1Click(Sender: TObject);
begin
With TTemplateSettingsForm.Create(Self) do
try
Templates:=Self.Templates;
If ShowModal=MROK then
SettingsChanged:=True;
Finally
Free;
end;
end;
procedure TProjectVariablesForm.SetVariables(const AValue: TStrings);
Var
N,V : String;
I : Integer;
begin
FVariables:=AValue;
SGVariables.RowCount:=FVariables.Count+1;
For I:=1 to FVariables.Count do
begin
FVariables.GetNameValue(I-1,N,V);
SGVariables.Cells[0,I]:=N;
SGVariables.Cells[1,I]:='';
SGVariables.Cells[2,I]:=V;
end;
end;
function TProjectVariablesForm.GetProjectDir: String;
begin
Result:=DEProject.Text;
end;
function TProjectVariablesForm.GetProjectName: String;
begin
Result:=EProjectName.Text;
end;
initialization
{$I frmtemplatevariables.lrs}
end.

View File

@ -0,0 +1,247 @@
unit IDETemplateProject;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
ProjectTemplates, ProjectIntf, LazIDEIntf;
type
{ TTemplateProjectDescriptor }
TTemplateProjectDescriptor = class(TProjectDescriptor)
Private
FTemplate : TProjectTemplate;
FProjectDirectory : String;
FProjectName : String;
FVariables : TStrings;
Function ShowOptionsDialog : TModalResult;
public
constructor Create(ATemplate : TProjectTemplate);
destructor destroy; override;
Function DoInitDescriptor : TModalResult; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function InitProject(AProject: TLazProject) : TModalResult; override;
function CreateStartFiles(AProject: TLazProject) : TModalResult; override;
Property template : TProjectTemplate Read FTemplate Write FTemplate;
published
{ Published declarations }
end;
procedure Register;
implementation
uses frmtemplateVariables,ConfigStorage,newitemintf;
Var
TemplateProjectDescriptor : TTemplateProjectDescriptor;
IDETemplates : TProjectTemplates;
Const
STemplateCategory = 'Template projects';
Procedure RegisterTemplateCategory;
begin
NewIDEItems.Add(STemplateCategory);
end;
procedure RegisterTemplateProject(ATemplate : TProjectTemplate);
var
ProjDesc: TTemplateProjectDescriptor;
begin
ProjDesc:=TTemplateProjectDescriptor.Create(Atemplate);
RegisterProjectDescriptor(ProjDesc,STemplateCategory);
end;
Function GetTemplateDir : String;
begin
With GetIDEConfigStorage('projtemplate.xml',True) do
try
Result:=GetValue('TemplateDir',IncludeTrailingPathDelimiter(LazarusIDE.GetPrimaryConfigPath)+'templates');
Finally
Free;
end;
end;
procedure Register;
Var
I : Integer;
D : String;
begin
D:=GetTemplateDir;
IDETemplates:=TProjectTemplates.Create(D);
RegisterTemplateCategory;
For I:=0 to IDETemplates.Count-1 do
RegisterTemplateProject(IDETemplates[i]);
end;
procedure SaveTemplateSettings;
begin
With GetIDEConfigStorage('projtemplate.xml',False) do
try
SetValue('TemplateDir',IDETemplates.TemplateDir);
WriteToDisk;
Finally
Free;
end;
end;
{ TTemplateProjectDescriptor }
function TTemplateProjectDescriptor.ShowOptionsDialog : TModalResult;
var
I: Integer;
begin
With TProjectVariablesForm.Create(Application) do
try
FVariables.Assign(FTemplate.Variables);
I:=FVariables.IndexOfName('ProjName');
if (I<>-1) then
FVariables.Delete(I);
I:=FVariables.IndexOfName('ProjDir');
if (I<>-1) then
FVariables.Delete(I);
Templates:=Templates;
Variables:=FVariables;
Result:=ShowModal;
if Result=mrOK then
begin
FProjectDirectory:=IncludeTrailingPathDelimiter(ProjectDir);
FProjectName:=ProjectName;
FVariables.Values['ProjName']:=FProjectName;
FVariables.Values['ProjDir']:=FProjectDirectory;
end;
if SettingsChanged then
SaveTemplateSettings;
finally
Free;
end;
end;
constructor TTemplateProjectDescriptor.Create(ATemplate : TProjectTemplate);
begin
inherited Create;
FTemplate:=ATemplate;
If Assigned(FTemplate) then
Name:=FTemplate.Name
else
Name:='Template Project';
FVariables:=TStringList.Create;
end;
destructor TTemplateProjectDescriptor.destroy;
begin
FTemplate:=Nil;
FreeAndNil(FVariables);
Inherited;
end;
function TTemplateProjectDescriptor.GetLocalizedName: string;
begin
Result:=FTemplate.Name;
end;
function TTemplateProjectDescriptor.GetLocalizedDescription: string;
begin
Result:=FTemplate.Description;
end;
function TTemplateProjectDescriptor.DoInitDescriptor: TModalResult;
begin
Result:=ShowOptionsDialog;
If (Result=mrOK) then
FTemplate.CreateProject(FProjectDirectory,FVariables);
end;
function TTemplateProjectDescriptor.InitProject(AProject: TLazProject) : TModalResult;
Var
I : Integer;
AFile: TLazProjectFile;
FN : String;
B : Boolean;
RFN : String;
L : TStringList;
begin
AProject.AddPackageDependency('FCL');
AProject.AddPackageDependency('LCL');
AProject.Title:=FProjectName;
If Assigned(FTemplate) then
begin
FTemplate.CreateProjectDirs(FProjectDirectory,FVariables);
AProject.ProjectInfoFile:=FProjectDirectory+FProjectName+'.lpi';
For I:=0 to FTemplate.FileCount-1 do
begin
FN:=FTemplate.FileNames[I];
B:=CompareText(ExtractFileExt(FN),'.lpr')=0;
If B then
begin
FN:=FProjectDirectory+FTemplate.TargetFileName(FN,FVariables);
AFile:=AProject.CreateProjectFile(FN);
AFile.IsPartOfProject:=true;
AProject.AddFile(AFile,Not B);
AProject.MainFileID:=0;
L:=TstringList.Create;
try
FTemplate.CreateFile(I,L,FVariables);
AFile.SetSourceText(L.Text);
Finally
L.Free;
end;
end;
end;
Result:=mrOK;
end
else
Result:=mrCancel;
end;
Function TTemplateProjectDescriptor.CreateStartFiles(AProject: TLazProject) : TModalresult;
Var
I : Integer;
E,FN,FN2 : String;
B : Boolean;
begin
if Assigned(FTemplate) then
begin
Result:=mrOK;
For I:=0 to FTemplate.FileCount-1 do
begin
FN:=FTemplate.FileNames[I];
E:=ExtractFileExt(FN);
If (CompareText(E,'.lpr')<>0)
and (CompareText(E,'.lfm')<>0) then
begin
FN:=FProjectDirectory+FTemplate.TargetFileName(FN,FVariables);
LazarusIDE.DoOpenEditorFile(FN,-1,[ofAddToProject]);
end;
end;
end
else
Result:=mrCancel;
end;
end.

View File

@ -0,0 +1,454 @@
unit ProjectTemplates;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, IniFiles;
type
{ TProjectTemplates }
TProjectTemplate = Class(TCollectionItem)
private
FAuthor: String;
FDescription: String;
FDirectory: String;
FExclude: String;
FName: String;
FRecurse: Boolean;
FFiles : TStrings;
FVariables: TStrings;
function GetFileCount: Integer;
function GetFileName(FileIndex : Integer): String;
procedure SetVariables(const AValue: TStrings);
procedure GetFileList(Const Dir : String);
Protected
procedure InitFromDir(Const DirName : String);
procedure CopyAndSubstituteDir(Const SrcDir,DestDir : String; Values : TStrings);
procedure CopyAndSubstituteFile(Const SrcFN,DestFN : String; Values : Tstrings);
Public
constructor Create(ACollection: TCollection); override;
Destructor Destroy; override;
Procedure CreateProject(Const ProjectDir : String; Values : TStrings);
Procedure CreateFile(FileIndex : Integer; Source,Values : TStrings);
Procedure CreateFile(Const FileName: String; Source,Values : TStrings);
Procedure CreateProjectDirs(Const BaseDir : String; Values : TStrings);
Function TargetFileName(FN : String; Values : TStrings) : String;
Function TargetFileName(I : Integer; Values : TStrings) : String;
Property FileCount : Integer read GetFileCount;
Property FileNames[FileIndex : Integer] : String Read GetFileName;
published
Property Name : String Read FName;
Property Directory : String Read FDirectory;
Property Description : String Read FDescription Write FDescription;
Property Variables : TStrings Read FVariables Write SetVariables;
Property Author : String Read FAuthor;
Property Recurse : Boolean Read FRecurse;
Property Exclude : String Read FExclude;
end;
{ TProjectTemplates }
TProjectTemplates = class(TCollection)
private
FTemplateDir: String;
function GetTemplate(Index : Integer): TProjectTemplate;
function GetTemplateName(Index : Integer): String;
procedure SetTemplate(Index : Integer; const AValue: TProjectTemplate);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(Const ATemplateDir : String);
Procedure Initialize(Const ATemplateDir : String);
Procedure CreateProject(Const ProjectName, ProjectDir : String; Variables : TStrings);
Function IndexOfProject(Const ProjectName : String) : Integer;
Function ProjectTemplateByName(Const ProjectName : String) : TProjectTemplate;
Property TemplateDir : String Read FTemplateDir;
Property Names [Index : Integer] : String Read GetTemplateName;
Property Templates[Index : Integer] : TProjectTemplate Read GetTemplate Write SetTemplate;default;
end;
ETemplateError=Class(Exception);
Const
// Section & Key names for ini file.
SProject = 'Project';
SVariables = 'Variables';
KeyName = 'Name';
KeyAuthor = 'Author';
KeyDescription = 'Description';
KeyRecurse = 'Recurse';
KeyExclude = 'Exclude';
Function SubstituteString(Const S : String; Variables : TStrings): String;
Function SimpleFileCopy(Const Source,Dest : String) : Boolean;
implementation
resourcestring
SErrNoSuchTemplate = '"%s": No such template.';
SErrCouldNotCreateDir = 'Could not create directory "%s"';
SErrFailedToCopyFile = 'Failed to copy file "%s" to "%s"';
{ Auxiliary function }
Function SubstituteString(Const S : String; Variables : TStrings): String;
Var
T : String;
P : Integer;
begin
T:=S;
Result:='';
Repeat
P:=Pos('$(',T);
If (P=0) then
begin
Result:=Result+T;
T:='';
end
else
begin
Result:=Result+Copy(T,1,P-1);
Delete(T,1,P+1);
P:=Pos(')',T);
If (P=0) then
begin
Result:=Result+'$('+T;
T:='';
end
else
begin
Result:=Result+Variables.Values[Copy(T,1,P-1)];
Delete(T,1,P);
end;
end;
until (T='');
end;
Function SimpleFileCopy(Const Source,Dest : String) : Boolean;
begin
Result:=True;
end;
{ TProjectTemplates }
function TProjectTemplates.GetTemplateName(Index : Integer): String;
begin
Result:=GetTemplate(Index).Name;
end;
function TProjectTemplates.GetTemplate(Index : Integer): TProjectTemplate;
begin
Result:=Items[Index] as TProjectTemplate
end;
procedure TProjectTemplates.SetTemplate(Index : Integer;
const AValue: TProjectTemplate);
begin
Items[Index]:=AValue;
end;
constructor TProjectTemplates.Create(const ATemplateDir: String);
begin
Inherited Create(TProjectTemplate);
Initialize(ATemplateDir);
end;
function TProjectTemplates.IndexOfProject(const ProjectName: String): Integer;
begin
Result:=Count-1;
While (Result>=0) and (CompareText(GetTemplate(Result).Name,ProjectName)<>0) do
Dec(Result)
end;
function TProjectTemplates.ProjectTemplateByName(const ProjectName: String): TProjectTemplate;
Var
Index : Integer;
begin
Index:=IndexOfProject(ProjectName);
If (Index=-1) then
Raise ETemplateError.CreateFmt(SErrNoSuchTemplate,[ProjectName]);
Result:=GetTemplate(Index);
end;
procedure TProjectTemplates.Initialize(const ATemplateDir: String);
Var
Info : TSearchRec;
D : String;
begin
Clear;
FTemplateDir:=IncludeTrailingPathDelimiter(ATemplateDir);
D:=FTemplateDir;
If FindFirst(D+'*',faDirectory,Info)=0 then
try
Repeat
If ((Info.Attr and faDirectory)<>0)
and not ((Info.Name='.') or (Info.Name='..')) then
With Add as TProjectTemplate do
InitFromDir(D+Info.Name);
Until FindNext(Info)<>0;
finally
FindClose(Info);
end;
end;
procedure TProjectTemplates.CreateProject(const ProjectName, ProjectDir: String; Variables : Tstrings);
Var
T : TProjectTemplate;
begin
T:=ProjectTemplateByName(ProjectName);
T.CreateProject(ProjectDir,Variables);
end;
{ TProjectTemplate }
constructor TProjectTemplate.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FVariables:=TStringList.Create;
FFiles:=TStringList.Create;
end;
destructor TProjectTemplate.Destroy;
begin
FreeAndNil(FVariables);
FreeAndNil(FFiles);
inherited Destroy;
end;
procedure TProjectTemplate.SetVariables(const AValue: TStrings);
begin
FVariables.Assign(AValue);
end;
function TProjectTemplate.GetFileName(FileIndex : Integer): String;
begin
Result:=FFiles[FileIndex];
end;
function TProjectTemplate.GetFileCount: Integer;
begin
Result:=FFiles.Count;
end;
procedure TProjectTemplate.InitFromDir(const DirName: String);
Var
L : TStringList;
FN : String;
begin
FDirectory:=IncludeTrailingPathDelimiter(DirName);
L:=TStringList.Create;
Try
FN:=FDirectory+'project.ini';
If FileExists(FN) then
begin
With TMemInifile.Create(FN) do
try
FName:=ReadString(SProject,KeyName,DirName);
FAuthor:=ReadString(SProject,KeyAuthor,'');
FDescription:=ReadString(SProject,KeyDescription,'');
FRecurse:=ReadBool(SProject,KeyRecurse,False);
FExclude:=ReadString(SProject,KeyExclude,'');
If (FExclude<>'') then
FExclude:=FExclude+',';
ReadSectionValues(SVariables,FVariables);
Finally
Free;
end;
end;
FN:=Directory+'description.txt';
If FileExists(FN) then
begin
L.LoadFromFile(FN);
FDescription:=L.Text;
end;
GetFileList(FDirectory);
Finally
L.Free;
end;
end;
procedure TProjectTemplate.CreateFile(FileIndex: Integer; Source, Values: TStrings);
begin
CreateFile(FileNames[FileIndex],Source,Values);
end;
procedure TProjectTemplate.CreateFile(const FileName: String; Source,
Values: TStrings);
Var
F : Text;
Line : String;
begin
AssignFile(F,FileName);
Reset(F);
Try
While not EOF(F) do
begin
ReadLn(F,Line);
Source.Add(SubstituteString(Line,Values));
end;
Finally
CloseFile(F);
end;
end;
procedure TProjectTemplate.CreateProjectDirs(const BaseDir: String; Values : TStrings);
Var
RFN : String;
I : Integer;
begin
If not ForceDirectories(BaseDir) then
Raise ETemplateError.CreateFmt(SErrCouldNotCreateDir,[BaseDir]);
For I:=0 to FileCount-1 do
begin
RFN:=ExtractRelativePath(Directory,FileNames[i]);
RFN:=SubstituteString(ExtractFilePath(RFN),Values);
If (RFN<>'') Then
If not ForceDirectories(BaseDir+RFN) then
Raise ETemplateError.CreateFmt(SErrCouldNotCreateDir,[BaseDir+RFN]);
end;
end;
function TProjectTemplate.TargetFileName(FN: String; Values: TStrings): String;
Var
RFN : String;
begin
Result:=ExtractRelativePath(Directory,FN);
Result:=SubstituteString(Result,Values);
end;
function TProjectTemplate.TargetFileName(I: Integer; Values: TStrings): String;
begin
Result:=TargetFileName(FileNames[I],Values);
end;
procedure TProjectTemplate.CopyAndSubstituteFile(Const SrcFN,DestFN : String; Values : Tstrings);
Var
L : TStrings;
begin
If pos(ExtractFileExt(SrcFN)+',',Exclude)<>0 then
begin
If not SimpleFileCopy(SrcFN,DestFN) then
Raise ETemplateError.CreateFmt(SErrFailedToCopyFile,[SrcFN,DestFN]);
end
else
begin
L:=TstringList.Create;
try
CreateFile(SrcFN,L,Values);
L.SaveToFile(DestFN);
Finally
L.Free;
end;
end;
end;
procedure TProjectTemplate.GetFileList(Const Dir : String);
Var
Info : TSearchRec;
begin
If FindFirst(Dir+'*',0,Info)=0 then
try
repeat
if (info.name<>'description.txt') and (info.name<>'project.ini') then
FFiles.Add(Dir+Info.Name);
Until (FindNext(Info)<>0);
finally
FindClose(Info);
end;
if Recurse then
If (FindFirst(Dir+'*',0,Info)<>0) then
try
repeat
if ((Info.attr and faDirectory)<>0) and
(Info.Name<>'.') and (info.Name<>'..') then
GetFileList(Dir+Info.Name+PathSeparator);
until FindNext(Info)<>0;
finally
FindClose(Info);
end;
end;
procedure TProjectTemplate.CopyAndSubstituteDir(Const SrcDir,DestDir : String; Values: Tstrings);
Var
D1,D2 : String;
Info : TSearchRec;
begin
D1:=IncludeTrailingPathDelimiter(SrcDir);
D2:=IncludeTrailingPathDelimiter(DestDir);
If not ForceDirectories(D2) then
Raise ETemplateError.CreateFmt(SErrCouldNotCreateDir,[D2]);
If FindFirst(D1+'*',0,Info)=0 then
try
repeat
if (info.name<>'description.txt')
and (info.name<>'project.ini') then
CopyAndSubstituteFile(D1+Info.Name,D2+SubstituteString(Info.Name,Values),Values);
Until (FindNext(Info)<>0);
finally
FindClose(Info);
end;
if Recurse then
If (FindFirst(D1+'*',0,Info)<>0) then
try
repeat
if ((Info.attr and faDirectory)<>0) and
(Info.Name<>'.') and (info.Name<>'..') then
CopyAndSubstituteDir(D1+Info.Name,D2+SubstituteString(Info.Name,Values),Values);
until FindNext(Info)<>0;
finally
FindClose(Info);
end;
end;
procedure TProjectTemplate.CreateProject(const ProjectDir: String;
Values: TStrings);
begin
CopyAndSubstituteDir(Directory,ProjectDir,Values);
end;
end.

View File

@ -0,0 +1,77 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="ProjTemplates"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="IDE extension to create projects based on project templates
"/>
<License Value="Modified LGPL as per the FCL license
"/>
<Version Major="1"/>
<Files Count="8">
<Item1>
<Filename Value="projecttemplates.pp"/>
<UnitName Value="ProjectTemplates"/>
</Item1>
<Item2>
<Filename Value="idetemplateproject.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="IDETemplateProject"/>
</Item2>
<Item3>
<Filename Value="frmtemplatevariables.lfm"/>
<Type Value="LFM"/>
</Item3>
<Item4>
<Filename Value="frmtemplatevariables.lrs"/>
<Type Value="LRS"/>
</Item4>
<Item5>
<Filename Value="frmtemplatevariables.pas"/>
<UnitName Value="frmTemplateVariables"/>
</Item5>
<Item6>
<Filename Value="frmtemplatesettings.lfm"/>
<Type Value="LFM"/>
</Item6>
<Item7>
<Filename Value="frmtemplatesettings.lrs"/>
<Type Value="LRS"/>
</Item7>
<Item8>
<Filename Value="frmtemplatesettings.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="frmtemplatesettings"/>
</Item8>
</Files>
<Type Value="DesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit ProjTemplates;
interface
uses
ProjectTemplates, IDETemplateProject, frmTemplateVariables,
LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('IDETemplateProject', @IDETemplateProject.Register);
end;
initialization
RegisterPackage('ProjTemplates', @Register);
end.