From 90b0558cbac9b3bb1e6e46a0d03df6c015cfcdfe Mon Sep 17 00:00:00 2001 From: lazarus Date: Wed, 20 Dec 2000 17:35:58 +0000 Subject: [PATCH] Added GetChildren Shane git-svn-id: trunk@72 - --- designer/objectinspector.pp | 96 ++++--- designer/propedits.pp | 530 +++++++++++++++++++++++++++--------- ide/customformeditor.pp | 6 +- ide/main.pp | 261 ++++-------------- lcl/controls.pp | 5 + lcl/include/wincontrol.inc | 19 ++ 6 files changed, 547 insertions(+), 370 deletions(-) diff --git a/designer/objectinspector.pp b/designer/objectinspector.pp index 9bbc0e2135..cd10c24194 100644 --- a/designer/objectinspector.pp +++ b/designer/objectinspector.pp @@ -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; diff --git a/designer/propedits.pp b/designer/propedits.pp index 0bf122261d..2043cfa82b 100644 --- a/designer/propedits.pp +++ b/designer/propedits.pp @@ -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 diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 0f21c051a7..e9fb5f29cb 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -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; diff --git a/ide/main.pp b/ide/main.pp index 5611b9fcd6..6ae1169155 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -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 diff --git a/lcl/controls.pp b/lcl/controls.pp index 0540ad1434..0c18a70422 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index ecf89172c8..0684d3e68a 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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