paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 09:38:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

added packagemanager and added config dialog for custom components from Tony

Browse Source 
git-svn-id: trunk@2912 -
This commit is contained in:
mattias 2002-08-18 08:55:58 +00:00
parent fe283f06e8
commit 38554d5f38
10 changed files with 1043 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitattributes vendored
View File

@ -719,11 +719,19 @@ lcl/utrace.pp svneol=native#text/pascal
lcl/vclglobals.pp svneol=native#text/pascal
/localize.sh -text svneol=native#application/x-sh
packager/addfiletoapackagedlg.pas svneol=native#text/pascal
packager/basepkgmanager.pas svneol=native#text/pascal
packager/brokendependenciesdlg.pas svneol=native#text/pascal
packager/lazaruspackageintf.pas svneol=native#text/pascal
packager/packagedefs.pas svneol=native#text/pascal
packager/packageeditor.pas svneol=native#text/pascal
packager/pkggraphexporer.pas svneol=native#text/pascal
packager/pkgmanager.pas svneol=native#text/pascal
packager/ucomponentmanmain.lfm svneol=native#text/plain
packager/ucomponentmanmain.lrs svneol=native#text/pascal
packager/ucomponentmanmain.pas svneol=native#text/pascal
packager/ufrmaddcomponent.lfm svneol=native#text/plain
packager/ufrmaddcomponent.lrs svneol=native#text/pascal
packager/ufrmaddcomponent.pas svneol=native#text/pascal
tools/RunAndWait.sh -text svneol=native#application/x-sh
tools/apiwizz/apiwizard.pp svneol=native#text/pascal
tools/apiwizz/apiwizz.pp svneol=native#text/pascal

40
ide/main.pp
View File

@ -45,8 +45,8 @@ uses
// fpc packages
Classes, SysUtils, Process, TypInfo,
// lcl
LCLType, LclLinux, LMessages, StdCtrls, Forms, Buttons, Menus, ComCtrls, Spin,
FileCtrl, Controls, Graphics, GraphType, ExtCtrls, Dialogs,
LCLType, LclLinux, LMessages, LResources, StdCtrls, Forms, Buttons, Menus,
ComCtrls, Spin, FileCtrl, Controls, Graphics, GraphType, ExtCtrls, Dialogs,
// codetools
CodeToolManager, CodeCache, DefineTemplates,
// synedit
@ -62,16 +62,16 @@ uses
Debugger, DBGOutputForm, GDBMIDebugger, RunParamsOpts, Watchesdlg,
BreakPointsdlg, DebuggerDlg, LocalsDlg,
// packager
PackageDefs, PackageEditor,
PkgManager, BasePkgManager,
// source editing
UnitEditor, EditDefineTree, CodeToolsOptions, IDEOptionDefs, CodeToolsDefines,
DiffDialog, DiskDiffsDialog, UnitInfoDlg, EditorOptions,
DiffDialog, DiskDiffsDialog, UnitInfoDlg, EditorOptions, ViewUnit_dlg,
// rest ide
LazarusIDEStrConsts, LazConf, MsgView, EnvironmentOpts,
TransferMacros, KeyMapping, IDEProcs, ExtToolDialog, ExtToolEditDlg,
MacroPromptDlg, OutputFilter, BuildLazDialog, MiscOptions,
InputHistory, UnitDependencies, ClipBoardHistory, ProcessList,
InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList,
InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList, AboutFrm,
// main ide
BaseDebugManager, DebugManager, MainBar;
@ -186,6 +186,8 @@ type
procedure mnuStopProjectClicked(Sender : TObject);
procedure mnuRunParametersClicked(Sender : TObject);
procedure mnuProjectCompilerSettingsClicked(Sender : TObject);
// components menu
// tools menu
procedure mnuToolConfigureClicked(Sender : TObject);
@ -360,6 +362,7 @@ type
procedure SetupViewMenu; override;
procedure SetupProjectMenu; override;
procedure SetupRunMenu; override;
procedure SetupComponentsMenu; override;
procedure SetupToolsMenu; override;
procedure SetupEnvironmentMenu; override;
procedure SetupWindowsMenu; override;
@ -589,7 +592,7 @@ const
implementation
uses
ViewUnit_dlg, Math, LResources, aboutfrm;
Math;
//==============================================================================
{
@ -802,10 +805,13 @@ begin
ConnectMainBarEvents;
end;
// initialize the other IDE manager
// initialize the other IDE managers
DebugBoss:=TDebugManager.Create(Self);
DebugBoss.ConnectMainBarEvents;
PkgBoss:=TPkgManager.Create(Self);
PkgBoss.ConnectMainBarEvents;
// setup the rest ...
LoadMenuShortCuts;
SetupComponentTabs;
SetupOutputFilter;
@ -1325,6 +1331,11 @@ begin
mnuRun.Caption := lisMenuRun;
mnuMain.Items.Add(mnuRun);
mnuComponents := TMenuItem.Create(Self);
mnuComponents.Name:='mnuComponents';
mnuComponents.Caption := lisMenuComponents;
mnuMain.Items.Add(mnuComponents);
mnuTools := TMenuItem.Create(Self);
mnuTools.Name:='mnuTools';
mnuTools.Caption := lisMenuTools;
@ -1351,6 +1362,7 @@ begin
SetupViewMenu;
SetupProjectMenu;
SetupRunMenu;
SetupComponentsMenu;
SetupToolsMenu;
SetupEnvironmentMenu;
SetupWindowsMenu;
@ -1503,6 +1515,11 @@ begin
itmProjectRunParameters.OnClick := @mnuRunParametersClicked;
end;
procedure TMainIDE.SetupComponentsMenu;
begin
inherited SetupComponentsMenu;
end;
procedure TMainIDE.SetupToolsMenu;
begin
inherited;
@ -1842,6 +1859,9 @@ begin
ecCompleteCode:
DoCompleteCodeAtCursor;
ecConfigCustomComps:
PkgBoss.ShowConfigureCustomComponents;
ecExtToolFirst..ecExtToolLast:
DoRunExternalTool(Command-ecExtToolFirst);
@ -1875,6 +1895,9 @@ begin
ecToggleObjectInsp:
mnuViewInspectorClicked(Self);
ecAboutLazarus:
mnuHelpAboutLazarusClicked(Self);
else
Handled:=false;
@ -8100,6 +8123,9 @@ end.
{ =============================================================================
$Log$
Revision 1.503 2003/04/01 17:29:36 mattias
added packagemanager and added config dialog for custom components from Tony
Revision 1.502 2003/04/01 16:25:45 mattias
started packageeditor and packagelinks

68
packager/basepkgmanager.pas Normal file
View File

@ -0,0 +1,68 @@
{ $Id$ }
{
/***************************************************************************
basepkgmanager.pas
------------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
TBasePkgManager is the base class for TPkgManager, which controls the whole
package system in the IDE. The base class is mostly abstract.
}
unit BasePkgManager;
{$mode objfpc}{$H+}
interface
{$I ide.inc}
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms;
type
TBasePkgManager = class(TComponent)
public
procedure ConnectMainBarEvents; virtual; abstract;
procedure ConnectSourceNotebookEvents; virtual; abstract;
procedure SetupMainBarShortCuts; virtual; abstract;
function ShowConfigureCustomComponents: TModalResult; virtual; abstract;
end;
var
PkgBoss: TBasePkgManager;
implementation
initialization
PkgBoss:=nil;
end.

107
packager/pkgmanager.pas Normal file
View File

@ -0,0 +1,107 @@
{ $Id$ }
{
/***************************************************************************
pkgmanager.pas
--------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
TPkgManager is the class for the global PkgBoss variable, which controls
the whole package system in the IDE.
}
unit PkgManager;
{$mode objfpc}{$H+}
interface
{$I ide.inc}
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms, KeyMapping, EnvironmentOpts,
UComponentManMain, PackageEditor, PackageDefs, PackageLinks, BasePkgManager,
MainBar;
type
TPkgManager = class(TBasePkgManager)
procedure mnuConfigCustomCompsClicked(Sender: TObject);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure ConnectMainBarEvents; override;
procedure ConnectSourceNotebookEvents; override;
procedure SetupMainBarShortCuts; override;
function ShowConfigureCustomComponents: TModalResult; override;
end;
implementation
{ TPkgManager }
procedure TPkgManager.mnuConfigCustomCompsClicked(Sender: TObject);
begin
ShowConfigureCustomComponents;
end;
constructor TPkgManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
end;
destructor TPkgManager.Destroy;
begin
inherited Destroy;
end;
procedure TPkgManager.ConnectMainBarEvents;
begin
with MainIDE do begin
itmCompsConfigCustomComps.OnClick :=@mnuConfigCustomCompsClicked;
end;
end;
procedure TPkgManager.ConnectSourceNotebookEvents;
begin
end;
procedure TPkgManager.SetupMainBarShortCuts;
begin
end;
function TPkgManager.ShowConfigureCustomComponents: TModalResult;
begin
Result:=ShowConfigureCustomComponentDlg(EnvironmentOptions.LazarusDirectory);
end;
end.

151
packager/ucomponentmanmain.lfm Normal file
View File

@ -0,0 +1,151 @@
object FrmComponentMan: TFrmComponentMan
CAPTION = 'Component Manager for Lazarus'
CLIENTHEIGHT = 244
CLIENTWIDTH = 465
ONCREATE = FrmMainCREATE
ONDESTROY = FrmMainDESTROY
ONSHOW = FrmMainSHOW
HORZSCROLLBAR.PAGE = 466
VERTSCROLLBAR.PAGE = 245
LEFT = 374
HEIGHT = 244
TOP = 171
WIDTH = 465
object ListComps: TLISTBOX
ANCHORS = [aktop, akleft]
ONCLICK = ListCompsCLICK
SORTED = True
TABSTOP = True
TOPINDEX = -1
LEFT = 12
HEIGHT = 184
TOP = 28
WIDTH = 224
end
object Label1: TLABEL
AUTOSIZE = True
ANCHORS = [aktop, akleft]
CAPTION = 'Installed Components:'
LAYOUT = tltop
LEFT = 12
HEIGHT = 14
TOP = 8
WIDTH = 130
end
object Button1: TBUTTON
ANCHORS = [aktop, akleft]
CAPTION = 'Add New'
TABSTOP = True
TABORDER = 2
ONCLICK = Button1CLICK
LEFT = 12
HEIGHT = 15
TOP = 220
WIDTH = 75
end
object BtnRemove: TBUTTON
ANCHORS = [aktop, akleft]
CAPTION = 'Remove'
TABSTOP = True
TABORDER = 3
ONCLICK = BtnRemoveCLICK
LEFT = 161
HEIGHT = 15
TOP = 220
WIDTH = 75
end
object Label2: TLABEL
AUTOSIZE = True
ANCHORS = [aktop, akleft]
CAPTION = 'Component Name:'
LAYOUT = tltop
LEFT = 248
HEIGHT = 14
TOP = 28
WIDTH = 113
end
object Label3: TLABEL
AUTOSIZE = True
ANCHORS = [aktop, akleft]
CAPTION = 'Pascal Unit:'
LAYOUT = tltop
LEFT = 248
HEIGHT = 14
TOP = 132
WIDTH = 77
end
object Label4: TLABEL
AUTOSIZE = True
ANCHORS = [aktop, akleft]
CAPTION = 'Page:'
LAYOUT = tltop
LEFT = 248
HEIGHT = 16
TOP = 80
WIDTH = 83
end
object BtnCancel: TBITBTN
KIND = bkcancel
SPACING = 3
ANCHORS = [aktop, akleft]
MODALRESULT = 2
CAPTION = 'Cancel'
TABSTOP = True
TABORDER = 7
ONCLICK = BtnCancelCLICK
LEFT = 384
HEIGHT = 25
TOP = 212
WIDTH = 75
end
object Bitbtn2: TBITBTN
KIND = bkok
SPACING = 3
ANCHORS = [aktop, akleft]
DEFAULT = True
MODALRESULT = 1
CAPTION = 'Save'
TABSTOP = True
TABORDER = 8
ONCLICK = Bitbtn2CLICK
LEFT = 292
HEIGHT = 25
TOP = 212
WIDTH = 75
end
object LblComponent: TLABEL
ANCHORS = [aktop, akleft]
CAPTION = 'LblComponent'
LAYOUT = tltop
LEFT = 266
HEIGHT = 17
TOP = 48
WIDTH = 193
end
object LblUnit: TLABEL
ANCHORS = [aktop, akleft]
CAPTION = 'LblUnit'
LAYOUT = tltop
LEFT = 264
HEIGHT = 17
TOP = 156
WIDTH = 196
end
object TxtPage: TEDIT
ANCHORS = [aktop, akleft]
ONCHANGE = TxtPageCHANGE
TABSTOP = True
TABORDER = 11
LEFT = 264
HEIGHT = 23
TOP = 100
WIDTH = 192
end
object DlgLoad: TOPENDIALOG
OPTIONS = [ofenablesizing, ofviewdetail]
FILTER = '*.pp|*.pas'
FILTERINDEX = 0
left = 12
top = 416
end
end

43
packager/ucomponentmanmain.lrs Normal file
View File

@ -0,0 +1,43 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TFrmComponentMan','FORMDATA',[
'TPF0'#16'TFrmComponentMan'#15'FrmComponentMan'#7'CAPTION'#6#29'Component Man'
+'ager for Lazarus'#12'CLIENTHEIGHT'#3#244#0#11'CLIENTWIDTH'#3#209#1#8'ONCREA'
+'TE'#7#13'FrmMainCREATE'#9'ONDESTROY'#7#14'FrmMainDESTROY'#6'ONSHOW'#7#11'Fr'
+'mMainSHOW'#18'HORZSCROLLBAR.PAGE'#3#210#1#18'VERTSCROLLBAR.PAGE'#3#245#0#4
+'LEFT'#3'v'#1#6'HEIGHT'#3#244#0#3'TOP'#3#171#0#5'WIDTH'#3#209#1#0#8'TLISTBOX'
+#9'ListComps'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'ONCLICK'#7#14'ListCompsCL'
+'ICK'#6'SORTED'#9#7'TABSTOP'#9#8'TOPINDEX'#2#255#4'LEFT'#2#12#6'HEIGHT'#3#184
+#0#3'TOP'#2#28#5'WIDTH'#3#224#0#0#0#6'TLABEL'#6'Label1'#8'AUTOSIZE'#9#7'ANCH'
+'ORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#21'Installed Components:'#6'LAYOU'
+'T'#7#5'tltop'#4'LEFT'#2#12#6'HEIGHT'#2#14#3'TOP'#2#8#5'WIDTH'#3#130#0#0#0#7
+'TBUTTON'#7'Button1'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#7'Add N'
+'ew'#7'TABSTOP'#9#8'TABORDER'#2#2#7'ONCLICK'#7#12'Button1CLICK'#4'LEFT'#2#12
+#6'HEIGHT'#2#15#3'TOP'#3#220#0#5'WIDTH'#2'K'#0#0#7'TBUTTON'#9'BtnRemove'#7'A'
+'NCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#6'Remove'#7'TABSTOP'#9#8'TABOR'
+'DER'#2#3#7'ONCLICK'#7#14'BtnRemoveCLICK'#4'LEFT'#3#161#0#6'HEIGHT'#2#15#3'T'
+'OP'#3#220#0#5'WIDTH'#2'K'#0#0#6'TLABEL'#6'Label2'#8'AUTOSIZE'#9#7'ANCHORS'
+#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#15'Component Name:'#6'LAYOUT'#7#5'tlto'
+'p'#4'LEFT'#3#248#0#6'HEIGHT'#2#14#3'TOP'#2#28#5'WIDTH'#2'q'#0#0#6'TLABEL'#6
+'Label3'#8'AUTOSIZE'#9#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#12'Pa'
+'scal Unit:'#6'LAYOUT'#7#5'tltop'#4'LEFT'#3#248#0#6'HEIGHT'#2#14#3'TOP'#3#132
+#0#5'WIDTH'#2'M'#0#0#6'TLABEL'#6'Label4'#8'AUTOSIZE'#9#7'ANCHORS'#11#5'aktop'
+#6'akleft'#0#7'CAPTION'#6#5'Page:'#6'LAYOUT'#7#5'tltop'#4'LEFT'#3#248#0#6'HE'
+'IGHT'#2#16#3'TOP'#2'P'#5'WIDTH'#2'S'#0#0#7'TBITBTN'#9'BtnCancel'#4'KIND'#7#8
+'bkcancel'#7'SPACING'#2#3#7'ANCHORS'#11#5'aktop'#6'akleft'#0#11'MODALRESULT'
+#2#2#7'CAPTION'#6#6'Cancel'#7'TABSTOP'#9#8'TABORDER'#2#7#7'ONCLICK'#7#14'Btn'
+'CancelCLICK'#4'LEFT'#3#128#1#6'HEIGHT'#2#25#3'TOP'#3#212#0#5'WIDTH'#2'K'#0#0
+#7'TBITBTN'#7'Bitbtn2'#4'KIND'#7#4'bkok'#7'SPACING'#2#3#7'ANCHORS'#11#5'akto'
+'p'#6'akleft'#0#7'DEFAULT'#9#11'MODALRESULT'#2#1#7'CAPTION'#6#4'Save'#7'TABS'
+'TOP'#9#8'TABORDER'#2#8#7'ONCLICK'#7#12'Bitbtn2CLICK'#4'LEFT'#3'$'#1#6'HEIGH'
+'T'#2#25#3'TOP'#3#212#0#5'WIDTH'#2'K'#0#0#6'TLABEL'#12'LblComponent'#7'ANCHO'
+'RS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#12'LblComponent'#6'LAYOUT'#7#5'tlt'
+'op'#4'LEFT'#3#10#1#6'HEIGHT'#2#17#3'TOP'#2'0'#5'WIDTH'#3#193#0#0#0#6'TLABEL'
+#7'LblUnit'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'CAPTION'#6#7'LblUnit'#6'LAY'
+'OUT'#7#5'tltop'#4'LEFT'#3#8#1#6'HEIGHT'#2#17#3'TOP'#3#156#0#5'WIDTH'#3#196#0
+#0#0#5'TEDIT'#7'TxtPage'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#8'ONCHANGE'#7#13
+'TxtPageCHANGE'#7'TABSTOP'#9#8'TABORDER'#2#11#4'LEFT'#3#8#1#6'HEIGHT'#2#23#3
+'TOP'#2'd'#5'WIDTH'#3#192#0#0#0#11'TOPENDIALOG'#7'DlgLoad'#7'OPTIONS'#11#14
+'ofenablesizing'#12'ofviewdetail'#0#6'FILTER'#6#10'*.pp|*.pas'#11'FILTERINDE'
+'X'#2#0#4'left'#2#12#3'top'#3#160#1#0#0#0
]);

517
packager/ucomponentmanmain.pas Normal file
View File

@ -0,0 +1,517 @@
{ $Id$ }
{***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Anthony Maro
}
unit UComponentManMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons, FileCtrl, IDEProcs, UFrmAddComponent;
Type
TRComponent = class(TObject)
public
Name: String;
Page: String;
unitname: String;
end;
type
TFrmComponentMan = class(TForm)
BtnCancel: TBITBTN;
Bitbtn2: TBITBTN;
Button1: TBUTTON;
BtnRemove: TBUTTON;
DlgLoad: TOPENDIALOG;
TxtPage: TEDIT;
Label1: TLABEL;
Label2: TLABEL;
Label3: TLABEL;
Label4: TLABEL;
LblUnit: TLABEL;
LblComponent: TLABEL;
ListComps: TLISTBOX;
procedure Bitbtn2CLICK(Sender: TObject);
procedure BtnCancelCLICK(Sender: TObject);
procedure BtnRemoveCLICK(Sender: TObject);
procedure Button1CLICK(Sender: TObject);
procedure FrmMainCREATE(Sender: TObject);
procedure FrmMainDESTROY(Sender: TObject);
procedure FrmMainSHOW(Sender: TObject);
procedure ListCompsCLICK(Sender: TObject);
procedure PopulateList;
procedure ParseRegister(ALine: String);
procedure TxtPageCHANGE(Sender: TObject);
procedure MakeHeader;
procedure MakeUses;
procedure MakeRegister;
function CountComponents: Integer;
function GetComponent(I: Integer): String;
function FindUnitName: String;
private
FLazPath: String;
MyFile: TStringList;
procedure SetLazPath(const AValue: String);
{ private declarations }
public
{ public declarations }
property LazPath: String read FLazPath write SetLazPath;
end;
function ShowConfigureCustomComponentDlg(const LazarusDir: string): TModalResult;
implementation
function ShowConfigureCustomComponentDlg(
const LazarusDir: string): TModalResult;
var
FrmComponentMan: TFrmComponentMan;
begin
FrmComponentMan:=TFrmComponentMan.Create(Application);
FrmComponentMan.SetLazPath(LazarusDir);
Result:=FrmComponentMan.ShowModal;
FrmComponentMan.Free;
end;
{ TFrmComponentMan }
procedure TFrmComponentMan.BtnCancelCLICK(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TFrmComponentMan.BtnRemoveCLICK(Sender: TObject);
var
MyObj: TRComponent;
begin
if ListComps.ItemIndex > -1 then begin
MyObj := ListComps.Items.Objects[ListComps.ItemIndex] as TRComponent;
if assigned(MyObj) then MyObj.Free;
ListComps.Items.Delete(ListComps.ItemIndex);
end;
end;
procedure TFrmComponentMan.Button1CLICK(Sender: TObject);
var
I, J: Integer;
Found: Boolean;
MyObj: TRComponent;
begin
DlgLoad.InitialDir := FLazPath+'components/custom';
if DlgLoad.Execute then begin
// load in and parse the source
try
MyFile.Clear;
MyFile.LoadFromFile(DlgLoad.Filename);
except
MessageDlg('Error loading unit!',mtError,[mbCancel],0);
exit;
end;
//MessageDlg('Found '+inttostr(CountComponents), mtInformation,[mbOk],0);
if CountComponents > 30 then begin
// just to save face if something goes wrong...
MessageDlg('More than 30 components is not supported.', mtError, [mbCancel],0);
exit;
end;
FrmAddComponent.ListCompAdd.Clear;
for I := 1 to CountComponents do begin
//MessageDlg(GetComponent(I),mtInformation,[mbOk],0);
// only add if not already in the list
Found := False;
if FrmAddComponent.ListCompAdd.Items.Count > 0 then begin
for J := 0 to FrmAddComponent.ListCompAdd.Items.Count -1 do begin
if uppercase(FrmAddComponent.ListCompAdd.Items[J]) = uppercase(trim(GetComponent(I)))
then Found := True;
end;
end;
if not(Found) then FrmAddComponent.ListCompAdd.Items.Add(trim(GetComponent(I)));
end;
if FrmAddComponent.ShowModal = mrOk then begin
// add selected items...
for I := 0 to FrmAddComponent.ListCompAdd.Items.Count-1 do begin
if FrmAddComponent.ListCompAdd.Selected[i] then begin
// add this one if not already there...
Found := False;
if ListComps.Items.Count > 0 then begin
for J := 0 to ListComps.Items.Count -1 do begin
if Uppercase(FrmAddComponent.ListCompAdd.Items[i]) = uppercase(ListComps.Items[J]) then Found := True;
end;
end; // if listcomps contains items already
if not(Found) then begin
MyObj := TRComponent.Create;
MyObj.Name := FrmAddComponent.ListCompAdd.Items[i];
MyObj.Page := 'Custom';
MyObj.unitname := FindUnitName;
ListComps.Items.AddObject(MyObj.Name, MyObj);
end; // if not found
end; // if listcompadd selected
end; // for I
end; // if showmodal
end;
end;
procedure TFrmComponentMan.Bitbtn2CLICK(Sender: TObject);
begin
// save the file...
MyFile.Clear;
MakeHeader;
MakeUses;
MakeRegister;
try
MyFile.SaveToFile(FLazPath+'components/custom/customidecomps.pas');
except
MessageDlg('Error saving customidecomps.pas!',mtError,[mbCancel],0);
exit;
end;
MessageDlg('Changes saved. Now return to Lazarus and Build the IDE',mtInformation,[mbOk],0);
ModalResult:=mrOk;
end;
procedure TFrmComponentMan.FrmMainCREATE(Sender: TObject);
begin
MyFile := TStringList.Create;
FrmAddComponent := TFrmAddComponent.Create(Self);
end;
procedure TFrmComponentMan.FrmMainDESTROY(Sender: TObject);
begin
MyFile.Free;
FrmAddComponent.Free;
end;
procedure TFrmComponentMan.FrmMainSHOW(Sender: TObject);
var
RegisterFilename: String;
begin
LblComponent.Caption := '';
TxtPage.Text := '';
LblUnit.Caption := '';
// try to load the current customidecomps files
RegisterFilename:=
AppendPathDelim(FLazPath)+'components/custom/customidecomps.pas';
try
MyFile.LoadFromFile(RegisterFilename);
except
on E: Exception do begin
if messagedlg('Error loading '+RegisterFilename+': '+E.Message+#13#10+
'Will start with blank file.', mtError, [mbOk,mbAbort],0)
<>mrOk
then begin
ModalResult:=mrCancel;
end;
MyFile.Clear;
exit;
end;
end;
if ((MyFile.Count < 1)
or (MyFile[0] <> '{ CustomIDEComps generated by Component Manager'))
then begin
if MessageDlg('This appears to be the first time you have used Component Manager.'+#13#10+
'Your original file will be backed up.',
mtConfirmation, [mbOk,mbAbort],0)
<>mrOk
then begin
ModalResult:=mrCancel;
MyFile.Clear;
exit;
end;
MyFile.SaveToFile(ChangeFileExt(RegisterFilename,'.orig'));
end;
// okay got a good file here...
PopulateList;
ListCompsClick(Self);
end;
procedure TFrmComponentMan.ListCompsCLICK(Sender: TObject);
var
MyObj: TRComponent;
begin
if ListComps.ItemIndex < 0 then exit;
MyObj := ListComps.Items.Objects[ListComps.ItemIndex] as TRComponent;
if assigned(MyObj) then begin
LblComponent.Caption := Myobj.Name;
TxtPage.Text := MyObj.Page;
LblUnit.Caption := MyObj.unitname;
end;
end;
procedure TFrmComponentMan.PopulateList;
var
I: Integer;
begin
// search the file for the REGISTER entry and list all components found
for I := 0 to MyFile.Count - 1 do begin
if uppercase(copy(trim(MyFile[I]),1,18)) = 'REGISTERCOMPONENT(' then begin
// got the start here... parse it
ParseRegister(MyFile[I]);
end
end;
end;
procedure TFrmComponentMan.ParseRegister(ALine: String);
var
MyObj: TRComponent;
CompName, CompUnit, CompPage, TempStr, TempLine: String;
begin
// given a line, parse and add the object to the list
TempLine := Trim(ALine);
if copy(TempLine,1,18) = 'RegisterComponent(' then begin
TempStr := copy(TempLine,20,255);
CompPage := copy(TempStr,1,pos('''', TempStr)-1);
TempStr := copy(TempStr,pos('''', TempStr)+3,255);
CompUnit := copy(TempStr,1,pos('''', TempStr)-1);
TempStr := copy(TempStr,pos('''', TempStr)+2,255);
CompName := copy(TempStr,1,pos(')', TempStr)-1);
MyObj := TRComponent.Create;
MyObj.Name := CompName;
MyObj.Page := CompPage;
MyObj.UnitName := CompUnit;
ListComps.Items.AddObject(CompName, MyObj);
end;
end;
procedure TFrmComponentMan.TxtPageCHANGE(Sender: TObject);
var
MyObj: TRComponent;
begin
if ListComps.ItemIndex >= 0 then begin
MyObj := ListComps.Items.Objects[ListComps.ItemIndex] as TRComponent;
if assigned(MyObj) then begin
MyObj.Page := TxtPage.Text;
end;
end;
end;
procedure TFrmComponentMan.MakeHeader;
begin
with MyFile do begin
Add('{ CustomIDEComps generated by Component Manager');
Add(' Last generated '+formatdatetime('MM/DD/YYYY', Now()));
Add(' Component Manager written by Anthony Maro');
Add(' http://tony.maro.net/ tony@maro.net');
Add('}');
Add('unit CustomIDEComps;');
Add('{$mode objfpc}{$H+}');
Add('interface');
end;
end;
procedure TFrmComponentMan.MakeUses;
var
I, J: Integer;
MyObj, MyObj2: TRComponent;
Found: Boolean;
begin
with MyFile do begin
Add('uses');
add('//USES SECTION');
if ListComps.Items.Count > 0 then begin
Add('Classes,');
for I := 0 to ListComps.Items.Count-1 do begin
MyObj := ListComps.Items.Objects[I] as TRComponent;
if assigned(MyObj) then begin
Found := False;
if I > 0 then begin
for J := 0 to I-1 do begin
// see if we already got this one...
MyObj2 := ListComps.Items.Objects[J] as TRComponent;
//messagedlg('Comparing object '+MyObj.Name+' at '+inttostr(I)+' with '+MyObj2.Name, mtInformation,[mbOk],0);
if assigned(MyOBj2) then begin
if MyObj2.UnitName = Myobj.UnitName then Found := True;
end; // if assigned
end; // for J
end; // For I
if not(Found) then add(MyObj.UnitName+',');
end;
end; // for I
// remove last comma
MyFile[MyFile.Count-1] := copy(MyFile[MyFile.Count-1],1,length(MyFile[MyFile.Count-1])-1);
end else add('Classes');
Add(';');
Add('');
Add('type');
Add(' TRegisterComponentProc = procedure(const Page, UnitName:ShortString;');
Add(' ComponentClass: TComponentClass);');
Add('');
Add('procedure RegisterCustomComponents(RegisterComponent: TRegisterComponentProc);');
Add('');
Add('implementation');
Add('');
Add('procedure RegisterCustomComponents(RegisterComponent: TRegisterComponentProc);');
Add('begin');
Add('');
end; // with MyFile
end;
procedure TFrmComponentMan.MakeRegister;
var
I: Integer;
MyObj: TRComponent;
begin
MyFile.Add('//REGISTER');
if ListComps.Items.Count > 0 then begin
for I := 0 to ListComps.Items.Count - 1 do begin
MyObj := ListComps.Items.Objects[I] as TRComponent;
if assigned(MyObj) then begin
MyFile.Add('RegisterComponent('''+MyObj.Page+''','''+MyObj.unitname+''','+MyObj.Name+');');
end;
end;
end;
MyFile.Add('//ENDREGISTER');
MyFile.Add('');
MyFile.Add('end;');
MyFile.Add('end.');
end;
function TFrmComponentMan.CountComponents: Integer;
var
I, J: integer;
Count: Integer;
begin
Count := 0;
if MyFile.Count < 0 then begin
Result := 0;
exit;
end;
for I := 0 to MyFile.Count -1 do begin
// find start of TYPE
if pos('TYPE', uppercase(MyFile[i])) > 0 then begin
//messagedlg('Found TYPE at '+inttostr(i),mtInformation,[mbOk],0);
for J := I+1 to MyFile.Count -1 do begin
if ((pos('= CLASS', uppercase(MyFile[j])) > 0) or
(pos('=CLASS', uppercase(MyFile[j])) > 0)) then begin
// found one!
//messagedlg('Found CLASS'+#13#10+MyFile[J],mtInformation,[mbOk],0);
Count := Count + 1;
end; // if class
if 'IMPLEMENTATION' = uppercase(MyFile[J]) then begin
// that's it
//messagedlg('Found IMPLEMENTATION at '+inttostr(J),mtInformation,[mbOk],0);
Result := Count;
exit;
end;
end; // For J
Result := Count;
exit;
end; // if pos('TYPE');
end; // for I
end;
function TFrmComponentMan.GetComponent(I: Integer): String;
var
K, J: integer;
TempStr: String;
Count: Integer;
begin
Count := 0;
if MyFile.Count < 0 then begin
Result := '';
exit;
end;
for K := 0 to MyFile.Count -1 do begin
// find start of TYPE
if pos('TYPE', uppercase(MyFile[K])) > 0 then begin
for J := K+1 to MyFile.Count -1 do begin
if ((pos('= CLASS', uppercase(MyFile[j])) > 0) or
(pos('=CLASS', uppercase(MyFile[j])) > 0)) then begin
// found one!
Count := Count + 1;
if Count = I then begin
TempStr := copy(MyFile[J],1,pos('=',MyFile[j])-1);
trim(TempStr);
Result := TempStr;
exit;
end;
end; // if class
if 'IMPLEMENTATION' = uppercase(MyFile[J]) then begin
// that's it
//messagedlg('Found IMPLEMENTATION at '+inttostr(J),mtInformation,[mbOk],0);
Result := '';
exit;
end;
end; // For J
Result := '';
exit;
end; // if pos('TYPE');
end; // for I
end;
function TFrmComponentMan.FindUnitName: String;
var
I: Integer;
TempStr: String;
begin
if MyFile.Count < 1 then exit;
for I := 0 to MyFile.Count - 1 do begin
if uppercase(copy(MyFile[i],1,4)) = 'UNIT' then begin
TempStr := copy(MyFile[i],5,64);
TempStr := trim(TempStr);
if copy(TempStr,length(TempStr),1) = ';' then TempStr := copy(TempStr,1,length(TempStr)-1);
Result := TempStr;
exit;
end; // if UNIT found
end; // for I
end;
procedure TFrmComponentMan.SetLazPath(const AValue: String);
begin
if FLazPath=AValue then exit;
FLazPath:=AValue;
end;
initialization
{$I ucomponentmanmain.lrs}
end.

47
packager/ufrmaddcomponent.lfm Normal file
View File

@ -0,0 +1,47 @@
object FrmAddComponent: TFrmAddComponent
CAPTION = 'Select components to add'
CLIENTHEIGHT = 256
CLIENTWIDTH = 228
HORZSCROLLBAR.PAGE = 229
VERTSCROLLBAR.PAGE = 257
LEFT = 415
HEIGHT = 256
TOP = 176
WIDTH = 228
object ListCompAdd: TLISTBOX
ANCHORS = [aktop, akleft]
MULTISELECT = True
SORTED = True
TABSTOP = True
TOPINDEX = -1
HEIGHT = 216
WIDTH = 228
end
object Bitbtn1: TBITBTN
KIND = bkcancel
SPACING = 3
ANCHORS = [aktop, akleft]
MODALRESULT = 2
CAPTION = 'Cancel'
TABSTOP = True
TABORDER = 1
LEFT = 144
HEIGHT = 25
TOP = 224
WIDTH = 75
end
object Bitbtn2: TBITBTN
KIND = bkok
SPACING = 3
ANCHORS = [aktop, akleft]
DEFAULT = True
MODALRESULT = 1
CAPTION = '&OK'
TABSTOP = True
TABORDER = 2
LEFT = 56
HEIGHT = 25
TOP = 224
WIDTH = 75
end
end

16
packager/ufrmaddcomponent.lrs Normal file
View File

@ -0,0 +1,16 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TFrmAddComponent','FORMDATA',[
'TPF0'#16'TFrmAddComponent'#15'FrmAddComponent'#7'CAPTION'#6#24'Select compon'
+'ents to add'#12'CLIENTHEIGHT'#3#0#1#11'CLIENTWIDTH'#3#228#0#18'HORZSCROLLBA'
+'R.PAGE'#3#229#0#18'VERTSCROLLBAR.PAGE'#3#1#1#4'LEFT'#3#159#1#6'HEIGHT'#3#0#1
+#3'TOP'#3#176#0#5'WIDTH'#3#228#0#0#8'TLISTBOX'#11'ListCompAdd'#7'ANCHORS'#11
+#5'aktop'#6'akleft'#0#11'MULTISELECT'#9#6'SORTED'#9#7'TABSTOP'#9#8'TOPINDEX'
+#2#255#6'HEIGHT'#3#216#0#5'WIDTH'#3#228#0#0#0#7'TBITBTN'#7'Bitbtn1'#4'KIND'#7
+#8'bkcancel'#7'SPACING'#2#3#7'ANCHORS'#11#5'aktop'#6'akleft'#0#11'MODALRESUL'
+'T'#2#2#7'CAPTION'#6#6'Cancel'#7'TABSTOP'#9#8'TABORDER'#2#1#4'LEFT'#3#144#0#6
+'HEIGHT'#2#25#3'TOP'#3#224#0#5'WIDTH'#2'K'#0#0#7'TBITBTN'#7'Bitbtn2'#4'KIND'
+#7#4'bkok'#7'SPACING'#2#3#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'DEFAULT'#9#11
+'MODALRESULT'#2#1#7'CAPTION'#6#3'&OK'#7'TABSTOP'#9#8'TABORDER'#2#2#4'LEFT'#2
+'8'#6'HEIGHT'#2#25#3'TOP'#3#224#0#5'WIDTH'#2'K'#0#0#0
]);

53
packager/ufrmaddcomponent.pas Normal file
View File

@ -0,0 +1,53 @@
{ $Id$ }
{***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Anthony Maro
}
unit UFrmAddComponent;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons;
type
TFrmAddComponent = class(TForm)
Bitbtn1: TBITBTN;
Bitbtn2: TBITBTN;
ListCompAdd: TLISTBOX;
private
{ private declarations }
public
{ public declarations }
end;
var
FrmAddComponent: TFrmAddComponent;
implementation
initialization
{$I ufrmaddcomponent.lrs}
end.