mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComObj, StdCtrls, ComCtrls, BinIntf;

const
  MAXITEMS = 10;

type
  TForm1 = class(TForm)
    grpItems: TGroupBox;
    Label4: TLabel;
    ecQuantity: TEdit;
    Label5: TLabel;
    ecDescription: TEdit;
    Label6: TLabel;
    ecValue: TEdit;
    btnAdd: TButton;
    btnOptimize: TButton;
    treeBins: TTreeView;
    Label1: TLabel;
    ecBinSize: TEdit;
    lblAlgorithm: TLabel;
    lblWaste: TLabel;
    procedure btnAddClick(Sender: TObject);
    procedure btnOptimizeClick(Sender: TObject);
  private
    { Private declarations }
    FQty: array[1 .. MAXITEMS] of Integer;
    FDesc: array[1 .. MAXITEMS] of string;
    FValue: array[1 .. MAXITEMS] of Integer;
    FItemCount: Integer;
    FBestIntf: IOneDBin2;
    FBestPercentWaste: Double;
    procedure TestPackingMethod(MethodID: TGUID);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnAddClick(Sender: TObject);
begin
  if FItemCount = MAXITEMS then begin
    ShowMessage('This demo does not accept more than ' + IntToStr(MAXITEMS) + ' items.');
    exit;
  end;

  Inc(FItemCount);
  FQty[FItemCount] := StrToInt(ecQuantity.Text);
  FDesc[FItemCount] := ecDescription.Text;
  FValue[FItemCount] := StrToInt(ecValue.Text);

  Beep;
  ActiveControl := ecQuantity;
end;

procedure TForm1.TestPackingMethod(MethodID: TGUID);
var
  TestIntf: IOneDBin2;
  Index: Integer;
begin
  TestIntf := CreateComObject(MethodID) as IOneDBin2;
  TestIntf.SetMaxValue(StrToInt(ecBinSize.Text));
  for Index := 1 to FItemCount do
    TestIntf.AddItem(FQty[Index], FDesc[Index], FValue[Index]);
  TestIntf.Optimize;
  if TestIntf.PercentWaste < FBestPercentWaste then begin
    FBestPercentWaste := TestIntf.PercentWaste;
    FBestIntf := TestIntf;
  end;
end;

procedure TForm1.btnOptimizeClick(Sender: TObject);
var
  BinCount: Integer;
  Node: TTreeNode;
  Desc: WideString;
  Value: Integer;
begin
  FBestPercentWaste := 100.0;

  TestPackingMethod(Class_NextFit);
  TestPackingMethod(Class_FirstFit);
  TestPackingMethod(Class_BestFit);

  BinCount := 0;

  lblAlgorithm.Caption := FBestIntf.GetName;
  lblWaste.Caption := FloatToStrF(FBestIntf.PercentWaste, ffFixed, 8, 2) + '% waste';

  treeBins.Items.BeginUpdate;
  try
    while FBestIntf.NextBin do begin
      Inc(BinCount);
      Node := treeBins.Items.AddChild(nil, 'Bin ' +
        IntToStr(BinCount));
      while FBestIntf.NextItem(Desc, Value) do
        treeBins.Items.AddChild(Node, Desc);
    end;
  finally
    treeBins.Items.EndUpdate;
  end;

  btnAdd.Enabled := False;
  btnOptimize.Enabled := False;
end;

end.