oilform.pas

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

unit OilForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, ActiveX, AxCtrls, ComObj;

type
  TOilItem = class(TCollectionItem)
  private
    FDate: TDateTime;
    FMileage: Double;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Date: TDateTime read FDate write FDate;
    property Mileage: Double read FMileage write FMileage;
  end;

  TOilItems = class(TCollection)
  public
    constructor Create;
    function Add: TOilItem;
    function GetItem(Index: Integer): TOilItem;
    procedure SetItem(Index: Integer; Value: TOilItem);
    property Items[Index: Integer]: TOilItem
      read GetItem write SetItem;
  end;

  TfrmOil = class(TForm)
    Panel1: TPanel;
    btnAdd: TButton;
    btnModify: TButton;
    btnDelete: TButton;
    Panel2: TPanel;
    list: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnModifyClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private declarations }
    FItems: TOilItems;
    procedure AddListItem(OilItem: TOilItem);
    procedure SetListItem(LI: TListItem; OilItem: TOilItem);
    procedure EnableButtons;
  public
    { Public declarations }
  end;

var
  frmOil: TfrmOil;

implementation

uses MainForm, OilItemForm;

{$R *.DFM}

type
  TDummy = class(TComponent)
  private
    FItems: TOilItems;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Items: TOilItems read FItems write FItems;
  end;

{ TfrmOil }

procedure TfrmOil.AddListItem(OilItem: TOilItem);
var
  LI: TListItem;
begin
  LI := list.Items.Add;
  LI.Caption := DateToStr(OilItem.Date);
  LI.SubItems.Add(FloatToStrF(OilItem.Mileage, ffFixed, 8, 1));

  list.Selected := LI;
end;

procedure TfrmOil.SetListItem(LI: TListItem; OilItem: TOilItem);
begin
  LI.Caption := DateToStr(OilItem.Date);
  LI.SubItems[0] := FloatToStrF(OilItem.Mileage, ffFixed, 8, 1);
end;

procedure TfrmOil.EnableButtons;
begin
  btnModify.Enabled := list.Selected <> nil;
  btnDelete.Enabled := list.Selected <> nil;
end;

procedure TfrmOil.FormCreate(Sender: TObject);
var
  stm: IStream;
  Dummy: TDummy;
  OS: TOleStream;
  Index: Integer;
  OilItem: TOilItem;
begin
  FItems := TOilItems.Create;

  if SUCCEEDED(frmMain.RootStorage.OpenStream('Oil', nil,
    STGM_READ or STGM_SHARE_EXCLUSIVE, 0, stm)) then begin
    Dummy := TDummy.Create(nil);
    try
      OS := TOleStream.Create(stm);
      try
        OS.ReadComponent(Dummy);
        FItems.Assign(Dummy.FItems);
      finally
        OS.Free;
      end;
    finally
      Dummy.Free;
    end;
  end else begin
    OleCheck(frmMain.RootStorage.CreateStream('Oil',
      STGM_CREATE or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, 0, stm));
  end;

  for Index := 0 to FItems.Count - 1 do begin
    OilItem := FItems.Items[Index];
    AddListItem(OilItem);
  end;
end;

procedure TfrmOil.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmOil.FormDestroy(Sender: TObject);
var
  stm: IStream;
  OS: TOleStream;
  Dummy: TDummy;
begin
  OleCheck(frmMain.RootStorage.CreateStream('Oil',
    STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, 0, stm));

  Dummy := TDummy.Create(nil);
  try
    Dummy.Items.Assign(FItems);
    OS := TOleStream.Create(stm);
    try
      OS.WriteComponent(Dummy);
    finally
      OS.Free;
    end;
  finally
    Dummy.Free;
  end;

  FItems.Free;
end;

procedure TfrmOil.btnAddClick(Sender: TObject);
var
  frmOilItem: TfrmOilItem;
  OilItem: TOilItem;
begin
  frmOilItem := TfrmOilItem.Create(nil);
  try
    if frmOilItem.ShowModal = mrOk then begin
      OilItem := FItems.Add;
      OilItem.Date := frmOilItem.Date;
      OilItem.Mileage := frmOilItem.Mileage;

      AddListItem(OilItem);

      EnableButtons;
    end;
  finally
    frmOilItem.Free;
  end;
end;

procedure TfrmOil.btnModifyClick(Sender: TObject);
var
  frmOilItem: TfrmOilItem;
  OilItem: TOilItem;
begin
  frmOilItem := TfrmOilItem.Create(nil);
  try
    OilItem := FItems.Items[list.Selected.Index];
    frmOilItem.dtDate.Date := OilItem.Date;
    frmOilItem.ecMileage.Text := FloatToStr(OilItem.Mileage);

    if frmOilItem.ShowModal = mrOk then begin
      OilItem.Date := frmOilItem.Date;
      OilItem.Mileage := frmOilItem.Mileage;

      SetListItem(list.Selected, OilItem);
    end;
  finally
    frmOilItem.Free;
  end;
end;

procedure TfrmOil.btnDeleteClick(Sender: TObject);
var
  Index: Integer;
  OilItem: TOilItem;
begin
  Index := list.Selected.Index;
  list.Items.Delete(Index);
  OilItem := FItems.Items[Index];
  OilItem.Free;

  EnableButtons;
end;

{ TOilItem }

procedure TOilItem.Assign(Source: TPersistent);
begin
  if Source is TOilItem then begin
    FDate := TOilItem(Source).FDate;
    FMileage := TOilItem(Source).FMileage;
  end else
    inherited Assign(Source);
end;

{ TOilItems }

function TOilItems.Add: TOilItem;
begin
  Result := inherited Add as TOilItem;
end;

constructor TOilItems.Create;
begin
  inherited Create(TOilItem);
end;

function TOilItems.GetItem(Index: Integer): TOilItem;
begin
  Result := inherited GetItem(Index) as TOilItem;
end;

procedure TOilItems.SetItem(Index: Integer; Value: TOilItem);
begin
  inherited SetItem(Index, Value);
end;

{ TDummy }

constructor TDummy.Create(AOwner: TComponent);
begin
  FItems := TOilItems.Create;
end;

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

end.