refcform.pas

Delphi高级开发指南是开发程序的好帮手

unit RefCForm;

interface

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

// redeclare the id and the interface
const
  CLSID_TDllNumber: TGUID =
    '{84960F62-1D49-11D1-854E-444553540000}';

type
  INumber = interface
    ['{ECD5DAE3-1D37-11D1-854E-444553540000}']
    function GetValue: Integer; stdcall;
    procedure SetValue (New: Integer); stdcall;
    procedure Increase; stdcall;
    function RefCount: Integer; stdcall;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button3: TButton;
    Timer1: TTimer;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    INum1, INum2, INum3: INumber;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
begin
  INum1 := CreateComObject (
    CLSID_TDllNumber) as INumber;
  INum1.SetValue (Random (1000));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  INum2 := INum1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Assigned (INum1) then
    Label1.Caption := Format (
      '%s: Value = %d; RefCount = %d',
      ['Num1',
      INum1.GetValue,
      INum1.RefCount])
  else
    Label1.Caption := 'INum1 not assigned';

  if Assigned (INum2) then
    Label2.Caption := Format (
      '%s: Value = %d; RefCount = %d',
      ['Num2',
      INum2.GetValue,
      INum2.RefCount])
  else
    Label2.Caption := 'INum2 not assigned';

  if Assigned (INum3) then
    Label3.Caption := Format (
      '%s: Value = %d; RefCount = %d',
      ['Num3',
      INum3.GetValue,
      INum3.RefCount])
  else
    Label3.Caption := 'INum3 not assigned';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  INum3 := INum1;
end;

end.