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

Added GetChildren

Browse Source 
Shane

git-svn-id: trunk@72 -
This commit is contained in:
lazarus 2000-12-20 17:35:58 +00:00
parent 698d96b93b
commit 90b0558cba
6 changed files with 547 additions and 370 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
designer/objectinspector.pp
View File

@ -81,7 +81,7 @@ type
TOIPropertyGrid = class(TCustomControl)
private
FComponentList: TComponentSelectionList;
FLookupRoot:TComponent;
FPropertyEditorHook:TPropertyEditorHook;
FFilter: TTypeKinds;
FItemIndex:integer;
FChangingItemIndex:boolean;
@ -116,7 +116,7 @@ type
procedure DoPaint(PaintOnlyChangedValues:boolean);
procedure SetSelections(const NewSelections:TComponentSelectionList);
procedure SetLookupRoot(NewLookupRoot:TComponent);
procedure SetPropertyEditorHook(NewPropertyEditorHook:TPropertyEditorHook);
procedure AddPropertyEditor(PropEditor: TPropertyEditor);
procedure AddStringToComboBox(const s:string);
@ -140,7 +140,7 @@ type
TrackBar:TTrackBar;
property Selections:TComponentSelectionList read FComponentList write SetSelections;
property LookupRoot:TComponent read FLookupRoot write SetLookupRoot;
property PropertyEditorHook:TPropertyEditorHook read FPropertyEditorHook write SetPropertyEditorHook;
procedure BuildPropertyList;
procedure RefreshPropertyValues;
@ -168,8 +168,8 @@ type
procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer); override;
procedure Paint; override;
procedure Clear;
constructor Create(AOwner:TComponent; NewLookupRoot:TComponent;
TypeFilter:TTypeKinds);
constructor Create(AOwner:TComponent;
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds);
destructor Destroy; override;
end;
@ -182,15 +182,16 @@ type
TObjectInspector = class (TCustomForm)
private
FComponentList: TComponentSelectionList;
FRootComponent:TComponent;
FPropertyEditorHook:TPropertyEditorHook;
FUpdatingAvailComboBox:boolean;
FOnAddAvailableComponent:TOnAddAvailableComponent;
FOnSelectComponentInOI:TOnSelectComponentInOI;
function ComponentToString(c:TComponent):string;
procedure SetRootComponent(Value:TComponent);
procedure SetPropertyEditorHook(NewValue:TPropertyEditorHook);
procedure SetSelections(const NewSelections:TComponentSelectionList);
procedure AvailComboBoxChange(Sender:TObject);
procedure AddComponentToAvailComboBox(AComponent:TComponent);
procedure PropEditLookupRootChange;
public
AvailCompsComboBox : TComboBox;
NoteBook:TNoteBook;
@ -205,7 +206,7 @@ type
read FOnAddAvailableComponent write FOnAddAvailableComponent;
property OnSelectComponentInOI:TOnSelectComponentInOI
read FOnSelectComponentInOI write FOnSelectComponentInOI;
property RootComponent:TComponent read FRootComponent write SetRootComponent;
property PropertyEditorHook:TPropertyEditorHook read FPropertyEditorHook write SetPropertyEditorHook;
procedure DoInnerResize;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -217,8 +218,8 @@ implementation
{ TOIPropertyGrid }
constructor TOIPropertyGrid.Create(AOwner:TComponent; NewLookupRoot:TComponent;
TypeFilter:TTypeKinds);
constructor TOIPropertyGrid.Create(AOwner:TComponent;
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds);
begin
inherited Create(AOwner);
SetBounds(1,1,200,300);
@ -226,7 +227,7 @@ begin
ControlStyle:=ControlStyle+[csAcceptsControls];
FComponentList:=TComponentSelectionList.Create;
FLookupRoot:=NewLookupRoot;
FPropertyEditorHook:=APropertyEditorHook;
FFilter:=TypeFilter;
FItemIndex:=-1;
FChangingItemIndex:=false;
@ -324,9 +325,11 @@ begin
ItemIndex:=CurRow.Index;
end;
procedure TOIPropertyGrid.SetLookupRoot(NewLookupRoot:TComponent);
procedure TOIPropertyGrid.SetPropertyEditorHook(
NewPropertyEditorHook:TPropertyEditorHook);
begin
FLookupRoot:=NewLookupRoot;
if FPropertyEditorHook=NewPropertyEditorHook then exit;
FPropertyEditorHook:=NewPropertyEditorHook;
SetSelections(FComponentList);
end;
@ -543,7 +546,8 @@ begin
ItemIndex:=-1;
for a:=0 to FRows.Count-1 do Rows[a].Free;
FRows.Clear;
GetComponentProperties(FComponentList,FFilter,@AddPropertyEditor,FLookupRoot);
GetComponentProperties(FPropertyEditorHook,FComponentList,FFilter,
@AddPropertyEditor);
SetItemsTops;
for a:=FExpandedProperties.Count-1 downto 0 do begin
CurRow:=GetRowByPath(FExpandedProperties[a]);
@ -901,9 +905,13 @@ begin
LineTo(NameRect.Right-1,NameRect.Bottom-1);
LineTo(NameRect.Right-1,NameRect.Top-1);
if ARow=FItemIndex then begin
Pen.Color:=cl3DDkShadow;
MoveTo(NameRect.Left,NameRect.Bottom-1);
LineTo(NameRect.Left,NameRect.Top);
LineTo(NameRect.Right-1,NameRect.Top);
Pen.Color:=cl3DLight;
MoveTo(NameRect.Left+1,NameRect.Bottom-2);
LineTo(NameRect.Right-1,NameRect.Bottom-2);
end;
// draw value background
if FBackgroundColor<>clNone then begin
@ -925,6 +933,10 @@ begin
Pen.Color:=cl3DLight;
MoveTo(ValueRect.Left,ValueRect.Bottom-1);
LineTo(ValueRect.Left,ValueRect.Top);
if ARow=FItemIndex then begin
MoveTo(ValueRect.Left,ValueRect.Bottom-2);
LineTo(ValueRect.Right,ValueRect.Bottom-2);
end;
end;
end;
@ -1091,7 +1103,7 @@ constructor TObjectInspector.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'Object Inspector';
FRootComponent:=nil;
FPropertyEditorHook:=nil;
FComponentList:=TComponentSelectionList.Create;
FUpdatingAvailComboBox:=false;
@ -1117,7 +1129,7 @@ begin
end;
// property grid
PropertyGrid:=TOIPropertyGrid.Create(Self,FRootComponent
PropertyGrid:=TOIPropertyGrid.Create(Self,PropertyEditorHook
,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod}
, tkSString, tkLString, tkAString, tkWString, tkVariant
{, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool
@ -1135,7 +1147,7 @@ begin
end;
// event grid
EventGrid:=TOIPropertyGrid.Create(Self,FRootComponent,[tkMethod]);
EventGrid:=TOIPropertyGrid.Create(Self,PropertyEditorHook,[tkMethod]);
with EventGrid do begin
Name:='EventGrid';
Parent:=NoteBook.Page[1];
@ -1170,17 +1182,19 @@ begin
NoteBook.SetBounds(0,NewTop,MaxX-4,MaxY-NewTop);
end;
procedure TObjectinspector.SetRootComponent(Value:TComponent);
procedure TObjectinspector.SetPropertyEditorHook(NewValue:TPropertyEditorHook);
begin
//XXX writeln('OI: SetRootComponent');
if FRootComponent<>Value then begin
FRootComponent:=Value;
//XXX writeln('OI: SetPropertyEditorHook');
if FPropertyEditorHook<>NewValue then begin
FPropertyEditorHook:=NewValue;
FPropertyEditorHook.OnChangeLookupRoot:=@PropEditLookupRootChange;
// select root component
FComponentList.Clear;
if FRootComponent<>nil then FComponentList.Add(FRootComponent);
if (FPropertyEditorHook<>nil) and (FPropertyEditorHook.LookupRoot<>nil) then
FComponentList.Add(FPropertyEditorHook.LookupRoot);
FillComponentComboBox;
PropertyGrid.LookupRoot:=FRootComponent;
EventGrid.LookupRoot:=FRootComponent;
PropertyGrid.PropertyEditorHook:=FPropertyEditorHook;
EventGrid.PropertyEditorHook:=FPropertyEditorHook;
RefreshSelections;
end;
end;
@ -1201,19 +1215,28 @@ begin
ComponentToString(AComponent),AComponent);
end;
procedure TObjectinspector.PropEditLookupRootChange;
begin
FillComponentComboBox;
end;
procedure TObjectinspector.FillComponentComboBox;
var a:integer;
Root:TComponent;
begin
if FUpdatingAvailComboBox then exit;
FUpdatingAvailComboBox:=true;
AvailCompsComboBox.Items.BeginUpdate;
AvailCompsComboBox.Items.Clear;
if FRootComponent<>nil then begin
AddComponentToAvailComboBox(FRootComponent);
AvailCompsComboBox.Text:=ComponentToString(FRootComponent);
for a:=0 to FRootComponent.ComponentCount-1 do begin
AddComponentToAvailComboBox(FRootComponent.Components[a]);
if (FPropertyEditorHook<>nil)
and (FPropertyEditorHook.LookupRoot<>nil) then begin
Root:=FPropertyEditorHook.LookupRoot;
AddComponentToAvailComboBox(Root);
for a:=0 to Root.ComponentCount-1 do begin
AddComponentToAvailComboBox(Root.Components[a]);
end;
if FComponentList.Count=1 then
AvailCompsComboBox.Text:=ComponentToString(FComponentList[0]);
end;
AvailCompsComboBox.Items.EndUpdate;
FUpdatingAvailComboBox:=false;
@ -1253,7 +1276,7 @@ begin
end;
procedure TObjectinspector.AvailComboBoxChange(Sender:TObject);
var NewComponent:TComponent;
var NewComponent,Root:TComponent;
a:integer;
procedure SetSelectedComponent(c:TComponent);
@ -1268,12 +1291,15 @@ var NewComponent:TComponent;
// AvailComboBoxChange
begin
if FRootComponent=nil then exit;
if AvailCompsComboBox.Text=ComponentToString(FRootComponent) then begin
SetSelectedComponent(FRootComponent);
if (FPropertyEditorHook=nil) or (FPropertyEditorHook.LookupRoot=nil) then
exit;
Root:=FPropertyEditorHook.LookupRoot;
if AvailCompsComboBox.Text=ComponentToString(Root)
then begin
SetSelectedComponent(Root);
end else begin
for a:=0 to FRootComponent.ComponentCount-1 do begin
NewComponent:=FRootComponent.Components[a];
for a:=0 to Root.ComponentCount-1 do begin
NewComponent:=Root.Components[a];
if AvailCompsComboBox.Text=ComponentToString(NewComponent) then begin
SetSelectedComponent(NewComponent);
break;

530
designer/propedits.pp
View File

@ -20,8 +20,10 @@ unit propedits;
workaround
-StrToInt64 has a bug. It prints infinitly "something happened"
-> taking my own
-Font property editors
-TFont property editors
-register ModalResultPropertyEditor
-Message Dialogoues on errors
-TStrings property editor
-many more... see XXX
}
@ -47,25 +49,7 @@ type
TGetStringProc = procedure(const s:string) of object;
TComponentSelectionList = class
private
FComponents:TList;
function GetItems(Index: integer): TComponent;
procedure SetItems(Index: integer; const CompValue: TComponent);
function GetCount: integer;
function GetCapacity:integer;
procedure SetCapacity(const NewCapacity:integer);
public
procedure Clear;
function IsEqual(SourceSelectionList:TComponentSelectionList):boolean;
property Count:integer read GetCount;
property Capacity:integer read GetCapacity write SetCapacity;
function Add(c:TComponent):integer;
procedure Assign(SourceSelectionList:TComponentSelectionList);
property Items[Index:integer]:TComponent read GetItems write SetItems; default;
constructor Create;
destructor Destroy; override;
end;
TComponentSelectionList = class;
{ TPropertyEditor
Edits a property of a component, or list of components, selected into the
@ -256,11 +240,11 @@ type
pedsInComboList);
TPropEditDrawState = set of TPropEditDrawStateType;
TPropertyEditorHook = class;
TPropertyEditor=class
private
// XXX
//FDesigner:IFormDesigner;
FLookupRoot:TComponent;
FPropertyHook:TPropertyEditorHook;
FComponents:TComponentSelectionList;
FPropList:PInstPropList;
FPropCount:Integer;
@ -290,9 +274,8 @@ type
procedure SetVarValue(const NewValue:Variant);
procedure Modified;
public
constructor Create({const ADesigner:IFormDesigner;}
LookupRoot:TComponent; ComponentList:TComponentSelectionList;
APropCount:Integer); virtual;
constructor Create(PropertyEditorFilter:TPropertyEditorHook;
ComponentList:TComponentSelectionList; APropCount:Integer); virtual;
destructor Destroy; override;
procedure Activate; virtual;
procedure Deactivate; virtual;
@ -324,7 +307,7 @@ type
AState:TPropEditDrawState); dynamic;
procedure PropDrawValue(ACanvas:TCanvas; const ARect:TRect;
AState:TPropEditDrawState); dynamic;
//property Designer:IFormDesigner read FDesigner;
property PropertyHook:TPropertyEditorHook read FPropertyHook;
property PrivateDirectory:string read GetPrivateDirectory;
property PropCount:Integer read FPropCount;
property FirstValue:string read GetValue write SetValue;
@ -418,7 +401,7 @@ type
end;
{ TNestedPropertyEditor
A property editor that uses the parent's Designer, PropList and PropCount.
A property editor that uses the PropertyHook, PropList and PropCount.
The constructor and destructor do not call inherited, but all derived classes
should. This is useful for properties like the TSetElementPropertyEditor. }
@ -653,8 +636,8 @@ type
procedure RegisterPropertyEditorMapper(Mapper:TPropertyEditorMapperFunc);
procedure GetComponentProperties(Components:TComponentSelectionList;
Filter:TTypeKinds; Proc:TGetPropEditProc; LookupRoot:TComponent);
procedure GetComponentProperties(PropertyEditorHook:TPropertyEditorHook;
Components:TComponentSelectionList; Filter:TTypeKinds; Proc:TGetPropEditProc);
//procedure RegisterComponentEditor(ComponentClass:TComponentClass;
// ComponentEditor:TComponentEditorClass);
@ -662,6 +645,147 @@ procedure GetComponentProperties(Components:TComponentSelectionList;
//function GetComponentEditor(Component:TComponent;
// Designer:IFormDesigner):TComponentEditor;
//==============================================================================
{
The TComponentSelectionList is simply a list of TComponents references.
It will never create or free any components. It is used by the property
editors, the object inspector and the form editor.
}
type
TComponentSelectionList = class
private
FComponents:TList;
function GetItems(Index: integer): TComponent;
procedure SetItems(Index: integer; const CompValue: TComponent);
function GetCount: integer;
function GetCapacity:integer;
procedure SetCapacity(const NewCapacity:integer);
public
procedure Clear;
function IsEqual(SourceSelectionList:TComponentSelectionList):boolean;
property Count:integer read GetCount;
property Capacity:integer read GetCapacity write SetCapacity;
function Add(c:TComponent):integer;
procedure Assign(SourceSelectionList:TComponentSelectionList);
property Items[Index:integer]:TComponent read GetItems write SetItems; default;
constructor Create;
destructor Destroy; override;
end;
//==============================================================================
{
TPropertyEditorHook
This is the interface for methods, components and objects handling of all
property editors. Just create such thing and give it the object inspector.
}
type
// lookup root
TPropHookChangeLookupRoot = procedure of object;
// methods
TPropHookCreateMethod = function(const Name:ShortString; TypeData:PTypeData): TMethod of object;
TPropHookGetMethodName = function(const Method:TMethod): ShortString of object;
TPropHookGetMethods = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
TPropHookMethodExists = function(const Name:ShortString):boolean of object;
TPropHookRenameMethod = procedure(const CurName, NewName:ShortString) of object;
TPropHookShowMethod = procedure(const Name:ShortString) of object;
TPropHookMethodFromAncestor = function(const Method:TMethod):boolean of object;
TPropHookChainCall = procedure(const MethodName, InstanceName, InstanceMethod:ShortString;
TypeData:PTypeData) of object;
// components
TPropHookGetComponent = function(const Name:ShortString):TComponent of object;
TPropHookGetComponentName = function(AComponent:TComponent):ShortString of object;
TPropHookGetComponentNames = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
TPropHookGetRootClassName = function:ShortString of object;
// persistent objects
TPropHookGetObject = function(const Name:ShortString):TPersistent of object;
TPropHookGetObjectName = function(Instance:TPersistent):ShortString of object;
TPropHookGetObjectNames = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
// modifing
TPropHookModified = procedure of object;
TPropHookRevert = procedure(Instance:TPersistent; PropInfo:PPropInfo) of object;
TPropertyEditorHook = class
private
// lookup root
FLookupRoot:TComponent;
FOnChangeLookupRoot:TPropHookChangeLookupRoot;
// methods
FOnCreateMethod:TPropHookCreateMethod;
FOnGetMethodName:TPropHookGetMethodName;
FOnGetMethods:TPropHookGetMethods;
FOnMethodExists:TPropHookMethodExists;
FOnRenameMethod:TPropHookRenameMethod;
FOnShowMethod:TPropHookShowMethod;
FOnMethodFromAncestor:TPropHookMethodFromAncestor;
FOnChainCall:TPropHookChainCall;
// components
FOnGetComponent:TPropHookGetComponent;
FOnGetComponentName:TPropHookGetComponentName;
FOnGetComponentNames:TPropHookGetComponentNames;
FOnGetRootClassName:TPropHookGetRootClassName;
// persistent objects
FOnGetObject:TPropHookGetObject;
FOnGetObjectName:TPropHookGetObjectName;
FOnGetObjectNames:TPropHookGetObjectNames;
// modifing
FOnModified:TPropHookModified;
FOnRevert:TPropHookRevert;
procedure SetLookupRoot(AComponent:TComponent);
public
GetPrivateDirectory:AnsiString;
// lookup root
property LookupRoot:TComponent read FLookupRoot write SetLookupRoot;
// methods
function CreateMethod(const Name:ShortString; TypeData:PTypeData): TMethod;
function GetMethodName(const Method:TMethod): ShortString;
procedure GetMethods(TypeData:PTypeData; Proc:TGetStringProc);
function MethodExists(const Name:ShortString):boolean;
procedure RenameMethod(const CurName, NewName:ShortString);
procedure ShowMethod(const Name:ShortString);
function MethodFromAncestor(const Method:TMethod):boolean;
procedure ChainCall(const AMethodName, InstanceName,
InstanceMethod:ShortString; TypeData:PTypeData);
// components
function GetComponent(const Name:ShortString):TComponent;
function GetComponentName(AComponent:TComponent):ShortString;
procedure GetComponentNames(TypeData:PTypeData; Proc:TGetStringProc);
function GetRootClassName:ShortString;
// persistent objects
function GetObject(const Name:ShortString):TPersistent;
function GetObjectName(Instance:TPersistent):ShortString;
procedure GetObjectNames(TypeData:PTypeData; Proc:TGetStringProc);
// modifing
procedure Modified;
procedure Revert(Instance:TPersistent; PropInfo:PPropInfo);
// lookup root
property OnChangeLookupRoot:TPropHookChangeLookupRoot read FOnChangeLookupRoot write FOnChangeLookupRoot;
// method events
property OnCreateMethod:TPropHookCreateMethod read FOnCreateMethod write FOnCreateMethod;
property OnGetMethodName:TPropHookGetMethodName read FOnGetMethodName write FOnGetMethodName;
property OnGetMethods:TPropHookGetMethods read FOnGetMethods write FOnGetMethods;
property OnMethodExists:TPropHookMethodExists read FOnMethodExists write FOnMethodExists;
property OnRenameMethod:TPropHookRenameMethod read FOnRenameMethod write FOnRenameMethod;
property OnShowMethod:TPropHookShowMethod read FOnShowMethod write FOnShowMethod;
property OnMethodFromAncestor:TPropHookMethodFromAncestor read FOnMethodFromAncestor write FOnMethodFromAncestor;
property OnChainCall:TPropHookChainCall read FOnChainCall write FOnChainCall;
// component event
property OnGetComponent:TPropHookGetComponent read FOnGetComponent write FOnGetComponent;
property OnGetComponentName:TPropHookGetComponentName read FOnGetComponentName write FOnGetComponentName;
property OnGetComponentNames:TPropHookGetComponentNames read FOnGetComponentNames write FOnGetComponentNames;
property OnGetRootClassName:TPropHookGetRootClassName read FOnGetRootClassName write FOnGetRootClassName;
// persistent object events
property OnGetObject:TPropHookGetObject read FOnGetObject write FOnGetObject;
property OnGetObjectName:TPropHookGetObjectName read FOnGetObjectName write FOnGetObjectName;
property OnGetObjectNames:TPropHookGetObjectNames read FOnGetObjectNames write FOnGetObjectNames;
// modifing events
property OnModified:TPropHookModified read FOnModified write FOnModified;
property OnRevert:TPropHookRevert read FOnRevert write FOnRevert;
end;
//==============================================================================
// XXX
// This class is a workaround for the missing typeinfo function
@ -770,6 +894,8 @@ const
tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
tkWString,tkVariant,tkArray,tkRecord,tkInterface,
tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord);
and 2 new kinds in version VER1_1_0 :
tkDynArray,tkInterfaceRaw
}
PropClassMap:array[TypInfo.TTypeKind] of TPropertyEditorClass=(
@ -794,6 +920,10 @@ const
TBoolPropertyEditor, // tkBool
TInt64PropertyEditor, // tkInt64
nil // tkQWord
{$IFDEF VER1_1_0}
,nil // tkDynArray
,nil // tkInterfaceRaw
{$ENDIF}
);
// XXX ToDo: There are bugs in the typinfo.pp. Thus this workaround -------
@ -1257,6 +1387,10 @@ begin
if not List.Contains(FList^[I]) then Delete(I);
end;
//------------------------------------------------------------------------------
{ GetComponentProperties }
procedure RegisterPropertyEditor(PropertyType:PTypeInfo;
@ -1348,8 +1482,8 @@ begin
Result:=PropClassMap[PropType^.Kind];
end;
procedure GetComponentProperties(Components:TComponentSelectionList;
Filter:TTypeKinds; Proc:TGetPropEditProc; LookupRoot:TComponent);
procedure GetComponentProperties(PropertyEditorHook:TPropertyEditorHook;
Components:TComponentSelectionList; Filter:TTypeKinds; Proc:TGetPropEditProc);
var
I,J,CompCount:Integer;
CompType:TClass;
@ -1373,7 +1507,7 @@ begin
if EditClass=nil then
Candidates.Delete(I)
else begin
Editor:=EditClass.Create(LookupRoot,Components,1);
Editor:=EditClass.Create(PropertyEditorHook,Components,1);
try
Editor.SetPropEntry(0,Components[0],PropInfo);
Editor.Initialize;
@ -1400,7 +1534,7 @@ begin
for I:=0 to Candidates.Count-1 do begin
EditClass:=GetEditorClass(Candidates[I],Obj);
if EditClass=nil then continue;
Editor:=EditClass.Create(LookupRoot,Components,CompCount);
Editor:=EditClass.Create(PropertyEditorHook,Components,CompCount);
try
AddEditor:=true;
for j:=0 to CompCount-1 do begin
@ -1438,13 +1572,11 @@ end;
{ TPropertyEditor }
constructor TPropertyEditor.Create({const ADesigner:IFormDesigner;}
LookupRoot:TComponent; ComponentList:TComponentSelectionList;
APropCount:Integer);
constructor TPropertyEditor.Create(
PropertyEditorFilter:TPropertyEditorHook;
ComponentList:TComponentSelectionList; APropCount:Integer);
begin
// XXX
//FDesigner:=ADesigner;
FLookupRoot:=LookupRoot;
FPropertyHook:=PropertyEditorFilter;
FComponents:=ComponentList;
GetMem(FPropList,APropCount * SizeOf(TInstProp));
FPropCount:=APropCount;
@ -1553,14 +1685,12 @@ end;
function TPropertyEditor.GetPrivateDirectory:string;
begin
Result:='';
// XXX
//if Designer<>nil then
// Result:=Designer.GetPrivateDirectory;
if PropertyHook<>nil then
Result:=PropertyHook.GetPrivateDirectory;
end;
procedure TPropertyEditor.GetProperties(Proc:TGetPropEditProc);
begin
//
end;
function TPropertyEditor.GetPropInfo:PPropInfo;
@ -1617,9 +1747,8 @@ end;
procedure TPropertyEditor.Modified;
begin
// XXX
//if Designer<>nil then
// Designer.Modified;
if PropertyHook<>nil then
PropertyHook.Modified;
end;
procedure TPropertyEditor.SetFloatValue(NewValue:Extended);
@ -1677,11 +1806,11 @@ begin
end;
procedure TPropertyEditor.Revert;
//var I:Integer;
var I:Integer;
begin
//if Designer<>nil then
// for I:=0 to FPropCount-1 do
// with FPropList^[I] do Designer.Revert(Instance,PropInfo);
if PropertyHook<>nil then
for I:=0 to FPropCount-1 do
with FPropList^[I] do PropertyHook.Revert(Instance,PropInfo);
end;
procedure TPropertyEditor.SetValue(const NewValue:string);
@ -2044,8 +2173,7 @@ end;
constructor TNestedPropertyEditor.Create(Parent: TPropertyEditor);
begin
// XXX
//FDesigner := Parent.Designer;
FPropertyHook:=Parent.PropertyHook;
FComponents:=Parent.FComponents;
FPropList:=Parent.FPropList;
FPropCount:=Parent.PropCount;
@ -2171,7 +2299,7 @@ begin
if SubComponent<>nil then
Components.Add(SubComponent);
end;
GetComponentProperties(Components, tkProperties, Proc, FLookupRoot);
GetComponentProperties(PropertyHook,Components,tkProperties,Proc);
finally
Components.Free;
end;
@ -2205,9 +2333,8 @@ var
FormMethodName: string;
begin
FormMethodName := GetValue;
// XXX
if (FormMethodName = '') {or Designer.MethodFromAncestor(GetMethodValue)} then
begin
if (FormMethodName = '')
or PropertyHook.MethodFromAncestor(GetMethodValue) then begin
if FormMethodName = '' then
FormMethodName := GetFormMethodName;
if FormMethodName = '' then begin
@ -2216,8 +2343,7 @@ begin
end;
SetValue(FormMethodName);
end;
// XXX
//Designer.ShowMethod(FormMethodName);
PropertyHook.ShowMethod(FormMethodName);
end;
function TMethodPropertyEditor.GetAttributes: TPropertyAttributes;
@ -2231,27 +2357,25 @@ begin
end;
function TMethodPropertyEditor.GetFormMethodName: string;
//var I: Integer;
var I: Integer;
begin
// XXX
Result:='';
{
if GetComponent(0) = Designer.GetRoot then begin
Result := Designer.GetRootClassName;
if PropertyHook.LookupRoot=nil then exit;
if GetComponent(0) = PropertyHook.LookupRoot then begin
Result := PropertyHook.GetRootClassName;
if (Result <> '') and (Result[1] = 'T') then
Delete(Result, 1, 1);
end else begin
Result := Designer.GetObjectName(GetComponent(0));
Result := PropertyHook.GetObjectName(GetComponent(0));
for I := Length(Result) downto 1 do
if Result[I] in ['.','[',']'] then
Delete(Result, I, 1);
end;
}
if Result = '' then begin
{raise EPropertyError.CreateRes(@SCannotCreateName);}
exit;
end;
//Result := Result + GetTrimmedEventName;
Result := Result + GetTrimmedEventName;
end;
function TMethodPropertyEditor.GetTrimmedEventName: string;
@ -2263,78 +2387,66 @@ begin
end;
function TMethodPropertyEditor.GetValue: string;
var MethodValue:TMethod;
begin
// XXX this is a workaround til TFormEditor can do this
MethodValue:=GetMethodValue;
if Assigned(MethodValue.Code) then
if Assigned(FLookupRoot) then begin
Result:=FLookupRoot.MethodName(MethodValue.Code);
if Result='' then
Result:='Unpublished';
end else
Result:='No LookupRoot'
else
Result := '';
//Result:=Designer.GetMethodName(GetMethodValue);
Result:=PropertyHook.GetMethodName(GetMethodValue);
end;
procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc);
begin
// XXX
//Designer.GetMethods(GetTypeData(GetPropType), Proc);
PropertyHook.GetMethods(GetTypeData(GetPropType), Proc);
end;
procedure TMethodPropertyEditor.SetValue(const AValue: string);
procedure CheckChainCall(const MethodName: string; Method: TMethod);
//var
//Persistent: TPersistent;
//Component: TComponent;
//InstanceMethod: string;
//Instance: TComponent;
var
Persistent: TPersistent;
Component: TComponent;
InstanceMethod: string;
Instance: TComponent;
begin
{Persistent := GetComponent(0);
Persistent := GetComponent(0);
if Persistent is TComponent then begin
Component := TComponent(Persistent);
if (Component.Name <> '') and (Method.Data <> Designer.GetRoot) and
(TObject(Method.Data) is TComponent) then
if (Component.Name <> '')
and (TObject(Method.Data) <> PropertyHook.LookupRoot)
and (TObject(Method.Data) is TComponent) then
begin
Instance := TComponent(Method.Data);
InstanceMethod := Instance.MethodName(Method.Code);
if InstanceMethod <> '' then begin
// XXX
//Designer.ChainCall(MethodName, Instance.Name, InstanceMethod,
// GetTypeData(GetPropType));
PropertyHook.ChainCall(MethodName, Instance.Name, InstanceMethod,
GetTypeData(GetPropType));
end;
end;
end;}
end;
end;
//var
//NewMethod: Boolean;
//CurValue: string;
//OldMethod: TMethod;
var
NewMethod: Boolean;
CurValue: string;
OldMethod: TMethod;
NewMethodExists: boolean;
begin
// XXX
exit;
{CurValue:= GetValue;
if (CurValue <> '') and (AValue <> '') and (SameText(CurValue, AValue) or
not Designer.MethodExists(AValue)) and not Designer.MethodFromAncestor(GetMethodValue) then
Designer.RenameMethod(CurValue, AValue)
CurValue:= GetValue;
NewMethodExists:=PropertyHook.MethodExists(AValue);
if (CurValue <> '') and (AValue <> '')
and (Uppercase(CurValue)<>UpperCase(AValue))
and (not NewMethodExists)
and (not PropertyHook.MethodFromAncestor(GetMethodValue)) then
PropertyHook.RenameMethod(CurValue, AValue)
else
begin
NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
NewMethod := (AValue <> '') and not NewMethodExists;
OldMethod := GetMethodValue;
SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
if NewMethod then
begin
if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) then
SetMethodValue(PropertyHook.CreateMethod(AValue, GetTypeData(GetPropType)));
if NewMethod then begin
if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil)
then
CheckChainCall(AValue, OldMethod);
Designer.ShowMethod(AValue);
PropertyHook.ShowMethod(AValue);
end;
end; }
end;
end;
{ TComponentPropertyEditor }
@ -2344,8 +2456,8 @@ begin
{if (GetKeyState(VK_CONTROL) < 0) and
(GetKeyState(VK_LBUTTON) < 0) and
(GetOrdValue <> 0) then begin
Designer.SelectComponent(TPersistent(GetOrdValue))
end else}
PropertyHook.SelectComponent(TPersistent(GetOrdValue))
end else }
inherited Edit;
end;
@ -2363,29 +2475,34 @@ function TComponentPropertyEditor.GetValue: string;
var Component: TComponent;
begin
Component:=TComponent(GetOrdValue);
// XXX workaround til TFormEditor can do this
//Result:=Designer.GetComponentName(Component);
if Assigned(Component) then
Result:=Component.Name
else
Result:='';
if Assigned(PropertyHook) then begin
Result:=PropertyHook.GetComponentName(Component);
end else begin
if Assigned(Component) then
Result:=Component.Name
else
Result:='';
end;
end;
procedure TComponentPropertyEditor.GetValues(Proc: TGetStringProc);
begin
{Designer.GetComponentNames(GetTypeData(GetPropType), Proc);}
PropertyHook.GetComponentNames(GetTypeData(GetPropType), Proc);
end;
procedure TComponentPropertyEditor.SetValue(const NewValue: string);
{var Component: TComponent;}
var Component: TComponent;
begin
{if NewValue = '' then Component := nil else
if NewValue = '' then Component := nil else
begin
Component := Designer.GetComponent(Value);
if not (Component is GetTypeData(GetPropType)^.ClassType) then
raise EPropertyError.CreateRes(@SInvalidPropertyValue);
Component := PropertyHook.GetComponent(NewValue);
if not (Component is GetTypeData(GetPropType)^.ClassType) then begin
// XXX
//raise EPropertyError.CreateRes(@SInvalidPropertyValue);
exit;
end;
end;
SetOrdValue(Longint(Component));}
SetOrdValue(Longint(Component));
end;
{ TComponentNamePropertyEditor }
@ -2777,8 +2894,10 @@ begin
Result := [paMultiSelect, paAutoUpdate, paRevertable];
end;
//==============================================================================
{ TComponentSelectionList }
function TComponentSelectionList.Add(c: TComponent): integer;
@ -2854,6 +2973,163 @@ begin
end;
//==============================================================================
{ TPropertyEditorHook }
function TPropertyEditorHook.CreateMethod(const Name:Shortstring;
TypeData:PTypeData): TMethod;
begin
if Assigned(FOnCreateMethod) then
Result:=FOnCreateMethod(Name,TypeData)
else begin
Result.Code:=nil;
Result.Data:=nil;
end;
end;
function TPropertyEditorHook.GetMethodName(const Method:TMethod): SHortString;
begin
if Assigned(FOnGetMethodName) then
Result:=FOnGetMethodName(Method)
else begin
if Assigned(Method.Code) then
if Assigned(LookupRoot) then begin
Result:=LookupRoot.MethodName(Method.Code);
if Result='' then
Result:='Unpublished';
end else
Result:='No LookupRoot';
end;
end;
procedure TPropertyEditorHook.GetMethods(TypeData:PTypeData; Proc:TGetStringProc);
begin
if Assigned(FOnGetMethods) then
FOnGetMethods(TypeData,Proc);
end;
function TPropertyEditorHook.MethodExists(const Name:Shortstring):boolean;
begin
if Assigned(FOnMethodExists) then
Result:=FOnMethodExists(Name)
else
Result:=false;
end;
procedure TPropertyEditorHook.RenameMethod(const CurName, NewName:ShortString);
begin
if Assigned(FOnRenameMethod) then
FOnRenameMethod(CurName,NewName);
end;
procedure TPropertyEditorHook.ShowMethod(const Name:Shortstring);
begin
if Assigned(FOnShowMethod) then
FOnShowMethod(Name);
end;
function TPropertyEditorHook.MethodFromAncestor(const Method:TMethod):boolean;
begin
if Assigned(FOnMethodFromAncestor) then
Result:=FOnMethodFromAncestor(Method)
else
Result:=false;
end;
procedure TPropertyEditorHook.ChainCall(const AMethodName, InstanceName,
InstanceMethod:Shortstring; TypeData:PTypeData);
begin
if Assigned(FOnChainCall) then
FOnChainCall(AMethodName,InstanceName,InstanceMethod,TypeData);
end;
function TPropertyEditorHook.GetComponent(const Name:Shortstring):TComponent;
begin
if Assigned(FOnGetComponent) then
Result:=FOnGetComponent(Name)
else
Result:=nil;
end;
function TPropertyEditorHook.GetComponentName(
AComponent:TComponent):Shortstring;
begin
if Assigned(FOnGetComponentName) then
Result:=FOnGetComponentName(AComponent)
else begin
if Assigned(AComponent) then
Result:=AComponent.Name
else
Result:='';
end;
end;
procedure TPropertyEditorHook.GetComponentNames(TypeData:PTypeData;
Proc:TGetStringProc);
begin
if Assigned(FOnGetComponentNames) then
FOnGetComponentNames(TypeData,Proc);
end;
function TPropertyEditorHook.GetRootClassName:Shortstring;
begin
if Assigned(FOnGetRootClassName) then begin
Result:=FOnGetRootClassName();
end else begin
if Assigned(LookupRoot) then
Result:=LookupRoot.ClassName
else
Result:='';
end;
end;
function TPropertyEditorHook.GetObject(const Name:Shortstring):TPersistent;
begin
if Assigned(FOnGetObject) then
Result:=FOnGetObject(Name)
else
Result:=nil;
end;
function TPropertyEditorHook.GetObjectName(Instance:TPersistent):Shortstring;
begin
if Assigned(FOnGetObjectName) then
Result:=FOnGetObjectName(Instance)
else
Result:='';
end;
procedure TPropertyEditorHook.GetObjectNames(TypeData:PTypeData;
Proc:TGetStringProc);
begin
if Assigned(FOnGetObjectNames) then
FOnGetObjectNames(TypeData,Proc);
end;
procedure TPropertyEditorHook.Modified;
begin
if Assigned(FOnModified) then
FOnModified();
end;
procedure TPropertyEditorHook.Revert(Instance:TPersistent;
PropInfo:PPropInfo);
begin
if Assigned(FOnRevert) then
FOnRevert(Instance,PropInfo);
end;
procedure TPropertyEditorHook.SetLookupRoot(AComponent:TComponent);
begin
if FLookupRoot=AComponent then exit;
FLookupRoot:=AComponent;
if Assigned(FOnChangeLookupRoot) then
FOnChangeLookupRoot();
end;
//******************************************************************************
// XXX
// workaround for missing typeinfo function

6
ide/customformeditor.pp
View File

@ -36,8 +36,7 @@ each control that's dropped onto the form
}
TCustomFormEditor = class; //forward declaration
TSetProc = Procedure (const Value) of Object;
TGetProc = Function : Variant of Object;
TComponentInterface = class(TIComponentInterface)
private
@ -49,8 +48,7 @@ each control that's dropped onto the form
protected
Function GetPPropInfobyIndex(Index : Integer) : PPropInfo;
Function GetPPropInfobyName(Name : String) : PPropInfo;
MySetProc : TSetPRoc;
MyGetProc : TGetProc;
public
constructor Create;
destructor Destroy; override;

261
ide/main.pp
View File

@ -32,7 +32,7 @@ uses
Spin, project,sysutils, global,
compileroptions, Controls, graphics, extctrls, Dialogs, dlgMEssage,
Designer, process, idecomp, Find_dlg, FormEditor, AbstractFormEditor,
CustomFormEditor, ObjectInspector, ControlSelection, UnitEditor;
CustomFormEditor, ObjectInspector, ControlSelection, PropEdits, UnitEditor;
const
STANDARDBTNCOUNT = 50;
@ -40,8 +40,6 @@ const
type
TForm1 = class(TFORM)
Opendialog1 : TOpenDialog;
Savedialog1 : TSaveDialog;
FontDialog1 : TFontDialog;
ColorDialog1 : TColorDialog;
FindDialog1 : TFindDialog;
@ -116,9 +114,11 @@ type
cmdTest2: TButton;
LAbel2 : TLabel;
{ event handlers }
procedure mnuNewClicked(Sender : TObject);
procedure mnuNewFormClicked(Sender : TObject);
procedure mnuOpenClicked(Sender : TObject);
procedure mnuSaveClicked(Sender : TObject);
procedure mnuSaveAsClicked(Sender : TObject);
procedure mnuSaveAllClicked(Sender : TObject);
procedure mnuCloseClicked(Sender : TObject);
procedure mnuQuitClicked(Sender : TObject);
procedure mnuViewInspectorClicked(Sender : TObject);
@ -157,13 +157,7 @@ type
Function CreateSeperator : TMenuItem;
Procedure SetBtnDefaults(Control : Pointer;I,Page : Integer);
Function ReturnActiveUnitList : TUnitInfo;
Function Create_LFM(SList : TUnitInfo) : Boolean;
Function SavebyUnit(SList : TUnitInfo) : Boolean;
Procedure UpdateViewDialogs;
function CreateUnit(var UnitName : string) : TUnitInfo;
function RenameUnit(OldUnitName, NewUnitName : string;SList : TUnitInfo) : Boolean;
Procedure ReAssignEditorLines(SList : TUnitInfo);
Procedure ReAssignSourcefromEditor(var SList : TUnitInfo);
protected
procedure DoFind(Sender : TObject);
@ -200,9 +194,14 @@ const
var
Form1 : TForm1;
FormEditor1 : TFormEditor;
// this should be moved to FormEditor <...
ObjectInspector1 : TObjectInspector;
PropertyEditorHook1 : TPropertyEditorHook;
// ...>
SourceNotebook : TSourceNotebook;
TagInc : Integer;
implementation
uses
@ -330,7 +329,7 @@ begin
Enabled := True;
Top := 25;
Left := Speedbutton2.Left + 26;
OnClick := @mnuNewCLicked;
// OnClick := @mnuNewCLicked;
Glyph := Pixmap1;
Visible := True;
Name := 'Speedbutton3';
@ -352,7 +351,7 @@ begin
Enabled := True;
Top := 25;
Left := Speedbutton3.Left + 26;
// OnClick := @SourceNotebook.OpenClicked;
OnClick := @mnuOpenCLicked;
Glyph := Pixmap1;
Visible := True;
Name := 'Speedbutton4';
@ -374,6 +373,7 @@ begin
Enabled := True;
Top := 25;
Left := Speedbutton4.Left + 26;
OnClick := @mnuSaveCLicked;
Glyph := Pixmap1;
Visible := True;
Name := 'Speedbutton5';
@ -395,6 +395,7 @@ begin
Enabled := True;
Top := 25;
Left := Speedbutton5.left + 26;
OnClick := @mnuSaveAllCLicked;
Glyph := Pixmap1;
Visible := True;
Name := 'Speedbutton6';
@ -623,8 +624,6 @@ begin
end;
end; //If toolbar1 assigned
OpenDialog1 := TOpenDialog.Create(self);
SaveDialog1 := TSaveDialog.Create(self);
FontDialog1 := TFontDialog.Create(self);
ColorDialog1 := TColorDialog.Create(self);
FindDialog1 := TFindDialog.Create(self);
@ -650,7 +649,8 @@ begin
ObjectInspector1.SetBounds(0,Top+Height+5,230,600);
ObjectInspector1.OnAddAvailComponent:=@OIOnAddAvailableComponent;
ObjectInspector1.OnSelectComponentInOI:=@OIOnSelectComponent;
PropertyEditorHook1:=TPropertyEditorHook.Create;
ObjectInspector1.PropertyEditorHook:=PropertyEditorHook1;
ObjectInspector1.Show;
FormEditor1 := TFormEditor.Create;
@ -662,8 +662,11 @@ begin
itmFileSaveAs.OnClick := @SourceNotebook.SaveAsClicked;
itmFileSaveAll.OnClick := @SourceNotebook.SaveAllClicked;
itmFileClose.OnClick := @SourceNotebook.CloseClicked;
Speedbutton4.OnClick := @SourceNotebook.OpenClicked;
itmFileOpen.OnClick := @SourceNotebook.OpenClicked;
SpeedButton4.OnClick := @SourceNotebook.OpenClicked;
SpeedButton5.OnClick := @SourceNotebook.SaveClicked;
SpeedButton6.OnClick := @SourceNotebook.SaveAllClicked;
end;
procedure TForm1.OIOnAddAvailableComponent(AComponent:TComponent;
@ -767,7 +770,7 @@ begin
itmFileNew := TMenuItem.Create(Self);
itmFileNew.Caption := 'New Unit';
itmFileNew.OnClick := @mnuNewClicked;
// itmFileNew.OnClick := @mnuNewClicked;
mnuFile.Add(itmFileNew);
itmFileNewForm := TMenuItem.Create(Self);
@ -986,155 +989,6 @@ begin
end;
function TForm1.RenameUnit(OldUnitName, NewUnitName : string; SList : TUnitInfo) : Boolean;
var
X1, X2, X3 : Integer;
I,T : Integer;
Count : Integer;
Texts : String;
OldUnitName2,NewUnitName2 : String;
Found : Boolean;
InComment : Boolean;
Begin
Assert(False, 'Trace:*********************RENAME UNIT*************************');
Assert(False, 'Trace:*********************RENAME UNIT*************************');
Count := SList.Source.Count;
Found := False;
InComment := False;
Assert(False, 'Trace:Oldunitname = '+OldUnitName);
Assert(False, 'Trace:NewUnitname = '+NewUnitName);
//drop the '.'
OldUnitName2 := Copy(OldUnitName,1,pos('.',OldUnitName)-1);
NewUnitName2 := Copy(NewUnitName,1,pos('.',NewUnitName)-1);
Assert(False, 'Trace:Oldunitname = '+OldUnitName2);
Assert(False, 'Trace:NewUnitname = '+NewUnitName2);
ReAssignSourcefromEditor(SList);
for I := 0 to Count-1 do
begin
Assert(False, 'Trace:' + inttostr(i));
Assert(False, 'Trace:' + SList.Source.Strings[i]);
//Search for the unit name
Texts := Uppercase(SList.Source.Strings[I]);
x1 := pos(Uppercase(OldUnitName2),Texts);
if X1 <> 0 then
//check to see if it's a comment
if ((pos('//',Texts) = 0) or (pos('//',Texts) > x1+Length(OldUnitName2))) then
Begin
InComment := False;
Assert(False, 'Trace:X1 = '+Inttostr(x1));
//found it but is it the one that follows "unit"
//check to see if the words "unit " are on this line
Texts := Uppercase(SList.Source.Strings[I]);
T := I;
Found := True;
{ x2 := pos('UNIT ',texts);
if x2 <> 0 then
Found := true
else
for t := 0 to i do //i contains the line number of the unit name
begin
Assert(False, 'Trace:t = '+inttostr(t));
Texts := Uppercase(SList.Source.Strings[t]);
Assert(False, 'Trace:Texts = '+texts);
x2 := pos('UNIT',Texts);
Assert(False, 'Trace:x2 = '+inttostr(x2));
if x2 <> 0 then
begin
Found := true;
break;
end;
end;
}
end;
if Found then Break;
end;
if Found then
Begin
Texts := SList.Source.Strings[I];
Assert(False, 'Trace:Texts = '+Texts);
Assert(False, 'Trace:X1 = '+inttostr(x1));
delete(Texts,X1,length(OldUnitName2));
System.Insert(NewUNitName2,Texts,X1);
Assert(False, 'Trace:Texts = '+texts);
SList.Source.Strings[i] := Texts;
SList.Name := NewUnitName;
ReAssignEditorLines(SList);
end;
Result := Found;
End;
Procedure TForm1.ReAssignEditorLines(SList : TUnitInfo);
Begin
end;
Procedure TForm1.ReAssignSourcefromEditor(var SList : TUnitInfo);
Begin
end;
Function TForm1.Create_LFM(SList : TUnitInfo) : Boolean;
Begin
end;
Function TForm1.SavebyUnit(SList : TUnitInfo) : Boolean;
Var
TempName : String;
Begin
Result := True;
Assert(False, 'Trace:SAVEBYUNIT');
ReAssignSourcefromEditor(SList);
if SList.Filename = '' then
Begin
SaveDialog1.Title := 'Save '+SList.Name+' as:';
SaveDialog1.Filename := ExtractFilePath(Project1.Name)+SList.name;
if SList.Flags = pfProject then
SaveDialog1.Filter := '*.lpr'
else
if SList.Flags = pfForm then
SaveDialog1.Filter := '*.pp'
else
if SList.Flags = pfSource then
SaveDialog1.Filter := '*.pp'
else
SaveDialog1.Filter := '*.*';
if SaveDialog1.Execute then
begin
RenameUnit(SList.Name, ExtractFileName(SaveDialog1.Filename),SList);
SList.Filename := SaveDialog1.Filename;
end
else
Exit;
end;
try
if FileExists(SList.Filename) then
Begin
TempName := SList.Filename;
TempName := Copy(TempName,1,pos('.',TempName));
TempName := tempName + '~';
TempName := TempName + Copy(SList.Filename,pos('.',SList.Filename)+1,Length(SList.Filename));
RenameFile(SList.Filename,TempName);
End;
SList.Source.SaveToFile(SList.Filename);
//check to see if this is a form. If so, create a LFM file.
if SList.Flags = pfForm then
Create_LFM(SList);
except
//error saving
Result := False;
end;
End;
{------------------------------------------------------------------------------}
{Fills the View Units dialog and the View Forms dialog}
@ -1222,6 +1076,24 @@ Begin
Assert(False, 'Trace:Exiting SetName_Form');
end;
procedure TForm1.mnuSaveClicked(Sender : TObject);
begin
//this is no longer used. TSourceNotebook.SaveClicked is called
end;
{------------------------------------------------------------------------------}
Procedure TForm1.mnuSaveAsClicked(Sender : TObject);
Begin
//this is no longer used. TSourceNotebook.SaveAsClicked is called
end;
Procedure TForm1.mnuSaveAllClicked(Sender : TObject);
Begin
//this is no longer used. TSourceNotebook.SaveAllClicked is called
End;
Procedure TForm1.mnuToggleFormClicked(Sender : TObject);
Begin
@ -1302,40 +1174,6 @@ if bpressed = 1 then
end;
function TForm1.CreateUnit(var UnitName : string) : TUnitInfo;
var
I,N: Integer;
Found : Boolean;
begin
{ Creates new unit. }
if UnitName = '' then begin
N:= 1;
repeat
UnitName := 'Unit'+IntToStr(N);
Found:= false;
for i:= 0 to Project1.UnitList.Count - 1 do begin
Result:= TUnitInfo(Project1.UnitList.Items[i]);
Found:= Uppercase(Result.Name) = Uppercase(UnitName + '.PP');
if Found then begin
Inc(N);
Break;
end;
end;
until not Found;
end;
Result:= TUnitInfo.Create;
Result.Name := UnitName + '.pp';
end;
{----------------------}
{ mnuNewClicked}
procedure TForm1.mnuNewClicked(Sender : TObject);
begin
end;
function TForm1.FindDesigner(ChildComponent:TComponent):TDesigner;
begin
if ChildComponent is TForm then
@ -1595,7 +1433,7 @@ begin
TempForm.OnActivate := @CodeOrFormActivated;
TempForm.Show;
ObjectInspector1.RootComponent := TForm(CInterface.Control);
PropertyEditorHook1.LookupRoot := TForm(CInterface.Control);
FormEditor1.ClearSelected;
FormEditor1.AddSelected(TComponent(CInterface.Control));
end;
@ -1620,8 +1458,23 @@ end;
{------------------------------------------------------------------------------}
procedure TForm1.mnuQuitClicked(Sender : TObject);
var
I : Integer;
SList : TUnitInfo;
begin
Close;
//if there is a project loaded, check if it should be saved
//free the unitlist objects
if Project1.UnitList.Count > 0 then
For I := 0 to Project1.UnitList.Count -1 do
Begin
SList := TUnitInfo(Project1.UnitList.Items[I]);
SList.Destroy;
end;
Project1.UnitList.Free;
Close;
end;
@ -1858,8 +1711,8 @@ end.
{ =============================================================================
$Log$
Revision 1.20 2000/12/20 14:32:42 lazarus
Fixed File OPen in the IDE.
Revision 1.21 2000/12/20 17:35:58 lazarus
Added GetChildren
Shane
Revision 1.19 2000/12/19 18:43:12 lazarus

5
lcl/controls.pp
View File

@ -617,6 +617,7 @@ TCMDialogKey = TLMKEY;
procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
procedure CreateSubClass(var Params: TCreateParams;ControlClassName: PChar);
Procedure GetChildren(Proc : TGetChildProc; Root : TComponent); override;
procedure PaintControls(DC: HDC; First: TControl);
procedure PaintHandler(var Message: TLMPaint);
procedure PaintWindow(DC: HDC); virtual;
@ -1123,6 +1124,10 @@ end.
{ =============================================================================
$Log$
Revision 1.7 2000/12/20 17:35:58 lazarus
Added GetChildren
Shane
Revision 1.6 2000/12/01 15:50:39 lazarus
changed the TCOmponentInterface SetPropByName. It works for a few properties, but not all.
Shane

19
lcl/include/wincontrol.inc
View File

@ -289,6 +289,21 @@ begin
end;
end;
{------------------------------------------------------------------------------}
{ TWinControl GetChildren }
{------------------------------------------------------------------------------}
Procedure TWinControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
var
I : Integer;
Control : TControl;
Begin
for I := 0 to ControlCount-1 do
Begin
Control := Controls[i];
if Control.Owner = Root then Proc(Control);
end;
End;
{------------------------------------------------------------------------------}
{ TWinControl GetClientOrigin }
{------------------------------------------------------------------------------}
@ -1860,6 +1875,10 @@ end;
{ =============================================================================
$Log$
Revision 1.4 2000/12/20 17:35:58 lazarus
Added GetChildren
Shane
Revision 1.3 2000/09/10 23:08:30 lazarus
MWE:
+ Added CreateCompatibeleBitamp function