Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: IntfConstraint.dproj

Project Structure

IntfConstraint.dpr
program IntfConstraint;

uses
  Forms,
  IntfConstraint_MainForm in 'IntfConstraint_MainForm.pas' {FormIntfConstraint};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormIntfConstraint, FormIntfConstraint);
  Application.Run;
end.
IntfConstraint_MainForm.pas
unit IntfConstraint_MainForm;

interface

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

type
  TFormIntfConstraint = class(TForm)
    btnValue: TButton;
    Memo1: TMemo;
    btnValueButton: TButton;
    btnPlainIntf: TButton;
    btnConstructor: TButton;
    ScrollBox1: TScrollBox;
    procedure btnValueClick(Sender: TObject);
    procedure btnPlainIntfClick(Sender: TObject);
    procedure btnConstructorClick(Sender: TObject);
    procedure btnValueButtonClick(Sender: TObject);
  private
    procedure Log (const strMsg: string);
  public
    { Public declarations }
  end;

var
  FormIntfConstraint: TFormIntfConstraint;

implementation

{$R *.dfm}

uses
  Math, Generics.Defaults;

type
  IGetValue = interface
    ['{60700EC4-2CDA-4CD1-A1A2-07973D9D2444}']
    function GetValue: Integer;
    procedure SetValue (Value: Integer);
  end;

  TGetValue = class (TSingletonImplementation, IGetValue)
  private
    fValue: Integer;
  public
    constructor Create (Value: Integer); // = 0);
    function GetValue: Integer;
    procedure SetValue (Value: Integer);
  end;

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

  TInftClass <T: IGetValue> = class
  private
    val1, val2: T; // or IGetValue
  public
    procedure Set1 (val: T);
    procedure Set2 (val: T);
    function GetMin: Integer;
    function GetAverage: Integer;
    procedure IncreaseByTen;
  end;

  TPlainInftClass = class
  private
    val1, val2: IGetValue;
  public
    procedure Set1 (val: IGetValue);
    procedure Set2 (val: IGetValue);
    function GetMin: Integer;
    function GetAverage: Integer;
    procedure IncreaseByTen;
  end;

  TConstrClass <T: class, constructor> = class
  private
    val: T;
  public
    constructor Create;
    function Get: T;
  end;

  // not used, code test only
  TInftComp <T: TComponent, IGetValue> = class
  private
    val: T;
  public
    function GetTheValue: Integer;
  end;


{ TGetValue }

constructor TGetValue.Create(Value: Integer);
begin
  fValue := Value;
end;

function TGetValue.GetValue: Integer;
begin
  Result := fValue;
end;

procedure TGetValue.SetValue(Value: Integer);
begin
  fValue := Value;
end;

{ TInftClass<T> }

function TInftClass<T>.GetAverage: Integer;
begin
  if Assigned (val1) and Assigned (val2) then
    Result := (val1.GetValue + val2.GetValue) div 2
  else
    Result := 0;
end;

function TInftClass<T>.GetMin: Integer;
begin
  if Assigned (val1) and Assigned (val2) then
    Result := min (val1.GetValue, val2.GetValue)
  else
    Result := 0;
end;

procedure TInftClass<T>.IncreaseByTen;
begin
  if Assigned (val1) and Assigned (val2) then
  begin
    val1.SetValue (val1.GetValue + 10);
    val2.SetValue (val2.GetValue + 10);
  end;
end;

procedure TInftClass<T>.Set1(val: T);
begin
  val1 := val;
end;

procedure TInftClass<T>.Set2(val: T);
begin
  val2 := val;
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 TFormIntfConstraint.btnValueButtonClick(Sender: TObject);
var
  iClass: TInftClass<TButtonValue>;
begin
  iClass := TInftClass<TButtonValue>.Create;
  try
    iClass.Set1 (TButtonValue.MakeTButtonValue (self, ScrollBox1));
    iClass.Set2 (TButtonValue.MakeTButtonValue (self, ScrollBox1));
    Log ('Average: ' + IntToStr (iClass.GetAverage));
    Log ('Min: ' + IntToStr (iClass.GetMin));
    iClass.IncreaseByTen;
    Log ('New Average: ' + IntToStr (iClass.GetAverage));
  finally
    iClass.Free;
  end;
end;

procedure TFormIntfConstraint.btnValueClick(Sender: TObject);
var
  iClass: TInftClass<TGetValue>;
begin
  iClass := TInftClass<TGetValue>.Create;
  try
    iClass.Set1 (TGetValue.Create (5));
    iClass.Set2 (TGetValue.Create (25));
    Log ('Average: ' + IntToStr (iClass.GetAverage));
    iClass.IncreaseByTen;
    Log ('Min: ' + IntToStr (iClass.GetMin));
  finally
    iClass.val1.Free;
    iClass.val2.Free;
    iCLass.Free;
  end;
end;

procedure TFormIntfConstraint.btnPlainIntfClick(Sender: TObject);
var
  aClass: TPlainInftClass;
begin
  aClass := TPlainInftClass.Create;
  try
    aClass.Set1 (TGetValue.Create (5));
    aClass.Set2 (TGetValue.Create (25));
    Log ('Average: ' + IntToStr (aClass.GetAverage));
    aClass.IncreaseByTen;
    Log ('Min: ' + IntToStr (aClass.GetMin));
  finally
    aClass.Free;
  end;
end;

type
  TSimpleConst = class
  public
    Value: Integer;
    constructor Create;
  end;

type
  TParamConst = class
  public
    Value: Integer;
    constructor Create (I: Integer);
  end;


procedure TFormIntfConstraint.btnConstructorClick(Sender: TObject);
var
  constructObj: TConstrClass<TSimpleConst>;
  paramCostObj: TConstrClass<TParamConst>;
begin
  constructObj := TConstrClass<TSimpleConst>.Create;
  Log ('Value 1: ' + IntToStr (constructObj.Get.Value));

  paramCostObj := TConstrClass<TParamConst>.Create;
  Log ('Value 2: ' + IntToStr (paramCostObj.Get.Value));

//  with TParamConst.Create do
//  begin
//    //
//  end;
  constructObj.Free;
  paramCostObj.Free;
end;

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

{ TPlainInftClass }

function TPlainInftClass.GetAverage: Integer;
begin
  Result := (val1.GetValue + val2.GetValue) div 2;
end;

function TPlainInftClass.GetMin: Integer;
begin
  Result := min (val1.GetValue, val2.GetValue);
end;

procedure TPlainInftClass.IncreaseByTen;
begin
  val1.SetValue (val1.GetValue + 10);
  val2.SetValue (val2.GetValue + 10);
end;

procedure TPlainInftClass.Set1(val: IGetValue);
begin
  val1 := val;
end;

procedure TPlainInftClass.Set2(val: IGetValue);
begin
  val2 := val;
end;

{ TConstrClass<T> }

constructor TConstrClass<T>.Create;
begin
  val := T.Create;
end;

function TConstrClass<T>.Get: T;
begin
  Result := val;
end;

{ TSimpleCont }

constructor TSimpleConst.Create;
begin
  Value := 10;
end;

{ TParamCont }

constructor TParamConst.Create(I: Integer);
begin
  Value := I;
end;

{ TInftComp<T> }

function TInftComp<T>.GetTheValue: Integer;
begin
  Result := val.getValue;
end;

initialization
  Randomize;

end.
IntfConstraint_MainForm.pas.dfm
object FormIntfConstraint: TFormIntfConstraint
  Left = 0
  Top = 0
  Caption = 'IntfConstraint'
  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 = 9
    Width = 97
    Height = 25
    Caption = 'btnValue'
    TabOrder = 0
    OnClick = btnValueClick
  end
  object Memo1: TMemo
    Left = 128
    Top = 8
    Width = 241
    Height = 276
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object btnValueButton: TButton
    Left = 16
    Top = 40
    Width = 97
    Height = 25
    Caption = 'btnValueButton'
    TabOrder = 2
    OnClick = btnValueButtonClick
  end
  object btnPlainIntf: TButton
    Left = 16
    Top = 71
    Width = 97
    Height = 25
    Caption = 'btnPlainIntf'
    TabOrder = 3
    OnClick = btnPlainIntfClick
  end
  object btnConstructor: TButton
    Left = 16
    Top = 208
    Width = 97
    Height = 25
    Caption = 'btnConstructor'
    TabOrder = 4
    OnClick = btnConstructorClick
  end
  object ScrollBox1: TScrollBox
    Left = 376
    Top = 8
    Width = 185
    Height = 276
    TabOrder = 5
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù