📄 mainformu.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 + -