unit AgesU;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
LCLType, DateUtils, Grids, EditBtn, ComCtrls, FileUtil;
type
TEventRecord = record // Record for a single event
EventName : string;
EventDate : TDateTime;
AgeAtEvent : Integer;
end;
TEventList = array of TEventRecord; // Dynamic array of events
TPersonRecord = record // Main record for the person
FullName : string;
DateOfBirth : TDateTime;
Description : string;
ImageFileName : string;
Events : TEventList;
end;
TPersonList = array of TPersonRecord; // Dynamic array of Persons
{ TForm1 }
TForm1 = class(TForm)
BtnLoad : TButton;
BtnLoadImage : TButton;
BtnAddEvent : TButton;
BtnQuit : TButton;
BtnNewPerson : TButton;
BtnSave : TButton;
DteDOB : TDateEdit;
DteEventDate : TDateEdit;
EdtName : TEdit;
EdtEventName : TEdit;
ImgPicture : TImage;
LblCurrentAge : TLabel;
LbNames : TListBox;
MemDescription : TMemo;
SGEvents : TStringGrid;
Display : TTimer;
StatusBar1 : TStatusBar;
procedure BtnAddEventClick(Sender: TObject);
procedure BtnLoadClick(Sender: TObject);
procedure BtnLoadImageClick(Sender: TObject);
procedure BtnNewPersonClick(Sender: TObject);
procedure BtnQuitClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure DisplayTimer(Sender: TObject);
procedure DteDOBChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormShow(Sender: TObject);
procedure LbNamesClick(Sender: TObject);
private
PersonDataList: TPersonList;
CurrentPersonIndex: Integer;
FileName: string;
IsLoading: Boolean;
function CalculateAgeOnDate(DOB, EventDate: TDateTime): Integer;
function CalculateCurrentAge(DOB: TDateTime): Integer;
function ReadString(Stream: TStream): string;
procedure WriteString(Stream: TStream; const S: string);
procedure UpdateEventGrid;
procedure SortEvents;
procedure DisplayCurrentRecord;
procedure LoadListBox;
procedure SaveDataToFile;
procedure LoadDataFromFile;
procedure UpdateCurrentRecord;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.WriteString(Stream: TStream; const S: string);
var
StrLen: Integer;
begin
StrLen := Length(S);
Stream.Write(StrLen, SizeOf(Integer));
if StrLen > 0 then Stream.Write(S[1], StrLen * SizeOf(Char));
end;
function TForm1.ReadString(Stream: TStream): string;
var
StrLen: Integer;
Buffer: array of Char;
begin
Stream.Read(StrLen, SizeOf(Integer));
if StrLen > 0 then
begin
SetLength(Buffer, StrLen);
Stream.Read(Buffer[0], StrLen * SizeOf(Char));
Result := string(Buffer);
end
else
Result := '';
end;
procedure TForm1.UpdateCurrentRecord;
begin
if (CurrentPersonIndex >= 0) and (CurrentPersonIndex <= High(PersonDataList)) then
begin
PersonDataList[CurrentPersonIndex].FullName := EdtName.Text;
PersonDataList[CurrentPersonIndex].DateOfBirth := DteDOB.Date;
PersonDataList[CurrentPersonIndex].Description := MemDescription.Text;
end;
end;
procedure TForm1.SaveDataToFile;
var
Stream : TFileStream;
i, SvEventIdx : Integer;
StrLen : LongInt;
PersonCount : Integer;
begin
UpdateCurrentRecord;
try
Stream := TFileStream.Create(FileName, fmCreate);
try
PersonCount := Length(PersonDataList);
Stream.Write(PersonCount, SizeOf(PersonCount));
for i := 0 to PersonCount - 1 do
begin
WriteString(Stream, PersonDataList[i].FullName); // Save FullName
Stream.Write(PersonDataList[i].DateOfBirth, SizeOf(TDateTime)); // Save DOB
WriteString(Stream, PersonDataList[i].Description); // Save Description
WriteString(Stream, PersonDataList[i].ImageFileName); // Save Image Path
// Save Events Array
SvEventIdx := Length(PersonDataList[i].Events);
Stream.Write(SvEventIdx, SizeOf(SvEventIdx));
for SvEventIdx := 0 to High(PersonDataList[i].Events) do
begin
WriteString(Stream, PersonDataList[i].Events[SvEventIdx].EventName);
Stream.Write(PersonDataList[i].Events[SvEventIdx].EventDate, SizeOf(TDateTime));
Stream.Write(PersonDataList[i].Events[SvEventIdx].AgeAtEvent, SizeOf(Integer));
end;
end;
finally
Stream.Free;
end;
except
on E: Exception do ShowMessage('Critical Error during Save: ' + E.Message);
end;
end;
procedure TForm1.LoadDataFromFile;
var
Stream : TFileStream;
Count : LongInt;
i, LdEventIdx : Integer;
NameLen, DescLen, ImageLen: LongInt;
begin
CurrentPersonIndex := -1;
if not FileExists(FileName) then
begin
SetLength(PersonDataList, 0);
Exit;
end;
try
Stream := TFileStream.Create(FileName, fmOpenRead);
try
Count := 0;
Stream.Read(Count, SizeOf(Count));
if (Count < 0) or (Count > 10000) then Raise Exception.Create('Invalid record count.');
SetLength(PersonDataList, Count);
for i := 0 to Count - 1 do
begin
PersonDataList[i].FullName := ReadString(Stream); // Read FullName
Stream.Read(PersonDataList[i].DateOfBirth, SizeOf(TDateTime)); // Read DOB
PersonDataList[i].Description := ReadString(Stream); // Read Description
PersonDataList[i].ImageFileName := ReadString(Stream); // Read ImageFileName
// Read Events
Stream.Read(LdEventIdx, SizeOf(LdEventIdx));
SetLength(PersonDataList[i].Events, LdEventIdx);
for LdEventIdx := 0 to High(PersonDataList[i].Events) do
begin
PersonDataList[i].Events[LdEventIdx].EventName := ReadString(Stream);
Stream.Read(PersonDataList[i].Events[LdEventIdx].EventDate, SizeOf(TDateTime));
Stream.Read(PersonDataList[i].Events[LdEventIdx].AgeAtEvent, SizeOf(Integer));
end;
end;
finally
Stream.Free;
end;
except
on E: Exception do
begin
ShowMessage('Error loading file: ' + E.Message);
SetLength(PersonDataList, 0);
end;
end;
end;
procedure TForm1.DisplayCurrentRecord;
begin
IsLoading := True;
try
Try
if (CurrentPersonIndex < 0) or (CurrentPersonIndex > High(PersonDataList)) then
begin
EdtName.Text := '';
DteDOB.Date := 0;
MemDescription.Text := '';
ImgPicture.Picture.Clear;
LblCurrentAge.Caption := 'Age: N/A';
SGEvents.RowCount := 1;
Exit;
end;
EdtName.Text := PersonDataList[CurrentPersonIndex].FullName;
DteDOB.Date := PersonDataList[CurrentPersonIndex].DateOfBirth; // Ensure DteDOB is updated
MemDescription.Text := PersonDataList[CurrentPersonIndex].Description;
if (PersonDataList[CurrentPersonIndex].ImageFileName <> '') and
FileExists(PersonDataList[CurrentPersonIndex].ImageFileName) then
ImgPicture.Picture.LoadFromFile(PersonDataList[CurrentPersonIndex].ImageFileName)
else
ImgPicture.Picture.Clear;
SortEvents;
UpdateEventGrid;
LblCurrentAge.Caption :='Age: ' + IntToStr(CalculateAgeOnDate(DteDOB.Date, Date));
except
on E: Exception do ShowMessage('Error displaying record: ' + E.Message);
end;
finally
IsLoading := False;
end;
end;
procedure TForm1.LbNamesClick(Sender: TObject);
begin
UpdateCurrentRecord; // Save changes before switching
if (LbNames.ItemIndex >= 0) and (LbNames.ItemIndex <= High(PersonDataList)) then
begin
CurrentPersonIndex := LbNames.ItemIndex;
DisplayCurrentRecord; // This updates DteDOB and calculations
end;
end;
procedure TForm1.UpdateEventGrid;
var
i: Integer;
begin
if (CurrentPersonIndex < 0) or (CurrentPersonIndex > High(PersonDataList)) then
begin
SGEvents.RowCount := 1;
Exit;
end;
SGEvents.RowCount := Length(PersonDataList[CurrentPersonIndex].Events) + 1;
for i := 0 to High(PersonDataList[CurrentPersonIndex].Events) do
begin
PersonDataList[CurrentPersonIndex].Events[i].AgeAtEvent :=
CalculateAgeOnDate(PersonDataList[CurrentPersonIndex].DateOfBirth,
PersonDataList[CurrentPersonIndex].Events[i].EventDate);
SGEvents.Cells[0, i + 1] := PersonDataList[CurrentPersonIndex].Events[i].EventName;
SGEvents.Cells[1, i + 1] := DateToStr(PersonDataList[CurrentPersonIndex].Events[i].EventDate);
SGEvents.Cells[2, i + 1] := IntToStr(PersonDataList[CurrentPersonIndex].Events[i].AgeAtEvent);
end;
end;
function TForm1.CalculateAgeOnDate(DOB, EventDate: TDateTime): Integer;
var Years: Integer;
begin
if (DOB = 0) or (EventDate < DOB) then Exit(0);
Years := YearOf(EventDate) - YearOf(DOB);
if (MonthOf(EventDate) < MonthOf(DOB)) or
((MonthOf(EventDate) = MonthOf(DOB)) and (DayOf(EventDate) < DayOf(DOB))) then
Dec(Years);
Result := Years;
end;
function TForm1.CalculateCurrentAge(DOB: TDateTime): Integer;
begin
Result := CalculateAgeOnDate(DOB, Date);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DefaultFormatSettings.ShortDateFormat := 'dd mmm yyyy';
DefaultFormatSettings.DateSeparator := ' ';
FileName := ChangeFileExt(Application.Location, '.dat');
SGEvents.Cells[0, 0] := 'Event';
SGEvents.Cells[1, 0] := 'Date';
SGEvents.Cells[2, 0] := 'Age';
LoadDataFromFile;
if Length(PersonDataList) > 0 then
begin
LoadListBox;
LbNames.ItemIndex := 0;
CurrentPersonIndex := 0;
DisplayCurrentRecord;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SaveDataToFile;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
EdtName.SetFocus;
end;
procedure TForm1.BtnNewPersonClick(Sender: TObject);
var
PersonName : string;
PersonDOB : TDateTime;
PersonDesc : string;
NewIndex : Integer;
begin
PersonName := Trim(EdtName.Text); // Read values from the input fields
PersonDOB := DteDOB.Date;
PersonDesc := Trim(MemDescription.Text);
if PersonName = '' then // Validate that at least a name was entered
begin
ShowMessage('Please enter a name.');
Exit;
end;
NewIndex := Length(PersonDataList); // Add a new person to the dynamic array
SetLength(PersonDataList, NewIndex + 1);
PersonDataList[NewIndex].FullName := PersonName;
PersonDataList[NewIndex].DateOfBirth := PersonDOB;
PersonDataList[NewIndex].Description := PersonDesc;
PersonDataList[NewIndex].ImageFileName := '';
SetLength(PersonDataList[NewIndex].Events, 0); // Initialize empty events
CurrentPersonIndex := NewIndex;
EdtName.Clear;
DteDOB.Date := Now;
MemDescription.Clear;
LoadListBox;
DisplayCurrentRecord;
end;
procedure TForm1.BtnQuitClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.BtnSaveClick(Sender: TObject);
begin
SaveDataToFile;
end;
procedure TForm1.DteDOBChange(Sender: TObject);
begin
if IsLoading then Exit; // Ignore changes during display updates
if (CurrentPersonIndex >= 0) and (CurrentPersonIndex <= High(PersonDataList)) then
begin
PersonDataList[CurrentPersonIndex].DateOfBirth := DteDOB.Date;
UpdateEventGrid;
LblCurrentAge.Caption :='Age: ' + IntToStr(CalculateAgeOnDate(DteDOB.Date, Date));
end;
end;
procedure TForm1.SortEvents;
var i, j: Integer; Temp: TEventRecord;
begin
if (CurrentPersonIndex < 0) then Exit;
for i := 1 to High(PersonDataList[CurrentPersonIndex].Events) do
begin
Temp := PersonDataList[CurrentPersonIndex].Events[i];
j := i - 1;
while (j >= 0) and (PersonDataList[CurrentPersonIndex].Events[j].EventDate > Temp.EventDate) do
begin
PersonDataList[CurrentPersonIndex].Events[j+1] := PersonDataList[CurrentPersonIndex].Events[j];
Dec(j);
end;
PersonDataList[CurrentPersonIndex].Events[j+1] := Temp;
end;
end;
procedure TForm1.LoadListBox;
var i: Integer;
begin
LbNames.Clear;
for i := 0 to High(PersonDataList) do LbNames.Items.Add(PersonDataList[i].FullName);
end;
procedure TForm1.BtnAddEventClick(Sender: TObject);
var NewLen: Integer;
begin
if (CurrentPersonIndex < 0) or (Trim(EdtEventName.Text) = '') then Exit;
NewLen := Length(PersonDataList[CurrentPersonIndex].Events) + 1;
SetLength(PersonDataList[CurrentPersonIndex].Events, NewLen);
with PersonDataList[CurrentPersonIndex].Events[NewLen-1] do
begin
EventName := EdtEventName.Text;
EventDate := DteEventDate.Date;
end;
SortEvents;
UpdateEventGrid;
end;
procedure TForm1.BtnLoadClick(Sender: TObject);
begin
LoadDataFromFile
end;
procedure TForm1.BtnLoadImageClick(Sender: TObject);
var OD: TOpenDialog;
begin
if CurrentPersonIndex < 0 then Exit;
OD := TOpenDialog.Create(nil);
try
if OD.Execute then
begin
PersonDataList[CurrentPersonIndex].ImageFileName := OD.FileName;
DisplayCurrentRecord;
end;
finally
OD.Free;
end;
end;
procedure TForm1.DisplayTimer(Sender: TObject);
begin
if (CurrentPersonIndex >= 0) and (PersonDataList[CurrentPersonIndex].DateOfBirth <> 0) then
LblCurrentAge.Caption := 'Age: ' + IntToStr(CalculateCurrentAge(PersonDataList[CurrentPersonIndex].DateOfBirth));
StatusBar1.Panels[0].Text := 'Person Records: ' + IntToStr(Length(PersonDataList));
StatusBar1.Panels[1].Text := 'Current Person: ' + IntToStr(CurrentPersonIndex);
StatusBar1.Panels[2].Text := 'ListBox Index: ' + IntToStr(LbNames.ItemIndex);
end;
end.
Recent
