fmdemo2main.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit fmDemo2Main;

interface

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

type
  TMyButton = class(TButton, IMyInterface1)
  private
    FRefCount : Integer;
  public
    Destructor Destroy; override;
    //IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    //IMyInterface1
    function GetName(const sStr : String) : String; stdcall;
  end;

  TForm2 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
  private
    { Private declarations }
    aButton : TMyButton;
    aContainer : TComponentList;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TMyButton }

function TMyButton.GetName(const sStr: String): String;
begin

end;

function TMyButton._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TMyButton._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TMyButton.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;


procedure TForm2.BitBtn3Click(Sender: TObject);
begin
  aButton := TMyButton.Create(Self);
  aButton.Parent := Self;
  aButton.Height := 50;
  aButton.Width := 300;
  aButton.Caption := 'I am Created at ' + DateTimeToStr(Now);
  aButton.Left := 10;
  aButton.Top := 10;

  aContainer := TComponentList.Create(True);

  aContainer.Add(aButton);
end;

procedure TForm2.BitBtn4Click(Sender: TObject);
var
  aIntf : IMyInterface1;
begin
  aIntf := aButton;
  ShowMessage(aIntf.GetName('Component-Interface'));
  aIntf := nil;
end;

destructor TMyButton.Destroy;
begin
  TForm(Self.Owner).Caption := 'I am Destroyed';
  inherited;
end;

procedure TForm2.BitBtn5Click(Sender: TObject);
begin
  aContainer.Free;
end;

end.