Разработка программы складского учёта

[fn]);

ADOConnection1.Open; //открыть

ini.WriteString('main', 'LastBase',fn); //последняя открытая база

DBCon:=ADOConnection1; //соединение для функций SqlAdoTools

if create then //если надо создать новую базу

//то запустить скрипт создания базы

RunScriptFromFile(ExtractFilePath(ParamStr(0))+'create.sql');

LoadKlassifikator(klkat,tblKlKat);

TableNds.Open;

HasNDS:=TableNdsNDS.Value;

NdsVal:=TableNdsNDSProc.Value;

TableNds.close;

end;

//закрытб БД

procedure Tdm.CloseDataBase;

begin

ADOConnection1.Close;

dbCon:=nil;

end;

function tdm.GetSkidkaOn(f:real):real;

begin

result:=0;

with TblSkidki do

begin

close;

open;

first;

while not eof do

begin

if TblSkidkiSummMany.Value>f then exit;

result:=TblSkidkiSkidka.Value;

next;

end;

end;

end;

//новая запись в таблице товар

procedure Tdm.QryTowarNewRecord(DataSet: TDataSet);

begin

QryTowarid.Value := getid('towar'); //новое значение идентификатора

if QryTowar.tag=-1 then exit;

QryTowarKategory.Value:=DataSet.tag; //новое значение категории

end;

//установка параметров для всех компонентов формы

procedure Tdm.UpdateSettings(form:tform);

type tsc=procedure (Value: TColor);

var cln:string;

i:integer;

// cl:tColor;

p:tsc;

var

ClassRef: TClass;

function SetColor(t:tColor):tColor; //установить цвет

begin

result:=t;

if TableParamscolor.IsNull then exit;

result:=TableParamscolor.value;

end;

function SetFontName(t:string):string; //название шрифта

begin

result:=t;

if TableParamsFontname.IsNull then exit;

result:=TableParamsFontname.value;

end;

function SetFontSize(t:integer):integer; //размер

begin

result:=t;

if TableParamsFontSize.IsNull then exit;

result:=TableParamsFontSize.value;

end;

procedure UpdateObj(o:tObject); //установка параметров объекта

begin

ClassRef := o.ClassType; //что за объет

if UpperCase(ClassRef.ClassName)=uppercase(cln) then //тот ли

begin

//если TLABEL то установить для него

if uppercase(cln)='TLABEL' then

begin

tLabel(o).Color := setcolor(tLabel(o).Color);

tLabel(o).font.Name:=SetFontName(tLabel(o).font.Name);

SetFontSize(tLabel(o).font.size);

end;

if uppercase(cln)='TPANEL' then

begin

TPANEL(o).Color:= setcolor(TPANEL(o).Color);

TPANEL(o).font.Name:= SetFontName(TPANEL(o).font.Name);

TPANEL(o).font.size:= SetFontSize(TPANEL(o).font.size);

end;

if uppercase(cln)='TDBGRID' then

begin

tDBGrid(o).Color :=setcolor(tDBGrid(o).Color);

tDBGrid(o).font.Name :=SetFontName(tDBGrid(o).font.Name);

tDBGrid(o).font.size :=SetFontSize(tDBGrid(o).font.size);

end;

if uppercase(cln)='TEDIT' then

begin

tEdit(o).Color :=setcolor(tEdit(o).Color);

tEdit(o).font.Name :=SetFontName(tEdit(o).font.Name);

tEdit(o).font.size :=SetFontSize(tEdit(o).font.size);

end;

if uppercase(cln)='TDBEDIT' then

begin

tDBEdit(o).Color :=setcolor(tDBEdit(o).Color);

tDBEdit(o).font.Name :=SetFontName(tDBEdit(o).font.Name);

tDBEdit(o).font.size :=SetFontSize(tDBEdit(o).font.size);

end;

if uppercase(cln)='TCHECKBOX' then

begin

tCheckBox(o).Color :=setcolor(tCheckBox(o).Color);

tCheckBox(o).font.Name :=SetFontName(tCheckBox(o).font.Name);

tCheckBox(o).font.size :=SetFontSize(tCheckBox(o).font.size);

end;

if uppercase(cln)='TRADIOGROUP' then

begin

tRadioGroup(o).Color :=setcolor(tRadioGroup(o).Color);

tRadioGroup(o).font.Name :=SetFontName(tRadioGroup(o).font.Name);

tRadioGroup(o).font.size :=SetFontSize(tRadioGroup(o).font.size);

end;

if uppercase(cln)='TPANEL' then

begin

tPanel(o).Color :=setcolor(tPanel(o).Color);

tPanel(o).font.Name :=SetFontName(tPanel(o).font.Name);

tPanel(o).font.size :=SetFontSize(tPanel(o).font.size);

end;

if uppercase(cln)='TGROUPBOX' then

begin

tGroupBox(o).Color :=setcolor(tGroupBox(o).Color);

tGroupBox(o).font.Name :=SetFontName(tGroupBox(o).font.Name);

tGroupBox(o).font.size :=SetFontSize(tGroupBox(o).font.size);

end;

end;

end;

begin

with TableParams do //таблица настроек

begin

Open;

First;

while not eof do

begin

cln := TableParamsClassName.Value; //имя класса

for i:=0 to form.ComponentCount-1 do //по всем объектам формы

begin

UpdateObj(form.Components[i]); //установить параметры

end;

next;

end;

end;

end;

procedure Tdm.TblClientsNewRecord(DataSet: TDataSet);

begin

TblClientsid.Value := GetId('Clients');

TblClientsIsClient.Value := 1;

end;

procedure Tdm.TblPostawNewRecord(DataSet: TDataSet);

begin

TblPostawId.Value := GetId('Clients');

TblPostawIsClient.Value := 0;

end;

procedure Tdm.TblKlKatNewRecord(DataSet: TDataSet);

begin

TblKlKatid.Value := GetId('Kl_Kat');

end;

procedure Tdm.TblKlUslugNewRecord(DataSet: TDataSet);

begin

TblKlUslugId.Value := GetId('kl_uslug');

end;

procedure Tdm.TblClientsBeforeDelete(DataSet: TDataSet);

begin

qrytmp.SQL.Text := format ('delete from orders where ClientId=%d',[TblClientsid.value]);

qrytmp.ExecSQL;

end;

procedure Tdm.TblPostawBeforeDelete(DataSet: TDataSet);

begin

qrytmp.SQL.Text := format ('delete from orders where PostawId=%d',[TblPostawId.value]);

qrytmp.ExecSQL;

end;

end.

Параметр	Значение
Имя файла	MovUn.pas
Имя модуля	MovUn
Количество строк	493
Количество символов	14194
Размер файла	14,82 Кб
Количество комментариев	56
Процент закоментированности	10,10 %

Модуль : MovUn.pas

Всего строк : 493

unit MovUn;

//осуществлении операции движения товара

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DB, ADODB, DBCtrls, StdCtrls, Mask, Buttons,sqladotools,

ExtCtrls, Grids, DBGrids, ComCtrls,numtostr;

type

TFrmMovTowar = class(TForm)

Qry: TADOQuery;

DataSource1: TDataSource;

Label7: TLabel;

DBEdit1: TDBEdit;

Label8: TLabel;

DBEdit2: TDBEdit;

GroupBox3: TGroupBox;

Label9: TLabel;

Label11: TLabel;

DBEdit5: TDBEdit;

Label12: TLabel;

DBEdit6: TDBEdit;

Label13: TLabel;

DBEdit7: TDBEdit;

Label14: TLabel;

DBEdit8: TDBEdit;

BtnOk: TBitBtn;

BtnApply: TBitBtn;

BitBtn3: TBitBtn;

Qryid: TIntegerField;

Qryprim: TWideStringField;

Qrydt: TDateTimeField;

QryOperation: TIntegerField;

Qrysumm: TFloatField;

Qrywaluta: TWideStringField;

QryNDSProc: TFloatField;

QrySummNDS: TFloatField;

QryPostawId: TIntegerField;

QryClientId: TIntegerField;

TblTowForOrd: TADOTable;

TblTowForOrdTowarId: TIntegerField;

TblTowForOrdOrderId: TIntegerField;

TblTowForOrdCostPerEd: TFloatField;

TblTowForOrdcnt: TFloatField;

TblTowForOrdField: TStringField;

DataSource2: TDataSource;

TblTowForOrdField2: TStringField;

TblTowForOrdField3: TStringField;

Edit1: TEdit;

QryField: TStringField;

QryField2: TStringField;

QryField3: TStringField;

QryField4: TIntegerField;

Notebook1: TNotebook;

GroupBox1: TGroupBox;

Label1: TLabel;

DBLookupComboBox1: TDBLookupComboBox;

Label2: TLabel;

DBLookupComboBox2: TDBLookupComboBox;

Label3: TLabel;

DBLookupComboBox3: TDBLookupComboBox;

Label4: TLabel;

DBLookupComboBox4: TDBLookupComboBox;

QryField5: TStringField;

QryField6: TStringField;

QryField7: TStringField;

GroupBox2: TGroupBox;

Label5: TLabel;

DBLookupComboBox5: TDBLookupComboBox;

Label6: TLabel;

DBLookupComboBox6: TDBLookupComboBox;

Label10: TLabel;

DBLookupComboBox7: TDBLookupComboBox;

TblTowForOrdField4: TFloatField;

QrySignOp: TIntegerField;

Label16: TLabel;

EditSkidka: TEdit;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

BitBtn2: TBitBtn;

BitBtn1: TBitBtn;

TblTowForOrdcostb: TFloatField;

TblTowForOrdcosts: TFloatField;

procedure QryNewRecord(DataSet: TDataSet);

procedure BtnApplyClick(Sender: TObject);

procedure BtnOkClick(Sender: TObject);

procedure DBEdit3Exit(Sender: TObject);

procedure DBLookupComboBox4Click(Sender: TObject);

procedure DataSource1DataChange(Sender: TObject; Field: TField);

procedure FormCreate(Sender: TObject);

procedure TblTowForOrdAfterPost(DataSet: TDataSet);

procedure TblTowForOrdNewRecord(DataSet: TDataSet);

procedure TblTowForOrdBeforePost(DataSet: TDataSet);

procedure QryNDSProcGetText(Sender: TField; var Text: String;

DisplayText: Boolean);

procedure DataSource2DataChange(Sender: TObject; Field: TField);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

newOp,mode:integer;

procedure RefreshTbls;

procedure CheckOk;

{ Public declarations }

end;

var

FrmMovTowar: TFrmMovTowar;

implementation

uses dat,msWord,RusDlg, naklPrep;

{$R *.dfm}

procedure TFrmMovTowar.RefreshTbls;

begin

TblTowForOrd.Close;

TblTowForOrd.Filter := 'OrderId='+Qryid.AsString;

TblTowForOrd.Open;

TblTowForOrdAfterPost(nil);

end;

//новая запись в таблицу движений

procedure TFrmMovTowar.QryNewRecord(DataSet: TDataSet);

begin

Qryid.Value := getid('orders'); //новое значение идентификатора

Qrydt.Value := now; //текущее время

QryOperation.Value := newOp; //операцуия

if not dm.HasNDS then QryNDSProc.Value:=0 else //величина НДС

QryNDSProc.Value:=dm.NdsVal;

Qrywaluta.Value := 'р.';

RefreshTbls;

end;

//применить

procedure TFrmMovTowar.BtnApplyClick(Sender: TObject);

var f:real;

begin

qry.Post; //сохранить в движение

if mode=1 then

begin

ModalResult:=mrOk;

exit;

end;

with TblTowForOrd do

begin

first;

while not eof do

begin

f:=TblTowForOrdField4.Value + TblTowForOrdcnt.Value*QrySignOp.Value; //новое количество товара на складе

if f=0 then //если 0

//то удалить запись со склада

RunSql('delete from [skladdata] where [towarid]=%d',[TblTowForOrdTowarId.value])

//иначе установить новое значение

else

if TblTowForOrdField4.Value>0 then

RunSql('update [skladdata] set kolwo=%s where [towarid]=%d',[FlToSql(f),TblTowForOrdTowarId.value])

else RunSql('insert into [skladdata] (id,TowarId,kolwo) values (%d,%d ,%s)',[GetId('SkladData'), TblTowForOrdTowarId.value,FlToSql(f)]);

next;

end;

dm.TblSkladData.Close;

dm.TblSkladData.Open;

if (QrySignOp.Value=-1) and not(QryField4.IsNull) then

begin

if CalculateInt('select count(*) from disc where numcard='+QryField4.AsString)=0 then

RunSql('insert into disc values (%d,%s)',[QryField4.Value, FlToSql(QrySummNDS.Value)])

else

RunSql('update disc set SummMany=SummMany+%s where numcard=%d',[FlToSql(QrySummNDS.Value),QryField4.value]);

end;

end;

Edit1.Text := '0';

EditSkidka.Text := '0';

if sender<>nil then

begin

qry.Append;

qry.post;

qry.edit;

end;

end;

//нажатие Ок - сохранить изменения

procedure TFrmMovTowar.BtnOkClick(Sender: TObject);

var word:TMSWord;

i:integer;

begin

i:=0;

word:=TMSWord.Create(''); //создать объект word

if not word.Open then

begin

Error('Не могу открыть msWord');

exit;

end;

word.New; //новый документ

word.InsertCenterText(caption+#13); //вставить текст

if Notebook1.PageIndex=1 then

begin

word.InsertText('Поставщик :'+QryField5.Value);

word.InsertText(' ИНН :'+QryField6.Value);

word.InsertText(' Адрес :'+QryField7.Value+#13);

end else

begin

word.InsertText('Покупатель :'+QryField.Value);

word.InsertText(' ИНН :'+QryField2.Value);

word.InsertText(' Адрес клиента :'+QryField3.Value);

word.InsertText(' № дисконтной карты :'+QryField4.AsString+#13);

end;

word.InsertText('Дата время операции:'+Qrydt.AsString+#13);

word.InsertText('Товары по накладной'#13);

word.InsertTable(5,16); //таблицу

word.InsertTableHead([50,150,90,90,90], ['№ п.п.','Товар','Цена','Количество','Сумма']);

with TblTowForOrd do

begin

First;

i:=0;

while not eof do

begin

inc(i);

word.InsertTableLine([IntToStr(i), //запись в таблицу

TblTowForOrdField.AsString,

TblTowForOrdCostPerEd.Text,

TblTowForOrdcnt.AsString,

CurrToStr(TblTowForOrdCostPerEd.Value*TblTowForOrdcnt.Value)

]);

next;

end;

word.EndOfTable;

end;

word.InsertText('Всего пунктов в таблице :'+Edit1.Text+#13);

word.InsertText('Товар на сумму :'+Qrysumm.Text+#13);

word.InsertText('Процент НДС :'+QryNDSProc.Text+#13);

if EditSkidka.Text<>'0' then

word.InsertText('Скидка :'+EditSkidka.Text+' %'#13);

word.InsertText('Расчет в валюте :'+Qrywaluta.Value+#13);

word.InsertText('Итого :'+QrySummNDS.Text+#13);

word.Show; //показать word

word.Free; //освободить память

end;

// рассчет сумм

procedure TFrmMovTowar.DBEdit3Exit(Sender: TObject);

begin

end;

//выбор товара

procedure TFrmMovTowar.DBLookupComboBox4Click(Sender: TObject);

begin

{ Qrysumm.Value := QryCostTowar.Value;

//расчет количества товара на складе

EditOnSlkad.Text := floatToStr(CalculateFloat('select [kolwo] from [skladdata] where [towarId]=%d',[QryTowarId.value]));

CheckOk;}

end;

//установка разрешения принятия операции

procedure TFrmMovTowar.CheckOk;

var b:boolean;

begin

if not(Qry.State in [dsEdit,dsInsert]) then exit;

if (QrySumm.isNull) then

begin

QrySummNDS.clear;

end else

begin

QrySummNDS.Value := QrySumm.Value * (1+QryNDSProc.Value/100);

if EditSkidka.Text<>'0' then

QrySummNDS.Value := QrySummNDS.Value-(QrySummNDS.Value*(StrToFloat(EditSkidka.Text)/100));

end;

end;

procedure TFrmMovTowar.DataSource1DataChange(Sender: TObject;

Field: TField);

var i:integer;

f:real;

begin

if qry.Tag=1 then exit;

qry.Tag:=1;

if not QryField4.IsNull then

begin

i:=QryField4.Value;

f:=CalculateFloat('select summmany from disc where numcard='+QryField4.AsString);

if f<>0 then

EditSkidka.Text := FloatToStr(dm.GetSkidkaOn(f))

else

EditSkidka.Text := '0';

end;

CheckOk;

qry.Tag:=0;

end;

//создание формы

procedure TFrmMovTowar.FormCreate(Sender: TObject);

begin

PageControl1.ActivePageIndex:=0;

dm.UpdateSettings(self); //установка визуальных параметров формы

mode:=0;

end;

procedure TFrmMovTowar.TblTowForOrdAfterPost(DataSet: TDataSet);

var i:integer;

f:real;

begin

with MakeCursor('select count(*) as itemcnt,sum(CostPerEd*cnt) as sumItem '+

'from TowForOrder where OrderId=%d',[qryid.value]) do

begin

Edit1.Text := Fields[0].AsString;

f:=Fields[1].AsFloat;

free;

end;

Qrysumm.Value :=f;

CheckOk;

end;

procedure TFrmMovTowar.TblTowForOrdNewRecord(DataSet: TDataSet);

begin

TblTowForOrdOrderId.Value := Qryid.Value;

BtnApply.Enabled:=false;

end;

procedure TFrmMovTowar.TblTowForOrdBeforePost(DataSet: TDataSet);

begin

if (QrySignOp.Value=-1) and (TblTowForOrdcnt.Value>TblTowForOrdField4.Value)

then TblTowForOrdcnt.Value:=TblTowForOrdField4.Value;

end;

procedure TFrmMovTowar.QryNDSProcGetText(Sender: TField; var Text: String;

DisplayText: Boolean);

begin

if not sender.IsNull then

text := sender.AsString +' %';

end;

procedure TFrmMovTowar.DataSource2DataChange(Sender: TObject;

Field: TField);

begin

if TblTowForOrd.Tag=1 then exit;

TblTowForOrd.Tag:=1;

BtnApply.Enabled := (Qrysumm.Value>0) ;

if (not TblTowForOrdTowarId.IsNull) and (TblTowForOrd.State in [dsEdit,dsInsert]) then

begin

// if not TblTowForOrdCostPerEd.IsNull then exit;

if QrySignOp.Value=1 then TblTowForOrdCostPerEd.Value := TblTowForOrdcostb.Value

else TblTowForOrdCostPerEd.Value := TblTowForOrdcosts.Value;

end;

TblTowForOrd.Tag:=0;

end;

procedure TFrmMovTowar.BitBtn2Click(Sender: TObject);

var word:TMSWord;

i:integer;

f,nds,mass,cost,mest:real;

begin

//форма с доп параметрами.

Application.CreateForm(TFrmprepareNakl, FrmprepareNakl);

if FrmprepareNakl.ShowModal=mrOk then //если ок

begin

mass:=0;cost:=0;mest:=0;

word:=TMSWord.create('');//создать ворд

word.Open; //открыть

//открыть файл шаблона

word.openfile(extractfilepath(paramstr(0))+'template.doc');

word.SaveAs('tmp.doc'); //сохранить как

// word.InsertFile(extractfilepath(paramstr(0))+'template.doc');

//замена строк

word.Replace('_INN_',QryField2.Value);

word.Replace('_INN_',QryField2.Value);

word.Replace('_clientname_',QryField.Value);

word.Replace('_clientname_',QryField.Value);

word.Replace('_NDOC_',FrmprepareNakl.LabeledEdit1.Text);

word.Replace('_DateDOC_',datetostr(FrmprepareNakl.dt.date));

i:=1;

nds:=QryNDSProc.Value*0.01;

with TblTowForOrd do //по таблице с накладными

begin

first;

while not eof do

begin

word.Find('_start_'); //поиск начала колонки

// mass:=mass+QryNakladField6.AsFloat;

f:=TblTowForOrdcnt.AsFloat*TblTowForOrdCostPerEd.Value;

cost:=cost+TblTowForOrdcnt.AsFloat*TblTowForOrdCostPerEd.Value;

mest:=mest+TblTowForOrdcnt.value;

word.InsertTableLine([IntToStr(i), //вставить линию в таблицу

TblTowForOrdField.AsString,

TblTowForOrdTowarId.AsString,

TblTowForOrdField3.AsString,

'','',

'',

TblTowForOrdcnt.AsString,

'',

CurrToStr(f),

CurrToStr(TblTowForOrdCostPerEd.Value),

CurrToStr(f),

QryNDSProc.text,

CurrToStr(f*nds),

CurrToStr(f*(nds+1))

]);

next; inc(i);

end;

word.EndOfTable;

end;

//еще замены

word.Replace('_summass_',floattostr(mass));

word.Replace('_allmass_',floattostr(mass));

word.Replace('_sbez_',floattostr(cost));

word.Replace('_allbez_',floattostr(cost));

word.Replace('_snds_',floattostr(cost*0.18));

word.Replace('_allnds_',floattostr(cost*0.18));

word.Replace('_ssnds_',floattostr(cost*1.18));

word.Replace('_allsnds_',floattostr(cost*1.18));

word.Replace('_punkts_',TextDbl2(i-1));

word.Replace('_punkts_',TextDbl2(i-1));

word.Replace('_mest_',TextDbl2(mest));

word.Replace('_summprop_',TextCurr(cost*1.18));

word.Show; //показать ворд

end;

FrmprepareNakl.Free; //освободить память

word.Free;

end;

procedure TFrmMovTowar.BitBtn1Click(Sender: TObject);

var word:TMSWord;

i:integer;

f,nds,mass,cost,mest:real;

begin

mass:=0;cost:=0;mest:=0;

word:=TMSWord.create('');//создать ворд

word.Open; //открыть

//открыть файл шаблона

word.openfile(extractfilepath(paramstr(0))+'shet.doc');

word.SaveAs('tmp.doc'); //сохранить как

// word.InsertFile(extractfilepath(paramstr(0))+'template.doc');

//замена строк

word.Replace('_INN_',QryField2.Value);

word.Replace('_INN_',QryField2.Value);

word.Replace('_clientname_',QryField.Value);

word.Replace('_clientname_',QryField.Value);

word.Replace('_ndisc_',QryField4.AsString);

i:=1;

nds:=QryNDSProc.Value*0.01;

with TblTowForOrd do //по таблице с накладными

begin

first;

while not eof do

begin

word.Find('_start_'); //поиск начала колонки

f:=TblTowForOrdcnt.AsFloat*TblTowForOrdCostPerEd.Value;

cost:=cost+TblTowForOrdcnt.AsFloat*TblTowForOrdCostPerEd.Value;

word.InsertTableLine([IntToStr(i), //вставить линию в таблицу

TblTowForOrdField.AsString,

TblTowForOrdCostPerEd.Text,

TblTowForOrdcnt.AsString,

CurrToStr(f)

]);

next; inc(i);

end;

word.EndOfTable;

end;

i:=1;

//еще замены

word.Replace('_summ1_',Currtostr(cost));

word.Replace('_nds_',QryNDSProc.text);

word.Replace('_skidka_',EditSkidka.Text+' %');

word.Replace('_itog_',QrySummNDS.Text);

word.Show; //показать ворд

word.free;

end;

end.

Параметр	Значение
Имя файла	towars.pas
Имя модуля	towars
Количество строк	149
Количество символов	3741
Размер файла	3,94 Кб
Количество комментариев	19
Процент закоментированности	9,12 %

Модуль : towars.pas

Всего строк : 149

unit towars;

//товары

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DB, ADODB, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Buttons,

ComCtrls,sg2word;

type

TFrmTowar = class(TForm)

Panel1: TPanel;

DBGrid1: TDBGrid;

DataSource1: TDataSource;

DBNavigator1: TDBNavigator;

Label1: TLabel;

ComboFilter: TComboBox;

BtnRep: TSpeedButton;

DBNavigator2: TDBNavigator;

BtnDel: TSpeedButton;

Status: TStatusBar;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure ComboFilterChange(Sender: TObject);

procedure DataSource1DataChange(Sender: TObject; Field: TField);

procedure BtnRepClick(Sender: TObject);

procedure BtnDelClick(Sender: TObject);

procedure DBGrid1TitleClick(Column: TColumn);

private

sortind:integer;

{ Private declarations }

public

{ Public declarations }

end;

var

FrmTowar: TFrmTowar;

implementation

uses main,dat,rusdlg,msWord,sqladotools,orders;

{$R *.dfm}

//создание формы

procedure TFrmTowar.FormCreate(Sender: TObject);

begin

DataSource1.DataSet.Open;

ComboFilter.Items := klkat;

ComboFilter.ItemIndex:=0;

ComboFilterChange(nil); //фильтр

sortind:=0; //индекс сортировки

DBGrid1TitleClick(nil); // сортировка

dm.UpdateSettings(self); //настройки

end;

//закрыть форму

procedure TFrmTowar.FormClose(Sender: TObject; var Action: TCloseAction);

begin

DataSource1.DataSet.Close; //закрыть таблицу

end;

//изменение фильтра

procedure TFrmTowar.ComboFilterChange(Sender: TObject);

var i:integer;

begin

with DataSource1.DataSet do

begin

i:=ComboFilter.ItemIndex;

if i=0 then i:=-1

else i:=integer(ComboFilter.Items.Objects[ComboFilter.ItemIndex]);

tag:=i;

if i=-1 then

begin

filtered:=false;

exit;

end;

if i=-10 then filter:='receptid>0' else

filter := 'kategory='+IntToStr(i);

filtered:=true;

end;

end;

//изменение в таблице

procedure TFrmTowar.DataSource1DataChange(Sender: TObject; Field: TField);

begin

tag := dm.QryTowarid.Value;

btndel.Enabled := not dm.QryTowar.IsEmpty;

BtnRep.Enabled := not dm.QryTowar.IsEmpty;

Status.Panels[1].Text := format('Запись %d из %d',[dm.QryTowar.recno, dm.QryTowar.recordcount]);

Status.Panels[0].Text := format('Сортировка: %s',[dbgrid1.Columns[sortind].Title.Caption]);

end;

//отчет

procedure TFrmTowar.BtnRepClick(Sender: TObject);

var word:TMSWord;

i:integer;

begin

i:=0;

word:=TMSWord.Create('');

if not word.Open then

begin

Error('Не могу открыть msWord');

exit;

end;

word.New;

word.InsertCenterText('Отчет по товарам'#13);

if ComboFilter.ItemIndex>0 then

word.InsertText('Фильтрация по категории: '+ComboFilter.Text+#13);

DataSetToWordTable(DBGrid1,dm.QryTowar,word);

word.InsertText(#13);

word.InsertText(#13+'Время создания отчета :'+DateTimeToStr(now));

word.Show;

word.Free;

end;

//удалить товар

procedure TFrmTowar.BtnDelClick(Sender: TObject);

begin

if not confirm('Вы действительно хотите удалить данный товар?') then exit;

if not (dm.QryTowar.State in [dsEdit,dsInsert]) then dm.QryTowar.Edit;

dm.QryTowar.Delete;

end;

//клик на заголовке, устанавливает поле для сортировки

procedure TFrmTowar.DBGrid1TitleClick(Column: TColumn);

var i:integer;

begin

if column<> nil then SortInd:=column.Index;

for i:=0 to dbgrid1.Columns.Count-1 do

if i=SortInd then dbgrid1.Columns[i].Title.Font.Style:=[fsBold] //выделенный - жирный

else dbgrid1.Columns[i].Title.Font.Style:=[];

with dm,QryTowar do

begin

i:=QryTowarid.Value;

close;

if column=nil then sql[2]:='name' //поле сортировки

else

if SortInd=1 then sql[2]:='kategory'

else sql[2]:=dbgrid1.Columns[SortInd].FieldName;

open;

locate('id',i,[]);

end;

end;

//показать движение товара

end.

Параметр	Значение
Имя файла	storer.dpr
Имя модуля	storer
Количество строк	39
Количество символов	1042
Размер файла	1,09 Кб
Количество комментариев	18
Процент закоментированности	17,66 %
Количество процедур	8
Количество объектов, классов	9
Список экспортируемых процедур	10
Полный список процедур	11
Список используемых модулей	12

Модуль : storer.dpr

Всего строк : 39

program storer;

uses

Forms,

Main in 'Main.pas' {FrmMain},

About in 'About.pas' {AboutBox},

SQLADOtools in 'SQLAdoTools.pas',

towars in 'towars.pas' {FrmTowar},

dat in 'dat.pas' {dm: TDataModule},

kl_kat in 'kl_kat.pas' {FrmKlKat},

RusDlg in 'RusDlg.pas',

Ost in 'Ost.pas' {FrmOst},

MSWord in 'MSWord.pas',

StrTools in 'StrTools.pas',

sg2word in 'sg2word.pas',

sklads in 'sklads.pas' {FrmSklads},

WaitUnit in 'WaitUnit.pas' {WaitForm},

MovUn in 'MovUn.pas' {FrmMovTowar},

Sett in 'Sett.pas' {FrmSetting},

orders in 'orders.pas' {FrmOrders},

Klients in 'Klients.pas' {FrmClients},

disc in 'disc.pas' {FrmDisc},

naklPrep in 'naklPrep.pas' {FrmprepareNakl},

NumToStr in 'NumToStr.pas',

SelMonth in 'SelMonth.pas' {FrmSelYM},

rep1 in 'rep1.pas' {Frmklmodels},

rep2 in 'rep2.pas' {FrmSaleTo};

{$R *.RES}

begin

Application.Initialize;

Application.Title := 'АСУ СКЛАД';

Application.CreateForm(Tdm, dm);

Application.CreateForm(TFrmMain, FrmMain);

Application.CreateForm(TFrmprepareNakl, FrmprepareNakl);

Application.Run;

end.

Размещено на Allbest.ru

...