delphi6 – summer swell

We use GNU Gettext for translation in our Delphi 6 application. We also use the Woll2Woll data-aware components. In our forms we add the following to the OnCreate event:

TranslateComponent( Self );

We also have set up the typical ignores but we still had a problem with the Woll2Wol TwwDBComboBox that was not being populated properly and we could not set it getting the error: “True is not a valid Boolean value”. Turns out that the resourcestrings in DBConsts for the ‘True’ and ‘False’ values had been translated but the ‘Items’ property of the TwwDBComboBox that mapped ‘Yes’ to ‘True’ wasn’t being translated because the string was ‘Yes’#9’True’.

I’ve added the following function to translate the items in the wwDBComboBox so that they map correctly:

uses
  Wwstr,
  gnugettext;

{-------------------------------------------------------------------------------
  Procedure: Translate_wwDBCustomComboBox
  Author:    bvonfintel
  DateTime:  2013.09.12
  Arguments: const AComponent: TwwDBCustomComboBox
  Result:    None
-------------------------------------------------------------------------------}
procedure Translate_wwDBCustomComboBox( const AComponent: TwwDBCustomComboBox );
var
  LIndex      : Integer;
  LTokenIndex : Integer;
  LToken1     : string;
  LToken2     : string;
begin
  for LIndex := 0 to AComponent.Items.Count - 1 do begin
    LTokenIndex := 1;
    LToken1     := _( strGetToken( AComponent.Items[LIndex], #9, LTokenIndex ) );
    LToken2     := _( strGetToken( AComponent.Items[LIndex], #9, LTokenIndex ) );

    AComponent.Items[LIndex] := LToken1 + #9 + LToken2;
  end;
end;

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.