unit Ledger;
{$mode ObjFPC}{$H+}
interface
uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Grids;
type
{ TForm2 }
TForm2 = class(TForm)
BtnBuy, BtnSell, BtnFound: TButton;
BtnClose: TButton;
EdtDollars, EdtHalfs, EdtQuarts, EdtDimes, EdtNicks: TEdit;
Label1, Label2, Label3, Label4, Label5: TLabel;
EdtItem, EdtAmount: TEdit;
CmbType: TComboBox;
StringGrid1: TStringGrid;
procedure BtnBuyClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
procedure BtnFoundClick(Sender: TObject);
procedure BtnSellClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function CoinValueInDollars(AType: string): Double;
function RemoveCoins(ValueInHalfs: Double): Boolean;
procedure AddTransaction(const AItem: string; AAmount: Integer; AType: string; IsBuy: Boolean);
procedure UpdateCoinDisplays;
procedure AddCoins(AType: string; Amount: Integer);
public
function GetTotalInDollars: Double;
procedure LoadData(const FileName: string);
procedure SaveData(const FileName: string);
end;
var
Form2: TForm2;
implementation
{$R *.lfm}
{ TForm2 }
procedure TForm2.FormCreate(Sender: TObject);
begin
// Setup String Grid.
StringGrid1.ColCount := 3; // Item, Amount and Type.
StringGrid1.RowCount := 1; // Start with an empty row.
StringGrid1.FixedCols := 0; // Rows don't have Headers.
StringGrid1.Cells[0,0] := 'Item'; // Column 0 Header.
StringGrid1.Cells[1,0] := 'Amount'; // Column 1 Header.
StringGrid1.Cells[2,0] := 'Type'; // Column 2 Header.
cmbType.Items.AddStrings(['Dollars','Halfs','Quarts','Dimes','Nicks']);
UpdateCoinDisplays;
end;
procedure TForm2.BtnCloseClick(Sender: TObject);
begin
ModalResult := mrOK; // returns control to Form1.ShowModal. Form 1 just has the Edit Box that shows the coins value in dollars.
end;
procedure TForm2.BtnBuyClick(Sender: TObject);
begin AddTransaction(edtItem.Text, StrToIntDef(edtAmount.Text,0), cmbType.Text, True); end;
procedure TForm2.BtnFoundClick(Sender: TObject);
begin AddTransaction(edtItem.Text, StrToIntDef(edtAmount.Text,0), cmbType.Text, False); end;
procedure TForm2.BtnSellClick(Sender: TObject);
begin AddTransaction(edtItem.Text, StrToIntDef(edtAmount.Text,0), cmbType.Text, False); end;
function TForm2.CoinValueInDollars(AType: string): Double;
begin
case UpperCase(AType) of
'Dollars': Result := 1;
'Halfs': Result := 0.5;
'Quarts': Result := 0.25;
'Dimes': Result := 0.1;
'Nicks': Result := 0.05;
else
Result := 0;
end;
end;
function TForm2.RemoveCoins(ValueInHalfs: Double): Boolean;
var
Remaining: Integer; // work in Nickel units to avoid floating errors.
CoinValues: array[0..4] of Integer = (20, 10, 5, 2, 1); // Dollars, Halfs, Quarts, Dimes, Nicks in Nickles.
CoinCounts: array[0..4] of Integer;
i, j: Integer;
begin
// Convert to Nickles
Remaining := Round(ValueInDollars * 20);
// Load coin counts
CoinCounts[0] := StrToIntDef(edtDollars.Text,0);
CoinCounts[1] := StrToIntDef(edtHalfs.Text,0);
CoinCounts[2] := StrToIntDef(edtQuarts.Text,0);
CoinCounts[3] := StrToIntDef(edtDimes.Text,0);
CoinCounts[4] := StrToIntDef(edtNicks.Text,0);
// Pay from lowest denomination upwards
for i := High(CoinValues) downto Low(CoinValues) do
begin
while (Remaining >= CoinValues[i]) and (CoinCounts[i] > 0) do
begin
Dec(CoinCounts[i]);
Dec(Remaining, CoinValues[i]);
end;
end;
// If still unpaid, try to break higher coins into smaller
i := Low(CoinValues);
while (Remaining > 0) and (i <= High(CoinValues)) do
begin
if (Remaining >= CoinValues[i]) then
begin
if CoinCounts[i] = 0 then // need this coin, but do we have?
begin
j := i-1;
while (j >= Low(CoinValues)) and (CoinCounts[j] = 0) do Dec(j); // find next higher coin
if j >= Low(CoinValues) then
begin
// break coin j into smaller ones
Dec(CoinCounts[j]);
Inc(CoinCounts[j+1], CoinValues[j] div CoinValues[j+1]);
Continue; // retry with smaller coins
end
else
Break; // No smaller coins, impossible.
end
else
begin
Dec(CoinCounts[i]);
Dec(Remaining, CoinValues[i]);
end;
end
else
Inc(i);
end;
Result := Remaining = 0;
if Result then
begin
edtDollars.Text := IntToStr(CoinCounts[0]);
edtHalfs.Text := IntToStr(CoinCounts[1]);
edtQuarts.Text := IntToStr(CoinCounts[2]);
edtDimes.Text := IntToStr(CoinCounts[3]);
edtNicks.Text := IntToStr(CoinCounts[4]);
end;
end;
function TForm2.GetTotalInDollars: Double;
begin
Result :=
StrToIntDef(edtDollars.Text,0)*1 +
StrToIntDef(edtHalfs.Text,0)*0.5 +
StrToIntDef(edtQuarts.Text,0)*0.25 +
StrToIntDef(edtDimes.Text,0)*0.1 +
StrToIntDef(edtNicks.Text,0)*0.05;
end;
procedure TForm2.AddTransaction(const AItem: string; AAmount: Integer; AType: string; IsBuy: Boolean);
var row: Integer;
Value: Double;
begin
if AAmount <= 0 then Exit;
Value := AAmount * CoinValueInDollars(AType);
if IsBuy then
begin
if RemoveCoins(Value) then
begin
row := StringGrid1.RowCount;
StringGrid1.RowCount := row+1;
StringGrid1.Cells[0,row] := AItem;
StringGrid1.Cells[1,row] := IntToStr(AAmount);
StringGrid1.Cells[2,row] := AType;
end
else
ShowMessage('Not enough coins!');
end
else
begin
AddCoins(AType,AAmount);
row := StringGrid1.RowCount;
StringGrid1.RowCount := row+1;
StringGrid1.Cells[0,row] := AItem;
StringGrid1.Cells[1,row] := IntToStr(AAmount);
StringGrid1.Cells[2,row] := AType;
end;
UpdateCoinDisplays;
end;
procedure TForm2.UpdateCoinDisplays;
begin
edtDollars.Text := IntToStr(StrToIntDef(edtDollars.Text,0));
edtHalfs.Text := IntToStr(StrToIntDef(edtHalfs.Text,0));
edtQuarts.Text := IntToStr(StrToIntDef(edtQuarts.Text,0));
edtDimes.Text := IntToStr(StrToIntDef(edtDimes.Text,0));
edtNicks.Text := IntToStr(StrToIntDef(edtNicks.Text,0));
end;
procedure TForm2.AddCoins(AType: string; Amount: Integer);
var v: Integer;
begin
if Amount <= 0 then Exit;
if AType='Dollars' then begin v:=StrToIntDef(edtDollars.Text,0)+Amount; edtDollars.Text:=IntToStr(v); end;
if AType='Halfs' then begin v:=StrToIntDef(edtHalfs.Text,0)+Amount; edtHalfs.Text:=IntToStr(v); end;
if AType='Quarts' then begin v:=StrToIntDef(edtQuarts.Text,0)+Amount; edtQuarts.Text:=IntToStr(v); end;
if AType='Dimes' then begin v:=StrToIntDef(edtDimes.Text,0)+Amount; edtDimes.Text:=IntToStr(v); end;
if AType='Nicks' then begin v:=StrToIntDef(edtNicks.Text,0)+Amount; edtNicks.Text:=IntToStr(v); end;
end;
procedure TForm2.LoadData(const FileName: string);
var
SL: TStringList;
parts: TStringArray;
i, row: Integer;
begin
if not FileExists(FileName) then Exit;
SL := TStringList.Create;
try
SL.LoadFromFile(FileName);
if SL.Count > 0 then
begin
parts := SL[0].Split([',']);
if Length(parts) = 5 then
begin
edtDollars.Text := parts[0];
edtHalfs.Text := parts[1];
edtQuarts.Text := parts[2];
edtDimes.Text := parts[3];
edtNicks.Text := parts[4];
end;
end;
StringGrid1.RowCount := 1; // Clear grid header.
for i := 1 to SL.Count-1 do
begin
parts := SL[i].Split(['|']);
if Length(parts) = 3 then
begin
row := StringGrid1.RowCount;
StringGrid1.RowCount := row + 1;
StringGrid1.Cells[0,row] := parts[0]; // Item
StringGrid1.Cells[1,row] := parts[1]; // Amount
StringGrid1.Cells[2,row] := parts[2]; // Type
end;
end;
finally
SL.Free;
end;
end;
procedure TForm2.SaveData(const FileName: string);
var
SL: TStringList;
i: Integer;
begin
SL := TStringList.Create;
try
SL.Add(edtDollars.Text+','+edtHalfs.Text+','+edtQuarts.Text+','+edtDimes.Text+','+edtNicks.Text); // Coins first line
for i := 1 to StringGrid1.RowCount-1 do SL.Add(StringGrid1.Cells[0,i]+'|'+StringGrid1.Cells[1,i]+'|'+StringGrid1.Cells[2,i]); // Transactions
SL.SaveToFile(FileName);
finally
SL.Free;
end;
end;
end.
Recent
