nextfit.pas

详细讲述如何用delphi进行com编程

unit NextFit;

interface

uses
  Windows, ActiveX, ComObj, classes, BinIntf;

type
  TBinItem = class
  protected
    FDescription: string;
    FValue: Integer;
  end;

  TBin = class
  protected
    FValue: Integer;
    FItems: TList;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TNextFit = class(TComObject, IOneDBin)
  protected
    FMaxValue: Integer;
    FItems: TList;
    FBins: TList;
    FCurrentBin: TBin;
    FBinIndex: Integer;
    FItemIndex: Integer;
  public
    procedure Initialize; override;
    destructor Destroy; override;
    {Declare IOneDBin methods here}
    procedure SetMaxValue(AMaxValue: Integer);
    procedure AddItem(AQuantity: Integer; ADescription: WideString; AValue: Integer);
    procedure Optimize;
    function NextBin: Boolean;
    function NextItem(var ADescription: WideString; var AValue: Integer): Boolean;
  end;

implementation

uses ComServ;

{ TBin }

constructor TBin.Create;
begin
  FItems := TList.Create;
end;

destructor TBin.Destroy;
begin
  FItems.Free;
end;

{ TNextFit }

procedure TNextFit.AddItem(AQuantity: Integer; ADescription: WideString;
  AValue: Integer);
var
  Item: TBinItem;
  Index: Integer;
begin
  for Index := 1 to AQuantity do begin
    Item := TBinItem.Create;
    Item.FDescription := ADescription;
    Item.FValue := AValue;
    FItems.Add(Item);
  end;
end;

destructor TNextFit.Destroy;
var
  Index: Integer;
begin
  for Index := 0 to FBins.Count - 1 do
    TBin(FBins[Index]).Free;
  FBins.Free;

  for Index := 0 to FItems.Count - 1 do
    TBinItem(FItems[Index]).Free;
  FItems.Free;
end;

procedure TNextFit.Initialize;
begin
  FItems := TList.Create;
  FBins := TList.Create;
end;

function TNextFit.NextBin: Boolean;
begin
  if FBinIndex < FBins.Count - 1 then begin
    Inc(FBinIndex);
    FCurrentBin := TBin(FBins[FBinIndex]);
    FItemIndex := -1;
    Result := True;
  end else
    Result := False;
end;

function TNextFit.NextItem(var ADescription: WideString;
  var AValue: Integer): Boolean;
begin
  if FItemIndex < FCurrentBin.FItems.Count - 1 then begin
    Inc(FItemIndex);
    ADescription := TBinItem(FCurrentBin.FItems[FItemIndex]).FDescription;
    AValue := TBinItem(FCurrentBin.FItems[FItemIndex]).FValue;
    Result := True;
  end else
    Result := False;
end;

procedure TNextFit.Optimize;
var
  Index: Integer;
  Item: TBinItem;
begin
  FCurrentBin := nil;
  for Index := 0 to FItems.Count - 1 do begin
    Item := TBinItem(FItems[Index]);
    if (FCurrentBin = nil) or (FCurrentBin.FValue + Item.FValue > FMaxValue) then begin
      FCurrentBin := TBin.Create;
      FBins.Add(FCurrentBin);
    end;

    FCurrentBin.FItems.Add(Item);
    FCurrentBin.FValue := FCurrentBin.FValue + Item.FValue;
  end;

  FBinIndex := -1;
end;

procedure TNextFit.SetMaxValue(AMaxValue: Integer);
begin
  FMaxValue := AMaxValue;
end;

initialization
{$IFDEF VER100}
  TComObjectFactory.Create(ComServer, TNextFit, Class_NextFit,
    'NextFit', 'Next-fit algorithm', ciMultiInstance);
{$ELSE}
  TComObjectFactory.Create(ComServer, TNextFit, Class_NextFit,
    'NextFit', 'Next-fit algorithm', ciMultiInstance, tmApartment);
{$ENDIF}
end.