Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BANKMA.ZIP/BANKACC.PAS

Pascal/Delphi Source File | 1991-08-19 | 15.3 KB | 580 lines

{ ----------------------------------------------------------------------- }
{ Source file: BANKACC.PAS                                                }
{ Application: Bank Manager                                               }
{ Version    : 1.0                                                        }
{ Created    : 08/19/91                                                   }
{ Updates    :                                                            }
{                                                                         }
{ Description: Maintain bank account data files.                          }
{              Account number, type, current balance, bank name and       }
{              current check number (if checking account!!)               }
{ Notes      :                                                            }
{ ----------------------------------------------------------------------- }
unit BankAcc;

{$R BANKACC.RES}

interface

uses Strings, WinTypes, WinProcs, WinDos, WObjects;

const
  AccFile   = 'BANKACC.DTA';

type
  PGetAcc   = ^TGetAcc;
  TGetAcc   =
    object( TDialog)
      { Overridden methods }
      procedure OK( var Msg: TMessage); virtual id_First + id_OK;
      procedure SetupWindow; virtual;
      { New methods }
      function GetAccounts( T: PChar): boolean;
      procedure Handle101( var Msg: TMessage); virtual id_First + 101;
      procedure Handle102( var Msg: TMessage); virtual id_First + 102;
      procedure Handle103( var Msg: TMessage); virtual id_First + 103;
      procedure Handle105( var Msg: TMessage); virtual id_First + 105;
      procedure Handle106( var Msg: TMessage); virtual id_First + 106;
    end;

  PAcc = ^TAcc;
  TAcc =
    object( TDialog)
      DialogN: array[0..20] of char;
      NewFile,
      NewRec : boolean;
      OldPos,
      RecPos : integer;
      { Overridden methods}
      constructor Init( AParent: PWindowsObject; AName: PChar);
      function CanClose: boolean; virtual;
      procedure SetupWindow; virtual;
      procedure OK( var Msg: TMessage); virtual id_First + id_OK;
      { New methods }
      procedure FillAccTypes; virtual;
      procedure FillFields; virtual;
      function FindAccNum( T: Pchar): boolean; virtual;
      procedure Handle101( var Msg: TMessage); virtual id_First + 101;
    end;

    PAccBalance = ^TAccBalance;
    TAccBalance =
      object( TDialog)
        constructor Init( AParent: PWindowsObject; ATitle: PChar);
        procedure SetupWindow; virtual;
        procedure SetupAccount; virtual;
        procedure SetMonthButton( M: integer); virtual;
        function GetBalance( T: PChar): real; virtual;
        procedure Handle105( var Msg: TMessage); virtual id_First + 105;
      end;
var
  GAccNum : array[0..20] of char;
  GMulti  : boolean;
  GAccType: array[0..12] of char;

implementation

const
  Month: array[1..12] of string[9] = ( 'January', 'February', 'March', 'April',
                                       'May', 'June', 'July', 'August', 'September',
                                       'October', 'November', 'December');
type
  AccRec =
    record
      AccType : array[0..12] of char;
      AccNum  : array[0..20] of char;
      AccBal  : real;
      AccBank : array[0..18] of char;
      AccCheck: integer;
    end;

  ActRec =
    record
      AccNum : array[0..20] of char;
      Trans  : array[0..31] of char;
      Credit : real;
      Debit  : real;
      Balance: real;
      Check  : integer;
      Date   : array[0..9] of char;
      Notes  : array[0..66] of char;
    end;

var
   GAccRec : AccRec;
   GActRec : ActRec;
   AccF    : file of AccRec;
   ActF    : file of ActRec;
   NewA,
   OldA    : boolean;
   PStr    : string[20];
   GYearN,
   GMonthN : word;
   GoBack  : boolean;

{--------------------------------------------------}
{ TGetAcc's method implementations:                }
{--------------------------------------------------}

{ Overridden methods }

procedure TGetAcc.SetupWindow;
begin
  assign( AccF, AccFile);
  {$I-}
  reset( AccF);
  {$I+}
  if ioresult <> 0 then
  begin
    MessageBox( HWindow, 'You must create an account first',
                'Account Manager', mb_IconInformation or mb_OK);
    EndDialog( HWindow, id_Cancel);
  end;
  close( AccF);
end;

procedure TGetAcc.OK( var Msg: TMessage);
begin
  if TDialog.CanClose then
  begin
    GetDlgItemText( HWindow, 104, GAccNum, 20);
    if StrLen( GAccNum) = 0 then EndDialog( HWindow, id_Cancel)
    else EndDialog( HWindow, id_OK);
  end;
end;

function TGetAcc.GetAccounts( T: PChar): boolean;
var
  AccT: array[0..18] of char;
  Temp: PChar;
begin
  StrCopy( GAccType, T);
  GetMem( Temp, 20);
  StrCopy( AccT, T);
  SendDlgItemMsg( 104, cb_ResetContent, 0, 0);
  reset( AccF);
  repeat
    read( AccF, GAccRec);
    if StrComp( AccT, GAccRec.AccType) = 0 then
    begin
      StrCopy( Temp, GAccRec.AccNum);
      SendDlgItemMsg( 104, cb_AddString, 0, longint( Temp));
    end;
  until FilePos( AccF) = FileSize( AccF);
  if SendDlgItemMsg( 104, cb_GetCount, 0, 0) = 0 then
  begin
    GetAccounts := FALSE;
    MessageBox( HWindow, 'You do not have any accounts of this type',
                'Open error', mb_IconStop or mb_OK);
  end
  else
  begin
    GetAccounts := TRUE;
    SendDlgItemMsg( 104, cb_SetCurSel, 0, 0);
  end;
  close( AccF);
  FreeMem( Temp, 20);
end;

procedure TGetAcc.Handle101( var Msg: TMessage);
begin
  if SendDlgItemMsg( 101, bm_GetCheck, 0, 0) > 0 then
    GetAccounts( 'Checking')
  else
    DefWndProc( Msg);
end;

procedure TGetAcc.Handle102( var Msg: TMessage);
begin
  if SendDlgItemMsg( 102, bm_GetCheck, 0, 0) > 0 then
    GetAccounts( 'Savings')
  else
    DefWndProc( Msg);
end;

procedure TGetAcc.Handle103( var Msg: TMessage);
begin
  if SendDlgItemMsg( 103, bm_GetCheck, 0, 0) > 0 then
    GetAccounts( 'Credit')
  else
    DefWndProc( Msg);
end;

procedure TGetAcc.Handle105( var Msg: TMessage);
begin
  if SendDlgItemMsg( 105, bm_GetCheck, 0, 0) <> 0 then GMulti := TRUE
  else GMulti := FALSE;
end;

procedure TGetAcc.Handle106( var Msg: TMessage);
begin
  if SendDlgItemMsg( 106, bm_GetCheck, 0, 0) > 0 then
    GetAccounts( 'Loan')
  else
    DefWndProc( Msg);
end;

{--------------------------------------------------}
{ TCreateAcc's method implementations:             }
{--------------------------------------------------}

{ Overridden methods }

constructor TAcc.Init( AParent: PwindowsObject; AName: PChar);
begin
  TDialog.Init( AParent, AName);
  StrCopy( DialogN, AName);
end;

procedure TAcc.SetupWindow;
begin
  assign( AccF, AccFile);
  {$I-}
  reset( AccF);
  {$I+}
  if ioresult <> 0 then
  begin
    rewrite( AccF);
    NewFile := TRUE;
  end
  else NewFile := FALSE;
  close( AccF);

  { Fill combo box }
  FillAccTypes;
  { Fill fields with existing information }
  if StrComp( DialogN, 'OLDACC') = 0 then FillFields;
end;

function TAcc.CanClose: boolean;
var
  Index: word;
  Temp : PChar;
  PTmp : string[20];
  Err  : integer;
  TB   : boolean;
begin
  TB := TDialog.CanClose;
  CanClose := TB;
  if TB then
  begin
    GetMem( Temp, 20);
    { Account number }
    GetDlgItemText( HWindow, 101, GAccRec.AccNum, 20);
    if StrLen( GAccRec.AccNum) = 0 then
    begin
      MessageBox( HWindow, 'Account number cannot be blank', 'Account Management',
                  mb_IconInformation or mb_OK);
      CanClose := FALSE;
      FreeMem( Temp, 20);
      exit;
    end;
    { Account type }
    Index := SendDlgItemMsg( 102, cb_GetCurSel, 0, 0);
    SendDlgItemMsg( 102, cb_GetLBText, Index, longint( Temp));
    StrCopy( GAccRec.AccType, Temp);
    { Account balance }
    GetDlgItemText( HWindow, 103, Temp, 10);
    PTmp := StrPas( Temp);
    val( PTmp, GAccRec.AccBal, Err);
    if Err <> 0 then
    begin
      MessageBox( HWindow, 'Invalid account balance', 'Account Management',
                  mb_IconInformation or mb_OK);
      CanClose := FALSE;
      GAccRec.AccBal := 0.0;
      FreeMem( Temp, 20);
      Exit;
    end;
    { Account bank }
    GetDlgItemText( HWindow, 104, GAccRec.AccBank, 20);
    { Account starting check number }
    if StrComp( GAccRec.AccType, 'Checking') = 0 then
    begin
      GetDlgItemText( HWindow, 105, Temp, 10);
      PTmp := StrPas( Temp);
      val( PTmp, GAccRec.AccCheck, Err);
      if Err <> 0 then
      begin
        MessageBox( HWindow, 'Invalid starting check number', 'Account Management',
                    mb_IconInformation or mb_OK);
        CanClose := FALSE;
        GAccRec.AccCheck := 0;
        FreeMem( Temp, 20);
        Exit;
      end;
    end;
    FreeMem( Temp, 20);
  end;
end;

procedure TAcc.OK( var Msg: TMessage);
begin
  if CanClose then
  begin
    reset( AccF);
    if not NewFile then
    begin
      if NewRec then System.Seek( AccF, FileSize( AccF))
      else System.Seek( AccF, OldPos);
    end;
    write( AccF, GAccRec);
    close( AccF);
    EndDialog( HWindow, id_OK);
  end;
end;

{ New methods }

procedure TAcc.FillAccTypes;
var
  cb_MyItem: PChar;
begin
  cb_MyItem := 'Checking';
  SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  cb_MyItem := 'Credit';
  SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  cb_MyItem := 'Savings';
  SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  cb_MyItem := 'Loan';
  SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  SendDlgItemMsg( 102, cb_SetCurSel, 0, 0);
end;

procedure TAcc.FillFields;
var
  PC   : PChar;
  Index: integer;
begin
  FindAccNum( GAccNum);
  GetMem( PC, 20);
  OldPos := RecPos;
  SetDlgItemText( HWindow, 101, GAccNum);
  NewRec := FALSE;
  StrCopy( PC, GAccRec.AccType);
  Index := SendDlgItemMsg( 102, cb_FindString, 0, longint( PC));
  SendDlgItemMsg( 102, cb_SetCurSel, Index, 0);
  str( GAccRec.AccBal:0:2, PStr);
  StrPCopy( PC, PStr);
  SetDlgItemText( HWindow, 103, PC);
  SetDlgItemText( HWindow, 104, GAccRec.AccBank);
  if StrComp( GAccRec.AccType, 'Checking') = 0 then
  begin
    str( GAccRec.AccCheck, PStr);
    StrPCopy( PC, PStr);
    SetDlgItemText( HWindow, 105, PC);
  end
  else
    SetDlgItemText( HWindow, 105, PChar( 0));
  FreeMem( PC, 20);
end;

function TAcc.FindAccNum( T: PChar): boolean;
begin
  reset( AccF);
  if not NewFile then
  begin
    System.Seek( AccF, 0);
    repeat
      read( AccF, GAccRec);
    until ( FilePos( AccF) = FileSize( AccF)) or ( StrComp( T, GAccRec.AccNum) = 0);
    if StrComp( T, GAccRec.AccNum) = 0 then
    begin
      RecPos := FilePos( AccF) - 1;
      FindAccNum := TRUE;
    end
    else
    begin
      RecPos := FileSize( AccF) + 1;
      FindAccNum := FALSE;
    end;
  end
  else FindAccNum := FALSE;
  close( AccF);
end;

procedure TAcc.Handle101( var Msg: TMessage);
var
  MyItem : PChar;
  TStr   : array[0..20] of char;
begin
  DefWndProc( Msg);
  GetMem( MyItem, 20);
  if Msg.LParamHi = en_KillFocus then
  begin
    GetDlgItemText( HWindow, 101, MyItem, 20);
    StrCopy( TStr, MyItem);
    if FindAccNum( MyItem) then
    begin
      if StrComp( DialogN, 'NEWACC') = 0 then
      begin
        MessageBox( HWindow, 'Account already exists', 'Account Manager',
                    mb_IconInformation or mb_OK);
        SetDlgItemText( HWindow, 101, PChar( 0));
        FreeMem( MyItem, 20);
        Exit;
      end
    end
    else if StrLen( TStr) <> 0 then
    begin
      NewRec := FALSE;
      if StrComp( DialogN, 'OLDACC') = 0 then
      begin
        if MessageBox( HWindow, 'Account number has changed. Save change?', 'Account Manager',
                       mb_IconQuestion or mb_YesNo) = id_Yes then
          RecPos := OldPos
        else
          SetDlgItemText( HWindow, 101, GAccNum);
      end
      else
      begin
        if MessageBox( HWindow, 'Account not found. Create a new one?', 'Account Manager',
                       mb_IconQuestion or mb_YesNo) = idYes then NewRec := TRUE
        else
        begin
          NewRec := FALSE;
          SetDlgItemText( HWindow, 101, PChar( 0));
        end;
      end;
    end;
  end;
  FreeMem( MyItem, 20);
end;

{--------------------------------------------------}
{ TAccBalance's method implementations:            }
{--------------------------------------------------}

{ Overridden methods }

constructor TAccBalance.Init( AParent: PWindowsObject; ATitle: PChar);
begin
  TDialog.Init( AParent, ATitle);
end;

procedure TAccBalance.SetupWindow;
begin
  TDialog.SetupWindow;
  SetupAccount;
  SetMonthButton( 0);
end;

{ New methods }

procedure TAccBalance.SetupAccount;
var
  Temp : PChar;
  Bal  : real;
begin
  SendDlgItemMsg( 106, bm_SetCheck, 0, 0);
  SendDlgItemMsg( 107, bm_SetCheck, 1, 0);
  GoBack := TRUE;

  GetMem( Temp, 20);
  StrCopy( Temp, GAccNum);
  SetDlgItemText( HWindow, 101, Temp);
  Bal := GetBalance( Temp);
  Str( Bal:0:2, PStr);
  StrPCopy( Temp, PStr);
  SetDlgItemText( HWindow, 102, Temp);
  FreeMem( Temp, 20);
end;

procedure TAccBalance.SetMonthButton( M: integer);
var
  D, W: word;
  Mo: array[0..10] of char;
begin
  if M = 0 then GetDate( GYearN, GMonthN, D, W);
  StrPCopy( Mo, Month[ GMonthN]);
  SetDlgItemText( HWindow, 105, Mo);
end;

function TAccBalance.GetBalance( T: PChar): real;
begin
  reset( AccF);
  repeat
    read( AccF, GAccRec);
  until ( FilePos( AccF) = FileSize( AccF)) or ( StrComp( T, GAccRec.AccNum) = 0);
  if StrComp( T, GAccRec.AccNum) = 0 then
    GetBalance := GAccRec.AccBal
  else
    GetBalance := 0.0;
  close( AccF);
end;

procedure TAccBalance.Handle105( var Msg: TMessage);
var
  Mo3 : string[3];
  Yr : string[4];
  Cred,
  Deb: real;
  Temp: PChar;
begin
  if SendDlgItemMsg( 106, bm_GetCheck, 0, 0) <> 0 then GoBack := FALSE
  else GoBack := TRUE;
  Mo3 := copy( Month[ GMonthN], 1, 3);
  str( GYearN, Yr);
  delete( Yr, 1, 2);
  assign( ActF, Mo3 + Yr + '.DTA');
  {$I-}
  reset( ActF);
  {$I+}
  if ioresult = 0 then
  begin
    Cred := 0.0;
    Deb := 0.0;
    repeat
      read( ActF, GActRec);
      if StrComp( GActRec.AccNum, GAccNum) = 0 then
      begin
        if GActRec.Credit <> 0.0 then Cred := Cred + GActRec.Credit
        else if GActRec.Debit <> 0.0 then Deb := Deb + GActRec.Debit;
      end;
    until FilePos( ActF) = FileSize( ActF);
    close( ActF);
    if GoBack then dec( GMonthN)
    else inc( GMonthN);
    if GMonthN < 1 then
    begin
      Dec( GYearN);
      GMonthN := 12;
    end;
    if GMonthN > 12 then
    begin
      inc( GYearN);
      GMonthN := 1;
    end;
    GetMem( Temp, 10);
    str( Cred:0:2, PStr);
    StrPCopy( Temp, PStr);
    SetDlgItemText( HWindow, 103, Temp);
    str( Deb:0:2, PStr);
    StrPCopy( Temp, PStr);
    SetDlgItemText( HWindow, 104, Temp);
    FreeMem( Temp, 10);
    SetMonthButton( 1);
  end
  else
  begin
    MessageBox( HWindow, 'No more transaction files', 'Account Balances',
                mb_IconStop or mb_OK);
    if GoBack then inc( GMonthN)
    else dec( GMonthN);
    if GMonthN < 1 then
    begin
      Dec( GYearN);
      GMonthN := 12;
    end;
    if GMonthN > 12 then
    begin
      inc( GYearN);
      GMonthN := 1;
    end;
    SetMonthButton( 1);
    SetDlgItemText( HWindow, 103, '');
    SetDlgItemText( HWindow, 104, '');
  end;
end;

end.