4. Приложение
4.1 Листинг программы
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ActnList, jpeg, ExtCtrls, sSkinManager;
type
TfrmMain = class(TForm)
mmMain: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
actlstMain: TActionList;
actConsumers: TAction;
actPrices: TAction;
N4: TMenuItem;
actFinishedProduction: TAction;
N5: TMenuItem;
actRequisitionForShipment: TAction;
N6: TMenuItem;
actPaymentRequest: TAction;
N7: TMenuItem;
N8: TMenuItem;
actDraft: TAction;
N9: TMenuItem;
N10: TMenuItem;
actReport1: TAction;
N11: TMenuItem;
actReport2: TAction;
N12: TMenuItem;
actReport3: TAction;
N13: TMenuItem;
actDepartments: TAction;
N14: TMenuItem;
Image1: TImage;
sSkinManager1: TsSkinManager;
procedure actConsumersExecute(Sender: TObject);
procedure actDepartmentsExecute(Sender: TObject);
procedure actDraftExecute(Sender: TObject);
procedure actPaymentRequestExecute(Sender: TObject);
procedure actPricesExecute(Sender: TObject);
procedure actFinishedProductionExecute(Sender: TObject);
procedure actReport1Execute(Sender: TObject);
procedure actReport2Execute(Sender: TObject);
procedure actReport3Execute(Sender: TObject);
procedure actRequisitionForShipmentExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses DataSetWrap, Directory, ReceivingPassingBillForm, DataModule,
RequisitionForm, PaymentRequestForm, FinishedProductionForm, FormManagerUnit,
AboutForm, DraftForm, Report1Form, Report2Form, Report3Form;
{$R *.dfm}
procedure TfrmMain.actConsumersExecute(Sender: TObject);
var
frmDirectory: TfrmDirectory;
ACaption: string;
begin
ACaption := 'V001 Потребители';
// frmDirectory := FormManager.Find( TfrmDirectory, ACaption ) as TfrmDirectory;
// if frmDirectory = nil then
frmDirectory := TfrmDirectory.Create(Self, Dm.dsConsumer);
frmDirectory.Caption := ACaption;
frmDirectory.ShowModal;
DM.ConsumersFile.StoreToFile;
end;
procedure TfrmMain.actDepartmentsExecute(Sender: TObject);
var
ACaption: string;
frmDirectory: TfrmDirectory;
begin
ACaption := 'V008 Цеха';
frmDirectory := TfrmDirectory.Create(Self, DM.dsDepartments);
frmDirectory.Caption := ACaption;
frmDirectory.Width := 275;
frmDirectory.ShowModal;
DM.DepartmentsFile.StoreToFile;
end;
procedure TfrmMain.actDraftExecute(Sender: TObject);
var
frmDraft: TfrmDraft;
begin
frmDraft := FormManager.Find(TfrmDraft) as TfrmDraft;
if frmDraft = nil then
frmDraft := TfrmDraft.Create(Self);
frmDraft.Show;
end;
procedure TfrmMain.actPaymentRequestExecute(Sender: TObject);
var
frmPaymentRequaest: TfrmPaymentRequaest;
begin
frmPaymentRequaest := FormManager.Find(TfrmPaymentRequaest) as TfrmPaymentRequaest;
if frmPaymentRequaest = nil then
frmPaymentRequaest := TfrmPaymentRequaest.Create(Self);
frmPaymentRequaest.Show;
end;
procedure TfrmMain.actPricesExecute(Sender: TObject);
var
frmDirectory: TfrmDirectory;
ACaption: string;
begin
ACaption := 'V002 Ценник по изделиям';
// frmDirectory := FormManager.Find(TfrmDirectory, ACaption) as TfrmDirectory;
// if frmDirectory = nil then
frmDirectory := TfrmDirectory.Create(Self, DM.dsGoods);
frmDirectory.Caption := ACaption;
frmDirectory.ShowModal;
DM.GoodsFile.StoreToFile;
end;
procedure TfrmMain.actFinishedProductionExecute(Sender: TObject);
var
AfrmFinishedProduction: TfrmFinishedProduction;
begin
AfrmFinishedProduction := FormManager.Find(TfrmFinishedProduction) as TfrmFinishedProduction;
if AfrmFinishedProduction = nil then
AfrmFinishedProduction := TfrmFinishedProduction.Create(Self);
AfrmFinishedProduction.Show;
end;
procedure TfrmMain.actReport1Execute(Sender: TObject);
var
AfrmReport1: TfrmReport1;
begin
AfrmReport1 := TfrmReport1.Create(Self);
AfrmReport1.QuickRep1.Preview;
FreeAndNil(AfrmReport1);
end;
procedure TfrmMain.actReport2Execute(Sender: TObject);
var
AfrmReport2: TfrmReport2;
begin
AfrmReport2 := TfrmReport2.Create(Self);
AfrmReport2.QuickRep1.Preview;
FreeAndNil(AfrmReport2);
end;
procedure TfrmMain.actReport3Execute(Sender: TObject);
var
AfrmReport3: TfrmReport3;
begin
AfrmReport3 := TfrmReport3.Create(Self);
AfrmReport3.QuickRep1.Preview;
FreeAndNil(AfrmReport3);
end;
procedure TfrmMain.actRequisitionForShipmentExecute(Sender: TObject);
var
AfrmRequisition: TfrmRequisition;
begin
AfrmRequisition := FormManager.Find(TfrmRequisition) as TfrmRequisition;
if AfrmRequisition = nil then
AfrmRequisition := TfrmRequisition.Create(Self);
AfrmRequisition.Show;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DM.StoreAllData;
end;
procedure TfrmMain.N8Click(Sender: TObject);
var
AfrmAbout: TfrmAbout;
begin
AfrmAbout := TfrmAbout.Create(Self);
try
AfrmAbout.ShowModal;
finally
FreeAndNil(AfrmAbout);
end;
end;
end.
unit AboutForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmAbout = class(TForm)
Label1: TLabel;
btn1: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.
unit DataModule;
interface
uses
SysUtils, Classes, DB, DBClient, DataSetWrap, QuickRpt;
type
TDM = class(TDataModule)
cdsConsumers: TClientDataSet;
cdsConsumersIDConsumer: TIntegerField;
cdsConsumersAddress: TStringField;
cdsConsumersEnterprise: TStringField;
cdsGoods: TClientDataSet;
cdsGoodsIDGoods: TIntegerField;
cdsGoodsGoods: TStringField;
cdsGoodsPrice: TFloatField;
cdsReceivingPassingBill: TClientDataSet;
cdsReceivingPassingBillIDGoods: TIntegerField;
cdsReceivingPassingBillAmount: TIntegerField;
cdsReceivingPassingBillIDDepartment: TIntegerField;
cdsReceivingPassingBillGoods: TStringField;
cdsRequisitionMaster: TClientDataSet;
cdsRequisitionMasterIDRequisition: TIntegerField;
cdsRequisitionMasterRequisitionDate: TDateField;
cdsRequisitionMasterIDConsumer: TIntegerField;
cdsRequisitionMasterEnterprise: TStringField;
cdsRequisitionMasterAddress: TStringField;
cdsRequisitionDetail: TClientDataSet;
cdsRequisitionDetailIDRequisition: TIntegerField;
cdsRequisitionDetailIDGoods: TIntegerField;
cdsRequisitionDetailAmount: TIntegerField;
cdsRequisitionDetailGoods: TStringField;
dsConsumer: TDataSource;
dsGoods: TDataSource;
dsReceivingPassingBill: TDataSource;
dsRequisitionMaster: TDataSource;
dsRequisitionDetail: TDataSource;
cdsReceivingPassingBillShift: TClientDataSet;
if1: TIntegerField;
if2: TIntegerField;
if3: TIntegerField;
sf1: TStringField;
ds1: TDataSource;
cdsRequisitionMasterTitle: TStringField;
cdsFinishedProduct: TClientDataSet;
dsFinishedProduct: TDataSource;
cdsPaymentRequest: TClientDataSet;
cdsPaymentRequestIDRequisition: TIntegerField;
cdsPaymentRequestAddress: TStringField;
cdsPaymentRequestEnterprise: TStringField;
cdsPaymentRequestShipDate: TDateField;
cdsPaymentRequestTitle: TStringField;
cdsPaymentRequestIDConsumer: TIntegerField;
dsPaymentRequest: TDataSource;
cdsPaymentRequestIDPaymentRequest: TIntegerField;
cdsPaymentRequestDetail: TClientDataSet;
IntegerField4: TIntegerField;
cdsPaymentRequestDetailIDGoods: TIntegerField;
StringField2: TStringField;
dsPaymentRequestDetail: TDataSource;
cdsRequisitionMasterState: TIntegerField;
cdsPaymentRequestDetailPrice: TFloatField;
cdsPaymentRequestDetailSumma: TFloatField;
cdsPaymentRequestDetailAmount: TIntegerField;
cdsShippedGoods: TClientDataSet;
dsShippedGoods: TDataSource;
cdsFinishedProductIDGoods: TIntegerField;
cdsFinishedProductAmount: TIntegerField;
cdsFinishedProductIDDepartment: TIntegerField;
cdsFinishedProductGoods: TStringField;
cdsShippedGoodsIDRequisition: TIntegerField;
cdsShippedGoodsIDGoods: TIntegerField;
cdsShippedGoodsAmount: TIntegerField;
cdsShippedGoodsIDDepartment: TIntegerField;
dsDraft: TDataSource;
cdsDraft: TClientDataSet;
cdsDraftIDDraft: TIntegerField;
cdsDraftIDPaymentRequest: TIntegerField;
cdsDraftIDConsumer: TIntegerField;
cdsDraftAddress: TStringField;
cdsDraftEnterprise: TStringField;
cdsDraftTitle: TStringField;
cdsRequisitionMasterStateTitle: TStringField;
cdsPaymentRequestState: TIntegerField;
cdsPaymentRequestStateTitle: TStringField;
cdsDraftDetail: TClientDataSet;
IntegerField1: TIntegerField;
IntegerField2: TIntegerField;
IntegerField3: TIntegerField;
StringField1: TStringField;
FloatField1: TFloatField;
dsDraftDetail: TDataSource;
cdsDraftIDRequisition: TIntegerField;
cdsShippedGoodsGoods: TStringField;
cdsShippedGoodsPrice: TFloatField;
cdsShippedGoodsSumma: TFloatField;
cdsFinishedProductPrice: TFloatField;
cdsFinishedProductSumma: TFloatField;
cdsRequisitionDetailPrice: TFloatField;
cdsRequisitionDetailSumma: TFloatField;
cdsRequisitionDetailIDConsumer: TIntegerField;
cdsDepartments: TClientDataSet;
dsDepartments: TDataSource;
cdsDepartmentsIDDepartment: TIntegerField;
cdsFinishedProductIDDepartmet2: TIntegerField;
cdsReceivingPassingBillIDDepartment2: TIntegerField;
procedure cdsDraftAfterInsert(DataSet: TDataSet);
procedure cdsDraftCalcFields(DataSet: TDataSet);
procedure cdsFinishedProductCalcFields(DataSet: TDataSet);
procedure cdsPaymentRequestAfterInsert(DataSet: TDataSet);
procedure cdsPaymentRequestCalcFields(DataSet: TDataSet);
procedure cdsPaymentRequestDetailCalcFields(DataSet: TDataSet);
procedure cdsRequisitionDetailAfterInsert(DataSet: TDataSet);
procedure cdsRequisitionDetailCalcFields(DataSet: TDataSet);
procedure cdsRequisitionMasterAfterInsert(DataSet: TDataSet);
procedure cdsRequisitionMasterBeforeDelete(DataSet: TDataSet);
procedure cdsRequisitionMasterCalcFields(DataSet: TDataSet);
procedure cdsShippedGoodsCalcFields(DataSet: TDataSet);
procedure DataModuleCreate(Sender: TObject);
private
FConsumersFile: TConsumersFile;
FDepartmentsFile: TDepartmentsFile;
FDraftFile: TDraftFile;
FEnterpriseName: String;
FFinishedProductFile: TReceivingPassingBillFile;
FGoodsFile: TGoodsFile;
FPaymentRequestFile: TPaymentRequestFile;
FReceivingPassingBillFile: TReceivingPassingBillFile;
FReceivingPassingBillShiftFile: TReceivingPassingBillFile;
FRequisitionDetailFile: TRequisitionDetailFile;
FRequisitionMasterFile: TRequisitionMasterFile;
FShippedGoodsFile: TShippedGoodsFile;
function GetConsumersFileName: string;
function GetDepartmentsFileName: string;
function GetDraftFileName: string;
function GetFinishedProductFileName: string;
function GetGoodsFileName: string;
function GetPaymentRequestFileName: string;
function GetRequisitionDetailFileName: string;
function GetRequisitionFileName: string;
function GetShiftFileName(ADate: TDateTime): string;
function GetShippedGoodsFileName: string;
{ Private declarations }
protected
public
procedure AddDraft;
procedure AddReceivingPassingBill(ADate: TDateTime);
function CancelDraft: Boolean;
function CancelPaymentRequest: Boolean;
procedure CancelRequisition;
function CheckRequistion: Boolean;
procedure CheckRequistionRecord;
procedure ProcessRequistion;
procedure RequisitionIDConsumerUpdate;
procedure SavePaymentRequest;
procedure SaveRequisition;
procedure StoreAllData;
property ConsumersFile: TConsumersFile read FConsumersFile;
property ConsumersFileName: string read GetConsumersFileName;
property DepartmentsFile: TDepartmentsFile read FDepartmentsFile;
property DepartmentsFileName: string read GetDepartmentsFileName;
property DraftFile: TDraftFile read FDraftFile;
property DraftFileName: string read GetDraftFileName;
property EnterpriseName: String read FEnterpriseName;
property GoodsFile: TGoodsFile read FGoodsFile;
property ReceivingPassingBillFile: TReceivingPassingBillFile read
FReceivingPassingBillFile;
property RequisitionDetailFile: TRequisitionDetailFile read
FRequisitionDetailFile;
property RequisitionMasterFile: TRequisitionMasterFile read
FRequisitionMasterFile;
property FinishedProductFileName: string read GetFinishedProductFileName;
property GoodsFileName: string read GetGoodsFileName;
property PaymentRequestFile: TPaymentRequestFile read FPaymentRequestFile;
property PaymentRequestFileName: string read GetPaymentRequestFileName;
property ReceivingPassingBillShiftFile: TReceivingPassingBillFile read
FReceivingPassingBillShiftFile;
property RequisitionDetailFileName: string read
GetRequisitionDetailFileName;
property RequisitionFileName: string read GetRequisitionFileName;
property ShippedGoodsFileName: string read GetShippedGoodsFileName;
{ Public declarations }
end;
var
DM: TDM;
implementation
uses Variants, IniFiles;
{$R *.dfm}
procedure TDM.AddDraft;
begin
if cdsPaymentRequest.RecordCount = 0 then
raise Exception.Create('Не найдено ни одного платёжного поручения');
cdsDraft.Append;
cdsDraftIDPaymentRequest.Value := cdsPaymentRequestIDPaymentRequest.Value;
cdsDraft.Post;
end;
procedure TDM.AddReceivingPassingBill(ADate: TDateTime);
begin
// Загружаем сменный файл отдела сбыта
ReceivingPassingBillShiftFile.FileName := GetShiftFileName(ADate);
ReceivingPassingBillShiftFile.LoadFromFile;
// Добавляем введённую информацию в сменный файл отдела сбыта
ReceivingPassingBillShiftFile.Add(ReceivingPassingBillFile);
// Сохраняем сменный файл
ReceivingPassingBillShiftFile.StoreToFile;
// Добавляем введённую информацию в месячный файл готовой продукции
FFinishedProductFile.Add(ReceivingPassingBillFile);
//Сохраняем месячный файл готовой продукции
FFinishedProductFile.StoreToFile;
cdsReceivingPassingBill.EmptyDataSet;
end;
function TDM.CancelDraft: Boolean;
begin
// Ищем платёжное требование для нашего платёжного поручения
Result := cdsPaymentRequest.Locate('IDPaymentRequest',
cdsDraftIDPaymentRequest.Value, []);
if Result then
begin
// Помечаем что платёжное требование не оплачено
cdsPaymentRequest.Edit;
cdsPaymentRequestState.Value := 0;
cdsPaymentRequest.Post;
cdsDraft.Delete; // Удаляем платёжное поручение
end;
end;
function TDM.CancelPaymentRequest: Boolean;
var
AMasterSource: TDataSource;
begin
cdsRequisitionMaster.DisableControls;
try
// ищем заявку среди выполненных
Result := cdsRequisitionMaster.Locate('IDRequisition;State',
VarArrayOf([cdsPaymentRequestIDRequisition.Value, 1]), []);
if Result then // Если эта заявка ещё сохранилась
begin
// Возвращаем товар на склад
cdsReceivingPassingBill.EmptyDataSet;
AMasterSource := cdsShippedGoods.MasterSource;
cdsShippedGoods.MasterSource := nil;
cdsShippedGoods.MasterSource := AMasterSource;
if cdsShippedGoods.Eof then
begin
Result := False;
Exit;
end;
cdsShippedGoods.First;
// Цикл по всем отгруженным изделиям найденной заявки
while not cdsShippedGoods.Eof do
begin
// Формируем приёмно-сдаточную накладную, чтобы вернуть изделия на склад
cdsReceivingPassingBill.Append;
// Код изделия
cdsReceivingPassingBillIDGoods.Value := cdsShippedGoodsIDGoods.Value;
// Кол-во изделий
cdsReceivingPassingBillAmount.Value := cdsShippedGoodsAmount.Value;
// Код цеха
cdsReceivingPassingBillIDDepartment.Value :=
cdsShippedGoodsIDDepartment.Value;
cdsReceivingPassingBill.Post;
cdsShippedGoods.Delete; // Удаляем запись из отгруженной продукции
end;
// Добавляем возвращённый товар на склад
FFinishedProductFile.Add(FReceivingPassingBillFile);
FFinishedProductFile.StoreToFile; // Сохраняем файл готовой продукции
FShippedGoodsFile.StoreToFile; // Сохраняем файл отгруженные товары
// Переводим заявку в разряд не выполненных
cdsRequisitionMaster.Edit;
cdsRequisitionMasterState.Value := 0;
cdsRequisitionMaster.Post;
end;
cdsPaymentRequest.Delete; // Удаляем платёжное требование
finally
cdsRequisitionMaster.EnableControls;
end;
end;
procedure TDM.CancelRequisition;
begin
cdsRequisitionMaster.Delete;
end;
procedure TDM.cdsDraftAfterInsert(DataSet: TDataSet);
var
ANewID: Integer;
ARecNo: Integer;
begin
cdsDraft.DisableControls;
cdsDraft.AfterInsert := nil;
try
cdsDraft.Cancel;
ARecNo := cdsDraft.RecNo;
cdsDraft.First;
ANewID := cdsDraftIDDraft.AsInteger + 1;
cdsDraft.RecNo := ARecNo;
cdsDraft.Insert;
cdsDraftIDDraft.Value := ANewID;
finally
cdsDraft.AfterInsert := cdsDraftAfterInsert;
cdsDraft.EnableControls;
end;
end;
procedure TDM.cdsDraftCalcFields(DataSet: TDataSet);
begin
// Формируем строку - код потребителя, адрес, наименование
cdsDraftTitle.Value :=
Format('%d, %s, %s', [cdsDraftIDConsumer.Value, cdsDraftAddress.Value,
cdsDraftEnterprise.Value])
end;
procedure TDM.cdsFinishedProductCalcFields(DataSet: TDataSet);
begin
cdsFinishedProductSumma.Value :=
cdsFinishedProductPrice.Value * cdsFinishedProductAmount.Value;
end;
procedure TDM.cdsPaymentRequestAfterInsert(DataSet: TDataSet);
var
ARecNo: Integer;
ANewID: Integer;
begin
cdsPaymentRequest.DisableControls;
cdsPaymentRequest.AfterInsert := nil;
try
cdsPaymentRequest.Cancel;
ARecNo := cdsPaymentRequest.RecNo;
cdsPaymentRequest.First;
ANewID := cdsPaymentRequestIDPaymentRequest.AsInteger + 1;
cdsPaymentRequest.RecNo := ARecNo;
cdsPaymentRequest.Insert;
cdsPaymentRequestShipDate.Value := Now;
// Дата отгрузки заполняется текущей датой
cdsPaymentRequestIDPaymentRequest.Value := ANewID;
finally
cdsPaymentRequest.AfterInsert := cdsPaymentRequestAfterInsert;
cdsPaymentRequest.EnableControls;
end;
end;
procedure TDM.cdsPaymentRequestCalcFields(DataSet: TDataSet);
begin
// Формируем поле где хранится через запятую название адрес код
if cdsPaymentRequestIDConsumer.IsNull then
cdsPaymentRequestTitle.AsString := ''
else
cdsPaymentRequestTitle.AsString
:= Format('%s, %s, заявка №%d, код %d',
[cdsPaymentRequestEnterprise.AsString,
cdsPaymentRequestAddress.AsString,
cdsPaymentRequestIDRequisition.AsInteger,
cdsPaymentRequestIDConsumer.AsInteger]);
case cdsPaymentRequestState.Value of
0: cdsPaymentRequestStateTitle.Value := 'Не оплачено';
1: cdsPaymentRequestStateTitle.Value := 'Оплачено';
end;
end;
procedure TDM.cdsPaymentRequestDetailCalcFields(DataSet: TDataSet);
begin
// Сумму рассчитываем как произведение количества на цену
cdsPaymentRequestDetailSumma.Value :=
cdsPaymentRequestDetailPrice.Value * cdsPaymentRequestDetailAmount.Value;
end;
procedure TDM.cdsRequisitionDetailAfterInsert(DataSet: TDataSet);
begin
// Заполняем код потребителя
// if cdsRequisitionDetail.MasterSource = dsRequisitionMaster then
// cdsRequisitionDetailIDConsumer.Value := cdsRequisitionMasterIDConsumer.Value;
end;
procedure TDM.cdsRequisitionDetailCalcFields(DataSet: TDataSet);
begin
cdsRequisitionDetailSumma.Value :=
cdsRequisitionDetailAmount.Value * cdsRequisitionDetailPrice.Value;
end;
procedure TDM.cdsRequisitionMasterAfterInsert(DataSet: TDataSet);
var
ANewID: Integer;
ARecNo: Integer;
begin
cdsRequisitionMaster.DisableControls;
cdsRequisitionMaster.AfterInsert := nil;
try
cdsRequisitionMaster.Cancel;
ARecNo := cdsRequisitionMaster.RecNo;
cdsRequisitionMaster.First;
ANewID := cdsRequisitionMasterIDRequisition.AsInteger + 1;
cdsRequisitionMaster.RecNo := ARecNo;
cdsRequisitionMaster.Insert;
cdsRequisitionMasterRequisitionDate.Value := Now;
cdsRequisitionMasterIDRequisition.Value := ANewID;
finally
cdsRequisitionMaster.AfterInsert := cdsRequisitionMasterAfterInsert;
cdsRequisitionMaster.EnableControls;
end;
end;
procedure TDM.cdsRequisitionMasterBeforeDelete(DataSet: TDataSet);
begin
// Удаляем все записи о заявке
while not cdsRequisitionDetail.Eof do
begin
cdsRequisitionDetail.Delete;
end;
end;
procedure TDM.cdsRequisitionMasterCalcFields(DataSet: TDataSet);
begin
// Формируем поле где хранится через запятую название адрес код
if cdsRequisitionMasterIDConsumer.IsNull then
cdsRequisitionMasterTitle.AsString := ''
else
cdsRequisitionMasterTitle.AsString
:= Format('%s, %s, %d',
[cdsRequisitionMasterEnterprise.AsString,
cdsRequisitionMasterAddress.AsString,
cdsRequisitionMasterIDConsumer.AsInteger]);
case cdsRequisitionMasterState.Value of
0: cdsRequisitionMasterStateTitle.Value := 'Не отгружен';
1: cdsRequisitionMasterStateTitle.Value := 'Отгружен';
end;
end;
procedure TDM.cdsShippedGoodsCalcFields(DataSet: TDataSet);
begin
cdsShippedGoodsSumma.Value := cdsShippedGoodsAmount.Value *
cdsShippedGoodsPrice.Value;
end;
procedure TDM.DataModuleCreate(Sender: TObject);
var
IniFile: TIniFile;
AFileName: String;
begin
// Считываем из ини файла название предприятия-поставщика
AFileName := ChangeFileExt(ParamStr(0), '.ini');
IniFile := TIniFile.Create( AFileName );
FEnterpriseName := IniFile.ReadString('Settings', 'EnterpriseName', '');
FreeAndNil(IniFile);
// Справочник изделий
FGoodsFile := TGoodsFile.Create(Self, cdsGoods);
FGoodsFile.FileName := GoodsFileName;
FGoodsFile.LoadFromFile;
// Справочник потребителей
FConsumersFile := TConsumersFile.Create(Self, cdsConsumers);
FConsumersFile.FileName := ConsumersFileName;
FConsumersFile.LoadFromFile;
// Справочник цехов
FDepartmentsFile := TDepartmentsFile.Create(Self, cdsDepartments);
FDepartmentsFile.FileName := DepartmentsFileName;
FDepartmentsFile.LoadFromFile;
// Файл отгруженные товары
FShippedGoodsFile := TShippedGoodsFile.Create(Self, cdsShippedGoods);
FShippedGoodsFile.FileName := ShippedGoodsFileName;
FShippedGoodsFile.LoadFromFile;
FReceivingPassingBillFile :=
TReceivingPassingBillFile.Create(Self, cdsReceivingPassingBill);
// Заявки на отгрузку
FRequisitionMasterFile := TRequisitionMasterFile.Create(Self,
cdsRequisitionMaster);
FRequisitionMasterFile.FileName := RequisitionFileName;
FRequisitionMasterFile.LoadFromFile;
// Заявки на отгрузку
FRequisitionDetailFile := TRequisitionDetailFile.Create(Self,
cdsRequisitionDetail);
FRequisitionDetailFile.FileName := RequisitionDetailFileName;
FRequisitionDetailFile.LoadFromFile;
// Сменный файл отчёта сбыта
FReceivingPassingBillShiftFile :=
TReceivingPassingBillFile.Create(Self, cdsReceivingPassingBillShift);
// Файл готовой продукции
FFinishedProductFile := TReceivingPassingBillFile.Create(Self,
cdsFinishedProduct);
FFinishedProductFile.FileName := FinishedProductFileName;
FFinishedProductFile.LoadFromFile;
// Платёжные требования
FPaymentRequestFile := TPaymentRequestFile.Create(Self, cdsPaymentRequest);
FPaymentRequestFile.FileName := PaymentRequestFileName;
FPaymentRequestFile.LoadFromFile;
// Заявки на отгрузку будут отбражаться в платёжном требовании
cdsPaymentRequestDetail.CloneCursor(cdsRequisitionDetail, True);
cdsPaymentRequestDetail.MasterSource := dsPaymentRequest;
cdsPaymentRequestDetail.MasterFields := 'IDRequisition';
// Заявки на отгрузку будут отражаться в платёжном поручении
cdsDraftDetail.CloneCursor(cdsRequisitionDetail, True);
cdsDraftDetail.MasterSource := dsDraft;
cdsDraftDetail.MasterFields := 'IDRequisition';
// Платёжные поручения
FDraftFile := TDraftFile.Create(Self, cdsDraft);
FDraftFile.FileName := DraftFileName;
FDraftFile.LoadFromFile;
end;
function TDM.GetFinishedProductFileName: string;
begin
// Возвращает имя месячного файла "Готовая продукция"
Result := 'Готовая продукция.dat';
end;
function TDM.GetShiftFileName(ADate: TDateTime): string;
begin
// Возвращает имя сменного файла отдела сбыта
Result := Format('Приёмно-сдаточная накладная %s.dat',
[FormatDateTime('dd-mm-yyyy',
ADate)]);
end;
// Обработка заявки
function TDM.CheckRequistion: Boolean;
var
OK: Boolean;
ACount: Integer;
begin
Ok := False;
cdsRequisitionDetail.DisableControls;
cdsFinishedProduct.DisableControls;
try
// Цикл по всем записям заявки на отгрузку
cdsRequisitionDetail.First;
while not cdsRequisitionDetail.Eof do
begin
ACount := 0;
Ok := False;
cdsFinishedProduct.Filter := Format('IDGoods=%d',
[cdsRequisitionDetailIDGoods.AsInteger]);
cdsFinishedProduct.Filtered := True;
while not cdsFinishedProduct.Eof do
begin
// Суммируем количество нужного товара на складе
ACount := ACount + cdsFinishedProduct.FieldByName('AMount').AsInteger;
// если уже набралось необходимое кол-во товара
if ACount >= cdsRequisitionDetailAmount.AsInteger then
begin
OK := True;
break;
end;
cdsFinishedProduct.Next;
end;
cdsFinishedProduct.Filter := '';
cdsFinishedProduct.Filtered := False;
if not Ok then
break;
cdsRequisitionDetail.Next;
end;
finally
cdsFinishedProduct.EnableControls;
cdsRequisitionDetail.EnableControls;
end;
Result := Ok;
end;
procedure TDM.CheckRequistionRecord;
begin
if cdsRequisitionMasterIDConsumer.IsNull then
raise Exception.Create('Не задан потребитель');
if cdsRequisitionMasterRequisitionDate.IsNull then
raise Exception.Create('Не задана дата заявки на отгрузку товара');
if cdsRequisitionDetail.State in [dsEdit, dsInsert] then
cdsRequisitionDetail.Post;
if cdsRequisitionDetail.RecordCount = 0 then
raise Exception.Create('Заявка на отгрузку не содержит ни одного товара');
end;
function TDM.GetConsumersFileName: string;
begin
Result := 'Потребители.dat';
end;
function TDM.GetDepartmentsFileName: string;
begin
Result := 'Цеха.dat';
end;
function TDM.GetDraftFileName: string;
begin
Result := 'Платёжные поручения.dat';
end;
function TDM.GetGoodsFileName: string;
begin
Result := 'Цены на изделия.dat';
end;
function TDM.GetPaymentRequestFileName: string;
begin
Result := 'Платёжные требования.dat';
end;
function TDM.GetRequisitionDetailFileName: string;
begin
Result := 'Заявки на отгрузку (товары).dat';
end;
function TDM.GetRequisitionFileName: string;
begin
Result := 'Заявки на отгрузку.dat';
end;
function TDM.GetShippedGoodsFileName: string;
begin
Result := 'Отгруженные товары.dat';
end;
procedure TDM.ProcessRequistion;
var
ACount: Integer;
begin
if CheckRequistion then // Если заявку можно выполнить
begin
// Отгружаем товар поставщику
cdsRequisitionDetail.DisableControls;
cdsFinishedProduct.DisableControls;
try
// Цикл по всем записям заявки на отгрузку
cdsRequisitionDetail.First;
while not cdsRequisitionDetail.Eof do
begin
ACount := cdsRequisitionDetailAmount.AsInteger;
// Сколько товара надо отгрузить
cdsFinishedProduct.Filter := Format('IDGoods=%d',
[cdsRequisitionDetailIDGoods.AsInteger]);
cdsFinishedProduct.Filtered := True;
while not cdsFinishedProduct.Eof do
begin
// Добавляем запись в "отгруженные изделия"
cdsShippedGoods.Append;
// Связываем запись отгруженных изделий с заявкой на отгрузку
cdsShippedGoodsIDRequisition.Value :=
cdsRequisitionMasterIDRequisition.Value;
// Запоминаем код отгруженного изделия
cdsShippedGoodsIDGoods.Value := cdsFinishedProductIDGoods.Value;
// Запоминаем цех изготовивший отгруженное изделие
cdsShippedGoodsIDDepartment.Value :=
cdsFinishedProductIDDepartment.Value;
// Начинаем перенос готовой продукции в отгруженную продукцию
cdsFinishedProduct.Edit;
if cdsFinishedProduct.FieldByName('Amount').AsInteger > ACount then
begin
// Уменьшаем кол-во изделий на складе
cdsFinishedProduct.FieldByName('Amount').AsInteger :=
cdsFinishedProduct.FieldByName('Amount').AsInteger - ACount;
// Увеличиваем кол-во отгруженных изделий
cdsShippedGoodsAmount.AsInteger := ACount;
ACount := 0;
end
else
begin
ACount := ACount - cdsFinishedProductAmount.Value;
// Увеличиваем кол-во отгруженных изделий
cdsShippedGoodsIDGoods.Value := cdsFinishedProductIDGoods.Value;
cdsShippedGoodsIDDepartment.Value :=
cdsFinishedProductIDDepartment.Value;
cdsShippedGoodsAmount.AsInteger := cdsFinishedProductAmount.Value;
// Уменьшаем кол-во изделий на складе
cdsFinishedProduct.FieldByName('Amount').AsInteger := 0;
end;
cdsFinishedProduct.Post;
cdsShippedGoods.Post;
// если уже набралось необходимое кол-во товара
if ACount = 0 then
break;
cdsFinishedProduct.Next; // Следующая запись в файле готовой продукции
end;
cdsFinishedProduct.Filter := '';
cdsFinishedProduct.Filtered := False;
cdsRequisitionDetail.Next; // Следующий товар в заявке на отгрузку
end;
// Теперь можно удалить из готовой продукции записи с нулевым остатком товара
cdsFinishedProduct.First;
while not cdsFinishedProduct.Eof do
begin
if cdsFinishedProduct.FieldByName('Amount').AsInteger = 0 then
cdsFinishedProduct.Delete
else
cdsFinishedProduct.Next;
end;
// Помечаем, что эта заявка на отгрузку товара выполнена
cdsRequisitionMaster.Edit;
cdsRequisitionMasterState.Value := 1;
cdsRequisitionMaster.Post;
FFinishedProductFile.StoreToFile;
FShippedGoodsFile.StoreToFile;
finally
cdsFinishedProduct.EnableControls;
cdsRequisitionDetail.EnableControls;
end;
end;
end;
procedure TDM.RequisitionIDConsumerUpdate;
begin
cdsRequisitionMaster.DisableControls;
cdsRequisitionDetail.DisableControls;
try
cdsRequisitionDetail.First;
while not cdsRequisitionDetail.Eof do
begin
if not cdsRequisitionMaster.Locate('IDRequisition',
cdsRequisitionDetailIDRequisition.Value, []) then
raise Exception.Create('Ошибка при заполнении IDConsumer');
cdsRequisitionDetail.Edit;
cdsRequisitionDetailIDConsumer.Value :=
cdsRequisitionMasterIDConsumer.Value;
cdsRequisitionDetail.Post;
cdsRequisitionDetail.Next;
end;
cdsRequisitionMaster.Next;
finally
cdsRequisitionMaster.EnableControls;
cdsRequisitionDetail.EnableControls;
end;
end;
procedure TDM.SavePaymentRequest;
begin
PaymentRequestFile.StoreToFile; // Сохраняем заявки на отгрузку в файл
end;
procedure TDM.SaveRequisition;
begin
RequisitionMasterFile.StoreToFile;
RequisitionDetailFile.StoreToFile;
end;
procedure TDM.StoreAllData;
begin
// Справочник изделий
FGoodsFile.StoreToFile;
// Справочник потребителей
FConsumersFile.StoreToFile;
// Справочник цехов
FDepartmentsFile.StoreToFile;
// Файл отгруженные товары
FShippedGoodsFile.StoreToFile;
// Заявки на отгрузку
FRequisitionDetailFile.StoreToFile;
// Заявки на отгрузку
FRequisitionMasterFile.StoreToFile;
// Файл готовой продукции
FFinishedProductFile.StoreToFile;
// Платёжные требования
FPaymentRequestFile.StoreToFile;
// Платёжные поручения
FDraftFile.StoreToFile;
end;
end.