unit UI_Form_Main;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.Generics.Collections, System.Actions, System.SysUtils, System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ComCtrls,
Vcl.StdCtrls,
Vcl.ActnList,
Vcl.ExtCtrls,
UI_Form_Base,
Model_Person;
type
TMainForm =
class( TBaseForm )
Persons_ListView : TListView;
NewPerson_Button : TButton;
EditPerson_Button : TButton;
ActionList1 : TActionList;
NewPerson_Action : TAction;
EditPerson_Action : TAction;
Action_Panel : TPanel;
DeletePerson_Action : TAction;
DeletePerson_Button : TButton;
procedure Persons_ListViewData( Sender : TObject; Item : TListItem );
procedure Persons_ListViewEdited( Sender : TObject; Item : TListItem;
var S :
string );
procedure Persons_ListViewChange( Sender : TObject; Item : TListItem; Change : TItemChange );
procedure NewPerson_ActionExecute( Sender : TObject );
procedure EditPerson_ActionExecute( Sender : TObject );
procedure EditPerson_ActionUpdate( Sender : TObject );
procedure DeletePerson_ActionUpdate( Sender : TObject );
procedure DeletePerson_ActionExecute( Sender : TObject );
private
{ Person-ID Generator }
FNextPersonId : Integer;
function GetNextPersonId : Integer;
private
{ Model }
FPersons : TList<TPerson>;
FCurrentPersonIndex : Integer;
function GetCurrentPerson : TPerson;
procedure SetCurrentPerson(
const Value : TPerson );
protected
{ Binding }
procedure DoLoadFromModel;
override;
procedure DoSaveToModel;
override;
private
{ Background }
procedure DoCreateSomePersons( Count : Integer );
procedure DoSave( Person : TPerson );
procedure DoSort;
private
{ Facade Methods }
function EditPerson( Person : TPerson ) : TPerson;
procedure CreateSomePersons( Count : Integer );
procedure SaveAndSort( Person : TPerson );
public
{ Facade }
procedure AddNewPerson;
procedure EditCurrentPerson;
procedure DeleteCurrentPerson;
public
procedure AfterConstruction;
override;
procedure BeforeDestruction;
override;
public
property CurrentPerson : TPerson
read GetCurrentPerson
write SetCurrentPerson;
end;
var
MainForm : TMainForm;
implementation
{$R *.dfm}
uses
System.DateUtils,
UI_Form_Person_Edit,
UI_Form_BackgroundWorker;
{ TMainForm }
procedure TMainForm.AddNewPerson;
begin
CreateSomePersons( 1 );
LoadFromModel;
end;
procedure TMainForm.AfterConstruction;
begin
inherited;
FPersons := TObjectList<TPerson>.Create( TPerson.EqualityComparer );
FCurrentPersonIndex := FPersons.Count - 1;
CreateSomePersons( 100000 );
LoadFromModel;
end;
procedure TMainForm.BeforeDestruction;
begin
inherited;
FPersons.Free;
end;
procedure TMainForm.NewPerson_ActionExecute( Sender : TObject );
begin
inherited;
AddNewPerson;
end;
function TMainForm.EditPerson( Person : TPerson ) : TPerson;
var
LPersonEdit : TEditPersonForm;
begin
if Assigned( Person )
then
begin
LPersonEdit := TEditPersonForm.Create(
nil );
try
LPersonEdit.Person := Person;
if LPersonEdit.ShowModal = mrOk
then
begin
SaveAndSort( LPersonEdit.Person );
end;
finally
LPersonEdit.Free;
end;
end;
Result := Person;
end;
procedure TMainForm.EditPerson_ActionExecute( Sender : TObject );
begin
inherited;
EditCurrentPerson;
end;
procedure TMainForm.EditPerson_ActionUpdate( Sender : TObject );
begin
inherited;
( Sender
as TAction ).Enabled := Assigned( CurrentPerson );
end;
procedure TMainForm.CreateSomePersons( Count : Integer );
var
LPerson : TPerson;
begin
DoCreateSomePersons( Count );
LPerson := FPersons.Last;
DoSort;
CurrentPerson := LPerson;
end;
procedure TMainForm.DeleteCurrentPerson;
begin
if Assigned( CurrentPerson )
then
begin
FPersons.Remove( CurrentPerson );
Dec( FCurrentPersonIndex );
end;
LoadFromModel;
end;
procedure TMainForm.DeletePerson_ActionExecute( Sender : TObject );
begin
inherited;
DeleteCurrentPerson;
end;
procedure TMainForm.DeletePerson_ActionUpdate( Sender : TObject );
begin
inherited;
( Sender
as TAction ).Enabled := Assigned( CurrentPerson );
end;
procedure TMainForm.DoCreateSomePersons( Count : Integer );
begin
PerformInBackground(
procedure
var
LPerson : TPerson;
LIdx : Integer;
begin
for LIdx := 1
to Count
do
begin
LPerson := TPerson.Create( GetNextPersonId );
try
LPerson.Firstname := C_FIRSTNAMES[Random( Length( C_FIRSTNAMES ) )];
LPerson.Lastname := C_LASTNAMES[Random( Length( C_LASTNAMES ) )];
LPerson.DisplayAs := LPerson.Lastname + '
, ' + LPerson.Firstname;
LPerson.DOB := Date - ( Random( 365 * 60 ) + 18 * 365 );
FPersons.Add( TPerson.Create( LPerson ) );
finally
LPerson.Free;
end;
end;
end, Format( '
Erzeuge %d Einträge...', [Count] ) );
end;
procedure TMainForm.DoLoadFromModel;
begin
inherited;
// Anzahl der Einträge festlegen
Persons_ListView.Items.Count := FPersons.Count;
// Aktuelle Auswahl festlegen
Persons_ListView.ItemIndex := FCurrentPersonIndex;
// sieht komisch aus, ist aber notwendig damit der aktuelle Eintrag auch
// sichtbar wird
Persons_ListView.Items.Count := FPersons.Count;
// Falls Änderungen an den Daten vorgenommen wurden, einfach mal neuzeichnen lassen
Persons_ListView.Invalidate;
end;
procedure TMainForm.DoSave( Person : TPerson );
begin
PerformInBackground(
procedure
begin
if FPersons.
Contains( Person )
then
FPersons[FPersons.IndexOf( Person )].Assign( Person )
else
FPersons.Add( TPerson.Create( Person ) );
end, Format( '
Speichern von %s', [Person.ToString] ) );
end;
procedure TMainForm.DoSaveToModel;
begin
inherited;
FCurrentPersonIndex := Persons_ListView.ItemIndex;
end;
procedure TMainForm.DoSort;
begin
PerformInBackground(
procedure
begin
FPersons.Sort( TPerson.SortComparer );
end, Format( '
Sortiere %d Einträge...', [FPersons.Count] ) );
end;
procedure TMainForm.EditCurrentPerson;
begin
CurrentPerson := EditPerson( CurrentPerson );
LoadFromModel;
end;
function TMainForm.GetCurrentPerson : TPerson;
begin
if FCurrentPersonIndex < 0
then
Result :=
nil
else
Result := FPersons[FCurrentPersonIndex];
end;
function TMainForm.GetNextPersonId : Integer;
begin
Result := FNextPersonId;
Inc( FNextPersonId );
end;
procedure TMainForm.Persons_ListViewChange( Sender : TObject; Item : TListItem; Change : TItemChange );
begin
inherited;
SyncWithModel;
end;
procedure TMainForm.Persons_ListViewData( Sender : TObject; Item : TListItem );
var
LPerson : TPerson;
begin
inherited;
LPerson := FPersons[Item.
Index];
Item.Caption := LPerson.ToString;
Item.SubItems.Add( LPerson.Lastname );
Item.SubItems.Add( LPerson.Firstname );
Item.SubItems.Add( DateToStr( LPerson.DOB ) );
Item.SubItems.Add( IntToStr( YearsBetween( Date, LPerson.DOB ) ) );
end;
procedure TMainForm.Persons_ListViewEdited( Sender : TObject; Item : TListItem;
var S :
string );
var
LPerson : TPerson;
begin
inherited;
LPerson := TPerson.Create( FPersons[Item.
Index] );
try
if LPerson.DisplayAs <> S
then
begin
LPerson.DisplayAs := S;
EditPerson( LPerson );
CurrentPerson := LPerson;
end;
finally
LPerson.Free;
end;
end;
procedure TMainForm.SaveAndSort( Person : TPerson );
begin
DoSave( Person );
DoSort;
end;
procedure TMainForm.SetCurrentPerson(
const Value : TPerson );
begin
if not Assigned( Value )
then
FCurrentPersonIndex := - 1
else
FCurrentPersonIndex := FPersons.IndexOf( Value );
LoadFromModel;
end;
end.