Delphi 封装(5)-物理上的封装-用DLL封装对象

library DemoSvr;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  ShareMem,
  SysUtils,
  Classes,
  Demo in 'Demo.PAS';

{$R *.res}

function CarObj:TCar;
begin
  Result:=TCar.create;
end;

function BicycleObj:TBicycle;
begin
  Result:=TBicycle.create;
end;

exports
  CarObj,
  BicycleObj;
end.

  TBicycle = class(TVehicle)
  public
    constructor create; 
    destructor Destory;
    procedure ride;virtual;
  end;
  
  TCar = class(TVehicle)
  protected
    FEngine: TEngine;
  public
    constructor create;
    destructor Destory;
    procedure drive;virtual;
  end;

unit frmDemo;

interface

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

type
//---这里声明需要用到的DLL中对象的方法---

  TVehicle = class(TObject);
  TCar = class(TVehicle)
  public
    procedure drive;virtual;abstract;
  end;
  TBicycle = class(TVehicle)
  public
    procedure ride;virtual;abstract;
  end;

//----------------------------

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function CarObj:TCar ;external 'DemoSvr.dll';
  function BicycleObj:TBicycle ;external 'DemoSvr.dll';

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var MyCar:TCar;
begin
  MyCar:=CarObj;
  if Mycar=nil then exit;
  try
    MyCar.drive;
  finally
    MyCar.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bicycle:TBicycle;
begin
  Bicycle:=BicycleObj;
  try
    Bicycle.ride;
  finally
    Bicycle.Free;
  end;
end;

end.

unit IDemo;

interface


type
  ICar = interface (IInterface)
    ['{ED52E264-6683-11D7-B847-001060806215}']
    procedure Drive;
  end;

  IBicycle = interface (IInterface)
    ['{ED52E264-6683-11D7-B847-001060806216}']
    procedure Ride;
  end;

implementation

end.

unit Demo;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,IDemo;

type
  TEngine = class(TObject)
  private
    FCapacity: Integer;
    FPower: Integer;
  public
    constructor create;
    procedure start;
    procedure stop;
  end;
  
  TWheel = class(TObject)
  private
    FNo: Integer;
    FSize: Integer;
    FTypeName: string;
    procedure check;
  public
    constructor create(size:Integer;TypeName:string;No:Integer);
  end;
  
  TVehicle = class(TInterfacedObject)
  protected
    FColor: string;
    FMake: string;
    FTopSpeed: Integer;
    FWheel: TWheel;
    FWheels: TList;
    procedure SlowDown;
    procedure SpeedUp;
    procedure Start;
    procedure Stop;
  end;
  
  TBicycle = class(TVehicle,IBicycle)
  public
    constructor create; 
    destructor Destory;
    procedure ride;
  end;
  
  TCar = class(TVehicle,ICar)
  protected
    FEngine: TEngine;
  public
    constructor create;
    destructor Destory;
    procedure drive;
  end;

implementation


{
*********************************** TBicycle ***********************************
}
constructor TBicycle.create;
var
  i: Integer;
begin
  FColor:='白色';
  FMake:='永久';
  FTopSpeed:=20;
  ShowMessage(FColor+FMake+'车，最高时速：'+IntToStr(FTopSpeed));
  FWheels:= TList.Create;
  for i:=1  to 2 do
    FWheels.Add(TWheel.create(21,'B型自行车车轮',i));
end;

destructor TBicycle.Destory;
var
  i: Integer;
begin
  for i:=1  to 2 do
    TWheel(FWheels.Items[i]).Free;
  inherited;
end;

procedure TBicycle.ride;
begin
  start;
  speedUp;
  showmessage('自行车车行驶中...');
  SlowDown;
  Stop;
end;

{
************************************* TCar *************************************
}
constructor TCar.create;
var
  i: Integer;
begin
  inherited create;
  FEngine:=TEngine.create;
  FColor:='黑色';
  FMake:='红旗';
  FTopSpeed:=200;
  ShowMessage(FColor+FMake+'车，最高时速：'+IntToStr(FTopSpeed));
  FWheels:= TList.Create;
  for i:=1  to 4 do
    FWheels.Add(TWheel.create(36,'A型汽车车轮',i));
end;

destructor TCar.Destory;
var
  i: Integer;
begin
  for i:=1  to 4 do
    TWheel(FWheels.Items[i]).Free;
  FEngine.Free;
  inherited;
end;

procedure TCar.drive;
begin
  start;
  FEngine.start;
  speedUp;
  showmessage('汽车行驶中...');
  SlowDown;
  FEngine.stop;
  Stop;
end;

{
*********************************** TEngine ************************************
}
constructor TEngine.create;
begin
  Fcapacity:=1500;
  Fpower:=130;
end;

procedure TEngine.start;
begin
  ShowMessage(inttostr(Fcapacity)+'cc,'+inttostr(Fpower)+'匹马力的发动机发动了!');
end;

procedure TEngine.stop;
begin
  ShowMessage('发动机关闭了');
end;

{
*********************************** TVehicle ***********************************
}

procedure TVehicle.SlowDown;
begin
  ShowMessage('正在减速...');
end;

procedure TVehicle.SpeedUp;
begin
  ShowMessage('正在加速...');
end;

procedure TVehicle.Start;
begin
  ShowMessage('车子开始启动');
end;

procedure TVehicle.Stop;
begin
  ShowMessage('车子停下');
end;

{
************************************ TWheel ************************************
}
constructor TWheel.create(size:Integer;TypeName:string;No:Integer);
begin
  FSize:=size;
  FTypeName:=TypeName;
  FNo:=No;
  check;
end;

procedure TWheel.check;
begin
  ShowMessage('检查第'+IntToStr(FNo)+'个车轮。型号：'+FTypeName+' 大小：'+IntToStr(FSize));
end;

end.

unit frmDemo;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function CarObj:ICar ;external 'DemoSvr.dll';
  function BicycleObj:IBicycle ;external 'DemoSvr.dll';

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var MyCar:ICar;
begin
  MyCar:=CarObj;
  MyCar.drive;
  Mycar:=nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bicycle:IBicycle;
begin
  Bicycle:=BicycleObj;
  Bicycle.ride;
  Bicycle:=nil;
end;

end.

 

转载于:https://www.cnblogs.com/YiShen/p/9870033.html