Categories
Delphi

TMethodList for Pre-Generics Delphi

While in the later versions of Delphi we can simply use a generic TList<TMethod> in the earlier versions of Delphi (like Delphi 6 which I am using) we need to override the base TList class to accommodate the methods and implement a TMethodList container. This method list is based on the multicast event handler outlined here: http://delphi.about.com/library/weekly/aa051005a.htm

The most important part of the class is assigning the TMethod to a pointer.

First we create a pointer to a TMethod

type
  PMethod = ^TMethod;

When adding the TMehod to the list we copy the .Data and .Code to the newly created Pointer

  Result := New( PMethod );
  Result^.Code := AItem.Code;
  Result^.Data := AItem.Data;

Later we will need to Dispose of the memory

  if ( Action = lnDeleted ) then begin
    Dispose( Ptr );
  end;

The whole class:

{******************************************************************************}
{                                                                              }
{  Unit: ssMethodList.pas                                                      }
{  Summerswell Core                                                            }
{                                                                              }
{  Copyright (C) 2013 Summerswell                                              }
{                                                                              }
{  Author     : bvonfintel                                                     }
{  Original   : 2013/09/13 11:23:02 AM                                         }
{                                                                              }
{******************************************************************************}
unit ssMethodList;

interface

uses
  Classes;

type
  // *** -------------------------------------------------------------------------
  // *** CLASS: TssMethodList
  // *** -------------------------------------------------------------------------
  TssMethodList = class( TList )
    protected
      procedure Put( AIndex: Integer; AItem: TMethod );
      function  Get( AIndex: Integer ): TMethod;
      procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    public
      function  Add( AItem: TMethod ): Integer;
      property Items[Index: Integer]: TMethod read Get write Put; default;
  end;

implementation

type
  PMethod = ^TMethod;

{-------------------------------------------------------------------------------
  Procedure: CreatePMethod
  Author:    bvonfintel
  DateTime:  2013.09.13
  Arguments: AItem: TMethod
  Result:    PMethod
-------------------------------------------------------------------------------}
function CreatePMethod( AItem: TMethod ): PMethod;
begin
  Result := New( PMethod );
  Result^.Code := AItem.Code;
  Result^.Data := AItem.Data;
end;

{ TssMethodList }

{-------------------------------------------------------------------------------
  Procedure: TssMethodList.Add
  Author:    bvonfintel
  DateTime:  2013.09.13
  Arguments: AItem: TMethod
  Result:    Integer
-------------------------------------------------------------------------------}
function TssMethodList.Add(AItem: TMethod): Integer;
begin
  Result := inherited Add( CreatePMethod( AItem ) );
end;

{-------------------------------------------------------------------------------
  Procedure: TssMethodList.Get
  Author:    bvonfintel
  DateTime:  2013.09.13
  Arguments: AIndex: Integer
  Result:    TMethod
-------------------------------------------------------------------------------}
function TssMethodList.Get(AIndex: Integer): TMethod;
begin
  Result := TMethod( inherited Get( AIndex )^ );
end;

{-------------------------------------------------------------------------------
  Procedure: TssMethodList.Notify
  Author:    bvonfintel
  DateTime:  2013.09.13
  Arguments: Ptr: Pointer; Action: TListNotification
  Result:    None
-------------------------------------------------------------------------------}
procedure TssMethodList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  inherited;
  if ( Action = lnDeleted ) then begin
    Dispose( Ptr );
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TssMethodList.Put
  Author:    bvonfintel
  DateTime:  2013.09.13
  Arguments: AIndex: Integer; AItem: TMethod
  Result:    None
-------------------------------------------------------------------------------}
procedure TssMethodList.Put(AIndex: Integer; AItem: TMethod);
begin
  inherited Put( AIndex, CreatePMethod( AItem ) );
end;

end.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.