• 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 comment

If you want to share your opinion, leave a comment.

You may use these HTML tags and attributes:

<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong> 

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