2006. július 27., csütörtök

Type casting and type checking with Interfaces


Problem/Question/Abstract:

If you are new to interfaces and you are use to type casting and type checking with objects you will find that Interfaces must be dealt with differently.  This artical shows you the basics to get started with doing type checking and type casting with Interfaces.

Answer:

If you are like me, you are impatient and can get the point without a bunch of explaining and you hate reading of bunch of stuff just to get a couple bits of info. So for you guys/girls here is the summary and then if you like you can read the rest of the artical:

SUMMARY

First off, your interface must have a GUID, use delphi Shift-Ctrl-G to create one. It should be entered as the first line in your interface definition, ex:

ITypeX = interface
  ['{A002AF60-5684-11D5-B4F9-525405F6BE8D}']
  procedure ShowX;
end;

Object Type Cast

Customer := TCustomer(SomeObject);

Interface Way

You cannot do it this way with interfaces

Object Type Cast (with type checking)

Customer := SomeObject as TCustomer;

Interface Way

Customer := SomeInterface as ICustomer; // assuming Customer is declared as ICustomer

Object Type Checking

if SomeObject is TCustomer then
  // Do Something

interface Way

if SomeInterface.QueryInterface(ICustomer, Customer) = S_OK then
begin
  Customer.DoSomething;
end;

Read further if you like more explaining

First I will summarize type casting and type checking with objects to get us on the same ground and then show how it is done when using interfaces.

Type casting with objects is done in 2 ways

Direct without type checking

Customer := TCustomer(SomeObject);

Using "built in" type checking

Customer := SomeObject as TCustomer

The second will raise an exception if SomeObject is not a TCustomer object or a descendent of one.

Type checking with objects can be done as....

if (SomeObject is TCustomer) then
  // Do something

Now for Interfaces, you MUST have a GUID for your interface before you can do any type checking or type casting. To make your interface have a GUID simply insert it as the first line in your interface definition like this:

ITypeX = interface
  ['{A002AF60-5684-11D5-B4F9-525405F6BE8D}']
  procedure ShowX;
end;

First off you may ask where the heck do I get a GUID, in Delphi just put your cursor where you want the GUID and then press Shift-Ctrl-G and Delphi will insert one for you.  That easy.

These are the interfaces I will use in my explaining:

ITypeX = interface
  ['{A002AF60-5684-11D5-B4F9-525405F6BE8D}']
  procedure ShowX;
end;

ITypeY = interface
  ['{56DA8BE0-5685-11D5-B4F9-525405F6BE8D}']
  procedure ShowY;
end;

Classes to implement them
TTypeX = class(TInterfacedObject, ITypeX)
public
  procedure ShowX;
end;

TTypeY = class(TInterfacedObject, ITypeY)
public
  procedure ShowY;
end;

TTypeXY = class(TInterfacedObject, ITypeX, ITypeY)
public
  procedure ShowX;
  procedure ShowY;
end;

Type casting.

The following code will not work!

procedure TForm_Interfaces.TypeCastXtoY;
var
  X: ITypeX;
begin
  X := TTypeXY.Create;
  ITypeY(X).ShowY;
end;

What happens is that the method ShowX gets called rather than ShowY, I do not know the technical reason... but bottom line, it does not work and you should not type cast this way.

The proper way to do it is this way:

procedure TForm_Interfaces.TypeCastXtoY;
var
  X: ITypeX;
begin
  X := TTypeXY.Create;
  (X as ITypeY).ShowY;
end;

You must use the as operator, also this way of doing it will raise an exception if X in some way does not implement Y.  If you need to do type checking then read more...

The "is" operator does not work with interfaces, so code like this will not compile

if X is ITypeY then
  // Do Something

The proper way to do it is this way:

U := TTypeY.Create;

if U.QueryInterface(ITypeX, Ret) = S_OK then
  ShowMessage('Supports ITypeX')
else
  ShowMessage('DOES NOT Support ITypeX');

if U.QueryInterface(ITypeY, Ret) = S_OK then
  ShowMessage('Supports ITypeY')
else
  ShowMessage('DOES NOT Support ITypeY')

Ret will contain a reference to the interface when the result is S_OK.

Note: If you read the Delphi help for QueryInterface you will see this line
After successfully obtaining an interface by calling QueryInterface, clients should increase the reference count by calling the IUnknown AddRef method.

I wrote code to verify this statement and found that the reference count was incermented and I did not have to call AddRef.

Full Source of my Research, you can also download the app from my website using the component link.

PAS

unit Frm_Interfaces;
{
  Discovery Typecasting interfaces

  You cannot typecast an interface in this manner,
  seems your method pointers are messed up
  X:= ITypeX(SomeInterface);
  // See "TypeCastXtoY" method to see the error, notice the message

  You must type cast in either of 2 ways
  1. X:= SomeInterface as ITypeX
  // See "TypeCastXtoY" method, this can raise an exception

  or
  2. if SomeInterface.QueryInterface(ITypeX, X) = S_OK then
       X.ShowX;
  // See "TypeChecking" method, this does not raise an exception

  Difference between 1 and 2 is that 1 will raise an exception and 2 will not.

  *** IMPORTANT ***
  In order for this to work you MUST include a GUID in your interface, it is
  the first line in the interface definition, use keyboard Shift-Ctrl-G to
  create a GUID.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type

  ITypeX = interface
    ['{A002AF60-5684-11D5-B4F9-525405F6BE8D}']
    procedure ShowX;
  end;

  ITypeY = interface
    ['{56DA8BE0-5685-11D5-B4F9-525405F6BE8D}']
    procedure ShowY;
  end;

  TTypeX = class(TInterfacedObject, ITypeX)
  public
    procedure ShowX;
  end;

  TTypeY = class(TInterfacedObject, ITypeY)
  public
    procedure ShowY;
  end;

  TTypeXY = class(TInterfacedObject, ITypeX, ITypeY)
  public
    procedure ShowX;
    procedure ShowY;
  end;

  TForm_Interfaces = class(TForm)
    FbtnTestCreate: TButton;
    FbtnTypeCastX2Y: TButton;
    FbtnTypeCastU2Y: TButton;
    FbtnTypeChecking: TButton;
    procedure Ev_FbtnTestCreateClick(Sender: TObject);
    procedure Ev_FbtnTypeCastX2YClick(Sender: TObject);
    procedure Ev_FbtnTypeCastU2YClick(Sender: TObject);
    procedure Ev_FbtnTypeCheckingClick(Sender: TObject);
  private
    { Private declarations }
    procedure TestCreate;
    procedure TypeCastXtoY;
    procedure TypeCastUnknownToY;
    procedure TypeChecking;
  public
    { Public declarations }
  end;

var
  Form_Interfaces: TForm_Interfaces;

implementation

{$R *.DFM}

{ TTypeX }

procedure TTypeX.ShowX;
begin
  ShowMessage('TTypeX.ShowX: Supports "ITypeX" only');
end;

{ TTypeY }

procedure TTypeY.ShowY;
begin
  ShowMessage('TTypeY.ShowY: Supports "ITypeY" only');
end;

{ TTypeXY }

procedure TTypeXY.ShowX;
begin
  ShowMessage('TTypeXY.ShowX: Supports both "ITypeX" and "ITypeY"');
end;

procedure TTypeXY.ShowY;
begin
  ShowMessage('TTypeXY.ShowY: Supports both "ITypeX" and "ITypeY"');
end;

{ TForm1 }

procedure TForm_Interfaces.Ev_FbtnTestCreateClick(Sender: TObject);
begin
  TestCreate;
end;

procedure TForm_Interfaces.Ev_FbtnTypeCastX2YClick(Sender: TObject);
begin
  TypeCastXtoY;
end;

procedure TForm_Interfaces.Ev_FbtnTypeCastU2YClick(Sender: TObject);
begin
  TypeCastUnknownToY;
end;

procedure TForm_Interfaces.Ev_FbtnTypeCheckingClick(Sender: TObject);
begin
  TypeChecking;
end;

procedure TForm_Interfaces.TestCreate;
var
  TypeX: ITypeX;
  TypeY: ITypeY;
begin
  TypeX := TTypeX.Create;
  TypeX.ShowX;

  TypeY := TTypeY.Create;
  TypeY.ShowY;

  // Implements both
  TypeX := TTypeXY.Create;
  TypeX.ShowX;

  TypeY := TTypeXY.Create;
  TypeY.ShowY;
end;

procedure TForm_Interfaces.TypeCastXtoY;
var
  X: ITypeX;
begin
  // Notice the message, this does not work.
  X := TTypeXY.Create;
  ITypeY(X).ShowY;

  // This does work
  (X as ITypeY).ShowY;
end;

procedure TForm_Interfaces.TypeCastUnknownToY;
var
  U: IUnknown;
  Y: ITypeY;
begin
  U := TTypeXY.Create;
  Y := U as ITypeY;
  Y.ShowY;
end;

procedure TForm_Interfaces.TypeChecking;
var
  U: IUnknown;
  Ret: IUnknown;
begin
  // Select whichever you want below
//********************************
  //  U:= TTypeXY.Create;
  //  U:= TTypeX.Create;
  U := TTypeY.Create;
  //********************************

    // "Is" does not work with interfaces.
  {
    if U is ITypeX then
      ShowMessage('Supports ITypeX')
    else
      ShowMessage('DOES NOT Support ITypeX')

    if U is ITypeY then
      ShowMessage('Supports ITypeY')
    else
      ShowMessage('DOES NOT Support ITypeY')
  }

  if U.QueryInterface(ITypeX, Ret) = S_OK then
    ShowMessage('Supports ITypeX')
  else
    ShowMessage('DOES NOT Support ITypeX');

  if U.QueryInterface(ITypeY, Ret) = S_OK then
    ShowMessage('Supports ITypeY')
  else
    ShowMessage('DOES NOT Support ITypeY')
end;

end.

DFM

object Form_Interfaces: TForm_Interfaces
  Left = 273
    Top = 278
    BorderStyle = bsDialog
    Caption = 'Experimenting with Typecasting interfaces'
    ClientHeight = 222
    ClientWidth = 341
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    Position = poScreenCenter
    PixelsPerInch = 96
    TextHeight = 13
    object FbtnTestCreate: TButton
    Left = 118
      Top = 39
      Width = 105
      Height = 25
      Caption = 'FbtnTestCreate'
      TabOrder = 0
      OnClick = Ev_FbtnTestCreateClick
  end
  object FbtnTypeCastX2Y: TButton
    Left = 118
      Top = 79
      Width = 105
      Height = 25
      Caption = 'FbtnTypeCastX2Y'
      TabOrder = 1
      OnClick = Ev_FbtnTypeCastX2YClick
  end
  object FbtnTypeCastU2Y: TButton
    Left = 118
      Top = 119
      Width = 105
      Height = 25
      Caption = 'FbtnTypeCastU2Y'
      TabOrder = 2
      OnClick = Ev_FbtnTypeCastU2YClick
  end
  object FbtnTypeChecking: TButton
    Left = 118
      Top = 159
      Width = 105
      Height = 25
      Caption = 'FbtnTypeChecking'
      TabOrder = 3
      OnClick = Ev_FbtnTypeCheckingClick
  end
end

Component Download: http://www.eggcentric.com/InterfaceTypeCast.zip

Nincsenek megjegyzések:

Megjegyzés küldése