datamodule.pas

《Delphi COM深入编程》原书光盘

unit DataModule;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables;

type
  TPartDM = class(TDataModule)
    dbParts: TDatabase;
    tblParts: TTable;
    tblPartsPARTNO: TStringField;
    tblPartsDESC: TStringField;
    tblPartsUNITPRICE: TFloatField;
    tblPartsONHAND: TFloatField;
    tblPartsREORDER: TFloatField;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure GetAllParts(varFields: OleVariant; var varValues: OleVariant);
    procedure GetPart(PartNumber: string; varFields: OleVariant; var varValues: OleVariant);
    function UsePart(PartNumber: string; Quantity: Integer): Integer;
    function AddPart(varFields: OleVariant; varValues: OleVariant): string;
    function DeletePart(PartNo: string): Boolean;
    function ModifyPart(PartNo: string; varFields: OleVariant; varValues: OleVariant): Boolean;
  end;

var
  PartDM: TPartDM;

implementation

uses
  Parts, PartSrv_TLB;

{$R *.DFM}

{ TPartDM }

function TPartDM.AddPart(varFields: OleVariant; varValues: OleVariant): string;
var
  Part: TPart;
begin
  Part := TPart.Create;
  try
    Part.FromVariant(varFields, varValues);
    with tblParts do begin
      Append;
      tblPartsPARTNO.AsString := Part.PartNumber;
      tblPartsDESC.AsString := Part.Description;
      tblPartsUNITPRICE.AsFloat := Part.UnitPrice;
      tblPartsONHAND.AsInteger := Part.OnHand;
      tblPartsREORDER.AsInteger := Part.Reorder;
      Post;

      Result := Part.PartNumber;
    end;
  finally
    Part.Free;
  end;
end;

function TPartDM.DeletePart(PartNo: string): Boolean;
begin
  Result := tblParts.Locate('PARTNO', PartNo, []);
  if Result then
    tblParts.Delete;
end;

procedure TPartDM.GetAllParts(varFields: OleVariant; var varValues: OleVariant);
var
  Part: TPart;
  Index: Integer;
begin
  Part := TPart.Create;
  try
    with tblParts do begin
      varValues := VarArrayCreate([0, RecordCount - 1], varVariant);

      Index := 0;
      First;
      while not EOF do begin
        Part.CreateFromDataSet(tblParts);
        varValues[Index] := Part.ToVariant(varFields);
        Inc(Index);
        Next;
      end;
    end;
  finally
    Part.Free;
  end;
end;

procedure TPartDM.GetPart(PartNumber: string; varFields: OleVariant;
  var varValues: OleVariant);
var
  Part: TPart;
begin
  if tblParts.Locate('PARTNO', PartNumber, []) then begin
    Part := TPart.Create;
    try
      Part.CreateFromDataSet(tblParts);
      varValues := Part.ToVariant(varFields);
    finally
      Part.Free;
    end;
  end;
end;

function TPartDM.ModifyPart(PartNo: string; varFields: OleVariant; varValues: OleVariant): Boolean;
var
  Index: Integer;
begin
  Result := False;

  if tblParts.Locate('PARTNO', PartNo, []) then begin
    with tblParts do begin
      Edit;
      try
        for Index := VarArrayLowBound(varFields, 1) to varArrayHighBound(varFields, 1) do begin
          case varFields[Index] of
            fnPartNumber: tblPartsPARTNO.AsString := varValues[Index];
            fnDescription: tblPartsDESC.AsString := varValues[Index];
            fnUnitPrice: tblPartsUNITPRICE.AsFloat := varValues[Index];
            fnOnHand: tblPartsONHAND.AsInteger := varValues[Index];
            fnReorder: tblPartsREORDER.AsInteger := varValues[Index];
          end;
        end;
        Post;

        Result := True;
      except
        Cancel;
      end;
    end;
  end;
end;

function TPartDM.UsePart(PartNumber: string; Quantity: Integer): Integer;
begin
  if tblParts.Locate('PARTNO', PartNumber, []) then begin
    if Quantity > tblPartsONHAND.AsInteger then
      raise Exception.CreateFmt('You requested %d of part %s.  ' +
        'That part currently has an onhand quantity of %d.',
        [Quantity, PartNumber, tblPartsONHAND.AsInteger]);

    tblParts.Edit;
    Result := tblPartsONHAND.AsInteger - Quantity;
    tblPartsONHAND.AsInteger := Result;
    tblParts.Post;

    // Check remaining inventory here.  If Result < tblPartsREORDER.AsInteger,
    // then trigger a routine to order more parts automatically.
  end else
    raise Exception.CreateFmt('Unknown part number %s.',
      [PartNumber]);
end;

end.