Про меня - все всё поняли.
http://18delphi.blogspot.ru/2013/11/supports.html?showComment=1383353862701#c88813335274335154
"Странные вещи пишите Александр... Очень странные...
<-- Документация System.SysUtils.Supports
Indicates whether a given object or interface supports a specified interface.
Call Supports to determine whether the object or interface specified by Instance, or the class specified by AClass, supports the interface identified by the IID parameter. If Instance supports the interface, Supports returns the interface as the Intf parameter and returns True. If AClass supports the interface, Supports does not return an interface, but still returns True. If the interface specified by IID is not supported, Supports returns False.
-->
Обратите внимание на упоминание в документации слов objects, class, instance.
Из документации явно следует, что SysUtils.Supports предназначена (задумывалась авторами) для проверки, поддерживает ли данный класс или объект (экземпляр класса) данный интерфейс. Иными словами: умеет ли *данный объект* «делать это»? Обратите внимание — объект, а не кто-то, кто как-то связан с этим объектом или кого можно получить, зная объект."
Ну меня дурака - положим "умный дядя научил".
Но вот незадача.
Других-то - не научил:
http://18delphi.blogspot.ru/2013/11/supports.html?showComment=1383353862701#c88813335274335154
"Странные вещи пишите Александр... Очень странные...
<-- Документация System.SysUtils.Supports
Indicates whether a given object or interface supports a specified interface.
Call Supports to determine whether the object or interface specified by Instance, or the class specified by AClass, supports the interface identified by the IID parameter. If Instance supports the interface, Supports returns the interface as the Intf parameter and returns True. If AClass supports the interface, Supports does not return an interface, but still returns True. If the interface specified by IID is not supported, Supports returns False.
-->
Обратите внимание на упоминание в документации слов objects, class, instance.
Из документации явно следует, что SysUtils.Supports предназначена (задумывалась авторами) для проверки, поддерживает ли данный класс или объект (экземпляр класса) данный интерфейс. Иными словами: умеет ли *данный объект* «делать это»? Обратите внимание — объект, а не кто-то, кто как-то связан с этим объектом или кого можно получить, зная объект."
Ну меня дурака - положим "умный дядя научил".
Но вот незадача.
Других-то - не научил:
function TCustomForm.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
// Route the QueryInterface throught the DesignerHook first
if (DesignerHook = nil) or (DesignerHook.QueryInterface(IID, Obj) <> 0) then
Result := inherited QueryInterface(IID, Obj)
else
Result := 0;
end;
...
function TCorbaImplementation.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
if Assigned(FController) then
Result := IObject(FController).QueryInterface(IID, Obj) else
Result := ObjQueryInterface(IID, Obj);
end;
...
function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if FVCLComObject = nil then
begin
if GetInterface(IID, Obj) then Result := S_OK
else Result := E_NOINTERFACE
end
else
Result := IVCLComObject(FVCLComObject).QueryInterface(IID, Obj);
end;
....
function TCustomWebAppDataModule.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
if IsEqualGuid(IID, IGetWebAppComponents) then
if Supports(AppServices, IGetWebAppComponents, Obj) then
begin
Result := S_OK;
exit;
end;
Result := inherited QueryInterface(IID, Obj);
end;
...
function TCustomWebAppPageModule.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if IsEqualGuid(IID, IGetWebAppComponents) then
if Supports(AppServices, IGetWebAppComponents, Obj) then
begin
Result := S_OK;
exit;
end;
Result := inherited QueryInterface(IID, Obj);
end;
...
function TXPInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if (FDelegator = nil) or FIntrospective then
Result := inherited QueryInterface(IID, Obj)
else
Result := IInterface(FDelegator).QueryInterface(IID, Obj);
end;
....
function TNestedScope.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
Result := E_NOINTERFACE;
if GetInterface(IID, Obj) then
Result := S_OK
else
if Supports(Inner, IID, Obj) or Supports(Outer, IID, Obj) then
Result := S_OK;
end;
....
function TVirtualObjectMemberInstance.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
// depending on the custom wrapper type, it returns the appropriate interfaces
// that the virtual wrapper is supposed to support
if ((IID = IValue) or (IID = IInvokable) or (IID = IArguments)) and
(not Supports(GetCustomWrapper, IID)) then
Result := E_NOINTERFACE
else
Result := inherited QueryInterface(IID, Obj);
end;
....
procedure TStyledWindowBorder.MouseMove(Shift: TShiftState; X, Y: Single);
var
P: TPointF;
Obj: IControl;
SG: ISizeGrip;
NewCursor: TCursor;
CursorService: IFMXCursorService;
begin
NewCursor := crDefault;
TPlatformServices.Current.SupportsPlatformService(IFMXCursorService, IInterface(CursorService));
FMousePos := PointF(X, Y);
if Assigned(FCaptured) then
begin
if Assigned(CursorService) then
begin
if ((FCaptured.QueryInterface(ISizeGrip, SG) = 0) and Assigned(SG)) then
CursorService.SetCursor(crSizeNWSE)
else
CursorService.SetCursor(FCaptured.Cursor);
end;
P := FCaptured.ScreenToLocal(PointF(FMousePos.X, FMousePos.Y));
FCaptured.MouseMove(Shift, P.X, P.Y);
Exit;
end;
Obj := ObjectAtPoint(FMousePos);
if Assigned(Obj) then
begin
SetHovered(Obj);
P := Obj.ScreenToLocal(PointF(FMousePos.X, FMousePos.Y));
Obj.MouseMove(Shift, P.X, P.Y);
if ((Obj.QueryInterface(ISizeGrip, SG) = 0) and Assigned(SG)) then
NewCursor := crSizeNWSE
else
NewCursor := Obj.Cursor;
end
else
SetHovered(nil);
// set cursor
if Assigned(CursorService) then
CursorService.SetCursor(NewCursor);
FDownPos := FMousePos;
end;
....
function TCommonCustomForm.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
// Route the QueryInterface through the Designer first
if not Assigned(Designer) or (Designer.QueryInterface(IID, Obj) <> 0) then
Result := inherited QueryInterface(IID, Obj)
else
Result := 0;
end;
....
function TServerEventDispatch.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
begin
Result := S_OK;
Exit;
end;
if IsEqualIID(IID, FServer.FServerData^.EventIID) then
begin
GetInterface(IDispatch, Obj);
Result := S_OK;
Exit;
end;
Result := E_NOINTERFACE;
end;
....
