2 программа формаларының сипаттамасы 20


Мәліметтер енгізу формасы



жүктеу/скачать 1 Mb.
бет4/5
Дата07.07.2016
өлшемі1 Mb.
#182875
1   2   3   4   5


2.2 Мәліметтер енгізу формасы

Программадағы негізгі іс-әрекеттер – тауарлар мен сауда орындары жөніндегі мәліметтерді енгізуге арналған форманың жалпы көрінісі төмендегідей.

Суреттердің алғашқысы Сауда орындары жөнінде толыққанды мәліметтерді енгізуге, ал екіншісі – тауарлардың мәліметтерін ендіруге арналған.

unit ActPrihod;
{акт оприходования - универсальный редактор актов прихода-расхода

сохраняет приход, расход или списание в виде таблицы под именем *.DB}

interface
uses

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

Db, DBTables, Grids, DBGrids, StdCtrls, Mask, Buttons, ExtCtrls, DBCtrls,

Menus, OleCtnrs, ToolWin, ComCtrls;


const maxY=2000; maxM=4;maxD=15;

type {строка записи о цене товара}

TPriceRecord=record

case integer of

1:(

TovarID:integer; {тип товара}



Price1,Price2:Single; {покупная и продажная цена}

);

2:(



M1,M2,M3:integer; {все скопом}

)

end;


type

TPriceArray=array[1..100000]of TPriceRecord; {массив записей товар - цена}


type

TPriceTable=record {ценовая таблица}

TradePoint:integer; {торговая точка, для которой составлена таблица}

PriceDate:integer; {дата, для которой действительны цены}

GetPriceTableFile:string; {имя файла открыитой ценовой таблицы}

TovarsCount:integer; {ну, сам понимаешь}

PriceArray:^TpriceArray; {массив товар - цена}

end;
type

{запись о товаре}

TTovarRec=record

Name:string;

TovarID:integer;

TovarType:integer;

end;
type

{запись о торговой точке}

TTradePointsRec=record

Name:String; {название}

TradeID:integer; {индивидуальный номер}

Active:boolean; {действующая или нет}

end;
type

{запись о документе}

TDocument=record

{используется при редактировании таблицы}

Name:String; {название}

FileSimbol:char; {идентификационная буква в имени файла}

ColCount:integer; {количество столбцов в таблице}

{номера колонок в которых отображаются соответственно:}

TradePointColNo, TovarTypeColNo, DateColNo:integer; {... торговая точка, товар и дата}

TovarSourcePrice1ColNo, TovarSourcePrice2ColNo:integer; {...покупная и продажная цена источника}

TovarDestPrice1ColNo, TovarDestPrice2ColNo :integer; {...покупная и продажная цена приемника}

TotalColNo:integer; {номер колонки "итого"}

TotalColCaption:String; {название этой строки}

ColCaptions:array[1..20]of string[50]; {заголовки столбцов}

ColFormules:array[1..20]of string[40]; {формулы для столбцов}

ColFields :array[1..20]of string[3]; {имена полей}

ColCanEdit:string[20]; {битовый массив: можно ли редактировать столбец}

{используется при создании отчетов}

IsSource:boolean; {имеется ли источник товара}

IsDestination:boolean; {имеется ли приемник товара}

SourceSign:Shortint; {знак для источника}

DestinationSign:Shortint; {знак для приемника}

KeyFileCH:char; {символ ключевого файла (напр. для торговых точек - остатки)}

end;
type {в таком формате строки таблицы передаются в подпрограммы}

TRowArgumentType_=record

name:string[3];

case integer of

1: (Freal:Single);

2: (Fint:Integer);

end;

TRowArgumentType=record



Count:Integer;

A:array[1..20]of TRowArgumentType_;

end;

type TRowFileType=record {в таком формате на диске хранятся записи о движении товаров }



case integer of

1:(


TovarID :integer;

TovarCount :integer;

TovarPrice1 :Single; {себестоимость}

TovarPrice2 :Single; {продажная цена}

TovarTotal :Single;

);

2:(Freal:array[1..7]of Single;);



3:(Fint:array[1..7]of Integer;);

end;
type

TEditDoc = class(TForm)

Button3: TButton;

AddButton: TButton;

DelButton: TButton;

StringGrid1: TStringGrid;

Button8: TButton;

Button9: TButton;

TableNameLabel: TLabel;

DateLabel: TLabel;

DateMaskEdit: TMaskEdit;

TotalEdit: TEdit;

TotalCaption: TLabel;

Button1: TButton;

TovarComboBox: TComboBox;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

Button4: TButton;

FilesStringGrid: TStringGrid;

N15: TMenuItem;

DayComboBox: TComboBox;

MonthComboBox: TComboBox;

YearComboBox: TComboBox;

TradePointComboBox: TComboBox;

Bevel1: TBevel;

FilesDate1: TMaskEdit;

FilesDate2: TMaskEdit;

Label1: TLabel;

Bevel2: TBevel;

N8: TMenuItem;

N7: TMenuItem;

N9: TMenuItem;

N13: TMenuItem;

Label2: TLabel;

N14: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

Button2: TButton;

N19: TMenuItem;

Label3: TLabel;

Bevel3: TBevel;

N20: TMenuItem;

N18: TMenuItem;

N21: TMenuItem;

ComboPopupMenu: TPopupMenu;

sdsad1: TMenuItem;

GridPopupMenu: TPopupMenu;

MenuItem1: TMenuItem;

MenuItem2: TMenuItem;

N22: TMenuItem;

N23: TMenuItem;

N24: TMenuItem;

procedure Button3Click(Sender: TObject);

procedure AddButtonClick(Sender: TObject);

procedure DelButtonClick(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;

const Value: String);

procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Integer;

var CanSelect: Boolean);

procedure Button1Click(Sender: TObject);

procedure TovarComboBoxChange(Sender: TObject);

procedure N12Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure N8Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FilesStringGridMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure FormatFilesGrid;

procedure FilesStringGridClick(Sender: TObject);

procedure FilesStringGridKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure DayComboBoxChange(Sender: TObject);

procedure TradePointComboBoxChange(Sender: TObject);

procedure FilesDate1Exit(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N15Click(Sender: TObject);

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

procedure N16Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure N19Click(Sender: TObject);

procedure TovarComboBoxEnter(Sender: TObject);

procedure TovarComboBoxExit(Sender: TObject);

procedure N20Click(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure StringGrid1Click(Sender: TObject);

procedure sdsad1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure MenuItem2Click(Sender: TObject);

procedure MenuItem1Click(Sender: TObject);

procedure N23Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N24Click(Sender: TObject);


private

{ Private declarations }

public

{ходячий беспонт}



procedure OpenTable(FileName:string);

procedure deleteRow(No1,No2:longint);

procedure AddRow(No:longint);

procedure UpdateTotalEdit;

procedure UpdateHotLines(Row:integer);

procedure FormatTableByType(TableNo:integer);

procedure UpdateTovarsName;

procedure UpdateTradePointsName;

procedure AddRowToTable(r:TRowArgumentType);

function CopyRowToTable(r:TRowArgumentType; RowIndex:longint):boolean;

procedure RereadDirectory(Directory,CurFileName: string);

procedure CreateRashod1;


procedure DisplayHint(Sender: TObject);

end;
{группа поддержки типов}

function GetGR1index(ID:integer):integer;

function GetGR2index(ID:integer):integer;

function GetOnlyID(ID:integer):integer;

procedure SetGR1index(var ID:integer; GR1index:integer);

procedure SetGR2index(var ID:integer; GR2index:integer);

function GroupVisible(ID:integer):boolean;

var tovarSortMode:(byType,byName);
procedure SortGridBy(var StringGrid1:TStringGrid; var StringList:TStringList; ACol:Longint);

function GetStringColor(s:string):integer;


var

SourcePriceTable,DestPriceTable:TPriceTable; {ценовая таблица для текущей торговой точки и даты}

function OpenPriceTableFor(TradePointID,NewDate:Integer;var PriceTable:TPriceTable):integer;

procedure SavePriceTable(PriceTable:TPriceTable); forward;

procedure SetPiceDate(var PriceTable:TPriceTable;NewDate:Integer); forward;

function GetSourceTovarPrice1(TovarIDg:integer):Single; forward;

function GetSourceTovarPrice2(TovarIDg:integer):Single; forward;

function GetDestTovarPrice1(TovarIDg:integer):Single; forward;

function GetDestTovarPrice2(TovarIDg:integer):Single; forward;
{устанавливает ширину столбца Col таблицы StringGrid в соответствии с шириной заголовка}

procedure SetColWidth(var StringGrid:TStringGrid; Col:longint );


var {это моя форма}

EditDoc: TEditDoc;


{массив типов документов}

const


DocTypesNum=13; {количество типов документов}

var


Documents:array[1..DocTypesNum]of TDocument;

MaxEditDocument:Integer; {последний редактируемый документ, он же индекс ценовой таблицы в списке}


var {массив торговых точек}

TradePoints:array[1..30]of TTradePointsRec;

TradePointNum:integer;
var {список названий товаров}

TovarsName:TstringList;


var

OurPath:string; {каталог запуска программы}

DocumentDirectory:string; {текущий каталог расположения документов}

CurrDocMask:string[10]; {текущая маска документа}

DocumentFileName:string; {в этом файле сохраняется документ}

DocumentType:integer; {текущий тип документа}

DocumentSettings:TDocument; {свойства текущего документа}

OtchetSettings:TDocument; {свойства текущего отчета}

CurrientCel:string; {содержимое подсвеченной ячейки}
{список документов}

FilesGridSortBy:integer=0; {способ сортировки:

0- не сортирован, 1- дата, 2- тип, 3- источник, 4- получатель

исходно - по дате}

FilesGridLeftCol:longint=0;

FilesGridTopRow:longint=1;


const {резервирование идентификационных номеров}

FirstTovarTypeID = 1;

LastTovarTypeID = 65435;

FirstTradePointID = 65436;

LastTradePointID = 65467;

implementation //====================================================================

{$R *.DFM}

uses tradeLIB, OpenDoc, CreatDoc, Mess, TradePointsUnit ,MakeOtchetUnit,

TovarsTypesUnit, ViewOptionsUnit, PrintUnit, Choose, InfoUnit, otchet,

AnalisOtchet;

const bit:array[0..7]of byte=(1,2,4,8,16,32,64,128);
const {цвета для найденного и ненайденного соответствия}

ShortEditColorIs = clGray;

ShortEditColorNo = clSilver;

ShortEditColorUnic = clGreen;


var

FilesList:TstringList; {список имен файлов, соответствующий списку их названий }


GridModified:boolean=false;
//====================================================================================

function GetGR2index(ID:integer):integer;

begin

GetGR2index:=(ID and $00FF0000)div$10000;



end;

function GetGR1index(ID:integer):integer;

begin

GetGR1index:=(ID and $FF000000)div$1000000;



end;

function GetOnlyID(ID:integer):integer;

begin

GetOnlyID:=(ID and $0000FFFF);



end;

procedure SetGR2index(var ID:integer; GR2index:integer);

begin

ID:=(ID and $FF00FFFF) + ($10000*GR2index and $00FF0000);



end;

procedure SetGR1index(var ID:integer; GR1index:integer);

begin

ID:=(ID and $00FFFFFF) + ($1000000*GR1index and $FF000000);



end;

function GroupVisible(ID:integer):boolean;

var

SubGroupList:TStringList;



ind:integer;

begin


GroupVisible:=False;

ind:=GetGR1index(ID); if ind>=TovarsTypesForm.GroupCombo1.Items.Count then exit;

SubGroupList:=TovarsTypesForm.GroupCombo1.Items.Objects[ind] as TStringList;

ind:=GetGR2index(ID); if ind>=SubGroupList.Count then exit;

if integer(SubGroupList.Objects[ind])=1

then GroupVisible:=True

else GroupVisible:=False;

end;
{сохраняет список товаров в файл}

procedure WriteTovarsName;

var


s:string;

f:text;


i,ind,ID:integer;

SubGroupList:TStringList;

begin

assign(f,OurPath+'tovars.tmp');



rewrite(f);

for i:=0 to TovarsName.Count-1 do

begin

ID:=integer(TovarsName.Objects[i]);



s:= intToStr(GetOnlyID(ID))+'/'+TovarsName.Strings[i];
ind:=GetGR1index(ID);

s:=s+'/'+TovarsTypesForm.GroupCombo1.Items[ind];


SubGroupList:=TovarsTypesForm.GroupCombo1.Items.Objects[ind] as TStringList;

ind:=GetGR2index(ID);

s:=s+'/'+SubGroupList[ind]+'/';
if GroupVisible(ID) then s:=s+'+' else s:=s+'-';
Writeln(f,s);

end;


close(f);

DeleteFile(OurPath+'tovars.txt');

RenameFile(OurPath+'tovars.tmp',OurPath+'tovars.txt')

end;


{читает список товаров из 'tovars.txt', заполняет TovarsName списком имен, его же заносит

в выпадающие списки на форме ComboBox1 и ListBox1}

procedure ReadTovarsName;

var


s,s1:string;

f:text;


ind,i,newID:integer;

SubGroupList:TStringList;

begin

TovarsName.Clear;



assign(f,OurPath+'tovars.txt');

{$I-}


reset(f);

{$I+}


if ioResult<>0 then begin OkButton:=2; {messag.}OutMessage('Ошибка при чтении списка товаров. '+#13#10+'Продолжение работы в этом каталоге'+#13#10+'не рекомендуется.','','Ok',''); exit end;

while not eof(f) do

begin

readln(f,s); TovarsName.Add('');



ind:=TovarsName.Count-1;
{ID товара}

s1:=copy(s,1,pos('/',s)-1);

TovarsName.Objects[ind]:=pointer(round(vala(s1)));

delete(s,1,pos('/',s));

{наименование товара}

s1:=copy(s,1,pos('/',s)-1);

TovarsName.Strings[ind]:=s1;

delete(s,1,pos('/',s));


{группа товара (GR1)}

s1:=copy(s,1,pos('/',s)-1); {s1 - навание группы}

i:=TovarsTypesForm.GroupCombo1.items.indexOf(s1); {есть ли такое название ? }

if i=-1 then

begin {новое название}

TovarsTypesForm.GroupCombo1.items.Add(s1); {добавить новое название в выпадающий список}

SubGroupList:=TStringList.Create; {создать подгруппу: ...}

i:=TovarsTypesForm.GroupCombo1.items.count-1; {... список названий ...}

TovarsTypesForm.GroupCombo1.items.Objects[i]:=SubGroupList; {... второго уровня ...}

end;
newID:=integer(TovarsName.Objects[ind]);

SetGR1Index(newID,i);{i-индекс в GR1}
delete(s,1,pos('/',s));
{подгруппа товара (GR2)}

s1:=copy(s,1,pos('/',s)-1);

SubGroupList:=TovarsTypesForm.GroupCombo1.items.Objects[i] as TStringList;

i:=SubGroupList.indexOf(s1);

if i=-1 then

begin


SubGroupList.Add(s1); {добавление члена подгруппы}

i:=SubGroupList.count-1;

end;

SetGR2Index(newID,i);{i-индекс в GR2}



TovarsName.Objects[ind]:=Pointer(newID);

{ for i:=1 to 4 do

ind:=ind-ind+ind;}

delete(s,1,pos('/',s));

{проставление видимости-невидимости (хранится в списках TovarsTypesForm.GroupCombo1 }

if copy(s,1,1)='+'

then SubGroupList.Objects[i]:=pointer(1)

else SubGroupList.Objects[i]:=pointer(0);

end;

close(f);



end;
{заново заполняет выпадающие списки на форме из переменной со списком товара}

procedure TEditDoc.UpdateTovarsName;

var

s:string;



begin

TovarComboBox.Items:=TovarsName;

end;

{обновляет список торговых точек в выпадающем списке}



procedure TEditDoc.UpdateTradePointsName;

var


i:integer;

begin


TradePointComboBox.Clear;

for i:=0 to TradePointNum do TradePointComboBox.items.Add(TradePoints[i].Name);

end;

{из файла 'Trade_po.txt' читает список и свойства торговых точек,



заполняет массив TradePoints}

procedure LoadTradePoints;

var

SL:TstringList;



i:integer;

s:string;

begin

TradePointNum:=0;



SL:=TstringList.Create;

try


SL.LoadFromFile(OurPath+'Trade_po.txt');

except


OkButton:=2; {messag.}OutMessage('Ошибка при чтении списка торговых точек.'+#13#10+'Продолжение работы в этом каталоге'+#13#10+'не рекомендуется.','','Ok',''); exit;

end;
for i:=0 to SL.Count-1 do

begin

s:=SL.Strings[i];



if (copy(s,1,1)='[')and(TradePointNum<=50) then

begin


inc(TradePointNum);

TradePoints[TradePointNum].Name:=copy(s,pos('=',s)+1,length(s));

TradePoints[TradePointNum].TradeID:=FirstTradePointID+IntVala(copy(s,2,pos(']',s)-2));

if TradePoints[TradePointNum].TradeID>0

then TradePoints[TradePointNum].Active:=true

else TradePoints[TradePointNum].Active:=false;

end;

end; {for}


SL.Destroy;

end;
{записывает список и свойства торговых точек в файл 'Trade_po.txt'}

procedure SaveTradePoints;

var


SL:TstringList;

i:integer;

s:string;

begin


SL:=TstringList.Create;
for i:=1 to TradePointNum do

begin


s:=intToStr(TradePoints[i].TradeID-FirstTradePointID);

s:='['+s+']='+TradePoints[i].Name; {... + название}

SL.Add(s);

end;
SL.SaveToFile(OurPath+'Trade_po.txt');

SL.Destroy;

end;

{пересчитывает строку "итого", содержащую сумму стоимости товаров в документе}

procedure TEditDoc.UpdateTotalEdit;

var

total:real;



i:integer;

s:string;

begin

EditDoc.TotalCaption.Font.Color:=clWindowText;



EditDoc.TotalEdit.Font.Color:=clWindowText;
total:=0;

for i:=1 to StringGrid1.RowCount-1 do

total:=total+vala(StringGrid1.Rows[i].strings[DocumentSettings.TotalColNo-1]);
str(total:8:2,s);TotalEdit.Text:=s;

TotalCaption.Caption:=DocumentSettings.TotalColCaption;

end;
{отражение горячих строк}

procedure TEditDoc.UpdateHotLines(Row:integer);

var s:string;

begin


{товар}

if DocumentSettings.TovarTypeColNo>0 then

begin

TovarComboBox.Text:=StringGrid1.Cells[DocumentSettings.TovarTypeColNo-1,Row];



TovarComboBox.Font.Color:=GetStringColor(TovarComboBox.Text);

TovarComboBox.Text:=StringGrid1.Cells[DocumentSettings.TovarTypeColNo-1,Row];

end;

{торговая точка}



if DocumentSettings.TradePointColNo>0 then

begin


TradePointComboBox.Text:=StringGrid1.Cells[DocumentSettings.TradePointColNo-1,Row];

end;


{дата}

if DocumentSettings.DateColNo>0 then

begin

s:=StringGrid1.Cells[DocumentSettings.DateColNo-1,Row];



DayComboBox.Text:=copy(s,1,pos(' ',s)-1);delete(s,1,pos(' ',s));

MonthComboBox.Text:=copy(s,1,pos(' ',s)-1);delete(s,1,pos(' ',s));

YearComboBox.Text:=copy(s,1,Length(s));

end;


{итого}

end;


procedure TEditDoc.Button3Click(Sender: TObject);

begin


Close;

end;
procedure TEditDoc.AddButtonClick(Sender: TObject);

begin

AddRow(StringGrid1.Row);



end;
procedure TEditDoc.AddRow(No:longint);

var {добавляет пустую строку перед строкой No }

i:integer;

s:string;

begin

StringGrid1.RowCount:=StringGrid1.RowCount+1;



for i:=StringGrid1.RowCount downto No do

StringGrid1.rows[i]:=StringGrid1.rows[i-1];

StringGrid1.rows[i+1].Clear;

GridModified:=True;

end;
procedure TEditDoc.deleteRow(No1,No2:longint);

var {удаляет строки в документе с No1 по No2}

difference,i:longint;

begin


i:=No2+1; {следующая после последней удаляемой}

difference:=(No2-No1+1); {количество удаляемых}

if (No1>0)and(No2>0)and(StringGrid1.RowCount>2)and(i<=StringGrid1.RowCount) then

begin


while (ibegin


StringGrid1.rows[i-difference]:=StringGrid1.rows[i];

inc(i);


end;

StringGrid1.RowCount:=StringGrid1.RowCount-difference;

end;

{строка итого}



UpdateTotalEdit;

GridModified:=True;

end;

procedure TEditDoc.DelButtonClick(Sender: TObject);



begin

{deleteRow(StringGrid1.Row,StringGrid1.Row);}

deleteRow(StringGrid1.Selection.Top,StringGrid1.Selection.Bottom);

end;

function GetObjectIndex(s:string):integer;

var


i:integer;

begin


GetObjectIndex:=-1;

i:=TovarsName.indexOf(s);

if i<>-1 then

begin


GetObjectIndex:=integer(TovarsName.Objects[i]);

exit;


end;

i:=1;


while (i<=TradePointNum)and (TradePoints[i].Name<>s) do inc(i);

if (i=TradePointNum)

then exit

else GetObjectIndex:=TradePoints[i].TradeID;

end;
function GetObjectName(No:integer):string;

var


i:integer;

begin


GetObjectName:='???';

case GetOnlyID(No) of

FirstTovarTypeID..LastTovarTypeID:

begin {поиск идентификационного номера в списке товаров }

i:=0;

while (i<=TovarsName.Count-1)and(GetOnlyID(integer(TovarsName.Objects[i]))<>GetOnlyID(No)) do inc(i);



if (i<>TovarsName.Count) then GetObjectName:=TovarsName[i];

end;


FirstTradePointID..LastTradePointID:

begin {поиск идентификационного номера в массиве торговых точек }

i:=1;

while (i<=TradePointNum)and (GetOnlyID(TradePoints[i].TradeID)<>No) do inc(i);



if (i<=TradePointNum) then GetObjectName:=TradePoints[i].Name;

end;


end;{case}

end;
{$I countSelProc.pas}


procedure SetColWidth(var StringGrid:TStringGrid; Col:longint );

begin


StringGrid.Canvas.Font:=StringGrid.Font;

if StringGrid.Rows[0].strings[Col]=''

then StringGrid.ColWidths[Col]:=2

else StringGrid.ColWidths[Col]:=StringGrid.Canvas.TextWidth(StringGrid.Rows[0].strings[Col]) + 6;

end;

{форматирует таблицу в соответствии с типом файла FileType}



procedure TEditDoc.FormatTableByType(TableNo:integer);

var


i:integer;

FileName,s:string;

begin

FileName:=FileOf(DocumentFileName);



StringGrid1.RowCount:=2;

if TableNo=0 then exit;

StringGrid1.ColCount:=Documents[TableNo].ColCount;

for i:=0 to StringGrid1.ColCount-1 do begin StringGrid1.Cells[i,1]:='' end; {очистка первой строки}

{внешний вид : --------------------------------------}
{строка товара}

if DocumentSettings.TovarTypeColNo<>-1

then TovarComboBox.Visible:=True

else begin TovarComboBox.Text:=''; TovarComboBox.Visible:=False; end;

{строка торговой точки}

if DocumentSettings.TradePointColNo<>-1

then TradePointComboBox.Visible:=True

else begin TradePointComboBox.Text:=''; TradePointComboBox.Visible:=False; end;

{строка даты}

if DocumentSettings.DateColNo<>-1

then begin

DayComboBox.Visible:=True;

MonthComboBox.Visible:=True;

YearComboBox.Visible:=True;

end

else begin



DayComboBox.Text:=''; DayComboBox.Visible:=False;

MonthComboBox.Text:=''; MonthComboBox.Visible:=False;

YearComboBox.Text:=''; YearComboBox.Visible:=False;

end;
{заголовок окна}

Caption:='Редактор документов - '+LowerCaseRus(TableCaption(FileName));{}

{название документа}

s:=Documents[TableNo].Name+TableDocNomber(FileName)+' от '+TableDate(FileName);

if TableTradeSource(FileName)<>'' then s:=s+' из '+TableTradeSource(FileName);

if TableTradeDest(FileName)<>'' then s:=s+' в '+TableTradeDest(FileName);

TableNameLabel.Caption:=s;

{размеры и вид таблицы}

for i:=1 to Documents[TableNo].ColCount do

begin

StringGrid1.Rows[0].strings[i-1]:=Documents[TableNo].ColCaptions[i];



SetColWidth(StringGrid1,i-1);

end;
{строка итого}

UpdateTotalEdit;

{end;{with}

end;
{преобразует строку таблицы из массива строк в формат дискового файла (массив чисел)}

procedure RecountStrings(var r:TRowFileType; Row:TStringList);

var

j:integer;



CurFormula:string;

maxCol,code:integer;

begin

if DocumentSettings.ColCount>7 then maxCol:=7 else maxCol:=DocumentSettings.ColCount;



for j:=1 to maxCol do

begin {цикл по ячейкам: начало}

CurFormula:=DocumentSettings.ColFormules[j]; {обращение к этой формуле}

if (Length(CurFormula)>0) then

case CurFormula[1] of

'%':


begin {тип ячейки по формуле - число}

val(Row.strings[j-1],r.Freal[j],code);{}

end;

'@':


begin {тип ячейки по формуле - ссылка}

r.Fint[j]:=GetObjectIndex(Row.strings[j-1]);{}

end;

'#':


begin {тип ячейки по формуле - дата}

r.Fint[j]:=StrDateToInt(Row.strings[j-1]);{}

end;

end;{case}



end; {цикл по ячейкам: конец}

end;
{преобразует строку таблицы из формата дискового файла (массив чисел) в массив строк}

procedure recountRowWith(var Row:TStringList; r:TRowFileType);

var


s:string;

i,k:integer;

CurFormula:string;

CurArgumentName:string;

CurArgumentIndex:integer;

op:string[1];

Argument1,Argument2,result:Single;

rArg:TRowArgumentType;

begin

Row.Clear;



for i:=1 to DocumentSettings.ColCount do

begin {цикл по ячейкам и формулам: начало}

CurFormula:=DocumentSettings.ColFormules[i];

Row.Add('');

if (Length(CurFormula)>0) then

case CurFormula[1]of

'%': begin str(r.FReal[i]:5:3,s); end;

'@': begin s:=GetObjectName(r.Fint[i]); end;

'#': begin s:=IntDateToStr(r.Fint[i]); end;

end;


Row.strings[i-1]:=s;

end; {цикл по ячейкам и формулам: конец}

end;
{корректная инициализация пустой таблицы}

procedure CloseTable;

begin

with EditDoc do



begin {with EditDoc}

{строка товара}

TovarComboBox.Visible:=False;

{строка торговой точки}

TradePointComboBox.Visible:=False;

{строка даты}

DayComboBox.Visible:=False; MonthComboBox.Visible:=False; YearComboBox.Visible:=False;
{заголовок окна}

Caption:='Редактор документов - <нет документов>';

{название документа}

TableNameLabel.Caption:='<нет документа>';

{размеры и содержимое таблицы}

StringGrid1.RowCount:=2;

StringGrid1.ColCount:=1;

StringGrid1.Cells[0,0]:='';

StringGrid1.Cells[0,1]:='';

end; {with EditDoc}

end;

{открытие таблицы}

procedure TEditDoc.OpenTable(FileName:string);

var


i,j,k:longint;

f:file of integer;

r:TRowFileType;

s:string;

tsv:TstringList;

begin


tsv:=TstringList.Create;
DocumentType:=TableType(NameOf(FileName)); if DocumentType=0 then exit;

DocumentSettings:=Documents[DocumentType];

FormatTableByType(DocumentType);
{выяснение редактируемых ячеек}

DocumentSettings.colCanEdit:='11111111';

for i:=1 to DocumentSettings.ColCount do

begin


s:=DocumentSettings.ColFormules[i]; {вычисления по этой формуле}

if (Length(s)>0)and(StrToInt(copy(s,2,2))=i) then

begin {ссылок на другие ячейки нет ?}

k:=5;


repeat

if StrToInt(copy(s,k+1,2))<>i then DocumentSettings.colCanEdit[i]:='0';

inc(k,4);

until k>length(s);

end;

end;
{чтение таблицы}



assignFile(f,FileName);

reset(f);

i:=0;

while not eof(f) do



begin

inc(i);


for j:=1 to DocumentSettings.ColCount do read(f,r.FInt[j]);

StringGrid1.RowCount:=StringGrid1.RowCount+1;

recountRowWith(tsv,r);

StringGrid1.Rows[i]:=tsv;

end;

closeFile(f);



{последняя строчка не нужна - она пустая}

if StringGrid1.RowCount>2 then StringGrid1.RowCount:=StringGrid1.RowCount-1;

{отражение горячих строк}

UpdateHotLines(StringGrid1.Row);

{строка итого}

UpdateTotalEdit;


tsv.Destroy;
GridModified:=False;
{инициализация ценовой таблицы источника}

i:=OpenPriceTableFor(TableTradeSourceInt(FileOf(DocumentFileName)),GetDateInt(FileOf(DocumentFileName)),SourcePriceTable );


if DocumentSettings.FileSimbol='U'

then


begin

{открытие ценовой таблицы акта уценки на день назад, чтобы правильно заполнялась старая продажная}

j:=OpenPriceTableFor(TableTradeSourceInt(FileOf(DocumentFileName)),GetDateInt(FileOf(DocumentFileName))-1,DestPriceTable );

end


else

begin


j:=OpenPriceTableFor(TableTradeDestInt(FileOf(DocumentFileName)),GetDateInt(FileOf(DocumentFileName)),DestPriceTable );

end;
end;

procedure SaveTable(FileName:string);

var {сохранение таблицы под именем}

i,j:longint;

trv:TRowFileType;

s:string;

F,F1:file of integer;

begin

if (not GridModified)or(FileName='') then exit; {таблицу, не подлежащую сохранению игнорируем}



assignFile(f,FileName);

rewrite(f);

for i:=1 to EditDoc.StringGrid1.RowCount-1 do

begin


RecountStrings(trv, TStringList(EditDoc.StringGrid1.Rows[i]));

{заполнение 3-й колонки платежей в кассу товаром типа "Деньги" (LastTovarTypeID)}

if DocumentSettings.FileSimbol='K' then trv.fint[3]:=LastTovarTypeID;

for j:=1 to DocumentSettings.ColCount do write(f,trv.fint[j]);

end;

closeFile(f);


{обновление (или создание новых) ценовых таблиц после редактирования акта уценки}

if DocumentSettings.FileSimbol='U' then

begin

s:=FileOf(FileName);



SetPiceDate(SourcePriceTable,GetDateInt(s));

s:='##'+StrToFileName(EditDoc.DateMaskEdit.text);

SetPiceDate(SourcePriceTable,GetDateInt(s));

SavePriceTable(SourcePriceTable);

end;
EditDoc.StringGrid1.Setfocus;

GridModified:=False;

end;

function CelMoreThen(s1,s2:string):shortint;



var

i1,i2:real;

code1,code2:integer;

begin


if tovarSortMode=byType then

begin {сравним их по группам товаров}

i1:=GetObjectIndex(s1);

i2:=GetObjectIndex(s2);

if i1>i2 then begin CelMoreThen:=1; exit; end else

if i1

end;
{попробуем их как даты}

i1:=StrDateToInt(s1);

i2:=StrDateToInt(s2);

if i1>i2 then begin CelMoreThen:=1; exit end else

if i1{попробуем их как числа}

i1:=vala(s1);

i2:=vala(s2);

if i1>i2 then begin CelMoreThen:=1; exit end else

if i1{строки и в африке строки}

if s1>s2 then begin CelMoreThen:=1; exit end else

if s1

CelMoreThen:=0;

end;
{сортирует гриду StringGrid1 по содержимому столбца ACol}

procedure SortGridBy(var StringGrid1:TStringGrid; var StringList:TStringList; ACol:Longint);

var

s1,s2:longint; {первая и последняя отсортированные строки}



i:longint; {текущая сортируемая}

a,b:longint; {первая и последняя строка диапазона, в котором зажата текущая}

abm:longint; {середина диапазона}

k:longint;

TempStringList:TStringList;

begin


if ACol<0 then exit;

TempStringList:=TStringList.Create;


s1:=1;

s2:=1;
a:=s1; b:=s2;

i:=s2+1;

abm:=(a+b)div 2;


if StringList.Count>0 then

begin


TempStringList.Add(StringList.Strings[0]);

TempStringList.Objects[0]:=StringList.Objects[0];

end;
while i<=StringGrid1.RowCount-1 do {пока есть несортированные строки}

begin


while (a<>b) do {пока не сравнялись границы поиска}

begin


abm:=(a+b)div 2;

if CelMoreThen(StringGrid1.Cells[ACol,abm] , StringGrid1.Cells[ACol,i])=1 then

begin

if (a<>abm) then a:=abm else inc(a); {середина совпадает с границей - опустить границу}



end

else


if CelMoreThen(StringGrid1.Cells[ACol,abm] , StringGrid1.Cells[ACol,i])=-1 then

begin


b:=abm;

end


else

begin


a:=abm;

b:=abm;


end;

end;


abm:=(a+b)div 2;

{если abm>i то вставляем после abm}

if CelMoreThen(StringGrid1.Cells[ACol,abm] , StringGrid1.Cells[ACol,i])=1 then inc(abm); {}

{---- изменение таблицы}

{добавление новой и перенос в нее текущей (i-й)}

StringGrid1.RowCount:=StringGrid1.RowCount+1;

StringGrid1.Rows[StringGrid1.RowCount-1]:=StringGrid1.rows[i];

{сдвиг строк вниз с конца (текущей i-й) до начала (abm)}

for k:=i downto abm+1 do

StringGrid1.rows[k]:=StringGrid1.rows[k-1];

{перенос текущей (i-й) на позицию abm и удаление промежуточной}

StringGrid1.rows[abm]:=StringGrid1.Rows[StringGrid1.RowCount-1];

StringGrid1.RowCount:=StringGrid1.RowCount-1;

{---- изменения связанного списка}

if StringList.Count>=i then

begin


TempStringList.Insert(abm-1,StringList.Strings[i-1]);

TempStringList.Objects[abm-1]:=StringList.Objects[i-1];

end;

inc(s2);


a:=s1; b:=s2;

i:=s2+1;


end;
for i:=0 to TempStringList.Count-1 do

begin


StringList.Strings[i]:=TempStringList.Strings[i];

StringList.Objects[i]:=TempStringList.Objects[i];

end;
TempStringList.Destroy;

end;


{перерисовка заголовка списка документов

и перемещение подсвеченной ячейки на нужную позицию}

procedure TEditDoc.FormatFilesGrid;

begin


{with EditDoc do {}

begin


FilesStringGrid.Cells[0,0]:=' дата '; SetColWidth(FilesStringGrid,0);

FilesStringGrid.Cells[1,0]:=' документ '; SetColWidth(FilesStringGrid,1);

FilesStringGrid.Cells[2,0]:=' источник товара '; SetColWidth(FilesStringGrid,2);

FilesStringGrid.Cells[3,0]:=' приемник товара '; SetColWidth(FilesStringGrid,3);

FilesStringGrid.Cells[4,0]:=''; SetColWidth(FilesStringGrid,4);

end;


end;

{для строки Row в таблице устанавливает значения покупной и продажной цен товара Tovar}

procedure SetPricesFor(Tovar,Row:integer);

var


s:string;

pr:single;

begin

if DocumentSettings.TovarDestPrice1ColNo<>-1 then {покупная в приемнике}



begin

pr:=GetDestTovarPrice1(Tovar); if pr<>-1 then

begin

Str(pr:5:3,s); EditDoc.StringGrid1.Cells[DocumentSettings.TovarDestPrice1ColNo-1,Row]:=s;



end;

end;


if DocumentSettings.TovarDestPrice2ColNo<>-1 then {продажная в приемнике}

begin


pr:=GetDestTovarPrice2(Tovar); if pr<>-1 then

begin


Str(pr:5:3,s); EditDoc.StringGrid1.Cells[DocumentSettings.TovarDestPrice2ColNo-1,Row]:=s;

end;


end;

if DocumentSettings.TovarSourcePrice1ColNo<>-1 then {покупная в источнике}

begin

pr:=GetSourceTovarPrice1(Tovar); if pr<>-1 then



begin

Str(pr:5:3,s); EditDoc.StringGrid1.Cells[DocumentSettings.TovarSourcePrice1ColNo-1,Row]:=s;

end;

end;


if DocumentSettings.TovarSourcePrice2ColNo<>-1 then {продажная в источнике}

begin


pr:=GetSourceTovarPrice2(Tovar); if pr<>-1 then

begin


Str(pr:5:3,s); EditDoc.StringGrid1.Cells[DocumentSettings.TovarSourcePrice2ColNo-1,Row]:=s;

end;


end;

end;


procedure TEditDoc.Button9Click(Sender: TObject);

begin


if DocumentFileName='' then

begin


OkButton:=2;

{Messag.}OutMessage('Этот документ не может быть сохранен.'+#13+#10+

'Воспользуйтесь командой "копировать в...".','','Ok','');

exit;


end;

SaveTable(DocumentFileName);

end;

procedure TEditDoc.StringGrid1KeyDown(Sender: TObject; var Key: Word;



Shift: TShiftState);

var


i:integer;

s:string;

pr:single;

begin


case key of

46: {del}

if (ssCtrl in Shift) then

begin


deleteRow(StringGrid1.Selection.Top,StringGrid1.Selection.Bottom);

key:=0;


end;

45:{ins}


if (ssCtrl in Shift) then

begin


AddRow(StringGrid1.Row);

key:=0;


end;

40:{Down}

if StringGrid1.Row=StringGrid1.RowCount-1 then

begin


AddRow(StringGrid1.Row+1);

{ key:=0;}

end;

38:{Up}


if StringGrid1.Row=StringGrid1.RowCount-1 then

begin


if StringGrid1.Rows[StringGrid1.Row].Strings[0]='' then

begin


deleteRow(StringGrid1.Row,StringGrid1.Row);

key:=0;


end;

end;
13:

if DocumentSettings.TovarTypeColNo=StringGrid1.Col+1 then

begin {Enter на ячейке с названием товара}

GridModified:=true;

{отражение в ячейку}

StringGrid1.Cells[DocumentSettings.TovarTypeColNo-1,StringGrid1.Row]:=TovarComboBox.Text;

TovarComboBox.Font.Color:=GetStringColor(TovarComboBox.Text);{цветовое решение}

{изменение цены}

i:=GetObjectIndex(TovarComboBox.Text); {i - код товара}

SetPricesFor(i,StringGrid1.Row);

{обсчет вычисляемых значений}

UpdateRowNo(StringGrid1.Row);

{расчет "итого"}

UpdateTotalEdit;

end;


end;{case}
end;

function GetMachString(s:string):string;

var

i:integer;



Mach,MachesNum:integer;

begin


GetMachString:='';

MachesNum:=0;

for i:=0 to TovarsName.Count-1 do

if pos(LowerCaseRus(s),LowerCaseRus(TovarsName.Strings[i]) )=1

then begin GetMachString:=TovarsName.Strings[i]; inc(MachesNum) end;

if MachesNum<>1 then GetMachString:='';

end;
function GetStringColor(s:string):integer;

var


i:integer;

Mach,MachesNum:integer;

begin

MachesNum:=0;



for i:=0 to TovarsName.Count-1 do

if pos( LowerCaseRus(s), LowerCaseRus(TovarsName.Strings[i]) )=1

then begin inc(MachesNum); Mach:=i end;

if MachesNum=0 then GetStringColor:=ShortEditColorNo else

if MachesNum>1 then GetStringColor:=ShortEditColorIs else

begin


{ ComboBox1.Text:=TovarsName.Strings[Mach];}

GetStringColor:=ShortEditColorUnic;

end;

end;
{подсчитывает сумму выделенных чисел в одном столбце таблицы и выводит ее в строку "итого"}



procedure SumRect(Selection:TGridRect);

var


i:integer;

Sum:Real;

s:string;

begin


Sum:=0;

for i:=Selection.Top to Selection.Bottom do

Sum:=Sum+Vala(EditDoc.StringGrid1.Cells[Selection.Left,i]);
Str(Sum:5:2,s);

EditDoc.TotalCaption.Caption:='сумма выделенных :';

EditDoc.TotalEdit.Text:=s;

EditDoc.TotalCaption.Font.Color:=$0064000A;

EditDoc.TotalEdit.Font.Color:=$0064000A;

end;
procedure TEditDoc.StringGrid1SelectCell(Sender: TObject; Col,

Row: Integer; var CanSelect: Boolean);

var s:string;

begin

{запоминание ячейки (для восстановления)}



CurrientCel:=StringGrid1.Rows[Row].strings[col];

{отражение горячих строк}

UpdateHotLines(Row);

end;


{добавляет массив параметров r к текущей таблице }

procedure TEditDoc.AddRowToTable(r:TRowArgumentType);

var

i,j,k:integer;



Result,Argument1:real;

CurFormula:string;

CurArgumentName:string;

s:string;

CurArgumentIndex:integer;

wasKeyField,badKeyField, onlyOneRow,onlyUnicalRow:boolean;

op:string[1];
tsv:TstringList;

CurRow:integer;


RowResult:TRowArgumentType;

begin


{----------- (начало) поиск строки с такими же ключевыми полями --------------}

for CurRow:=1 to StringGrid1.RowCount-1 do

begin

{формирование строки таблицы в виде массива TRowArgumentType }



RowResult.count:=DocumentSettings.ColCount;

for i:=1 to RowResult.count do

begin

RowResult.A[i].name:=DocumentSettings.ColFields[i];



case DocumentSettings.ColFormules[i][1] of

'%': RowResult.A[i].Freal:=vala(StringGrid1.Cells[i-1,CurRow]);

'@': RowResult.A[i].Fint :=GetObjectIndex(StringGrid1.Cells[i-1,CurRow]);

'#': RowResult.A[i].Fint :=StrDateToInt(StringGrid1.Cells[i-1,CurRow]);

end;{case}

end;
{значения ключевых полей одинаковы ?}

onlyUnicalRow:=False;

onlyOneRow:=False;

wasKeyField:=False;

badKeyField:=False;

for i:=1 to DocumentSettings.ColCount do

begin {i - цикл по ячейкам и их формулам: начало}

CurFormula:=DocumentSettings.ColFormules[i]; {вычисления по этой формуле}

if (Length(CurFormula)>0)and(CurFormula[4]='<') then {эта формула предполагает ключевое поле}

begin

wasKeyField:=true; {ключевое поле в таблице существует}



{поиск ключевого поля среди аргументов формулы}

k:=5;


repeat {цикл по аргументам формулы}

CurArgumentName:=copy(CurFormula,k+1,3); {имя очередного аргумента из формулы ячейки}

CurArgumentIndex:=-1;

for j:=1 to r.Count do {вычичсление индекса очередного аргумента}

if CurArgumentName=R.A[j].Name then CurArgumentIndex:=j;

if (CurArgumentIndex<>-1) then

case CurFormula[1] of

'%' : if RowResult.A[i].Freal<>r.A[CurArgumentIndex].Freal then badKeyField:=True;

'@','#': if RowResult.A[i].Fint <>r.A[CurArgumentIndex].Fint then badKeyField:=True;
end; {case}

inc(k,4);

until (k>=Length(CurFormula))

end else


if (Length(CurFormula)>0)and(CurFormula[4]='!') then {предполагает запись только в первую строку}

begin


onlyOneRow:=true;

end else


if (Length(CurFormula)>0)and(CurFormula[4]='_') then {предполагает запись только в новую строку}

begin


onlyUnicalRow:=true;

end;


end;
if (wasKeyField=True)and(badKeyField=False) then break; {все ключевые поля совпали с переданными}

if onlyUnicalRow or onlyOneRow then break; {никаких ключей!}

end;

{----------- (конец) поиск строки с такими же ключевыми полями --------------}



{вычисления производим только с первой строкой}

if onlyOneRow then

begin

CurRow:=1;



end else

{(были ключевые поля и

по крайней мере одно из них не совпадает) или (ключевых полей вообще не было) или (ключей не надо)}

if (wasKeyField and badKeyField) or (not wasKeyField) or (onlyUnicalRow) then

begin {добавление новой строки}

StringGrid1.RowCount:=StringGrid1.RowCount+1;

CurRow:=StringGrid1.RowCount-1; {последняя}

for i:=1 to StringGrid1.ColCount do StringGrid1.Cells[i,CurRow]:='';

{формирование новой строки таблицы в виде массива TRowArgumentType }

for i:=1 to RowResult.count do

begin

RowResult.A[i].name:=DocumentSettings.ColFields[i];



case DocumentSettings.ColFormules[i][1] of

'%': RowResult.A[i].Freal:=vala(StringGrid1.Cells[i-1,CurRow]);

'@': RowResult.A[i].Fint :=GetObjectIndex(StringGrid1.Cells[i-1,CurRow]);

'#': RowResult.A[i].Fint :=StrDateToInt(StringGrid1.Cells[i-1,CurRow]);

end;{case}

end;


end;
for i:=1 to DocumentSettings.ColCount do

begin {i - цикл по ячейкам и их формулам: начало}

CurFormula:=DocumentSettings.ColFormules[i]; {вычисления по этой формуле}

if (Length(CurFormula)>0) then

{присвоение в текущую (i-ю) ячейку по формуле}

begin


CountCellNo(i,RowResult,r,CurFormula); {RowResult <- r}

case CurFormula[1] of

'%': begin str(RowResult.A[i].fReal:5:3,s); end;

'@': begin s:=GetObjectName(RowResult.A[i].fInt); end;

'#': begin s:=IntDateToStr(RowResult.A[i].fInt); end;

end;{case}

StringGrid1.Cells[i-1,CurRow]:=s;

end;


end; {i - цикл по ячейкам и формулам: конец}
end;
{обсчитывает содержимое массива r со строку таблицы № RowIndex так,

если бы строка была с нулевыми значениями

возвращает true если хоть один из переданных аргументов попал в таблицу}

function TEditDoc.CopyRowToTable(r:TRowArgumentType; RowIndex:longint):boolean;

var

i:integer;



s,CurFormula:string;

RowResult:TRowArgumentType;

begin

CopyRowToTable:=false;



{подготовка пустой строки в формате TRowArgumentType}

for i:=1 to DocumentSettings.ColCount do

begin

CurFormula:=DocumentSettings.ColFormules[i]; {вычисления по этой формуле}



if (Length(CurFormula)>0) then

begin


case CurFormula[1] of

'%' : begin RowResult.A[i].fReal:=0; end;

'@','#' : begin RowResult.A[i].fInt:=0; end;

end;{case}

RowResult.A[i].name:=DocumentSettings.ColFields[i];

end;


end;

{обсчет пустой строки с переданными аргументами}

for i:=1 to DocumentSettings.ColCount do

begin


CurFormula:=DocumentSettings.ColFormules[i]; {вычисления по этой формуле}

if (Length(CurFormula)>0) then

begin

if result=false



then result:=CountCellNo(i,RowResult,r,CurFormula)

else CountCellNo(i,RowResult,r,CurFormula);;

case CurFormula[1] of

'%': begin str(RowResult.A[i].fReal:5:3,s); end;

'@': begin s:=GetObjectName(RowResult.A[i].fInt); end;

'#': begin s:=IntDateToStr(RowResult.A[i].fInt); end;

end;{case}

StringGrid1.Cells[i-1,RowIndex]:=s;

end;

end;
CopyRowToTable:=result;



end;

procedure TEditDoc.CreateRashod1;

var

curTableType:integer; {тип добавляемой таблицы}



t:file of integer; {файл с добавляемой таблицей}

CurrRow:TRowFileType; {сюда читаем строки таблицы}

r:TRowArgumentType; {а сюда записываем для передачи в подпрограмму}

date1,date2,s,s1,s2:string;

TradePo:integer;

F:TSearchRec;

DocumentsList:TStringList;

i,j,k:integer;

ch1,ch2:char;

go,FirstRow:boolean;

CurTableDate,CurTableSourceID,CurTableDestinationID:integer;

ResultTableID:integer;

begin

if not MakeOtchetForm.Execute(TradePo,date1,date2) then exit;


ResultTableID:=TradePoints[TradePo].TradeID;
DocumentsList:=TStringList.Create;

{---- формирование списка отчетных документов за этот период - DocumentsList ----}

{первые два - акты снятия остатков}

DocumentsList.Clear;

{обсчитываемая торговая точка}

ch1:=GetTradePointCH(TradePoints[MakeOtchetForm.SourceComboBox.itemIndex+1].TradeID);

ch2:=Documents[DocumentType].KeyFileCH; if ch2='' then ch2:='?';
{s соответствует всем документам, где торговая точка фигурирует в качестве источника

и таблица лежит в заданном диапазоне дат}

s:='F?????'+ch1+'?.DB*';

if findFirst(DocumentDirectory+s,faAnyFile,F)=0 then

repeat

F.Name:=UpperCaseRus(F.Name);



if (copy(NameOf(F.Name),3,4)>=date1)and(copy(NameOf(F.Name),3,4)<=date2)

then DocumentsList.Add(DocumentDirectory+F.Name);

until findNext(F)<>0;
{s соответствует всем документам, где торговая точка фигурирует в качестве приемника}

s:='F??????'+ch1+'.DB*';

if findFirst(DocumentDirectory+s,faAnyFile,F)=0 then

repeat


F.Name:=UpperCaseRus(F.Name);

if (copy(NameOf(F.Name),3,4)>=date1)and(copy(NameOf(F.Name),3,4)<=date2)

then DocumentsList.Add(DocumentDirectory+F.Name);

until findNext(F)<>0;


{прикинь, ни одного документа !}

if DocumentsList.Count = 0 then

begin

OkButton:=2;



{Messag.}OutMessage('Отчет не может быть сформирован - '+#13#10

+'в заданном Вами промежутке дат не найдено ни одного документа','','Ok','');

exit;

end;
{дублирование актов уценки,



удаление промежуточных актов снятия остатков и присвоение знаков начальному и конечному}

i:=0;


while ibegin


if copy(fileOf(DocumentsList[i]),2,1)='U' then {======== если документ - акт уценки ...}

begin


DocumentsList.Insert(i,DocumentsList[i]);{... то его надо продублировать ...}

DocumentsList.Objects[i]:=Pointer(-1); {... при этом один акт с плюсом, ...}

DocumentsList.Objects[i+1]:=Pointer(+1); {... а другой с минусом}

inc(i); {и переййти сразу к следующему через один документу}

end

else


if (copy(fileOf(DocumentsList[i]),2,1)='O') then {======== если документ - акт снятия остатков ...}

begin


if copy(NameOf(DocumentsList[i]),3,4)=date1 then

DocumentsList.Objects[i]:=Pointer(+1) {... начальный остаток будет с плюсом,} else

if copy(NameOf(DocumentsList[i]),3,4)=date2 then

DocumentsList.Objects[i]:=Pointer(-1) {... конечный остаток будет с минусом,} else

DocumentsList.Objects[i]:=Pointer(0); {... а промежуточный остаток будет игнорироваться}

end


else

DocumentsList.Objects[i]:=Pointer(65535); {... то на месте разберемся}


inc(i);

end;
{------------ подготовка целевой таблицы --------}

DocumentFileName:=''; {этот документ не может быть сохранен}

DocumentType:=MaxEditDocument+MakeOtchetForm.DocTypeComboBox.ItemIndex+1;


StringGrid1.ColCount:=Documents[DocumentType].ColCount;

StringGrid1.RowCount:=2;

for i:=0 to StringGrid1.ColCount-1 do StringGrid1.Cells[i,StringGrid1.RowCount-1]:='';

DocumentSettings:=Documents[DocumentType];


{внешний вид: }

formatTableByType(DocumentType);

{заголовок окна}

Caption:='Отчет - '+LowerCaseRus(Documents[DocumentType].Name);

{название документа}

s:=TableTradeSource(NameOf(DocumentsList.Strings[0]));

s1:=FileNameToStr(copy(Date1,1,4));insert('.',s1,5);insert('.',s1,3);

s2:=FileNameToStr(copy(Date2,1,4));insert('.',s2,5);insert('.',s2,3);

TableNameLabel.Caption:=Documents[DocumentType].Name+' для '+s+' от '+s1+' до '+s2;

{-------------------- вычисления -----------------}

FirstRow:=True;

for i:=0 to DocumentsList.Count-1 do

if integer(DocumentsList.Objects[i])<>0 then

begin {цикл по документам}

{открытие таблицы}

s:=NameOf(DocumentsList.Strings[i]);

curTableType:=TableType(s);

CurTableDate:=GetDateInt(s);

CurTableSourceID:=TableTradeSourceInt(s);

CurTableDestinationID:=TableTradeDestInt(s);

assignFile(t,DocumentsList.Strings[i]);

reset(t);

while not eof(t) do

begin {цикл по строкам}

{считывание строки таблицы}

for k:=1 to Documents[curTableType].ColCount do read(t,CurrRow.Fint[k]);

{формирование массива аргументов из строки}

r.Count:=Documents[curTableType].ColCount;

for j:=1 to Documents[curTableType].ColCount do

begin


r.A[j].name:=Documents[curTableType].ColFields[j];

r.A[j].Fint :=CurrRow.Fint[j];

end;
Inc(r.Count);

r.A[r.Count].name:='DT'+Documents[curTableType].FileSimbol;

r.A[r.Count].Fint:=CurTableDate;

Inc(r.Count);

r.A[r.Count].name:='SO'+Documents[curTableType].FileSimbol;

r.A[r.Count].Fint:=CurTableSourceID;

Inc(r.Count);

r.A[r.Count].name:='DE'+Documents[curTableType].FileSimbol;

r.A[r.Count].Fint:=CurTableDestinationID;
{расстановка знаков}

for j:=1 to r.Count do

begin

if integer(DocumentsList.Objects[i])=+1 then



begin {с плюсом}

r.A[j].name:=UpperCaseRus(r.A[j].name);

end

else


if integer(DocumentsList.Objects[i])=-1 then

begin {с минусом}

r.A[j].name:=LowerCaseRus(r.A[j].name);

end


else

if integer(DocumentsList.Objects[i])=65535 then

begin {в зависимости от направления движения товара}

{если товар уходит, то имя поля - маленькими буквами}

if CurTableSourceID=ResultTableID then r.A[j].name:=LowerCaseRus(r.A[j].name);

{если товар приходит, то имя поля - большими буквами}

if CurTableDestinationID=ResultTableID then r.A[j].name:=UpperCaseRus(r.A[j].name);

end


end;
{обсчет аргументов}

if FirstRow {}

then begin FirstRow:=not CopyRowToTable(r,1); end {копирование в первую строку}

else AddRowToTable(r); {добавление к существующей таблице}

end;

CloseFile(t);



end; {отчет сформирован -----------------------------------------}
DocumentsList.Destroy;
UpdateTotalEdit;

end;


{открывает диалоговое окно задания типа отчета и рассчитывает отчет}

procedure TEditDoc.StringGrid1SetEditText(Sender: TObject; ACol,

ARow: Integer; const Value: String);

var s:string;

begin

GridModified:=true;



if Documents[DocumentType].colCanEdit[Acol+1]='0' then

begin {ячейку нельзя редактировать - восстановление этой ячейки}

StringGrid1.Rows[ARow].strings[Acol]:=CurrientCel;

end


else

if DocumentSettings.TovarTypeColNo<>-1 then

begin {название товара и цветовое решение}

s:=StringGrid1.Cells[DocumentSettings.TovarTypeColNo-1,StringGrid1.Row];

TovarComboBox.Font.Color:=GetStringColor(s);

if TovarComboBox.Font.Color=ShortEditColorUnic

then TovarComboBox.Text:=GetMachString(s)

else TovarComboBox.Text:=s;

UpdateRowNo(ARow);

end;
updateTotalEdit;

end;
procedure CreateDocPess;

var


i:integer;

s:string;

begin

with CreatDocForm do



begin

Caption:='Создание документа'; DateLabel.Caption:='сегодня'; Label3.Caption:='создать';

if GetNewFile(DocumentFileName,DocumentType)=0 then Exit;

end;
DocumentSettings:=Documents[DocumentType]; {параметры таблицы}

EditDoc.FormatTableByType(DocumentType); {форматирование таблицы}

GridModified:=True; SaveTable(DocumentFileName);


EditDoc.RereadDirectory(DocumentDirectory,DocumentFileName);
s:=FileOf(DocumentFileName);

OpenPriceTableFor(TableTradeSourceInt(s),GetDateInt(s),SourcePriceTable);

OpenPriceTableFor(TableTradeDestInt(s) ,GetDateInt(s),DestPriceTable);
EditDoc.StringGrid1.Setfocus;

end;


procedure TEditDoc.TovarComboBoxChange(Sender: TObject);

var


i:integer;

s:string;

pr:single;

begin


if DocumentSettings.TovarTypeColNo<>-1 then

begin


GridModified:=true;

{отражение в ячейку}

StringGrid1.Cells[DocumentSettings.TovarTypeColNo-1,StringGrid1.Row]:=TovarComboBox.Text;

TovarComboBox.Font.Color:=GetStringColor(TovarComboBox.Text);{цветовое решение}

{изменение цены}

i:=GetObjectIndex(TovarComboBox.Text);

SetPricesFor(i,StringGrid1.Row);

{вычисления по формуле}

UpdateRowNo(StringGrid1.Row);

{строка "итого"}

UpdateTotalEdit;

end;


StringGrid1.Setfocus;

end;
procedure TEditDoc.N12Click(Sender: TObject);

begin

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+



TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);


TradePointsForm.ShowModal; Application.OnHint := DisplayHint;
SaveTradePoints;

end;
procedure TEditDoc.N11Click(Sender: TObject);

begin

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+



TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);


TovarsTypesForm.ShowModal; Application.OnHint := DisplayHint;
UpdateTovarsName; {товары в выпадающий список}

WriteTovarsName; {записать обновление в файл}


{отображаемые раньше ценовые таблицы могли исчезнуть}

if FilesStringGrid.Row

then RereadDirectory(DocumentDirectory,FilesList[FilesStringGrid.Row-1]);
if FilesStringGrid.Row

then DocumentFileName:=UpperCaseRus(FilesList[FilesStringGrid.Row-1])

else DocumentFileName:='';

OpenTable(DocumentFileName);

end;
procedure TEditDoc.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

case key of



116: {F5} N11Click(Self);

117: {F6} N12Click(Self);

88: {x (LAT)} if (ssAlt in Shift) then Halt;

83: {Ctrl + S}

if (ssCtrl in Shift) then SaveTable(DocumentFileName);

78: {Ctrl + N}

if (ssCtrl in Shift) then

begin


Button8Click(Sender);

end;


79: {Ctrl + O}

if (ssCtrl in Shift) then

begin

N2Click(Sender);



end;

70: {Ctrl + F}

if (ssCtrl in Shift) then

begin


Button2Click(Sender);

end;


80: {Ctrl + P}

if (ssCtrl in Shift) then

begin

PrintForm.ShowModal;



end;

82: {Ctrl + R}

if (ssCtrl in Shift) then

begin


Button1Click(Sender);

end;
end;{case}

end;
procedure DeleteDocPress;

var


DocumentFileName,s:string;

i:longint;

toAsk:boolean;

AskResult:integer;

OldFilesGridSelection:integer;

begin


if (FilesList.Count<=0) or (EditDoc.FilesStringGrid.Row<0) then exit;

toAsk:=true;


OldFilesGridSelection:=EditDoc.FilesStringGrid.Selection.Top;
for i:=EditDoc.FilesStringGrid.Selection.Top-1 to EditDoc.FilesStringGrid.Selection.Bottom-1 do

begin


DocumentFileName:=UpperCaseRus(FilesList[i]);

if toAsk then

begin

s:='Удалить '+TableTotalCaption(FileOf(DocumentFileName))+' (файл '+FileOf(DocumentFileName)+') ?';



AskResult:={Messag.}OutMessage(s,'Удалить','Удалить все','Не удалять');

end;


if AskResult=2 then toAsk:=false;

if AskResult in[1,2] then

begin

OkButton:=2;



if not DeleteFile(DocumentFileName)

then {Messag.}OutMessage('Файл '+DocumentFileName+' невозможно удалить','','Ok','');

end;

end;
if (OldFilesGridSelection>1) and fileExists(FilesList[OldFilesGridSelection-2])



then s:=FilesList[OldFilesGridSelection-2]

else s:='';


EditDoc.RereadDirectory(DocumentDirectory,s);
if FilesList.Count=0 then CloseTable;
end;

procedure TEditDoc.Button1Click(Sender: TObject);

begin

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+



TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);

CreateRashod1;

{EditDoc.FilesStringGridClick(Sender);}

end;
procedure TEditDoc.N8Click(Sender: TObject);

begin


if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);
CreateRashod1;

end;


procedure TEditDoc.DisplayHint(Sender: TObject);

begin


Label3.Caption := GetLongHint(Application.Hint);

end;
procedure RereadAll;

begin

{инициализация списка товаров}



ReadTovarsName;

EditDoc.UpdateTovarsName;


{инициализация массива торговых точек}

LoadTradePoints;

EditDoc.UpdateTradePointsName;
{инициализация начальной, конечной и текущей отображаемой даты, а также фильтров}

LoadVO(DocumentDirectory+'View_Fil.txt');

EditDoc.DateMaskEdit.text:=DateToday;
{инициализация таблички со списком документов}

FilesList:=Tstringlist.Create;

EditDoc.RereadDirectory(DocumentDirectory,'');

{FilesGridSelection:=1;}

EditDoc.FormatFilesGrid;
{открытие первого попавшегося файла}

if FilesList.Count>0

then

begin


DocumentFileName:=UpperCaseRus(FilesList[EditDoc.FilesStringGrid.Row-1]);

EditDoc.OpenTable(DocumentFileName);

end

else


CloseTable;

end;


procedure OpenDocPress;

begin


OpenDocumentDialog.Mask:='F*.DB*';

if not OpenDocumentDialog.Execute then exit;

if OpenDocumentDialog.ChangeDirCheck.checked then

begin


{смена рабочего каталога : }

DocumentDirectory:=PathOf(OpenDocumentDialog.FileName);

OurPath:=PathOf(OpenDocumentDialog.FileName);

{перечитать все, что читается}

RereadAll;

{открытие файла}

DocumentFileName:=OpenDocumentDialog.FileName;

EditDoc.OpenTable(DocumentFileName);

end

else


begin

{просто открытие файла}

DocumentFileName:=OpenDocumentDialog.FileName;

EditDoc.OpenTable(DocumentFileName);

end;

EditDoc.StringGrid1.Setfocus;



end;

procedure TEditDoc.FormActivate(Sender: TObject);

var

i:integer;



Image1:Ticon;

begin


Application.OnHint := DisplayHint;

Label3.Caption:='';


{инициализация типов документов}

{$I DocTypesInit.pas}


{заполнение выпадающих списков даты на форме}

for i:=1 to 31 do DayComboBox.Items.add(intTostr(i));

for i:=1 to 12 do MonthComboBox.Items.add(monthName[i]);

for i:=1998 to 2020 do YearComboBox.Items.add(intTostr(i));


{инициализация путей}

OurPath:=PathOf(ParamStr(0));

DocumentDirectory:=UpperCaseRus(PathOf(ParamStr(0)));
{прочитать все, что читается}

RereadAll;


AnalisForm.ShowModal; {}

end;


procedure TEditDoc.StringGrid1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

ACol,ARow:integer;



PsevdoList:TStringList;

begin


StringGrid1.MouseToCell(x,y,ACol,ARow);

if ARow<>0 then exit;

PsevdoList:=TStringList.Create;

tovarSortMode:=byName; {сравниваем как строки}

SortGridBy(StringGrid1, PsevdoList, ACol);

PsevdoList.Destroy

end;
procedure SortFilesStringGrid(ACol:integer);

var


k,i,j:integer;

s:string;

TempFilesList:TstringList;

begin


with EditDoc do

begin


FilesGridLeftCol:=FilesStringGrid.LeftCol;

FilesGridTopRow:=FilesStringGrid.TopRow;{}


if FilesList.Count>0 then FilesList.Objects[FilesStringGrid.Row-1]:=Pointer(1);

tovarSortMode:=byName; {сравниваем как строки}

SortGridBy(FilesStringGrid, FilesList, ACol);
for i:=0 to FilesList.Count-1 do

if FilesList.Objects[i]=Pointer(1) then

begin

FilesList.Objects[i]:=Pointer(0);



{ FilesGridSelection:=i+1;}

end;
{перерисовка списка}

FormatFilesGrid;

{ FilesStringGrid.Visible:=true;{}

end;{with}

end;


{заполняет список FilesList и FilesStringGrid именами файлов и названиями документов, находящихся в них}

procedure TEditDoc.RereadDirectory(Directory,CurFileName: string);

var

F:TSearchRec;



i:integer;

begin


FilesStringGrid.RowCount:=2;

FilesList.Clear;


CurrDocMask:='F*.DB*';{}

if findFirst(Directory+CurrDocMask,faAnyFile,F)=0 then

repeat {прщверка имени найденного файла на соответствие фильтру}

F.Name:=UpperCaseRus(F.Name);

if (UpperCaseRus(VOUseFilter)='FALSE')or (

(pos(F.Name[2],VODocument)<>0)and

((pos(F.Name[7],VOSource)<>0)or(pos(F.Name[8],VODestination)<>0))and

(copy(F.Name,3,4)>=VODateBegin)and

(copy(F.Name,3,4)<=VODateEnd)

)

then



begin

F.Name:=UpperCaseRus(F.Name);

FilesList.Add(Directory+F.Name);

FilesStringGrid.Cells[0,FilesStringGrid.RowCount-1]:=TableDate(F.Name);

FilesStringGrid.Cells[1,FilesStringGrid.RowCount-1]:=TableCaption(F.Name)+TableDocNomber(F.Name);

FilesStringGrid.Cells[2,FilesStringGrid.RowCount-1]:=TableTradeSource(F.Name);

FilesStringGrid.Cells[3,FilesStringGrid.RowCount-1]:=TableTradeDest(F.Name);

FilesStringGrid.RowCount:=FilesStringGrid.RowCount+1;

end;

until findNext(F)<>0;



FindClose(F);
if FilesStringGrid.RowCount>2

then begin

FilesStringGrid.RowCount:=FilesStringGrid.RowCount-1;

SortFilesStringGrid(FilesGridSortBy);

i:=FilesList.Count-1;

while (i>0)and(CurFileName<>FilesList[i]) do dec(i);

FilesStringGrid.Row:=i+1;

end


else begin

FilesStringGrid.Cells[0,1]:='';

FilesStringGrid.Cells[1,1]:='';

FilesStringGrid.Cells[2,1]:='';

FilesStringGrid.Cells[3,1]:='';

end;
FormatFilesGrid;


{обновление окошек нач и кон датт}

FilesDate1.Text:=FileNameToStr(VODateBegin);

FilesDate2.Text:=FileNameToStr(VODateEnd);

end;


procedure TEditDoc.FilesStringGridMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

ACol,ARow:integer;



begin

FilesStringGrid.MouseToCell(x,y,ACol,ARow);

if ARow=0

then


begin

FilesGridSortBy:=ACol;

{SortFilesStringGrid(FilesGridSortBy);}

EditDoc.RereadDirectory(DocumentDirectory,DocumentFileName);

end;

end;


procedure TEditDoc.FilesStringGridClick(Sender: TObject);

begin


if FilesList.Count=0 then exit;

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);

if (FilesList.Count>=FilesStringGrid.Row)and(FilesStringGrid.Row>0) then

begin


DocumentFileName:=UpperCaseRus(FilesList[FilesStringGrid.Row-1]);

OpenTable(DocumentFileName);

end;

end;
procedure TEditDoc.FilesStringGridKeyDown(Sender: TObject; var Key: Word;



Shift: TShiftState);

begin


case key of

13: begin

DocumentFileName:=UpperCaseRus(FilesList[FilesStringGrid.Row-1]);

OpenTable(DocumentFileName);

end;

end;{case}



end;

procedure TEditDoc.DayComboBoxChange(Sender: TObject);

begin

if DocumentSettings.DateColNo<>-1 then



begin

GridModified:=true;

StringGrid1.Cells[DocumentSettings.DateColNo-1,StringGrid1.Row]:=DayComboBox.Text+' '+MonthComboBox.Text+' '+YearComboBox.Text;

end;


end;
procedure TEditDoc.TradePointComboBoxChange(Sender: TObject);

begin


if DocumentSettings.TradePointColNo<>-1 then

begin


GridModified:=true;

StringGrid1.Cells[DocumentSettings.TradePointColNo-1,StringGrid1.Row]:=TradePointComboBox.Text;

end;

end;



procedure TEditDoc.FilesDate1Exit(Sender: TObject);

var s:string;

begin

VODateBegin:=StrToFileName(FilesDate1.Text);



VODateEnd:=StrToFileName(FilesDate2.Text);
if FilesStringGrid.Row<=FilesList.Count

then s:=FilesList[FilesStringGrid.Row-1]

else s:='';
RereadDirectory(DocumentDirectory,s);

end;
procedure TEditDoc.N6Click(Sender: TObject);

begin

Close;


end;
procedure TEditDoc.Button8Click(Sender: TObject);

begin


if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);
CreateDocPess;

end;
procedure TEditDoc.N4Click(Sender: TObject);

begin

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+



TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);


CreateDocPess;

EditDoc.FilesStringGridClick(Sender);

end;
procedure TEditDoc.N3Click(Sender: TObject);

begin


SaveTable(DocumentFileName);

end;
procedure TEditDoc.N2Click(Sender: TObject);

begin

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+



TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);


OpenDocPress;

end;
procedure TEditDoc.N15Click(Sender: TObject);

begin

DeleteDocPress;



EditDoc.FilesStringGridClick(Sender);

end;


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

begin


SavePriceTable(SourcePriceTable);

SavePriceTable(DestPriceTable);

if FilesList.Count=0 then exit;

if GridModified and (DocumentFileName<>'') and ({Messag.}OutMessage('Сохранить изменения в таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);

end;
{$I PriceDate.pas} {функции работы с ценами}

procedure TEditDoc.N16Click(Sender: TObject);

var s:string;

begin


ViewOptionsForm.ShowModal;
if FilesStringGrid.Rowthen s:=FilesList[FilesStringGrid.Row]

else s:='';

RereadDirectory(DocumentDirectory,FilesList[FilesStringGrid.Row]);

EditDoc.FilesStringGridClick(Sender);

end;


procedure TEditDoc.Button2Click(Sender: TObject);

var s:string;

begin

ViewOptionsForm.ShowModal;



if FilesStringGrid.Row

then s:=FilesList[FilesStringGrid.Row-1]

else s:='';
RereadDirectory(DocumentDirectory,s);

EditDoc.FilesStringGridClick(Sender);


if FilesList.Count>0 then

begin


{ FormatFilesGrid;

OpenTable(s);

StringGrid1.Setfocus;}

end


else

begin


CloseTable;

end;
end;

procedure TEditDoc.Button4Click(Sender: TObject);

begin


DeleteDocPress;

EditDoc.FilesStringGridClick(Sender);

end;
procedure TEditDoc.N19Click(Sender: TObject);

begin


PrintForm.ShowModal;

end;
procedure TEditDoc.TovarComboBoxEnter(Sender: TObject);

begin

TovarComboBox.Font.Color:=clBlack;



end;
procedure TEditDoc.TovarComboBoxExit(Sender: TObject);

begin


TovarComboBox.Font.Color:=GetStringColor(TovarComboBox.Text);{цветовое решение}

end;
procedure TEditDoc.N20Click(Sender: TObject);

var

i:integer;



s:string;

NewDocumentFileName:string;

NewDocumentType:integer;

label


OtherDocLabel;

begin {сохранить как}

with CreatDocForm do

begin


if DocumentFileName='' then

begin


s:='Этот документ не может'+#13+#10+'быть сохранен под другим именем.'+#13+#10+

'Воспользуйтесь командой "копировать в...".';

OkButton:=2; {Messag.}OutMessage(s,'','Ok','');

exit;


end;
{пояснительные надписи}

Caption:='Сохранить документ как...';

DateLabel.Caption:='под датой';

Label3.Caption:='сохранить как';

{индексы торговых точек и тип документа - как в исходнике}

DocComboIndex:=DocumentType-1;

for i:=1 to TradePointNum do

if TradePoints[i].TradeID=TableTradeSourceInt(FileOf(DocumentFileName))

then SourceComboIndex:=i-1;

for i:=1 to TradePointNum do

if TradePoints[i].TradeID=TableTradeDestInt(FileOf(DocumentFileName))

then DestComboIndex:=i-1;


OtherDocLabel:

if GetNewFile(NewDocumentFileName,NewDocumentType)=0 then Exit;


if NewDocumentFileName<>DocumentFileName then

begin


{ошибки в параметрах}

if Documents[DocumentType].ColCount<>Documents[NewDocumentType].ColCount then

begin

s:='Количество колонок в исходном документе - ' +



intToStr(Documents[DocumentType].ColCount) + ','+#13+#10+' а в новом - ' +

intToStr(Documents[NewDocumentType].ColCount) +

'. Выберите другой документ или воспользуйтесь командой "копировать в...".';

if {Messag.}OutMessage(s,'Ok','Отмена','')=1 then goto OtherDocLabel else exit;

end;

{ошибки при переименовании}



if not renameFile(DocumentFileName,NewDocumentFileName) then

begin


OkButton:=2;

{Messag.}OutMessage('Ошибка при переименовании документа','','Ok','');

exit

end;


{переименование состоялось - остались детали}

DocumentFileName:=NewDocumentFileName;

DocumentType:=NewDocumentType;

SaveTable(DocumentFileName);

StringGrid1.Setfocus;

end;
RereadDirectory(DocumentDirectory,DocumentFileName);

EditDoc.FilesStringGridClick(Sender);

StringGrid1.Setfocus;

end;{with}

end;


procedure TEditDoc.N21Click(Sender: TObject);

var


i,j:integer;

DestColCount:integer;

f:file of integer;

r:TRowFileType;

IOR:integer;

NewDocumentFileName:string;

NewDocumentType:integer;

begin {копировать документ в}

with CreatDocForm do

begin


Caption:='Скопировать документ в ...';

DateLabel.Caption:='под датой';

Label3.Caption:='сохранить как';
for i:=1 to TradePointNum do

if TradePoints[i].TradeID=TableTradeSourceInt(FileOf(DocumentFileName))

then SourceComboIndex:=i-1;

for i:=1 to TradePointNum do

if TradePoints[i].TradeID=TableTradeDestInt(FileOf(DocumentFileName))

then DestComboIndex:=i-1;

DocComboIndex:=DocumentType-1;
{а под каким документом сохраним мы это ?}

if GetNewFile(NewDocumentFileName,NewDocumentType)=0 then Exit;

{сохранить под старым именем (если надо)}

if GridModified and (DocumentFileName<>'') and

({Messag.}OutMessage('Сохранить изменения и в старой таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);
DocumentFileName:=NewDocumentFileName;

DocumentType:=NewDocumentType;


{чтение таблицы строка за строкой и запись в файл}

DestColCount:=Documents[DocumentType].ColCount;


try

AssignFile(F,DocumentFileName);

Rewrite(F); {копия файла под другим именем и, возможно, с другим количеством колонок}

for i:=1 to StringGrid1.RowCount-1 do

begin

RecountStrings(r, TStringList(StringGrid1.Rows[i]));



for j:=1 to DestColCount do

begin


Write(f,r.Fint[j]);

end;


end;

CloseFile(f);


except

begin


{Messag.}OutMessage('Ошибка при копировании документа','','Ok','');

CloseFile(f);

end;
end;{try}
RereadDirectory(DocumentDirectory,DocumentFileName);

EditDoc.FilesStringGridClick(Sender);

StringGrid1.Setfocus;

end;{with}

end;

procedure TEditDoc.StringGrid1Click(Sender: TObject);



begin

{если выделено более одной строки только в одном столбце - сумма зтих ячеек}

if ((StringGrid1.Selection.Left=StringGrid1.Selection.Right) and

(StringGrid1.Selection.Bottom<>StringGrid1.Selection.Top))

then SumRect(StringGrid1.Selection)

else UpdateTotalEdit;

end;
{создает полный список товаров для какой-либо торговой точки}

procedure FormTovarList;

var

i,TradePointID,TodDate:integer;



s:string;

begin


{сохранить, если надо, открытую таблицу}

if GridModified and (DocumentFileName<>'') and

({Messag.}OutMessage('Сохранить изменения в старой таблице '+#13+#10+

TableTotalCaption(fileOf(DocumentFileName))+' ?','Сохранить','Не сохранять','')=1)

then SaveTable(DocumentFileName);
with Choos do

begin {with Choos}

ChooseCombo.Items.Clear;

for i:=1 to TradePointNum do Choos.ChooseCombo.Items.Add(TradePoints[i].Name);


i:=0;

PromptText:='Укажите торговую точку';

if Choos.ReadValue(i)=0 then exit;

TradePointID:=TradePoints[i+1].TradeID;

end; {with Choos}
with EditDoc do

begin {with EditDoc}

TodDate:=StrDateToInt(GetDateString(EditDoc.DateMaskEdit.text));
OpenPriceTableFor(TradePointID, TodDate, SourcePriceTable);

DocumentFileName:=''; {этот документ не может быть сохранен}


{внешний вид}

CloseTable;

{внешний вид - заголовок окна}

Caption:='Редактор документов - список товаров';

{внешний вид - название документа}

TableNameLabel.Caption:='список товаров для '+GetObjectName(TradePointID);


StringGrid1.RowCount:=2;

StringGrid1.ColCount:=5;

StringGrid1.Cells[0,0]:=' товар ';

StringGrid1.Cells[1,0]:=' количество ';

StringGrid1.Cells[2,0]:=' покупная ';

StringGrid1.Cells[3,0]:=' продажная ';

StringGrid1.Cells[4,0]:=' ';

SetColWidth(StringGrid1,0);

SetColWidth(StringGrid1,1);

SetColWidth(StringGrid1,2);

SetColWidth(StringGrid1,3);

SetColWidth(StringGrid1,4);


for i:=0 to TovarsName.Count-1 do

begin


StringGrid1.RowCount:=StringGrid1.RowCount+1;

s:=TovarsName[i];

StringGrid1.Cells[0,i+1]:=s;

s:='';


StringGrid1.Cells[1,i+1]:=s;

str(GetSourceTovarPrice1(GetOnlyID(integer(TovarsName.objects[i]))):5:3,s);

StringGrid1.Cells[2,i+1]:=s;

str(GetSourceTovarPrice2(GetOnlyID(integer(TovarsName.objects[i]))):5:3,s);

StringGrid1.Cells[3,i+1]:=s;

s:='';


StringGrid1.Cells[4,i+1]:=s;

end;
if StringGrid1.RowCount>2 then StringGrid1.RowCount:=StringGrid1.RowCount-1; {последняя - лишняя}

end; {with EditDoc}

end;
procedure TEditDoc.sdsad1Click(Sender: TObject);

begin

FormTovarList;



end;
procedure TEditDoc.FormCreate(Sender: TObject);

begin


TovarsName:=Tstringlist.Create;

end;
procedure TEditDoc.N13Click(Sender: TObject);

begin

InfoForm.ShowModal;



end;

procedure TEditDoc.MenuItem2Click(Sender: TObject);

var

PsevdoList:TStringList;



begin {сортировка по названиям}

tovarSortMode:=byName;

PsevdoList:=TStringList.Create;

SortGridBy(StringGrid1, PsevdoList, DocumentSettings.TovarTypeColNo-1);

PsevdoList.Destroy;

GridModified:=true;

end;
procedure TEditDoc.MenuItem1Click(Sender: TObject);

var


PsevdoList:TStringList;

begin {сортировка по типам товара}

tovarSortMode:=byType;

PsevdoList:=TStringList.Create;

SortGridBy(StringGrid1, PsevdoList, DocumentSettings.TovarTypeColNo-1);

PsevdoList.Destroy;

GridModified:=true;

end;
procedure TEditDoc.N23Click(Sender: TObject);

begin

FormTovarList;



end;
procedure TEditDoc.N9Click(Sender: TObject);

var


Key: Word;

Shift: TShiftState;

begin


жүктеу/скачать 1 Mb.

Достарыңызбен бөлісу:
1   2   3   4   5



©dereksiz.org 2024
әкімшілігінің қараңыз
    Басты бет