Файл: Информационная система финансового анализа состояния преприятия.doc
Добавлен: 21.10.2018
Просмотров: 32183
Скачиваний: 9
Приложение
Исходный текст программы
Программный модуль Analysis.dpr
program Analysis;
uses
Forms,
uMain in 'uMain.pas' {fmMain},
uBalanceStructure in 'uBalanceStructure.pas' {fmBalanceStructure},
uDM in 'uDM.pas' {DM: TDataModule},
uOPUStructure in 'uOPUStructure.pas' {fmOPUStructure},
uOPU in 'uOPU.pas' {fmOPU},
uBalance in 'uBalance.pas' {fmBalance},
uRep in 'uRep.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfmMain, fmMain);
Application.CreateForm(TfmBalanceStructure, fmBalanceStructure);
Application.CreateForm(TDM, DM);
Application.CreateForm(TfmOPUStructure, fmOPUStructure);
Application.CreateForm(TfmOPU, fmOPU);
Application.CreateForm(TfmBalance, fmBalance);
Application.Run;
end.
Программный модуль uBalance.pas
unit uBalance;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, DBCtrls, ExtCtrls, Grids, DBGrids;
type
TfmBalance = class(TForm)
DBGrid1: TDBGrid;
Panel1: TPanel;
DBNavigator1: TDBNavigator;
BitBtn1: TBitBtn;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmBalance: TfmBalance;
implementation
uses uDM;
{$R *.dfm}
procedure TfmBalance.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DM.dstBalance.Close;
end;
procedure TfmBalance.FormShow(Sender: TObject);
begin
DM.dstBalance.Sort := 'КодСтроки';
end;
end.
Программный модуль uBalanceStructure.pas
unit uBalanceStructure;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons;
type
TfmBalanceStructure = class(TForm)
DBGrid1: TDBGrid;
Panel1: TPanel;
DBNavigator1: TDBNavigator;
BitBtn1: TBitBtn;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmBalanceStructure: TfmBalanceStructure;
implementation
uses uDM;
{$R *.dfm}
procedure TfmBalanceStructure.FormShow(Sender: TObject);
begin
DM.dstBalanceStr.Open;
DM.dstBalanceStr.Sort := 'Код';
end;
end.
Программный модуль uDM.pas
unit uDM;
interface
uses
SysUtils, Classes, DB, ADODB;
type
TDM = class(TDataModule)
ADOConnection1: TADOConnection;
dstBalanceStr: TADODataSet;
dsBalanceStr: TDataSource;
dstOPUStr: TADODataSet;
dsOPUStr: TDataSource;
dstOPUStrDSDesigner: TSmallintField;
dstOPUStrDSDesigner2: TWideStringField;
dstBalance: TADODataSet;
dsBalance: TDataSource;
dstBalanceDSDesigner: TSmallintField;
dstBalanceDSDesigner2: TWordField;
dstBalanceDSDesigner3: TSmallintField;
dstBalanceDSDesigner1: TBCDField;
dstBalanceDSDesigner22: TBCDField;
dstBalanceField: TStringField;
dstBalanceField2: TIntegerField;
qrNewBalance: TADOQuery;
dstPeriodList: TADODataSet;
dsBalanceList: TDataSource;
qrDelBalance: TADOQuery;
qrNewOPU: TADOQuery;
qrDelOPU: TADOQuery;
dstOPU: TADODataSet;
SmallintField1: TSmallintField;
WordField1: TWordField;
SmallintField2: TSmallintField;
BCDField1: TBCDField;
BCDField2: TBCDField;
StringField1: TStringField;
IntegerField1: TIntegerField;
dsOPU: TDataSource;
qrGetBalValue: TADOQuery;
qrGetOPUValue: TADOQuery;
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function GetBalValue(Year, Quarter, Row, Period: Integer): Real;
function GetOPUValue(Year, Quarter, Row, Period: Integer): Real;
var
DM: TDM;
implementation
uses Forms, Windows;
{$R *.dfm}
procedure TDM.DataModuleDestroy(Sender: TObject);
begin
ADOConnection1.Close;
end;
//Получение значения из указанной строки баланса за заданный год и квартал:
function GetBalValue(Year, Quarter, Row, Period: Integer): Real;
begin
DM.qrGetBalValue.Parameters.ParamByName('pYear').Value := Year;
DM.qrGetBalValue.Parameters.ParamByName('pQuarter').Value := Quarter;
DM.qrGetBalValue.Parameters.ParamByName('pRow').Value := Row;
DM.qrGetBalValue.Open;
if DM.qrGetBalValue.RecordCount <= 0 then
begin
Application.MessageBox (PChar('Данные баланса за ' + IntToStr(Quarter) + '-й квартал ' +
IntToStr(Year) + ' года не внесены в базу данных, либо в данном балансе не внесено '+
' значение для ' + IntToStr(Row) + ' строки!'), 'Ошибка', MB_OK+MB_ICONERROR);
DM.qrGetBalValue.Close;
raise Exception.Create('');
end;
if Period = 1 then
//Берутся данные на начало отчетного года:
Result := DM.qrGetBalValue.FieldByName('Период1').AsFloat
else
//Берутся данные на конец отчетного периода:
Result := DM.qrGetBalValue.FieldByName('Период2').AsFloat;
DM.qrGetBalValue.Close;
end;
//Получение значения из указанной строки баланса за заданный год и квартал:
function GetOPUValue(Year, Quarter, Row, Period: Integer): Real;
begin
DM.qrGetOPUValue.Parameters.ParamByName('pYear').Value := Year;
DM.qrGetOPUValue.Parameters.ParamByName('pQuarter').Value := Quarter;
DM.qrGetOPUValue.Parameters.ParamByName('pRow').Value := Row;
DM.qrGetOPUValue.Open;
if DM.qrGetOPUValue.RecordCount <= 0 then
begin
Application.MessageBox (PChar('Данные ОПиУ за ' + IntToStr(Quarter) + '-й квартал ' +
IntToStr(Year) + ' года не внесены в базу данных, либо в данном ОПиУ не внесено '+
' значение для ' + FormatFloat('000', Row) + ' строки!'), 'Ошибка', MB_OK+MB_ICONERROR);
DM.qrGetOPUValue.Close;
raise Exception.Create('');
end;
if Period = 1 then
//Берутся данные за отчетный период:
Result := DM.qrGetOPUValue.FieldByName('Период1').AsFloat
else
//Берутся данные за аналогичный период предыдущего года:
Result := DM.qrGetOPUValue.FieldByName('Период2').AsFloat;
DM.qrGetOPUValue.Close;
end;
end.
Программный модуль uMain.pas
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, DBGrids, ActnList, StdActns, ImgList,
ActnMan, ToolWin, ActnCtrls, ActnMenus, XPStyleActnCtrls, XPMan;
type
TfmMain = class(TForm)
bbtEditBalance: TBitBtn;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
bbtNewBalance: TBitBtn;
DBGrid1: TDBGrid;
bbtNewOPU: TBitBtn;
bbtDelBalance: TBitBtn;
bbtEditOPU: TBitBtn;
bbtDelOPU: TBitBtn;
cbYear: TComboBox;
cbQuarter: TComboBox;
sgPeriods: TStringGrid;
bbtAdd: TBitBtn;
bbtDel: TBitBtn;
ActionManager1: TActionManager;
ImageList1: TImageList;
FileExit1: TFileExit;
acEditBalance: TAction;
acDelBalance: TAction;
acNewBalance: TAction;
acNewOPU: TAction;
acEditOPU: TAction;
acDelOPU: TAction;
acStructBal: TAction;
acStructOPU: TAction;
acTables1: TAction;
BitBtn1: TBitBtn;
acTables2: TAction;
BitBtn2: TBitBtn;
acTables3: TAction;
BitBtn3: TBitBtn;
acTables4: TAction;
BitBtn6: TBitBtn;
acTables5: TAction;
BitBtn7: TBitBtn;
ActionMainMenuBar1: TActionMainMenuBar;
XPManifest1: TXPManifest;
procedure FormShow(Sender: TObject);
procedure bbtAddClick(Sender: TObject);
procedure bbtDelClick(Sender: TObject);
procedure acNewBalanceExecute(Sender: TObject);
procedure acEditBalanceExecute(Sender: TObject);
procedure acDelBalanceExecute(Sender: TObject);
procedure acNewOPUExecute(Sender: TObject);
procedure acEditOPUExecute(Sender: TObject);
procedure acDelOPUExecute(Sender: TObject);
procedure acStructBalExecute(Sender: TObject);
procedure acStructOPUExecute(Sender: TObject);
procedure acTables1Execute(Sender: TObject);
procedure acTables2Execute(Sender: TObject);
procedure acTables3Execute(Sender: TObject);
procedure acTables4Execute(Sender: TObject);
procedure acTables5Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmMain: TfmMain;
implementation
uses uBalanceStructure, uOPUStructure, uDM, uBalance, DB, uOPU, uRep;
{$R *.dfm}
procedure TfmMain.FormShow(Sender: TObject);
begin
DM.dstPeriodList.Open;
sgPeriods.Cells[0,0] := 'Период';
sgPeriods.Cells[1,0] := 'Год';
sgPeriods.Cells[2,0] := 'Квартал';
sgPeriods.Cells[0,1] := ' n-2';
sgPeriods.Cells[0,2] := ' n-1';
sgPeriods.Cells[0,3] := ' n';
end;
//Добавление в список анализируемых кварталов нового квартала:
procedure TfmMain.bbtAddClick(Sender: TObject);
var
i, Goal: Integer;
Flag: Boolean;
Year, Quarter: string;
begin
Year := DM.dstPeriodList.FieldByName('Год').AsString;
Quarter := DM.dstPeriodList.FieldByName('Квартал').AsString;
Goal := -1;
Flag := False;
for i:=1 to sgPeriods.RowCount-1 do
begin
//Проверка, включен ли уже выбранный квартал в список анализируемых кварталов:
if (sgPeriods.Cells[1,i] = Year) and (sgPeriods.Cells[2,i] = Quarter) then
Flag := True;
//Определение номера первой пустой строки:
if (Goal < 0) and (sgPeriods.Cells[1,i] = '') and (sgPeriods.Cells[2,i] = '') then
Goal := i;
end;
if not Flag and (Goal > 0) then
begin
sgPeriods.Cells[1, Goal] := Year;
sgPeriods.Cells[2, Goal] := Quarter;
end
end;
//Удаление из списка анализируемых кварталов выбранного квартала:
procedure TfmMain.bbtDelClick(Sender: TObject);
begin
sgPeriods.Cells[1,sgPeriods.Row] := '';
sgPeriods.Cells[2,sgPeriods.Row] := '';
end;
//Добавление нового баланса:
procedure TfmMain.acNewBalanceExecute(Sender: TObject);
begin
if (Trim(cbYear.Text)='') or (Trim(cbQuarter.Text)='') then
Application.MessageBox('Укажите период!', 'Ошибка', MB_ICONERROR+MB_OK)
else
begin
DM.qrNewBalance.Parameters.ParamByName('pYear').Value := StrToInt(cbYear.Text);
DM.qrNewBalance.Parameters.ParamByName('pQuarter').Value := StrToInt(cbQuarter.Text);
try
DM.qrNewBalance.ExecSQL;
DM.dstBalance.Filter := '(Год = ' + cbYear.Text + ') and (Квартал = ' + cbQuarter.Text + ')';
DM.dstBalance.Open;
fmBalance.Caption := 'Баланс (форма №1) за ' + cbQuarter.Text + ' квартал ' + cbYear.Text + ' г.';
fmBalance.ShowModal;
DM.dstPeriodList.Requery;
except
Application.MessageBox('Баланс за данный период уже создан. Выберите этот период из таблицы' +
' и нажмите кнопку "Редактировать".', 'Информация', MB_ICONINFORMATION+MB_OK);
end;
end;
end;
//Редактирование баланса за выбранный период:
procedure TfmMain.acEditBalanceExecute(Sender: TObject);
var
Year, Quarter: string;
begin
Year := DM.dstPeriodList.FieldByName('Год').AsString;
Quarter := DM.dstPeriodList.FieldByName('Квартал').AsString;
DM.dstBalance.Filter := '(Год = ' + Year + ') and (Квартал = ' + Quarter + ')';
DM.dstBalance.Open;
if DM.dstBalance.RecordCount > 0 then
begin
fmBalance.Caption := 'Баланс (форма №1) за ' + Quarter + ' квартал ' + Year + ' г.';
fmBalance.ShowModal;
end
else
if Application.MessageBox('Баланс за данный период еще не создан. Создать баланс?',
'Вопрос', MB_ICONQUESTION+MB_YESNO) = IDYES then
begin
//Добавление баланса, если его за выбранный квартал еще нет:
DM.dstBalance.Close;
DM.qrNewBalance.Parameters.ParamByName('pYear').Value := Year;
DM.qrNewBalance.Parameters.ParamByName('pQuarter').Value := Quarter;
DM.qrNewBalance.ExecSQL;
DM.dstBalance.Open;
fmBalance.Caption := 'Баланс за ' + Quarter + ' квартал ' + Year + ' г.';
fmBalance.ShowModal;
end;
end;
//Удаление баланса за выбранный период:
procedure TfmMain.acDelBalanceExecute(Sender: TObject);
begin
if Application.MessageBox('Удалить баланс за выбранный период?', 'Вопрос',
MB_ICONQUESTION+MB_YESNO) = IDYES then
begin
DM.qrDelBalance.Parameters.ParamByName('pYear').Value := DM.dstPeriodList.FieldByName('Год').AsString;
DM.qrDelBalance.Parameters.ParamByName('pQuarter').Value := DM.dstPeriodList.FieldByName('Квартал').AsString;
DM.qrDelBalance.ExecSQL;
Application.MessageBox('Баланс за выбранный период удален.', 'Информация',
MB_ICONINFORMATION+MB_OK);
DM.dstPeriodList.Requery;
end;
end;
//Добавление нового ОПиУ:
procedure TfmMain.acNewOPUExecute(Sender: TObject);
begin
if (Trim(cbYear.Text)='') or (Trim(cbQuarter.Text)='') then
Application.MessageBox('Укажите период!', 'Ошибка', MB_ICONERROR+MB_OK)
else
begin
DM.qrNewOPU.Parameters.ParamByName('pYear').Value := StrToInt(cbYear.Text);
DM.qrNewOPU.Parameters.ParamByName('pQuarter').Value := StrToInt(cbQuarter.Text);
try
DM.qrNewOPU.ExecSQL;
DM.dstOPU.Filter := '(Год = ' + cbYear.Text + ') and (Квартал = ' + cbQuarter.Text + ')';
DM.dstOPU.Open;
fmOPU.Caption := 'Отчет о прибылях и убытках (форма №2) за ' + cbQuarter.Text + ' квартал ' + cbYear.Text + ' г.';
fmOPU.ShowModal;
DM.dstPeriodList.Requery;
except
Application.MessageBox('ОПиУ за данный период уже создан. Выберите этот период из таблицы' +
' и нажмите кнопку "Редактировать".', 'Информация', MB_ICONINFORMATION+MB_OK);
end;
end;
end;
//Редактирование ОПиУ за выбранный период:
procedure TfmMain.acEditOPUExecute(Sender: TObject);
var
Year, Quarter: string;
begin
Year := DM.dstPeriodList.FieldByName('Год').AsString;
Quarter := DM.dstPeriodList.FieldByName('Квартал').AsString;
DM.dstOPU.Filter := '(Год = ' + Year + ') and (Квартал = ' + Quarter + ')';
DM.dstOPU.Open;
if DM.dstOPU.RecordCount > 0 then
begin
fmOPU.Caption := 'Отчет о прибылях и убытках (форма №2) за ' + Quarter + ' квартал ' + Year + ' г.';
fmOPU.ShowModal;
end
else
if Application.MessageBox('ОПиУ за данный период еще не создан. Создать ОПиУ?',
'Вопрос', MB_ICONQUESTION+MB_YESNO) = IDYES then
begin
//Добавление ОПиУ, если его за выбранный квартал еще нет:
DM.dstOPU.Close;
DM.qrNewOPU.Parameters.ParamByName('pYear').Value := Year;
DM.qrNewOPU.Parameters.ParamByName('pQuarter').Value := Quarter;
DM.qrNewOPU.ExecSQL;
DM.dstOPU.Open;
fmOPU.Caption := 'Отчет о прибылях и убытках (форма №2) за ' + Quarter + ' квартал ' + Year + ' г.';
fmOPU.ShowModal;
end;
end;
//Удаление ОПиУ за выбранный период:
procedure TfmMain.acDelOPUExecute(Sender: TObject);
begin
if Application.MessageBox('Удалить ОПиУ за выбранный период?', 'Вопрос',
MB_ICONQUESTION+MB_YESNO) = IDYES then
begin
DM.qrDelOPU.Parameters.ParamByName('pYear').Value := DM.dstPeriodList.FieldByName('Год').AsString;
DM.qrDelOPU.Parameters.ParamByName('pQuarter').Value := DM.dstPeriodList.FieldByName('Квартал').AsString;
DM.qrDelOPU.ExecSQL;
Application.MessageBox('ОПиУ за выбранный период удален.', 'Информация',
MB_ICONINFORMATION+MB_OK);
DM.dstPeriodList.Requery;
end;
end;
procedure TfmMain.acStructBalExecute(Sender: TObject);
begin
fmBalanceStructure.Show;
end;
procedure TfmMain.acStructOPUExecute(Sender: TObject);
begin
fmOPUStructure.Show;
end;
//Формирование таблиц "Коэффициенты ликвидности и платежеспособности"
procedure TfmMain.acTables1Execute(Sender: TObject);
begin
if (sgPeriods.Cells[1,1] = '') or (sgPeriods.Cells[1,2] = '') or (sgPeriods.Cells[1,3] = '') then
Application.MessageBox('Не выбран один или несколько периодов!', 'Предупреждение', MB_OK+MB_ICONEXCLAMATION)
else
Rep_Tables1(StrToInt(sgPeriods.Cells[1,1]), StrToInt(sgPeriods.Cells[2,1]),
StrToInt(sgPeriods.Cells[1,2]), StrToInt(sgPeriods.Cells[2,2]),
StrToInt(sgPeriods.Cells[1,3]), StrToInt(sgPeriods.Cells[2,3]));
end;
//Формирование таблиц "Показатели финансовой устойчивости":
procedure TfmMain.acTables2Execute(Sender: TObject);
begin
if (sgPeriods.Cells[1,1] = '') or (sgPeriods.Cells[1,2] = '') or (sgPeriods.Cells[1,3] = '') then
Application.MessageBox('Не выбран один или несколько периодов!', 'Предупреждение', MB_OK+MB_ICONEXCLAMATION)
else
Rep_Tables2(StrToInt(sgPeriods.Cells[1,1]), StrToInt(sgPeriods.Cells[2,1]),
StrToInt(sgPeriods.Cells[1,2]), StrToInt(sgPeriods.Cells[2,2]),
StrToInt(sgPeriods.Cells[1,3]), StrToInt(sgPeriods.Cells[2,3]));
end;
//Формирование таблиц "Показатели рентабельности и деловой активности":
procedure TfmMain.acTables3Execute(Sender: TObject);
begin
if (sgPeriods.Cells[1,1] = '') or (sgPeriods.Cells[1,2] = '') or (sgPeriods.Cells[1,3] = '') then
Application.MessageBox('Не выбран один или несколько периодов!', 'Предупреждение', MB_OK+MB_ICONEXCLAMATION)
else
Rep_Tables3(StrToInt(sgPeriods.Cells[1,1]), StrToInt(sgPeriods.Cells[2,1]),
StrToInt(sgPeriods.Cells[1,2]), StrToInt(sgPeriods.Cells[2,2]),
StrToInt(sgPeriods.Cells[1,3]), StrToInt(sgPeriods.Cells[2,3]));
end;
//Формирование таблицы "Сводный сравнительный аналитический баланс предприятия":
procedure TfmMain.acTables4Execute(Sender: TObject);
begin
if (sgPeriods.Cells[1,1] = '') or (sgPeriods.Cells[1,2] = '') or (sgPeriods.Cells[1,3] = '') then
Application.MessageBox('Не выбран один или несколько периодов!', 'Предупреждение', MB_OK+MB_ICONEXCLAMATION)
else
Rep_Tables4(StrToInt(sgPeriods.Cells[1,1]), StrToInt(sgPeriods.Cells[2,1]),
StrToInt(sgPeriods.Cells[1,2]), StrToInt(sgPeriods.Cells[2,2]),
StrToInt(sgPeriods.Cells[1,3]), StrToInt(sgPeriods.Cells[2,3]));
end;
//Формирование таблицы "Анализ прибыли (убытка) предприятия":
procedure TfmMain.acTables5Execute(Sender: TObject);
begin
if (sgPeriods.Cells[1,1] = '') or (sgPeriods.Cells[1,2] = '') or (sgPeriods.Cells[1,3] = '') then
Application.MessageBox('Не выбран один или несколько периодов!', 'Предупреждение', MB_OK+MB_ICONEXCLAMATION)
else
Rep_Tables5(StrToInt(sgPeriods.Cells[1,1]), StrToInt(sgPeriods.Cells[2,1]),
StrToInt(sgPeriods.Cells[1,2]), StrToInt(sgPeriods.Cells[2,2]),