firstfit.pas

delphi com深入编程,非常有收藏价值

unit FirstFit;

interface

uses
  Windows, ActiveX, ComObj, classes, BinIntf, BinBase;

type
  TFirstFit = class(TAbstractOneDBin)
    procedure Optimize; override;
    function GetName: WideString; override;
  end;

implementation

uses
  ComServ;

{ TFirstFit }

function TFirstFit.GetName: WideString;
begin
  Result := 'First Fit';
end;

procedure TFirstFit.Optimize;
var
  Index: Integer;
  Item: TBinItem;
  BinFound: Boolean;
  BinIndex: Integer;
begin
  FCurrentBin := nil;
  for Index := 0 to FItems.Count - 1 do begin
    Item := TBinItem(FItems[Index]);

    // Find a bin with enough room
    BinFound := False;
    BinIndex := 0;
    while (not BinFound) and (BinIndex < FBins.Count) do begin
      FCurrentBin := TBin(FBins[BinIndex]);
      if FCurrentBin.Value + Item.Value <= FMaxValue then
        BinFound := True
      else
        Inc(BinIndex);
    end;

    // if no available bin, create a new one
    if not BinFound then begin
      FCurrentBin := TBin.Create;
      FBins.Add(FCurrentBin);
    end;

    FCurrentBin.Items.Add(Item);
    FCurrentBin.Value := FCurrentBin.Value + Item.Value;
  end;

  FBinIndex := -1;
end;

initialization
{$IFDEF VER100}
  TComObjectFactory.Create(ComServer, TFirstFit, Class_FirstFit,
    'FirstFit', 'First Fit algorithm', ciMultiInstance);
{$ELSE}
  TComObjectFactory.Create(ComServer, TFirstFit, Class_FirstFit,
    'FirstFit', 'First Fit algorithm', ciMultiInstance, tmApartment);
{$ENDIF}
end.