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

📄 mainformu.pas

📁 source for card readers
💻 PAS
字号:
unit MainFormU;

//Displays a list of Sightings which can also each be deleted.

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, TemplateU, Buttons, StdCtrls, ExtCtrls,
  SightingU;

type
  TfrmMain = class(TfrmTemplate)
    lstSightings: TListBox;
    btnShowInfo: TButton;
    btnDel: TButton;
    rgpNew: TRadioGroup;
    btnCapture: TButton;
    procedure btnShowInfoClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure rgpNewClick(Sender: TObject);
    procedure btnCaptureClick(Sender: TObject);  // see comments below
  private
    FNewSighting: TSighting;
  end; // end TfrmMain = class(TfrmTemplate)

var
  frmMain: TfrmMain;

implementation

uses ShowInfoU, GetBirdInfoU, GetTreeInfoU;

{$R *.dfm} 

procedure TfrmMain.btnDelClick(Sender: TObject);
begin
  if lstSightings.ItemIndex >= 0 then
  begin
    lstSightings.Items.Objects [lstSightings.ItemIndex].Free;
    lstSightings.DeleteSelected;
  end;
end; // end procedure TfrmMain.btnDelClick

procedure TfrmMain.btnShowInfoClick(Sender: TObject);
var
  Temp: TObject;
begin
  if lstSightings.ItemIndex >= 0 then
  begin
    Temp := lstSightings.Items.Objects [lstSightings.ItemIndex];
    frmShowInfo.ShowInfo (Temp as TSighting);
  end;
end; // end procedure TfrmMain.btnShowInfoClick

procedure TfrmMain.rgpNewClick(Sender: TObject);
var
  TypeOfSighting: string;
begin
  //Replaced by a button with an OnClick event handler -- see below
  if rgpNew.ItemIndex < 0 then
  begin
    ShowMessage ('Please select the type of sighting');
    Exit;
  end;

  TypeOfSighting := rgpNew.Items[rgpNew.ItemIndex];
  rgpNew.ItemIndex := -1;

  if TypeOfSighting = 'Bird' then
    with frmGetBirdInfo do
    begin
      ElicitInfo;
      if InfoValid = False then
        exit;
      FNewSighting := TBirdSighting.Create (Grid,
              Number, SightType, Breeding, SightDate);
      {
      // following accesses innards of frmGetBirdInfo, so not desirable
      FNewSighting := TBirdSighting.Create (edtGrid.Text,
              sedNumber.Value, rgpType.Items[rgpType.ItemIndex],
              chkBreeding.Checked, DateToStr (dtpDate.DateTime));
              }
      lstSightings.AddItem(FNewSighting.SightType, FNewSighting);
    end
  else if TypeOfSighting = 'Tree' then
    with frmGetTreeInfo do
    begin
      ElicitInfo;
      if InfoValid = False then
        exit;
      FNewSighting := TTreeSighting.Create (Grid,
              Number, SightType);
      lstSightings.AddItem(FNewSighting.SightType, FNewSighting);
    end
  else
    ShowMessage ('Unknown type of sighting');
end; // end procedure TfrmMain.rgpNewClick

{ The rgpNewClick event handler meets the requirerments stated in the question.
  However, one might choose to add a 'Capture Data' button to the interface, and
  use this to trigger the data collection rather than a click on a RadioButton.
  If one did this, one would not implement the rgpNewClick event handler above,
  but instead would write a btnCaptureClick event handler as below.
  }

(*
procedure TfrmMain.rgpNewClick(Sender: TObject);
begin                    
end; // end procedure TfrmMain.rgpNewClick
*)

procedure TfrmMain.btnCaptureClick(Sender: TObject);
var
  TypeOfSighting: string;
begin
  if rgpNew.ItemIndex < 0 then
  begin
    ShowMessage ('Please select the type of sighting');
    Exit;
  end;

  TypeOfSighting := rgpNew.Items[rgpNew.ItemIndex];
  rgpNew.ItemIndex := -1;

  if TypeOfSighting = 'Bird' then
    with frmGetBirdInfo do
    begin
      ElicitInfo;
      if InfoValid = False then
        exit;
      FNewSighting := TBirdSighting.Create (Grid,
              Number, SightType, Breeding, SightDate);
      lstSightings.AddItem(FNewSighting.SightType, FNewSighting);
    end
  else if TypeOfSighting = 'Tree' then
    with frmGetTreeInfo do
    begin
      ElicitInfo;
      if InfoValid = False then
        exit;
      FNewSighting := TTreeSighting.Create (Grid,
              Number, SightType);
      lstSightings.AddItem(FNewSighting.SightType, FNewSighting);
    end
  else
    ShowMessage ('Unknown type of sighting');
end;  // end procedure TfrmMain.btnCaptureClick 

end. // end MainFormU

⌨️ 快捷键说明

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