Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: GenericInterface.dproj

Project Structure

GenericInterface.dpr
program GenericInterface;

uses
  Forms,
  GenericInterface_MainForm in 'GenericInterface_MainForm.pas' {FormGenericInterface};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormGenericInterface, FormGenericInterface);
  Application.Run;
end.
GenericInterface_MainForm.pas
unit GenericInterface_MainForm;

interface

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

type
  TFormGenericInterface = class(TForm)
    btnValue: TButton;
    Memo1: TMemo;
    btnValueButton: TButton;
    btnIValue: TButton;
    ScrollBox1: TScrollBox;
    procedure btnValueClick(Sender: TObject);
    procedure btnIValueClick(Sender: TObject);
    procedure btnValueButtonClick(Sender: TObject);
  private
    procedure Log (const strMsg: string);
  public
    { Public declarations }
  end;

var
  FormGenericInterface: TFormGenericInterface;

implementation

{$R *.dfm}

uses
  Math, Generics.Defaults;

type
  IGetValue<T> = interface
    function GetValue: T;
    procedure SetValue (Value: T);
  end;

  TGetValue<T> = class (TInterfacedObject, IGetValue<T>)
  private
    fValue: T;
  public
    constructor Create (Value: T);
    destructor Destroy; override;
    function GetValue: T;
    procedure SetValue (Value: T);
  end;

  TButtonValue = class (TButton, IGetValue<Integer>)
  public
    function GetValue: Integer;
    procedure SetValue (Value: Integer);
    class function MakeTButtonValue (
      Owner: TComponent; Parent: TWinControl): TButtonValue;
  end;

{ TGetValue }

constructor TGetValue<T>.Create(Value: T);
begin
  fValue := Value;
end;

destructor TGetValue<T>.Destroy;
begin
  FormGenericInterface.Log('Destroyed');
end;

function TGetValue<T>.GetValue: T;
begin
  Result := fValue;
end;

procedure TGetValue<T>.SetValue(Value: T);
begin
  fValue := Value;
end;

{ TButtonValue }

function TButtonValue.GetValue: Integer;
begin
  Result := Left;
end;

class function TButtonValue.MakeTButtonValue(Owner: TComponent;
  Parent: TWinControl): TButtonValue;
begin
  Result := TButtonValue.Create(Owner);
  Result.Parent := Parent;
  Result.SetBounds(
    Random (Parent.Width), Random (Parent.Height),
    Result.Width, Result.Height);
  Result.Caption := 'btnv';
end;

procedure TButtonValue.SetValue(Value: Integer);
begin
  Left := Value;
end;

procedure TFormGenericInterface.btnValueButtonClick(Sender: TObject);
var
  iVal: IGetValue<Integer>;
begin
  iVal := TButtonValue.MakeTButtonValue (self, ScrollBox1);
  Log ('Button value: ' + IntToStr (iVal.GetValue));
end;

procedure TFormGenericInterface.btnValueClick(Sender: TObject);
var
  aVal: TGetValue<string>;
begin
  aVal := TGetValue<string>.Create (Caption);
  try
    Log ('TGetValue value: ' + aVal.GetValue);
  finally
    aVal.Free;
  end;
end;

procedure TFormGenericInterface.btnIValueClick(Sender: TObject);
var
  aVal: IGetValue<string>;
begin
  aVal := TGetValue<string>.Create (Caption);
  Log ('IGetValue value: ' + aVal.GetValue);
  // freed automatically, as it is reference counted
end;

procedure TFormGenericInterface.Log(const strMsg: string);
begin
  Memo1.Lines.Add (strMsg);
end;

initialization
  Randomize;

end.
GenericInterface_MainForm.pas.dfm
object FormGenericInterface: TFormGenericInterface
  Left = 0
  Top = 0
  Caption = 'GenericInterface'
  ClientHeight = 292
  ClientWidth = 570
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnValue: TButton
    Left = 16
    Top = 8
    Width = 97
    Height = 25
    Caption = 'btnValue'
    TabOrder = 0
    OnClick = btnValueClick
  end
  object Memo1: TMemo
    Left = 128
    Top = 8
    Width = 241
    Height = 276
    TabOrder = 1
  end
  object btnValueButton: TButton
    Left = 16
    Top = 104
    Width = 97
    Height = 25
    Caption = 'btnValueButton'
    TabOrder = 2
    OnClick = btnValueButtonClick
  end
  object btnIValue: TButton
    Left = 16
    Top = 40
    Width = 97
    Height = 25
    Caption = 'btnIValue'
    TabOrder = 3
    OnClick = btnIValueClick
  end
  object ScrollBox1: TScrollBox
    Left = 376
    Top = 8
    Width = 185
    Height = 276
    TabOrder = 4
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù