⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gasform.pas

📁 delphi com深入编程,非常有收藏价值
💻 PAS
字号:
unit GasForm;

interface

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

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

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

  TfrmGas = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    list: TListView;
    btnAdd: TButton;
    btnModify: TButton;
    btnDelete: TButton;
    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: TGasItems;
    procedure AddListItem(GasItem: TGasItem);
    procedure SetListItem(LI: TListItem; GasItem: TGasItem);
    procedure EnableButtons;
  public
    { Public declarations }
  end;

implementation

uses MainForm, GasItemForm;

{$R *.DFM}

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

{ TfrmGas }

procedure TfrmGas.AddListItem(GasItem: TGasItem);
var
  LI: TListItem;
begin
  LI := list.Items.Add;
  LI.Caption := DateToStr(GasItem.Date);
  LI.SubItems.Add(FloatToStrF(GasItem.Gallons, ffFixed, 8, 1));
  LI.SubItems.Add(FloatToStrF(GasItem.Mileage, ffFixed, 8, 1));

  list.Selected := LI;
end;

procedure TfrmGas.SetListItem(LI: TListItem; GasItem: TGasItem);
begin
  LI.Caption := DateToStr(GasItem.Date);
  LI.SubItems[0] := FloatToStrF(GasItem.Gallons, ffFixed, 8, 1);
  LI.SubItems[1] := FloatToStrF(GasItem.Mileage, ffFixed, 8, 1);
end;

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

procedure TfrmGas.FormCreate(Sender: TObject);
var
  stm: IStream;
  Dummy: TDummy;
  OS: TOleStream;
  Index: Integer;
  GasItem: TGasItem;
begin
  FItems := TGasItems.Create;

  if SUCCEEDED(frmMain.RootStorage.OpenStream('Gas', 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('Gas',
      STGM_CREATE or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, 0, stm));
  end;

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

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

procedure TfrmGas.FormDestroy(Sender: TObject);
var
  stm: IStream;
  OS: TOleStream;
  Dummy: TDummy;
begin
  OleCheck(frmMain.RootStorage.CreateStream('Gas',
    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 TfrmGas.btnAddClick(Sender: TObject);
var
  frmGasItem: TfrmGasItem;
  GasItem: TGasItem;
begin
  frmGasItem := TfrmGasItem.Create(nil);
  try
    if frmGasItem.ShowModal = mrOk then begin
      GasItem := FItems.Add;
      GasItem.Date := frmGasItem.Date;
      GasItem.Gallons := frmGasItem.Gallons;
      GasItem.Mileage := frmGasItem.Mileage;

      AddListItem(GasItem);

      EnableButtons;
    end;
  finally
    frmGasItem.Free;
  end;
end;

procedure TfrmGas.btnModifyClick(Sender: TObject);
var
  frmGasItem: TfrmGasItem;
  GasItem: TGasItem;
begin
  frmGasItem := TfrmGasItem.Create(nil);
  try
    GasItem := FItems.Items[list.Selected.Index];
    frmGasItem.dtDate.Date := GasItem.Date;
    frmGasItem.ecGallons.Text := FloatToStr(GasItem.Gallons);
    frmGasItem.ecMileage.Text := FloatToStr(GasItem.Mileage);

    if frmGasItem.ShowModal = mrOk then begin
      GasItem.Date := frmGasItem.Date;
      GasItem.Gallons := frmGasItem.Gallons;
      GasItem.Mileage := frmGasItem.Mileage;

      SetListItem(list.Selected, GasItem);
    end;
  finally
    frmGasItem.Free;
  end;
end;

procedure TfrmGas.btnDeleteClick(Sender: TObject);
var
  Index: Integer;
  GasItem: TGasItem;
begin
  Index := list.Selected.Index;
  list.Items.Delete(Index);
  GasItem := FItems.Items[Index];
  GasItem.Free;

  EnableButtons;
end;

{ TGasItem }

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

{ TGasItems }

function TGasItems.Add: TGasItem;
begin
  Result := inherited Add as TGasItem;
end;

constructor TGasItems.Create;
begin
  inherited Create(TGasItem);
end;

function TGasItems.GetItem(Index: Integer): TGasItem;
begin
  Result := inherited GetItem(Index) as TGasItem;
end;

procedure TGasItems.SetItem(Index: Integer; Value: TGasItem);
begin
  inherited SetItem(Index, Value);
end;

{ TDummy }

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

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

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -