paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 11:08:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* revised TComponent class. There was a lot of outdated, bad, maybe also old code. Tested also with Lazarus.

Browse Source 
git-svn-id: trunk@13297 -
This commit is contained in:
ivost 2009-06-19 00:07:59 +00:00
parent becf7df747
commit 8b7167e538
2 changed files with 252 additions and 293 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/objpas/classes/classesh.inc
View File

@ -1510,7 +1510,7 @@ type
procedure WriteTop(Writer: TWriter); procedure WriteTop(Writer: TWriter);
protected protected
FComponentStyle: TComponentStyle; FComponentStyle: TComponentStyle;
procedure ChangeName(const NewName: TComponentName); //procedure ChangeName(const NewName: TComponentName);
procedure DefineProperties(Filer: TFiler); override; procedure DefineProperties(Filer: TFiler); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
function GetChildOwner: TComponent; dynamic; function GetChildOwner: TComponent; dynamic;

415
rtl/objpas/classes/compon.inc
View File

@ -15,25 +15,26 @@
{* TComponent *} {* TComponent *}
{****************************************************************************} {****************************************************************************}
Function TComponent.GetComponent(AIndex: Integer): TComponent; function TComponent.GetComponent(AIndex: Integer): TComponent;
begin begin
If not assigned(FComponents) then if Assigned(FComponents) then
Result:=Nil Result := TComponent(FComponents.Items[Aindex])
else else
Result:=TComponent(FComponents.Items[Aindex]); Result := nil;
end; end;
function TComponent.IsImplementorOf(const Intf: IInterface):boolean; function TComponent.IsImplementorOf(const Intf: IInterface):boolean;
var ref : IInterfaceComponentReference; var
ref: IInterfaceComponentReference;
begin begin
result:=assigned(intf) and supports(intf,IInterfaceComponentReference,ref); result := Assigned(intf) and Supports(intf,IInterfaceComponentReference,ref) and (ref.getcomponent=self);
if result then
result:=ref.getcomponent=self;
end; end;
procedure TComponent.ReferenceInterface(const intf: IInterface; op: TOperation); procedure TComponent.ReferenceInterface(const intf: IInterface; op: TOperation);
var ref : IInterfaceComponentReference; var
ref: IInterfaceComponentReference;
comp: TComponent; comp: TComponent;
begin begin
if assigned(intf) and supports(intf,IInterfaceComponentReference,ref) then if assigned(intf) and supports(intf,IInterfaceComponentReference,ref) then
@ -43,109 +44,97 @@ begin
end; end;
end; end;
Function TComponent.GetComponentCount: Integer;
function TComponent.GetComponentCount: Integer;
begin begin
If not assigned(FComponents) then if assigned(FComponents) then
result:=0 Result := FComponents.Count
else else
Result:=FComponents.Count; Result := 0;
end; end;
Function TComponent.GetComponentIndex: Integer; function TComponent.GetComponentIndex: Integer;
begin begin
If Assigned(FOwner) and Assigned(FOwner.FComponents) then if Assigned(FOwner) and Assigned(FOwner.FComponents) then
Result:=FOWner.FComponents.IndexOf(Self) Result := FOwner.FComponents.IndexOf(Self)
else else
Result := -1; Result := -1;
end; end;
Procedure TComponent.Insert(AComponent: TComponent); procedure TComponent.Insert(AComponent: TComponent);
begin begin
If not assigned(FComponents) then if not Assigned(FComponents) then
FComponents := TList.Create; FComponents := TList.Create;
FComponents.Add(AComponent); FComponents.Add(AComponent);
AComponent.FOwner := Self; AComponent.FOwner := Self;
end; end;
Procedure TComponent.ReadLeft(Reader: TReader); procedure TComponent.ReadLeft(Reader: TReader);
begin begin
LongRec(FDesignInfo).Lo := Reader.ReadInteger; LongRec(FDesignInfo).Lo := Reader.ReadInteger;
end; end;
Procedure TComponent.ReadTop(Reader: TReader); procedure TComponent.ReadTop(Reader: TReader);
begin begin
LongRec(FDesignInfo).Hi := Reader.ReadInteger; LongRec(FDesignInfo).Hi := Reader.ReadInteger;
end; end;
Procedure TComponent.Remove(AComponent: TComponent); procedure TComponent.Remove(AComponent: TComponent);
begin begin
AComponent.FOwner:=Nil; AComponent.FOwner := nil;
If assigned(FCOmponents) then if Assigned(FCOmponents) then
begin begin
FComponents.Remove(AComponent); FComponents.Remove(AComponent);
IF FComponents.Count=0 then iF FComponents.Count = 0 then
FreeAndNil(FComponents);
end;
end;
procedure TComponent.RemoveNotification(AComponent: TComponent);
begin begin
FComponents.Free; if Assigned(FFreeNotifies) then
FComponents:=Nil;
end;
end;
end;
Procedure TComponent.RemoveNotification(AComponent: TComponent);
begin
if FFreeNotifies<>nil then
begin begin
FFreeNotifies.Remove(AComponent); FFreeNotifies.Remove(AComponent);
if FFreeNotifies.Count=0 then if FFreeNotifies.Count=0 then
begin begin
FFreeNotifies.Free; FreeAndNil(FFreeNotifies);
FFreeNotifies:=nil;
Exclude(FComponentState,csFreeNotification); Exclude(FComponentState,csFreeNotification);
end; end;
end; end;
end; end;
Procedure TComponent.SetComponentIndex(Value: Integer); procedure TComponent.SetComponentIndex(Value: Integer);
var
Var Temp,Count : longint; OldIndex, Count: Integer;
begin begin
If Not assigned(Fowner) then exit; if not Assigned(FOwner) then Exit;
Temp:=getcomponentindex; OldIndex := GetComponentIndex;
If temp<0 then exit; if OldIndex < 0 then Exit;
If value<0 then value:=0; if Value < 0 then Value := 0;
Count:=Fowner.FComponents.Count; Count := FOwner.FComponents.Count;
If Value>=Count then value:=count-1; if Value >= Count then Value := Count-1;
If Value<>Temp then if Value <> OldIndex then
begin begin
FOWner.FComponents.Delete(Temp); FOwner.FComponents.Delete(OldIndex);
FOwner.FComponents.Insert(Value, Self); FOwner.FComponents.Insert(Value, Self);
end; end;
end; end;
Procedure TComponent.SetReference(Enable: Boolean); procedure TComponent.SetReference(Enable: Boolean);
var var
Field: ^TComponent; Field: ^TComponent;
begin begin
if Assigned(Owner) then if Assigned(FOwner) then
begin begin
Field := Owner.FieldAddress(Name); Field := FOwner.FieldAddress(Name);
if Assigned(Field) then if Assigned(Field) then
if Enable then if Enable then
Field^ := Self Field^ := Self
@ -155,32 +144,28 @@ begin
end; end;
Procedure TComponent.WriteLeft(Writer: TWriter); procedure TComponent.WriteLeft(Writer: TWriter);
begin begin
Writer.WriteInteger(LongRec(FDesignInfo).Lo); Writer.WriteInteger(LongRec(FDesignInfo).Lo);
end; end;
Procedure TComponent.WriteTop(Writer: TWriter); procedure TComponent.WriteTop(Writer: TWriter);
begin begin
Writer.WriteInteger(LongRec(FDesignInfo).Hi); Writer.WriteInteger(LongRec(FDesignInfo).Hi);
end; end;
Procedure TComponent.ChangeName(const NewName: TComponentName); {procedure TComponent.ChangeName(const NewName: TComponentName);
begin begin
FName := NewName; FName := NewName;
end; end;}
Procedure TComponent.DefineProperties(Filer: TFiler); procedure TComponent.DefineProperties(Filer: TFiler);
var
Var Ancestor : TComponent; Ancestor: TComponent;
Temp : longint; Temp: Longint;
begin begin
Temp := 0; Temp := 0;
Ancestor := TComponent(Filer.Ancestor); Ancestor := TComponent(Filer.Ancestor);
@ -192,72 +177,65 @@ begin
end; end;
Procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent); procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin begin
// Does nothing. // Does nothing.
end; end;
Function TComponent.GetChildOwner: TComponent; function TComponent.GetChildOwner: TComponent;
begin begin
Result:=Nil; Result := nil;
end; end;
Function TComponent.GetChildParent: TComponent; function TComponent.GetChildParent: TComponent;
begin begin
Result := Self; Result := Self;
end; end;
Function TComponent.GetNamePath: string; function TComponent.GetNamePath: string;
begin begin
Result := FName; Result := FName;
end; end;
Function TComponent.GetOwner: TPersistent; function TComponent.GetOwner: TPersistent;
begin begin
Result := FOwner; Result := FOwner;
end; end;
Procedure TComponent.Loaded; procedure TComponent.Loaded;
begin begin
Exclude(FComponentState,csLoading); Exclude(FComponentState,csLoading);
end; end;
Procedure TComponent.Loading;
procedure TComponent.Loading;
begin begin
Include(FComponentState,csLoading); Include(FComponentState,csLoading);
end; end;
Procedure TComponent.Notification(AComponent: TComponent; procedure TComponent.Notification(AComponent: TComponent; Operation: TOperation);
Operation: TOperation); var
Runner: Integer;
Var Runner : Longint;
begin begin
If (Operation=opRemove) and Assigned(FFreeNotifies) then if (Operation=opRemove) and Assigned(FFreeNotifies) then
begin begin
FFreeNotifies.Remove(AComponent); FFreeNotifies.Remove(AComponent);
If FFreeNotifies.Count=0 then if FFreeNotifies.Count=0 then
begin begin
FFreeNotifies.Free; FreeAndNil(FFreeNotifies);
FFreenotifies:=Nil; Exclude(FComponentState,csFreeNotification);
end; end;
end; end;
If assigned(FComponents) then
For Runner:=0 To FComponents.Count-1 do if Assigned(FComponents) then
TComponent(FComponents.Items[Runner]).Notification(AComponent,Operation); for Runner := 0 To FComponents.Count-1 do
TComponent(FComponents.List^[Runner]).Notification(AComponent,Operation);
end; end;
@ -266,216 +244,196 @@ procedure TComponent.PaletteCreated;
end; end;
Procedure TComponent.ReadState(Reader: TReader); procedure TComponent.ReadState(Reader: TReader);
begin begin
Reader.ReadData(Self); Reader.ReadData(Self);
end; end;
Procedure TComponent.SetAncestor(Value: Boolean); procedure TComponent.SetAncestor(Value: Boolean);
var
Var Runner : Longint; Runner: Integer;
begin begin
If Value then if Value then
Include(FComponentState,csAncestor) Include(FComponentState,csAncestor)
else else
Exclude(FCOmponentState,csAncestor); Exclude(FCOmponentState,csAncestor);
if Assigned(FComponents) then if Assigned(FComponents) then
For Runner := 0 To FComponents.Count-1 do For Runner := 0 To FComponents.Count-1 do
TComponent(FComponents.Items[Runner]).SetAncestor(Value); TComponent(FComponents.List^[Runner]).SetAncestor(Value);
end; end;
Procedure TComponent.SetDesigning(Value: Boolean; SetChildren : Boolean = True); procedure TComponent.SetDesigning(Value: Boolean; SetChildren : Boolean = True);
var
Var Runner : Longint; Runner: Integer;
begin begin
If Value then if Value then
Include(FComponentState,csDesigning) Include(FComponentState,csDesigning)
else else
Exclude(FComponentState,csDesigning); Exclude(FComponentState,csDesigning);
if Assigned(FComponents) and SetChildren then if Assigned(FComponents) and SetChildren then
For Runner := 0 To FComponents.Count - 1 do For Runner := 0 To FComponents.Count - 1 do
TComponent(FComponents.items[Runner]).SetDesigning(Value); TComponent(FComponents.List^[Runner]).SetDesigning(Value);
end; end;
Procedure TComponent.SetDesignInstance(Value: Boolean);
procedure TComponent.SetDesignInstance(Value: Boolean);
begin begin
If Value then if Value then
Include(FComponentState,csDesignInstance) Include(FComponentState,csDesignInstance)
else else
Exclude(FComponentState,csDesignInstance); Exclude(FComponentState,csDesignInstance);
end; end;
Procedure TComponent.SetInline(Value: Boolean);
procedure TComponent.SetInline(Value: Boolean);
begin begin
If Value then if Value then
Include(FComponentState,csInline) Include(FComponentState,csInline)
else else
Exclude(FComponentState,csInline); Exclude(FComponentState,csInline);
end; end;
Procedure TComponent.SetName(const NewName: TComponentName); procedure TComponent.SetName(const NewName: TComponentName);
begin begin
If FName=NewName then exit; if FName=NewName then Exit;
If (NewName<>'') and not IsValidIdent(NewName) then if (NewName<>'') and not IsValidIdent(NewName) then
Raise EComponentError.CreateFmt(SInvalidName,[NewName]); raise EComponentError.CreateFmt(SInvalidName,[NewName]);
If Assigned(FOwner) Then
if Assigned(FOwner) Then
FOwner.ValidateRename(Self,FName,NewName) FOwner.ValidateRename(Self,FName,NewName)
else else
ValidateRename(Nil,FName,NewName); ValidateRename(Nil,FName,NewName);
SetReference(False); SetReference(False);
ChangeName(NewName); //ChangeName(NewName);
FName := NewName;
Setreference(True); Setreference(True);
end; end;
Procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer); procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer);
begin begin
// does nothing // does nothing
end; end;
Procedure TComponent.SetParentComponent(Value: TComponent); procedure TComponent.SetParentComponent(Value: TComponent);
begin begin
// Does nothing // Does nothing
end; end;
Procedure TComponent.Updating; procedure TComponent.Updating;
begin begin
Include (FComponentState,csUpdating); Include (FComponentState,csUpdating);
end; end;
Procedure TComponent.Updated; procedure TComponent.Updated;
begin begin
Exclude(FComponentState,csUpdating); Exclude(FComponentState,csUpdating);
end; end;
class Procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); class procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin begin
// For compatibility only. // For compatibility only.
end; end;
Procedure TComponent.ValidateRename(AComponent: TComponent; procedure TComponent.ValidateRename(AComponent: TComponent;
const CurName, NewName: string); const CurName, NewName: string);
begin begin
//!! This contradicts the Delphi manual. //!! This contradicts the Delphi manual.
If (AComponent<>Nil) and (CompareText(CurName,NewName)<>0) and (AComponent.Owner = Self) and if Assigned(AComponent) and (CompareText(CurName,NewName)<>0) and
(FindComponent(NewName)<>Nil) then (AComponent.Owner = Self) and Assigned(FindComponent(NewName)) then
raise EComponentError.Createfmt(SDuplicateName,[newname]); raise EComponentError.Createfmt(SDuplicateName,[newname]);
If (csDesigning in FComponentState) and (FOwner<>Nil) then
if (csDesigning in FComponentState) and Assigned(FOwner) then
FOwner.ValidateRename(AComponent,Curname,Newname); FOwner.ValidateRename(AComponent,Curname,Newname);
end; end;
Procedure TComponent.ValidateContainer(AComponent: TComponent); procedure TComponent.ValidateContainer(AComponent: TComponent);
begin begin
AComponent.ValidateInsert(Self); AComponent.ValidateInsert(Self);
end; end;
Procedure TComponent.ValidateInsert(AComponent: TComponent); procedure TComponent.ValidateInsert(AComponent: TComponent);
begin begin
// Does nothing. // Does nothing.
end; end;
Procedure TComponent.WriteState(Writer: TWriter); procedure TComponent.WriteState(Writer: TWriter);
begin begin
Writer.WriteComponentData(Self); Writer.WriteComponentData(Self);
end; end;
Constructor TComponent.Create(AOwner: TComponent); constructor TComponent.Create(AOwner: TComponent);
begin begin
FComponentStyle := [csInheritable]; FComponentStyle := [csInheritable];
If Assigned(AOwner) then AOwner.InsertComponent(Self); if Assigned(AOwner) then
AOwner.InsertComponent(Self);
end; end;
Destructor TComponent.Destroy; destructor TComponent.Destroy;
var
Var
I : Integer;
C: TComponent; C: TComponent;
begin begin
Destroying; while Assigned(FFreeNotifies) and (FFreeNotifies.Count > 0) do
If Assigned(FFreeNotifies) then
begin begin
I:=FFreeNotifies.Count-1; C := TComponent(FFreeNotifies.List^[0]);
While (I>=0) do FFreeNotifies.Delete(0);
begin C.Notification(Self, opRemove);
C:=TComponent(FFreeNotifies.Items[I]);
// Delete, so one component is not notified twice, if it is owned.
FFreeNotifies.Delete(I);
C.Notification (self,opRemove);
If (FFreeNotifies=Nil) then
I:=0
else if (I>FFreeNotifies.Count) then
I:=FFreeNotifies.Count;
dec(i);
end; end;
FreeAndNil(FFreeNotifies); FreeAndNil(FFreeNotifies);
end; Exclude(FComponentState,csFreeNotification);
DestroyComponents; DestroyComponents;
If FOwner<>Nil Then FOwner.RemoveComponent(Self); if Assigned(FOwner) then
inherited destroy; FOwner.RemoveComponent(Self);
inherited Destroy;
end; end;
Procedure TComponent.BeforeDestruction; procedure TComponent.BeforeDestruction;
begin begin
if not(csDestroying in FComponentstate) then
Destroying; Destroying;
end; end;
Procedure TComponent.DestroyComponents; procedure TComponent.DestroyComponents;
var
Var acomponent: TComponent; acomponent: TComponent;
begin begin
While assigned(FComponents) do while assigned(FComponents) do
begin begin
aComponent := TComponent(FComponents.Last); aComponent := TComponent(FComponents.Last);
Remove(aComponent); Remove(aComponent);
Acomponent.Destroy; Acomponent.Free;
end; end;
end; end;
Procedure TComponent.Destroying; procedure TComponent.Destroying;
var
Var Runner : longint; Runner: Integer;
begin begin
If csDestroying in FComponentstate Then Exit; if csDestroying in FComponentstate then Exit;
include (FComponentState,csDestroying); Include(FComponentState,csDestroying);
If Assigned(FComponents) then if Assigned(FComponents) then
for Runner := 0 to FComponents.Count-1 do for Runner := 0 to FComponents.Count-1 do
TComponent(FComponents.Items[Runner]).Destroying; TComponent(FComponents.List^[Runner]).Destroying;
end; end;
@ -485,90 +443,89 @@ begin
begin begin
Action.ExecuteTarget(Self); Action.ExecuteTarget(Self);
Result := True; Result := True;
end end else
else
Result := False; Result := False;
end; end;
Function TComponent.FindComponent(const AName: string): TComponent; function TComponent.FindComponent(const AName: string): TComponent;
var
Var I : longint; I: Integer;
begin begin
Result:=Nil; Result := nil;
If (AName='') or Not assigned(FComponents) then exit; if (AName='') or not Assigned(FComponents) then
For i:=0 to FComponents.Count-1 do Exit;
if (CompareText(TComponent(FComponents[I]).Name,AName)=0) then
for I := 0 to FComponents.Count-1 do
if (CompareText(TComponent(FComponents.List^[I]).Name,AName)=0) then
begin begin
Result:=TComponent(FComponents.Items[I]); Result := TComponent(FComponents.List^[I]);
exit; Exit;
end; end;
end; end;
Procedure TComponent.FreeNotification(AComponent: TComponent); procedure TComponent.FreeNotification(AComponent: TComponent);
begin
if Assigned(Owner) and (AComponent=Owner) then
Exit;
if not (csDestroying in ComponentState) then
begin begin
If (Owner<>Nil) and (AComponent=Owner) then exit; if not Assigned(FFreeNotifies) then
if csDestroying in ComponentState then
AComponent.Notification(Self,opRemove)
else
begin begin
If not (Assigned(FFreeNotifies)) then
FFreeNotifies := TList.Create; FFreeNotifies := TList.Create;
If FFreeNotifies.IndexOf(AComponent)=-1 then Include(FComponentState,csFreeNotification);
end;
if FFreeNotifies.IndexOf(AComponent)=-1 then
begin begin
FFreeNotifies.Add(AComponent); FFreeNotifies.Add(AComponent);
AComponent.FreeNotification (self); AComponent.FreeNotification(Self);
end;
end; end;
end else
AComponent.Notification(Self,opRemove)
end; end;
procedure TComponent.RemoveFreeNotification(AComponent: TComponent); procedure TComponent.RemoveFreeNotification(AComponent: TComponent);
begin begin
RemoveNotification(AComponent); RemoveNotification(AComponent);
AComponent.RemoveNotification (self); AComponent.RemoveNotification(Self);
end; end;
Procedure TComponent.FreeOnRelease; procedure TComponent.FreeOnRelease;
begin begin
// Delphi compatibility only at the moment. // Delphi compatibility only at the moment.
end; end;
Function TComponent.GetParentComponent: TComponent; function TComponent.GetParentComponent: TComponent;
begin begin
Result:=Nil; Result := nil;
end; end;
Function TComponent.HasParent: Boolean; function TComponent.HasParent: Boolean;
begin begin
Result := False; Result := False;
end; end;
Procedure TComponent.InsertComponent(AComponent: TComponent); procedure TComponent.InsertComponent(AComponent: TComponent);
begin begin
AComponent.ValidateContainer(Self); AComponent.ValidateContainer(Self);
ValidateRename(AComponent,'',AComponent.FName); ValidateRename(AComponent,'',AComponent.FName);
Insert(AComponent); Insert(AComponent);
AComponent.SetReference(True); AComponent.SetReference(True);
If csDesigning in FComponentState then if csDesigning in FComponentState then
AComponent.SetDesigning(true); AComponent.SetDesigning(true);
Notification(AComponent,opInsert); Notification(AComponent,opInsert);
end; end;
Procedure TComponent.RemoveComponent(AComponent: TComponent); procedure TComponent.RemoveComponent(AComponent: TComponent);
begin begin
Notification(AComponent,opRemove); Notification(AComponent,opRemove);
AComponent.SetReference(False); AComponent.SetReference(False);
@ -578,13 +535,13 @@ begin
end; end;
Function TComponent.SafeCallException(ExceptObject: TObject; function TComponent.SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): Integer; ExceptAddr: Pointer): Integer;
begin begin
SafeCallException := 0; SafeCallException := 0;
end; end;
procedure TComponent.SetSubComponent(ASubComponent: Boolean); procedure TComponent.SetSubComponent(ASubComponent: Boolean);
begin begin
if ASubComponent then if ASubComponent then
@ -600,31 +557,33 @@ begin
begin begin
Action.UpdateTarget(Self); Action.UpdateTarget(Self);
Result := True; Result := True;
end end else
else
Result := False; Result := False;
end; end;
function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall; function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
begin begin
if GetInterface(IID, Obj) then if GetInterface(IID, Obj) then
result:=S_OK Result := S_OK
else else
result:=E_NOINTERFACE; Result := E_NOINTERFACE;
end; end;
function TComponent._AddRef: Integer;stdcall; function TComponent._AddRef: Integer;stdcall;
begin begin
result:=-1; Result := -1;
end; end;
function TComponent._Release: Integer;stdcall; function TComponent._Release: Integer;stdcall;
begin begin
result:=-1; Result := -1;
end; end;
function TComponent.iicrGetComponent: TComponent; function TComponent.iicrGetComponent: TComponent;
begin begin
result:=self; Result := self;
end; end;