paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas

Browse Source 
git-svn-id: trunk@5744 -
This commit is contained in:
mattias 2004-08-05 21:20:47 +00:00
parent ac6e455257
commit 513788c44b
16 changed files with 393 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -304,7 +304,6 @@ debugger/watchpropertydlg.pp svneol=native#text/pascal
designer/abstractcompiler.pp svneol=native#text/pascal
designer/abstracteditor.pp svneol=native#text/pascal
designer/abstractfilesystem.pp svneol=native#text/pascal
designer/abstractformeditor.pp svneol=native#text/pascal
designer/aligncompsdlg.pp svneol=native#text/pascal
designer/changeclassdialog.lfm svneol=native#text/plain
designer/changeclassdialog.lrs svneol=native#text/pascal
@ -622,6 +621,7 @@ ideintf/allideintf.pas svneol=native#text/pascal
ideintf/columndlg.pp svneol=native#text/pascal
ideintf/componenteditors.pas svneol=native#text/pascal
ideintf/componenttreeview.pas svneol=native#text/pascal
ideintf/formeditingintf.pas svneol=native#text/pascal
ideintf/graphpropedits.pas svneol=native#text/pascal
ideintf/helpintf.pas svneol=native#text/pascal
ideintf/idecommands.pas svneol=native#text/pascal

117
designer/abstractformeditor.pp
View File

@ -1,117 +0,0 @@
{
/***************************************************************************
AbstractFormEditor.pp
---------------------
***************************************************************************/
***************************************************************************
* *
* 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. *
* *
***************************************************************************
}
unit AbstractFormEditor;
{$mode objfpc}{$H-}
interface
uses
Classes, TypInfo, Controls;
type
{ Should I include typinfo.pp and use TTypeKind instead of TPropertyType
or use TPropertyType
}
TIComponentInterface = class
public
Function GetComponentType : String; virtual; abstract;
Function GetComponentHandle : LongInt; virtual; abstract;
Function GetParent : TIComponentInterface; virtual; abstract;
Function IsTControl : Boolean; virtual; abstract;
Function GetPropCount : Integer; virtual; abstract;
Function GetPropType(Index : Integer) : TTypeKind; virtual; abstract;
// Function GetPropType(Index : Integer) : TPropertyType; virtual; abstract;
Function GetPropName(Index : Integer) : String; virtual; abstract;
Function GetPropTypebyName(Name : String) : TTypeKind; virtual; abstract;
// Function GetPropTypebyName(Name : String) : TPropertyType; virtual; abstract;
Function GetPropTypeName(Index : Integer) : String; virtual; abstract;
Function GetPropValue(Index : Integer; var Value) : Boolean; virtual; abstract;
Function GetPropValuebyName(Name: String; var Value) : Boolean; virtual; abstract;
Function SetProp(Index : Integer; const Value) : Boolean; virtual; abstract;
Function SetPropbyName(Name : String; const Value) : Boolean; virtual; abstract;
Function GetControlCount: Integer; virtual; abstract;
Function GetControl(Index : Integer): TIComponentInterface; virtual; abstract;
Function GetComponentCount: Integer; virtual; abstract;
Function GetComponent(Index : Integer): TIComponentInterface; virtual; abstract;
Function Select : Boolean; virtual; abstract;
Function Focus : Boolean; virtual; abstract;
Function Delete : Boolean; virtual; abstract;
end;
{ TIFormInterface - currently not used }
TIFormInterface = class
public
Function Filename : AnsiString; virtual; abstract;
Function FormModified : Boolean; virtual; abstract;
Function MarkModified : Boolean; virtual; abstract;
Function GetFormComponent : TIComponentInterface; virtual; abstract;
Function FindComponent : TIComponentInterface; virtual; abstract;
Function GetComponentfromHandle(ComponentHandle:Pointer): TIComponentInterface; virtual; abstract;
Function GetSelCount: Integer; virtual; abstract;
Function GetSelComponent(Index : Integer): TIComponentInterface; virtual; abstract;
Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
end;
{
Created by Shane Miller
This unit defines the layout for the forms editor. The forms editor is
responsible for creating all forms, holding all component interfaces .
}
TAbstractFormEditor = class
public
Function FindComponentByName(const Name : ShortString) : TIComponentInterface; virtual; abstract;
Function FindComponent(AComponent: TComponent): TIComponentInterface; virtual; abstract;
Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
Function CreateComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; Interactive: boolean
): TIComponentInterface; virtual; abstract;
Function CreateChildComponentFromStream(BinStream: TStream;
ComponentClass: TComponentClass;
Root: TComponent;
ParentControl: TWinControl
): TIComponentInterface; virtual; abstract;
end;
implementation
end.

1
designer/changeclassdialog.lfm
View File

@ -58,6 +58,7 @@ object ChangeClassDlg: TChangeClassDlg
Width = 200
object NewClassComboBox: TComboBox
MaxLength = 0
OnEditingDone = NewClassComboBoxEditingDone
TabOrder = 0
Text = 'NewClassComboBox'
Left = 14

25
designer/changeclassdialog.lrs
View File

@ -17,16 +17,17 @@ LazarusResources.Add('TChangeClassDlg','FORMDATA',[
+#0#0#0#0#0#9'TGroupBox'#11'NewGroupBox'#7'Caption'#6#11'NewGroupBox'#12'Clie'
+'ntHeight'#3#231#0#11'ClientWidth'#3#196#0#11'ParentColor'#9#8'TabOrder'#2#1
+#4'Left'#3#216#0#6'Height'#3#248#0#3'Top'#2#8#5'Width'#3#200#0#0#9'TComboBox'
+#16'NewClassComboBox'#9'MaxLength'#2#0#8'TabOrder'#2#0#4'Text'#6#16'NewClass'
+'ComboBox'#4'Left'#2#14#6'Height'#2#25#3'Top'#2#9#5'Width'#3#174#0#0#0#9'TGr'
+'oupBox'#19'NewAncestorGroupBox'#5'Align'#7#8'alBottom'#7'Caption'#6#19'NewA'
+'ncestorGroupBox'#12'ClientHeight'#3#175#0#11'ClientWidth'#3#192#0#11'Parent'
+'Color'#9#8'TabOrder'#2#1#6'Height'#3#192#0#3'Top'#2''''#5'Width'#3#196#0#0#8
+'TListBox'#19'NewAncestorsListBox'#5'Align'#7#8'alClient'#16'ClickOnSelChang'
+'e'#8#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#3#175#0#5'Width'#3#192#0#0
+#0#0#0#7'TButton'#8'OkButton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Capti'
+'on'#6#2'Ok'#11'ModalResult'#2#1#8'TabOrder'#2#2#4'Left'#3#192#0#6'Height'#2
+#25#3'Top'#3#14#1#5'Width'#2'['#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11
+#7'akRight'#8'akBottom'#0#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOr'
+'der'#2#3#4'Left'#3'@'#1#6'Height'#2#25#3'Top'#3#14#1#5'Width'#2'['#0#0#0
+#16'NewClassComboBox'#9'MaxLength'#2#0#13'OnEditingDone'#7#27'NewClassComboB'
+'oxEditingDone'#8'TabOrder'#2#0#4'Text'#6#16'NewClassComboBox'#4'Left'#2#14#6
+'Height'#2#25#3'Top'#2#9#5'Width'#3#174#0#0#0#9'TGroupBox'#19'NewAncestorGro'
+'upBox'#5'Align'#7#8'alBottom'#7'Caption'#6#19'NewAncestorGroupBox'#12'Clien'
+'tHeight'#3#175#0#11'ClientWidth'#3#192#0#11'ParentColor'#9#8'TabOrder'#2#1#6
+'Height'#3#192#0#3'Top'#2''''#5'Width'#3#196#0#0#8'TListBox'#19'NewAncestors'
+'ListBox'#5'Align'#7#8'alClient'#16'ClickOnSelChange'#8#8'TabOrder'#2#0#8'To'
+'pIndex'#2#255#6'Height'#3#175#0#5'Width'#3#192#0#0#0#0#0#7'TButton'#8'OkBut'
+'ton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#2'Ok'#11'ModalResu'
+'lt'#2#1#8'TabOrder'#2#2#4'Left'#3#192#0#6'Height'#2#25#3'Top'#3#14#1#5'Widt'
+'h'#2'['#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11#7'akRight'#8'akBottom'
+#0#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#3#4'Left'#3'@'#1
+#6'Height'#2#25#3'Top'#3#14#1#5'Width'#2'['#0#0#0
]);

138
designer/changeclassdialog.pas
View File

@ -36,7 +36,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, AVGLvlTree, LazarusIDEStrConsts, ComponentReg;
Buttons, AVGLvlTree, PropEdits, LazarusIDEStrConsts, ComponentReg;
type
TChangeClassDlg = class(TForm)
@ -51,6 +51,7 @@ type
NewGroupBox: TGroupBox;
OldGroupBox: TGroupBox;
procedure ChangeClassDlgCreate(Sender: TObject);
procedure NewClassComboBoxEditingDone(Sender: TObject);
private
FClasses: TAvgLvlTree;
FNewClass: TClass;
@ -63,6 +64,7 @@ type
procedure FillAncestorListBox(AClass: TClass; AListBox: TListBox);
procedure AddClass(const AClass: TPersistentClass);
procedure AddComponentClass(const AClass: TComponentClass);
function CompareClasses(Tree: TAvgLvlTree; Class1, Class2: TClass): integer;
public
destructor Destroy; override;
procedure FillNewClassComboBox;
@ -71,33 +73,54 @@ type
end;
function ShowChangeClassDialog(APersistent: TPersistent): TModalResult;
function ShowChangeClassDialog(ADesigner: TIDesigner;
APersistent: TPersistent): TModalResult;
function ChangePersistentClass(ADesigner: TIDesigner; APersistent: TPersistent;
NewClass: TClass): TModalResult;
implementation
function ShowChangeClassDialog(APersistent: TPersistent): TModalResult;
function ShowChangeClassDialog(ADesigner: TIDesigner;
APersistent: TPersistent): TModalResult;
var
ChangeClassDlg: TChangeClassDlg;
begin
Result:=mrCancel;
MessageDlg('Not implemented yet','Not implemented yet',mtInformation,[mbOk],0);
exit;
//MessageDlg('Not implemented yet','Not implemented yet',mtInformation,[mbOk],0);
//exit;
ChangeClassDlg:=TChangeClassDlg.Create(Application);
try
ChangeClassDlg.ThePersistent:=APersistent;
ChangeClassDlg.FillNewClassComboBox;
if ChangeClassDlg.ShowModal=mrOk then begin
Result:=ChangePersistentClass(ADesigner,APersistent,
ChangeClassDlg.NewClass);
end;
finally
ChangeClassDlg.Free;
end;
end;
function CompareClasses(Class1, Class2: TClass): integer;
function ChangePersistentClass(ADesigner: TIDesigner; APersistent: TPersistent;
NewClass: TClass): TModalResult;
begin
// TODO
Result:=0;
// select only this persistent
GlobalDesignHook.SelectOnlyThis(APersistent);
// stream selection
// parse
// change class
// check properties
// delete selection
// insert streamed selection
Result:=mrCancel;
end;
{ TChangeClassDlg }
@ -112,6 +135,11 @@ begin
CancelButton.Caption:='Cancel';
end;
procedure TChangeClassDlg.NewClassComboBoxEditingDone(Sender: TObject);
begin
UpdateNewInfo;
end;
procedure TChangeClassDlg.SetThePersistent(const AValue: TPersistent);
begin
if FThePersistent=AValue then exit;
@ -129,6 +157,7 @@ end;
procedure TChangeClassDlg.UpdateInfo;
begin
UpdateNewInfo;
UpdateOldInfo;
end;
procedure TChangeClassDlg.UpdateOldInfo;
@ -146,7 +175,21 @@ begin
end;
procedure TChangeClassDlg.UpdateNewInfo;
var
ANode: TAvgLvlTreeNode;
begin
FNewClass:=nil;
if FClasses<>nil then begin
ANode:=FClasses.FindLowest;
while (ANode<>nil) do begin
FNewClass:=TClass(ANode.Data);
if (CompareText(NewClass.ClassName,NewClassComboBox.Text)=0) then
break
else
FNewClass:=nil;
ANode:=FClasses.FindSuccessor(ANode);
end;
end;
FillAncestorListBox(NewClass,NewAncestorsListBox);
if NewClass<>nil then
NewClassComboBox.Text:=NewClass.ClassName
@ -175,7 +218,8 @@ end;
procedure TChangeClassDlg.AddClass(const AClass: TPersistentClass);
begin
if FClasses.FindPointer(AClass)<>nil then exit;
FClasses.Add(AClass);
end;
procedure TChangeClassDlg.AddComponentClass(const AClass: TComponentClass);
@ -183,6 +227,54 @@ begin
AddClass(AClass);
end;
function TChangeClassDlg.CompareClasses(Tree: TAvgLvlTree; Class1,
Class2: TClass): integer;
// sort:
// transforming ThePersistent to descending classes is easy
// transforming ThePersistent to ascending classes is medium
//
// count distance between, that means: find nearest shared ancestor, then
// give two points for every step from ThePersistent to ancestor and one point
// for every step from ancestor to class
//
// otherwise sort for classnames
function AncestorDistance(ChildClass, AncestorClass: TClass): integer;
begin
Result:=0;
while (ChildClass<>nil) and (ChildClass<>AncestorClass) do begin
ChildClass:=ChildClass.ClassParent;
inc(Result);
end;
end;
function RelationDistance(SrcClass, DestClass: TClass): integer;
var
Ancestor: TClass;
begin
// find shared ancestor of
Ancestor:=SrcClass;
while (Ancestor<>nil) and (not DestClass.InheritsFrom(Ancestor)) do
Ancestor:=Ancestor.ClassParent;
// going to the ancestor is normally more difficult than going away
Result:=2*AncestorDistance(SrcClass,Ancestor)
+AncestorDistance(DestClass,Ancestor);
end;
var
Dist1: LongInt;
Dist2: LongInt;
begin
Result:=0;
if (ThePersistent<>nil) then begin
Dist1:=RelationDistance(ThePersistent.ClassType,Class1);
Dist2:=RelationDistance(ThePersistent.ClassType,Class2);
Result:=Dist1-Dist2;
if Result<>0 then exit;
end;
Result:=CompareText(Class1.ClassName,Class2.ClassName);
end;
destructor TChangeClassDlg.Destroy;
begin
FClasses.Free;
@ -191,12 +283,36 @@ begin
end;
procedure TChangeClassDlg.FillNewClassComboBox;
var
ANode: TAvgLvlTreeNode;
List: TStringList;
begin
FClasses:=TAvgLvlTree.Create(@CompareClasses);
// create/clear tree
if FClasses=nil then
FClasses:=TAvgLvlTree.Create(@CompareClasses)
else
FClasses.Clear;
// add class of ThePersistent
if ThePersistent<>nil then
AddClass(TPersistentClass(ThePersistent.ClassType));
// add all registered component classes
if (IDEComponentPalette<>nil) then
IDEComponentPalette.IterateRegisteredClasses(@AddComponentClass);
// add list of classnames
List:=TStringList.Create;
ANode:=FClasses.FindLowest;
while ANode<>nil do begin
List.Add(TClass(ANode.Data).ClassName);
ANode:=FClasses.FindSuccessor(ANode);
end;
// assign to combobox
NewClassComboBox.Items.Assign(List);
if (NewClassComboBox.Items.IndexOf(NewClassComboBox.Text)<0)
and (NewClassComboBox.Items.Count>0) then
NewClassComboBox.Text:=NewClassComboBox.Items[0];
UpdateNewInfo;
// clean up
List.Free;
end;
initialization

2
designer/designer.pp
View File

@ -721,7 +721,7 @@ procedure TDesigner.DoShowChangeClassDialog;
begin
if (ControlSelection.Count=1) and (not ControlSelection.LookupRootSelected)
then
ShowChangeClassDialog(ControlSelection[0].Persistent);
ShowChangeClassDialog(Self,ControlSelection[0].Persistent);
end;
procedure TDesigner.GiveComponentsNames;

27
ide/customformeditor.pp
View File

@ -43,7 +43,7 @@ uses
// components
AVL_Tree, PropEdits, ObjectInspector, IDECommands,
// IDE
JITForms, NonControlForms, AbstractFormEditor, ComponentReg, IDEProcs,
JITForms, NonControlForms, FormEditingIntf, ComponentReg, IDEProcs,
ComponentEditors, KeyMapping, EditorOptions, DesignerProcs;
Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
@ -160,14 +160,18 @@ each control that's dropped onto the form
const OldMethodName, NewMethodName: shortstring);
procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
function DesignerCount: integer; override;
function GetDesigner(Index: integer): TIDesigner; override;
function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
function CreateUniqueComponentName(AComponent: TComponent): string;
function CreateUniqueComponentName(const AClassName: string;
OwnerComponent: TComponent): string;
OwnerComponent: TComponent): string;
Function CreateComponentInterface(AComponent: TComponent): TIComponentInterface;
procedure CreateChildComponentInterfaces(AComponent: TComponent);
Function CreateComponent(ParentCI : TIComponentInterface;
TypeClass: TComponentClass; X,Y,W,H : Integer): TIComponentInterface; override;
TypeClass: TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; override;
Function CreateComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass;
Interactive: boolean): TIComponentInterface; override;
@ -895,6 +899,23 @@ begin
NonControlForm.DoSaveBounds;
end;
function TCustomFormEditor.DesignerCount: integer;
begin
Result:=JITFormList.Count+JITDataModuleList.Count;
end;
function TCustomFormEditor.GetDesigner(Index: integer): TIDesigner;
var
AForm: TCustomForm;
begin
if Index<JITFormList.Count then
Result:=JITFormList[Index].Designer
else begin
AForm:=GetDesignerForm(JITDataModuleList[Index-JITFormList.Count]);
Result:=TIDesigner(AForm.Designer);
end;
end;
function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
): TBaseComponentEditor;
var

19
ide/formeditor.pp
View File

@ -32,7 +32,7 @@ interface
uses
Classes, CustomFormEditor, Controls, Forms, Buttons, SysUtils, Graphics,
ObjectInspector, Designer;
ObjectInspector, Designer, FormEditingIntf;
type
TFormEditor = class(TCustomFormEditor)
@ -45,11 +45,26 @@ type
end;
var
FormEditor1 : TFormEditor;
FormEditor1: TFormEditor;
procedure CreateFormEditor;
procedure FreeFormEditor;
implementation
procedure CreateFormEditor;
begin
FormEditor1 := TFormEditor.Create;
FormEditingHook := FormEditor1;
end;
procedure FreeFormEditor;
begin
FormEditingHook:=nil;
FormEditor1.Free;
FormEditor1:=nil;
end;
procedure TFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspector);
begin

5
ide/main.pp
View File

@ -968,7 +968,7 @@ begin
FreeThenNil(Project1);
// free IDE parts
FreeThenNil(FormEditor1);
FreeFormEditor;
FreeThenNil(PkgBoss);
FreeThenNil(GlobalDesignHook);
FreeThenNil(TheCompiler);
@ -10489,6 +10489,9 @@ end.
{ =============================================================================
$Log$
Revision 1.742 2004/08/05 21:20:46 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas
Revision 1.741 2004/08/04 16:58:15 mattias
fixed setting Modified for hidden lpr file when adding CreateFormStatement

3
ideintf/Makefile.fpc
View File

@ -28,7 +28,8 @@ implicitunits=actionseditor \
propedits \
helpintf \
texttools \
actionseditor
actionseditor \
formeditingintf
[clean]
files=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) \

2
ideintf/allideintf.pas
View File

@ -21,7 +21,7 @@ interface
uses
IDECommands, PropEdits, ObjInspStrConsts, ObjectInspector, ColumnDlg,
ComponentEditors, GraphPropEdits, ListViewPropEdit, ImageListEditor,
ComponentTreeView, ActionsEditor, HelpIntf, TextTools;
ComponentTreeView, ActionsEditor, HelpIntf, TextTools, FormEditingIntf;
implementation

109
ideintf/formeditingintf.pas Normal file
View File

@ -0,0 +1,109 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program 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. *
* *
*****************************************************************************
Author: Shane Miller, Mattias Gaertner
Abstract:
Methods to access the form editing of the IDE.
}
unit FormEditingIntf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, TypInfo, Forms, Controls;
type
{ TIComponentInterface }
TIComponentInterface = class
public
Function GetComponentType : ShortString; virtual; abstract;
Function GetComponentHandle : LongInt; virtual; abstract;
Function GetParent : TIComponentInterface; virtual; abstract;
Function IsTControl : Boolean; virtual; abstract;
Function GetPropCount : Integer; virtual; abstract;
Function GetPropType(Index : Integer) : TTypeKind; virtual; abstract;
// Function GetPropType(Index : Integer) : TPropertyType; virtual; abstract;
Function GetPropName(Index : Integer) : Shortstring; virtual; abstract;
Function GetPropTypeByName(Name : ShortString) : TTypeKind; virtual; abstract;
// Function GetPropTypebyName(Name : ShortString) : TPropertyType; virtual; abstract;
Function GetPropTypeName(Index : Integer) : ShortString; virtual; abstract;
Function GetPropValue(Index : Integer; var Value) : Boolean; virtual; abstract;
Function GetPropValuebyName(Name: Shortstring; var Value) : Boolean; virtual; abstract;
Function SetProp(Index : Integer; const Value) : Boolean; virtual; abstract;
Function SetPropbyName(Name : Shortstring; const Value) : Boolean; virtual; abstract;
Function GetControlCount: Integer; virtual; abstract;
Function GetControl(Index : Integer): TIComponentInterface; virtual; abstract;
Function GetComponentCount: Integer; virtual; abstract;
Function GetComponent(Index : Integer): TIComponentInterface; virtual; abstract;
Function Select : Boolean; virtual; abstract;
Function Focus : Boolean; virtual; abstract;
Function Delete : Boolean; virtual; abstract;
end;
{ TIFormInterface - currently not used }
TIFormInterface = class
public
Function Filename : AnsiString; virtual; abstract;
Function FormModified : Boolean; virtual; abstract;
Function MarkModified : Boolean; virtual; abstract;
Function GetFormComponent : TIComponentInterface; virtual; abstract;
Function FindComponent : TIComponentInterface; virtual; abstract;
Function GetComponentfromHandle(ComponentHandle:Pointer): TIComponentInterface; virtual; abstract;
Function GetSelCount: Integer; virtual; abstract;
Function GetSelComponent(Index : Integer): TIComponentInterface; virtual; abstract;
Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
end;
{ TAbstractFormEditor }
TAbstractFormEditor = class
protected
function GetDesigner(Index: integer): TIDesigner; virtual; abstract;
public
Function FindComponentByName(const Name : ShortString) : TIComponentInterface; virtual; abstract;
Function FindComponent(AComponent: TComponent): TIComponentInterface; virtual; abstract;
Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
Function CreateComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; Interactive: boolean
): TIComponentInterface; virtual; abstract;
Function CreateChildComponentFromStream(BinStream: TStream;
ComponentClass: TComponentClass;
Root: TComponent;
ParentControl: TWinControl
): TIComponentInterface; virtual; abstract;
function DesignerCount: integer; virtual; abstract;
property Designer[Index: integer]: TIDesigner read GetDesigner;
end;
var
FormEditingHook: TAbstractFormEditor; // will be set by the IDE
implementation
end.

98
lcl/avglvltree.pas
View File

@ -15,6 +15,9 @@
Author: Mattias Gaertner
Abstract:
The Tree is sorted ascending from left to right. That means Compare gives
positive values for comparing right with left.
TAvgLvlTree is an Average Level binary Tree. This binary tree is always
balanced, so that inserting, deleting and finding a node is performed in
O(log(#Nodes)).
@ -29,6 +32,11 @@ uses
Classes, SysUtils, FPCAdds;
type
TAvgLvlTree = class;
TObjectSortCompare = function(Tree: TAvgLvlTree; Data1, Data2: Pointer
): integer of object;
TAvgLvlTreeNode = class
public
Parent, Left, Right: TAvgLvlTreeNode;
@ -36,21 +44,24 @@ type
Data: Pointer;
procedure Clear;
function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
constructor Create;
destructor Destroy; override;
end;
PAvgLvlTreeNode = ^TAvgLvlTreeNode;
TAvgLvlTree = class
private
FOnCompare: TListSortCompare;
FCount: integer;
FOnCompare: TListSortCompare;
FOnObjectCompare: TObjectSortCompare;
procedure BalanceAfterInsert(ANode: TAvgLvlTreeNode);
procedure BalanceAfterDelete(ANode: TAvgLvlTreeNode);
function FindInsertPos(Data: Pointer): TAvgLvlTreeNode;
procedure SetOnCompare(const AValue: TListSortCompare);
procedure SetOnObjectCompare(const AValue: TObjectSortCompare);
procedure SetCompares(const NewCompare: TListSortCompare;
const NewObjectCompare: TObjectSortCompare);
public
Root: TAvgLvlTreeNode;
function Compare(Data1, Data2: Pointer): integer;
function Find(Data: Pointer): TAvgLvlTreeNode;
function FindKey(Key: Pointer;
OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
@ -76,6 +87,7 @@ type
procedure MoveDataLeftMost(var ANode: TAvgLvlTreeNode);
procedure MoveDataRightMost(var ANode: TAvgLvlTreeNode);
property OnCompare: TListSortCompare read FOnCompare write SetOnCompare;
property OnObjectCompare: TObjectSortCompare read FOnObjectCompare write SetOnObjectCompare;
procedure Clear;
procedure FreeAndClear;
procedure FreeAndDelete(ANode: TAvgLvlTreeNode);
@ -84,6 +96,7 @@ type
procedure WriteReportToStream(s: TStream; var StreamSize: TStreamSeekType);
function ReportAsString: string;
constructor Create(OnCompareMethod: TListSortCompare);
constructor Create(OnCompareMethod: TObjectSortCompare);
constructor Create;
destructor Destroy; override;
end;
@ -145,7 +158,7 @@ begin
inc(FCount);
if Root<>nil then begin
InsertPos:=FindInsertPos(ANode.Data);
InsertComp:=fOnCompare(ANode.Data,InsertPos.Data);
InsertComp:=Compare(ANode.Data,InsertPos.Data);
ANode.Parent:=InsertPos;
if InsertComp<0 then begin
// insert to the left
@ -482,7 +495,12 @@ constructor TAvgLvlTree.Create(OnCompareMethod: TListSortCompare);
begin
inherited Create;
FOnCompare:=OnCompareMethod;
FCount:=0;
end;
constructor TAvgLvlTree.Create(OnCompareMethod: TObjectSortCompare);
begin
inherited Create;
FOnObjectCompare:=OnCompareMethod;
end;
constructor TAvgLvlTree.Create;
@ -640,7 +658,7 @@ var Comp: integer;
begin
Result:=Root;
while (Result<>nil) do begin
Comp:=fOnCompare(Data,Result.Data);
Comp:=Compare(Data,Result.Data);
if Comp=0 then exit;
if Comp<0 then begin
Result:=Result.Left
@ -650,8 +668,8 @@ begin
end;
end;
function TAvgLvlTree.FindKey(Key: Pointer; OnCompareKeyWithData: TListSortCompare
): TAvgLvlTreeNode;
function TAvgLvlTree.FindKey(Key: Pointer;
OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
var Comp: integer;
begin
Result:=Root;
@ -688,7 +706,7 @@ begin
Result:=ANode;
repeat
LeftNode:=FindPrecessor(Result);
if (LeftNode=nil) or (fOnCompare(Data,LeftNode.Data)<>0) then break;
if (LeftNode=nil) or (Compare(Data,LeftNode.Data)<>0) then break;
Result:=LeftNode;
until false;
end else begin
@ -706,7 +724,7 @@ begin
Result:=ANode;
repeat
RightNode:=FindSuccessor(Result);
if (RightNode=nil) or (fOnCompare(Data,RightNode.Data)<>0) then break;
if (RightNode=nil) or (Compare(Data,RightNode.Data)<>0) then break;
Result:=RightNode;
until false;
end else begin
@ -719,7 +737,7 @@ var Comp: integer;
begin
Result:=Root;
while (Result<>nil) do begin
Comp:=fOnCompare(Data,Result.Data);
Comp:=Compare(Data,Result.Data);
if Comp=0 then exit;
if Comp<0 then begin
if Result.Left<>nil then
@ -741,7 +759,7 @@ begin
while (Result<>nil) do begin
if Result.Data=Data then break;
Result:=FindSuccessor(Result);
if fOnCompare(Data,Result.Data)<>0 then Result:=nil;
if Compare(Data,Result.Data)<>0 then Result:=nil;
end;
end;
@ -752,7 +770,7 @@ begin
Result:=Find(Data);
while (Result<>nil) do begin
Left:=FindPrecessor(Result);
if (Left=nil) or (fOnCompare(Data,Left.Data)<>0) then break;
if (Left=nil) or (Compare(Data,Left.Data)<>0) then break;
Result:=Left;
end;
end;
@ -764,7 +782,7 @@ begin
Result:=Find(Data);
while (Result<>nil) do begin
Right:=FindSuccessor(Result);
if (Right=nil) or (fOnCompare(Data,Right.Data)<>0) then break;
if (Right=nil) or (Compare(Data,Right.Data)<>0) then break;
Result:=Right;
end;
end;
@ -774,7 +792,7 @@ var Comp: integer;
begin
Result:=Root;
while (Result<>nil) do begin
Comp:=fOnCompare(Data,Result.Data);
Comp:=Compare(Data,Result.Data);
if Comp<0 then begin
if Result.Left<>nil then
Result:=Result.Left
@ -823,7 +841,7 @@ begin
LeftMost:=ANode;
repeat
PreNode:=FindPrecessor(LeftMost);
if (PreNode=nil) or (FOnCompare(ANode,PreNode)<>0) then break;
if (PreNode=nil) or (Compare(ANode,PreNode)<>0) then break;
LeftMost:=PreNode;
until false;
if LeftMost=ANode then exit;
@ -841,7 +859,7 @@ begin
RightMost:=ANode;
repeat
PostNode:=FindSuccessor(RightMost);
if (PostNode=nil) or (FOnCompare(ANode,PostNode)<>0) then break;
if (PostNode=nil) or (Compare(ANode,PostNode)<>0) then break;
RightMost:=PostNode;
until false;
if RightMost=ANode then exit;
@ -867,7 +885,7 @@ var RealCount: integer;
if ANode.Left.Parent<>ANode then begin
Result:=-2; exit;
end;
if fOnCompare(ANode.Left.Data,ANode.Data)>0 then begin
if Compare(ANode.Left.Data,ANode.Data)>0 then begin
Result:=-3; exit;
end;
Result:=CheckNode(ANode.Left);
@ -878,7 +896,7 @@ var RealCount: integer;
if ANode.Right.Parent<>ANode then begin
Result:=-4; exit;
end;
if fOnCompare(ANode.Data,ANode.Right.Data)>0 then begin
if Compare(ANode.Data,ANode.Right.Data)>0 then begin
Result:=-5; exit;
end;
Result:=CheckNode(ANode.Right);
@ -995,11 +1013,28 @@ begin
end;
procedure TAvgLvlTree.SetOnCompare(const AValue: TListSortCompare);
begin
if AValue=nil then
SetCompares(nil,FOnObjectCompare)
else
SetCompares(AValue,nil);
end;
procedure TAvgLvlTree.SetOnObjectCompare(const AValue: TObjectSortCompare);
begin
if AValue=nil then
SetCompares(FOnCompare,nil)
else
SetCompares(nil,AValue);
end;
procedure TAvgLvlTree.SetCompares(const NewCompare: TListSortCompare;
const NewObjectCompare: TObjectSortCompare);
var List: PPointer;
ANode: TAvgLvlTreeNode;
i, OldCount: integer;
begin
if FOnCompare=AValue then exit;
if (FOnCompare=NewCompare) and (FOnObjectCompare=NewObjectCompare) then exit;
// sort the tree again
if Count>0 then begin
OldCount:=Count;
@ -1016,7 +1051,8 @@ begin
// clear the tree
Clear;
// set the new compare function
FOnCompare:=AValue;
FOnCompare:=NewCompare;
FOnObjectCompare:=NewObjectCompare;
// re-add all nodes
for i:=0 to OldCount-1 do
Add(List[i]);
@ -1026,21 +1062,17 @@ begin
end;
end;
function TAvgLvlTree.Compare(Data1, Data2: Pointer): integer;
begin
if Assigned(FOnCompare) then
Result:=FOnCompare(Data1,Data2)
else
Result:=FOnObjectCompare(Self,Data1,Data2);
end;
{ TAvgLvlTreeNode }
constructor TAvgLvlTreeNode.Create;
begin
inherited Create;
end;
destructor TAvgLvlTreeNode.Destroy;
begin
inherited Destroy;
end;
function TAvgLvlTreeNode.TreeDepth: integer;
// longest WAY down. e.g. only one node => 0 !
var LeftDepth, RightDepth: integer;

38
lcl/controls.pp
View File

@ -672,8 +672,7 @@ type
chtOnChangeBounds
);
(*
* Note on TControl.Caption
{* Note on TControl.Caption
* The VCL implementation relies on the virtual Get/SetTextBuf to
* exchange text between widgets and VCL. This means a lot of
* (unnecesary) text copies.
@ -686,31 +685,31 @@ type
* To keep things optimal, LCL implementations should always
* override RealGet/SetText. Get/SetTextBuf is only kept for
* compatibility.
*)
}
TControl = class(TLCLComponent)
private
FActionLink: TControlActionLink;
FAlign : TAlign;
FAnchors : TAnchors;
FAutoSize : Boolean;
FAlign: TAlign;
FAnchors: TAnchors;
FAutoSize: Boolean;
FBaseBounds: TRect;
FBaseBoundsLock: integer;
FBaseParentClientSize: TPoint;
FBorderSpacing: TControlBorderSpacing;
FCaption : TCaption;
FColor : TColor;
FConstraints : TSizeConstraints;
FCaption: TCaption;
FColor: TColor;
FConstraints: TSizeConstraints;
FControlFlags: TControlFlags;
FControlHandlers: array[TControlHandlerType] of TMethodList;
FControlStyle: TControlStyle;
FCtl3D : Boolean;
FCursor : TCursor;
FCtl3D: Boolean;
FCursor: TCursor;
FDockOrientation: TDockOrientation;
FDragCursor : TCursor;
FDragKind : TDragKind;
FDragMode : TDragMode;
FEnabled : Boolean;
FDragCursor: TCursor;
FDragKind: TDragKind;
FDragMode: TDragMode;
FEnabled: Boolean;
FFloatingDockSiteClass: TWinControlClass;
FFont: TFont;
FHeight: Integer;
@ -736,9 +735,9 @@ type
FOnConstrainedResize : TConstrainedResizeEvent;
FOnContextPopup: TContextPopupEvent;
FOnDblClick: TNotifyEvent;
FOnDoneEditing: TNotifyEvent;
FOnDragDrop: TDragDropEvent;
FOnDragOver: TDragOverEvent;
FOnEditingDone: TNotifyEvent;
FOnEndDock: TEndDragEvent;
FOnEndDrag: TEndDragEvent;
FOnMouseDown: TMouseEvent;
@ -761,7 +760,7 @@ type
FShowHint: Boolean;
FSizeLock: integer;
FTabOrder: integer;
FTabStop : Boolean;
FTabStop: Boolean;
FTBDockHeight: Integer;
FTop: Integer;
FUndockHeight: Integer;
@ -993,7 +992,7 @@ type
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock;
property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
property OnDoneEditing: TNotifyEvent read FOnDoneEditing write FOnDoneEditing;
property OnEditingDone: TNotifyEvent read FOnEditingDone write FOnEditingDone;
public
FCompStyle: Byte; // enables (valid) use of 'IN' operator (this is a hack
// for speed. It will be replaced by the use of the widgetset classes.
@ -2389,6 +2388,9 @@ end.
{ =============================================================================
$Log$
Revision 1.232 2004/08/05 21:20:47 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas
Revision 1.231 2004/08/03 09:01:54 mattias
LCL now handles for non win32 CN_CHAR

5
lcl/include/control.inc
View File

@ -239,7 +239,7 @@ End;
------------------------------------------------------------------------------}
procedure TControl.EditingDone;
begin
if Assigned(OnEditingDone) then OnEditingDone(Self);
end;
procedure TControl.FontChanged(Sender: TObject);
@ -3220,6 +3220,9 @@ end;
{ =============================================================================
$Log$
Revision 1.207 2004/08/05 21:20:47 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas
Revision 1.206 2004/07/25 01:04:45 mattias
TXMLPropStorage basically working

4
lcl/stdctrls.pp
View File

@ -316,6 +316,7 @@ type
property OnCloseUp;
property OnDrawItem;
property OnDropDown;
property OnEditingDone;
property OnEnter;
property OnExit;
property OnKeyDown;
@ -1158,6 +1159,9 @@ end.
{ =============================================================================
$Log$
Revision 1.156 2004/08/05 21:20:47 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas
Revision 1.155 2004/08/04 09:57:17 mattias
TStaticText.CanTab=false