mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ComObj, ActiveX, PartSrv_TLB, Menus, ExtCtrls, OleServer, StdCtrls;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    pnlClient: TPanel;
    StringGrid1: TStringGrid;
    pnlBottom: TPanel;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    InsertPart1: TMenuItem;
    EditPart1: TMenuItem;
    DeletePart1: TMenuItem;
    PartServer1: TPartServer;
    ecServer: TEdit;
    btnConnect: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure InsertPart1Click(Sender: TObject);
    procedure DeletePart1Click(Sender: TObject);
    procedure EditPart1Click(Sender: TObject);
    procedure PartServer1Add(Sender: TObject; varFields,
      varValues: OleVariant);
    procedure PartServer1Delete(Sender: TObject;
      var PartNumber: OleVariant);
    procedure PartServer1Modify(Sender: TObject;
      var PartNumber: OleVariant; varFields, varValues: OleVariant);
    procedure btnConnectClick(Sender: TObject);
  private
    { Private declarations }
    FFields: OleVariant;
    procedure LoadPartGrid;
    procedure LoadRow(Row: Integer; varFields, varValues: OleVariant);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses PartForm;

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FFields := VarArrayCreate([0, 4], varInteger);
  FFields[0] := fnPartNumber;
  FFields[1] := fnDescription;
  FFields[2] := fnUnitPrice;
  FFields[3] := fnOnHand;
  FFields[4] := fnReorder;
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
  // If no server was entered, we'll use the local machine
  if ecServer.Text <> '' then
    PartServer1.RemoteMachineName := ecServer.Text;

  PartServer1.Connect;

  // Load all parts from the database server
  LoadPartGrid;

  // Enable the edit menu
  Edit1.Enabled := True;
end;

procedure TfrmMain.LoadRow(Row: Integer; varFields, varValues: OleVariant);
var
  ValueIndex: Integer;
  ColIndex: Integer;
begin
  for ValueIndex := VarArrayLowBound(varValues, 1) to VarArrayHighBound(varValues, 1) do
    for ColIndex := VarArrayLowBound(FFields, 1) to VarArrayHighBound(FFields, 1) do
      if FFields[ColIndex] = varFields[ValueIndex] then
        StringGrid1.Cells[ColIndex, Row] := varValues[ValueIndex];
end;

procedure TfrmMain.LoadPartGrid;
var
  varValues: OleVariant;
  Index: Integer;
  FieldNumber: Integer;
  Row: Integer;
begin
  varValues := PartServer1.GetAll(FFields);

  StringGrid1.RowCount := VarArrayHighBound(varValues, 1) -
    VarArrayLowBound(varValues, 1) + 2;

  StringGrid1.ColCount := VarArrayHighBound(FFields, 1) -
    VarArrayLowBound(FFields, 1) + 1;

  for Index := VarArrayLowBound(FFields, 1) to VarArrayHighBound(FFields, 1) do begin
    FieldNumber := FFields[Index];
    case FieldNumber of
      fnPartNumber: StringGrid1.Cells[Index, 0] := 'Part #';
      fnDescription: StringGrid1.Cells[Index, 0] := 'Description';
      fnUnitPrice: StringGrid1.Cells[Index, 0] := 'Unit Price';
      fnOnHand: StringGrid1.Cells[Index, 0] := 'On Hand';
      fnReorder: StringGrid1.Cells[Index, 0] := 'Reorder';
    end;
  end;

  Row := 1;
  for Index := VarArrayLowBound(varValues, 1) to VarArrayHighBound(varValues, 1) do begin
    LoadRow(Row, FFields, varValues[Index]);
    Inc(Row);
  end;
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.InsertPart1Click(Sender: TObject);
var
  frmPart: TfrmPart;
  varValues: OleVariant;
begin
  frmPart := TfrmPart.Create(nil);
  try
    if frmPart.ShowModal = mrOk then begin
      varValues := VarArrayCreate([0, 4], varVariant);
      varValues[0] := frmPart.PartNumber;
      varValues[1] := frmPart.Description;
      varValues[2] := frmPart.UnitPrice;
      varValues[3] := frmPart.OnHand;
      varValues[4] := frmPart.Reorder;
      PartServer1.AddPart(FFields, varValues);
    end;
  finally
    frmPart.Free;
  end;
end;

procedure TfrmMain.DeletePart1Click(Sender: TObject);
begin
  if StringGrid1.Row > 0 then
    PartServer1.DeletePart(StringGrid1.Cells[0, StringGrid1.Row]);
end;

procedure TfrmMain.EditPart1Click(Sender: TObject);
var
  PartNumber: string;
  frmPart: TfrmPart;
  varValues: OleVariant;
begin
  if StringGrid1.Row > 0 then begin
    PartNumber := StringGrid1.Cells[0, StringGrid1.Row];
    varValues := PartServer1.GetPart(PartNumber, FFields);

    frmPart := TfrmPart.Create(nil);
    try
      frmPart.ecPartNumber.Text := varValues[0];
      frmPart.ecDescription.Text := varValues[1];
      frmPart.ecUnitPrice.Text := varValues[2];
      frmPart.ecOnHand.Text := varValues[3];
      frmPart.ecReorder.Text := varValues[4];

      if frmPart.ShowModal = mrOk then begin
        varValues := VarArrayCreate([0, 4], varVariant);
        varValues[0] := frmPart.PartNumber;
        varValues[1] := frmPart.Description;
        varValues[2] := frmPart.UnitPrice;
        varValues[3] := frmPart.OnHand;
        varValues[4] := frmPart.Reorder;
        PartServer1.ModifyPart(PartNumber, FFields, varValues);
      end;
    finally
      frmPart.Free;
    end;
  end;
end;

procedure TfrmMain.PartServer1Add(Sender: TObject; varFields,
  varValues: OleVariant);
begin
  // A new part was added - reload the whole grid
  LoadPartGrid;
end;

procedure TfrmMain.PartServer1Delete(Sender: TObject;
  var PartNumber: OleVariant);
begin
  // A part was deleted - reload the whole grid
  LoadPartGrid;
end;

procedure TfrmMain.PartServer1Modify(Sender: TObject;
  var PartNumber: OleVariant; varFields, varValues: OleVariant);
var
  Index: Integer;
  Found: Boolean;
begin
  Found := False;
  Index := 1;

  // If we can find the original part, just reload the row
  while (not Found) and (Index < StringGrid1.RowCount) do begin
    if StringGrid1.Cells[0, Index] = PartNumber then begin
      LoadRow(Index, varFields, varValues);
      Found := True;
    end else
      Inc(Index);
  end;

  // Couldn't find the part, so reload the whole grid
  if not Found then
    LoadPartGrid;
end;

end.