Код: Выделить всё
Const
xlColorBlack = 0;
End;
interface _gt_nakltodbf 'Выгрузка накладных в DBF' (,,sci178InsPM) escclose;
var i: integer;
var ListAptek: array [0..1] of String;
var itoglabel:longint;
var itogsumprod:double;
File Ifile,F;
table struct naklto
(
nrec:comp
)
with index
(idx1=nrec);
create view
var
Apteka:word;
ToNrec:comp;
as
select * from
katsopr
, rzkutprih
, katpodr katpodrfrom
, katpodr katpodrto
, katmc
, naklto _naklto
, katparty
, attrval dattrval
, attrnam dattrnam
//, barcode
, NAKLTO
where
((
word(2)==katpodrto.sklad (noindex)
and 603==katsopr.vidsopr
and 0<<katsopr.dopr
and ToNrec==katsopr.CPODRTO(noindex)
and katsopr.CPODRFROM==katpodrfrom.nrec
and naklto.nrec==rzkutprih.csopr
and rzkutprih.cmc==katmc.nrec
and rzkutprih.cparty==katparty.nrec
and rzkutprih.cotped==katotped.nrec
and katsopr.nrec==_naklto.nrec
and 'Штрих-код'==attrnam.name
and word(1430)==attrnam.wtable
and word(1430)==attrval.wtable
and katparty.nrec==attrval.crec
and attrnam.nrec==attrval.cattrnam
and 'Делитель'==dattrnam.name
and word(1411)==dattrnam.wtable
and word(1411)==dattrval.wtable
and katmc.nrec==dattrval.crec
and dattrnam.nrec==dattrval.cattrnam
));
procedure PrintLabel(var i:longint);
{
var kol:longint;
var kolbar:longint;
var code:string;
kolbar:=i;
code:=substr(katmc.barkod,1,6)+replace(lpad(replace(doubletostr(pprice,'6666,88'),',',''),6),' ','0');
i:=integer(substr(code,2,1))+integer(substr(code,4,1))+integer(substr(code,6,1))+integer(substr(code,8,1))+integer(substr(code,10,1))+integer(substr(code,12,1));
i:=i*3+integer(substr(code,1,1))+integer(substr(code,3,1))+integer(substr(code,5,1))+integer(substr(code,7,1))+integer(substr(code,9,1))+integer(substr(code,11,1));
i:=integer(substr(string(i),length(string(i)),1));
if i=0 then code:=code+'0' else code:=code+string(10-i);
if not isvalid(tnattrval) then insert into attrval set
attrval.vstring:=code,
attrval.wtable:=word(1430),
attrval.crec:=katparty.nrec,
attrval.cattrnam:=attrnam.nrec;
if attrval.vstring<>code then update current attrval set attrval.vstring:=code;
if not Ifile.OpenFile ('c:\ez2p.txt', stCreate) message ('Ошибка создания файла c:\ez2p.txt!', Error);
Ifile.writeln('^Q20,3');
Ifile.writeln('^W43');
Ifile.writeln('^H09');
Ifile.writeln('^S2');
Ifile.writeln('^P1');
Ifile.writeln('^E12');
Ifile.writeln('^C'+string(kolbar));
Ifile.writeln('^O0');
Ifile.writeln('^D0');
Ifile.writeln('^L');
// Ifile.writeln('AA,65,3,1,1,1,0,Аптека Вектор-Фарм');
// Ifile.writeln('AA,65,3,1,1,1,0,'+datetostr(rzkutprih.ddoc,'DD.MM.YY')+' '+rzkutprih.nomer);
Ifile.writeln('AA,65,3,1,1,1,0,'+datetostr(katsopr.dsopr,'DD.MM.YY')+' '+katsopr.nsopr);
Ifile.writeln('BE,65,25,2,5,50,0,1,'+attrval.vstring); //Штрих код
Ifile.writeln('AA,65,90,1,1,1,0,'+locase(trim(substr(katmc.name,1,20)))); //наименование
Ifile.writeln('AA,65,105,1,1,1,0,'+locase(trim(substr(katmc.name,21,40)))); //наименование
Ifile.writeln('AI,65,135,2,1,1,0,'+string(rzkutprih.pprice)+'р.');
Ifile.writeln('E');
Ifile.close();
CopyMoveFile('c:\ez2p.txt','lpt1',false);
}
window Win_MC 'Выбор позиции' (,,sci178InsPM), Escclose; // "Подробно"
show(1,1,80,30)
screen Scr_Group_Select;
show(,,,2)
fields
itoglabel:protect,skip;
itogsumprod:[8.2],protect,skip;
Buttons
cmPrintOne;
cmPrintAll;
cmOk,default;
cmTov;
cmCancel;
<<
Количество этикеток в накладной .@@@@
Общая сумма по накладной .@@@@@@@@@@
<. Печать .> <.Печать всеx.> <. Срок годности .> <.Товарный отчет.> <. Выход .>
>>
end;
Panel Pnl_MC;
show(,3,,)
browse Brw_MC;
table rzkutprih;
fields
katmc.name 'Наименование МЦ':[50],protect;
attrval.vstring 'Штрих код':[15],protect;
if(date(31,12,2100)<>katparty.dgodn,katparty.dgodn,'') 'Годен до':[10, 'DD/MM/YYYY'],protect;
string(round(rzkutprih.pprice,2)) 'Цена':[10],protect;
string(round(rzkutprih.kol,2)) 'Кол-во':[10],protect;
string(round(rzkutprih.kol*rzkutprih.pprice,2)) 'Сумма':[10],protect;
end;
end;
HandleEvent
cmInit:
{
if getfirst naklto<>tsOk then insert in naklto set naklto.nrec:=katsopr.nrec;
itoglabel:=0;
itogsumprod:=0;
_loop rzkutprih
{
// update current rzkutprih set rzkutprih.pprice:=trunc(pprice,1);
itoglabel:=itoglabel+longint(rzkutprih.kol);
itogsumprod:=itogsumprod+rzkutprih.pprice*rzkutprih.kol;
}
}
cmTov:
{
_loop rzkutprih
{
}
message('В разработке ...');
}
cmOk:
{ var datgodn, olddate:date;
olddate:=katparty.dgodn;
// datgodn:=olddate;
datgodn := date(0,0,0);
if(date(31,12,2100)<>katparty.dgodn) then datgodn:=katparty.dgodn;
RunDialog('GetDate',datgodn);
if (olddate<>datgodn and string(datgodn)<>'ДД/ММ/ГГГГ') then {
// message(datgodn);
update current katparty set katparty.dgodn:=datgodn;
rereadrecord(#rzkutprih);
RescanPanel (#rzkutprih);
}
}
cmPrintAll:
{
var kolbar:longint;
_loop rzkutprih
{
kolbar:=longint(rzkutprih.kol);
PrintLabel(kolbar);
}
getfirst rzkutprih;
}
cmPrintOne:
{
var kolbar:longint;
kolbar:=longint(rzkutprih.kol);
RunDialog('GetKol',kolbar);
PrintLabel(kolbar);
}
cmCancel:
{
delete all from naklto;
rereadrecord(#katsopr);
CloseWindow(Win_MC);
}
end;
end;
screen NakToBdfScr
show at(,,,3);
fields
Apteka: [List ''],Protect;
buttons
cmOK;
cmPrnt;
cmPrn,default;
cmKorrect;
cmCancel;
<<
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
<. Выгрузить .> <. Распечатать .> <. Подробно .> <.Корректировать цены.> <. Закрыть .>
>>
end;
panel P1
show at(,4,,);
browse Bro1
table katsopr;
fields
if (katsopr.mtara=1, '+', '-'):[1],skip, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
if (isValid(#_naklto), 'v', ''):[1],skip, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katsopr.dsopr 'Дата':[10],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katsopr.descr 'Дескриптор':[10],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katsopr.nsopr 'Номер':[10],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katpodrfrom.name 'Откуда':[25],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katpodrto.name 'Куда':[25],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
katsopr.summa 'Сумма':[10],protect, {FONT = { Italic = IF( isvalid(tn_naklto),True, false)}}, {FONT = { COLOR = IF( isvalid(tn_naklto), 3, 0)}};
end;
end;
handleevent
// Always Message (CurCommand);
cmMarkUnMark:// message ('cmMarkUnMark');
{
if not isValid(#_naklto)
{
insert in naklto set naklto.nrec:=katsopr.nrec;
if getnext katsopr = tsOk {}
}
else
{
delete from naklto where ((katsopr.nrec==naklto.nrec));
if getnext katsopr = tsOk {}
}
RescanPanel (#katsopr);
}
cmSelectAll: //message ('cmSelectAll');
{
PushPos(tnkatsopr);
_loop katsopr if not isValid(#_naklto) insert in naklto set naklto.nrec:=katsopr.nrec;
PopPos(tnkatsopr);
RescanPanel (#katsopr);
}
cmUnSelectAll:// message ('cmUnSelectAll');
{
PushPos(tnkatsopr);
// _loop katsopr if isValid(#_naklto) delete from _naklto where ((katsopr.nrec==nrec));
delete all from naklto;
PopPos(tnkatsopr);
RescanPanel (#katsopr);
}
cmInvertAll: //message ('cmInvertAll');
{ // Обработка клавиши "Gray *"
PushPos(tnkatsopr);
_loop katsopr
if not isValid(#_naklto)
{
insert in naklto set naklto.nrec:=katsopr.nrec;
}
else
{
delete from naklto where ((katsopr.nrec==naklto.nrec));
}
PopPos(tnkatsopr);
RescanPanel (#katsopr);
};
cmPrnt:
{
var XlRes: Boolean;
var aFileName: String;
var i,j:integer;
if getfirst naklto<>tsOk then insert in naklto set naklto.nrec:=katsopr.nrec;
RescanPanel (#katsopr);
XlRes := True;
aFileName := GetStringParameter('Files','OutputFilesDirectory',0) +'rozn.xls';
DeleteFile(aFileName);
XlRes := xlCreateExcel((aFileName), True);
if (XlRes) XlRes := xlIsExcelValid;
If (not XlRes) {
StopVisual('',0);
message('Ошибка создания EXEL файла');
Exit;
}
i:=0;
xlCreateMatrix ( 1000, 10 );
_loop naklto {
getfirst katsopr where ((naklto.nrec==katsopr.nrec));
i:=i+1;
xlSTWriteToMatrix(i,1,'Розничная накладная N'+katsopr.nsopr+' от '+string(katsopr.dsopr));
i:=i+1;
xlSetFontStyle ( xlBold, i , 1 , i, 1);
j:=i;
_loop rzkutprih {
i:=i+1;
xlSTWriteToMatrix(i,1,katmc.name);
xlSTWriteToMatrix(i,2,katmc.barkod);
xlSTWriteToMatrix(i,3,attrval.vstring);
xlDOWriteToMatrix(i,4,rzkutprih.pprice);
xlDOWriteToMatrix(i,5,rzkutprih.kol);
xlSTWriteToMatrix(i,6,'=RC[-1]*RC[-2]');
}
i:=i+1;
i:=i+1;
xlSTWriteToMatrix(i,1,'Сумма по накладной');
xlSTWriteToMatrix(i,6,'=sum(R[-'+string(i-j-1)+']C:R[-1]C)');
xlSetFontStyle ( xlBold, i , 1 , i, 4);
}
xlWriteMatrixToExcel ( 1, 1 );
xlFreeMatrix;
xlSetNumberFormat ( '0', 1, 2, MaxExcelRow, 3 );
xlSetNumberFormat ( '# ##0,00', 1, 4, MaxExcelRow, 6 );
xlAutoFit(1,1,MaxExcelRow , MaxExcelCol);
xlKillExcel;
}
cmOk:
{
var hDBFh:longint;
var dir:string;
var code:string;
var i,atten:integer;
atten:=0;
//if RecordsInTable (#katsopr)=0 then message('Накладные отсутвуют') else {
if not isvalid(#katsopr) then message('Накладные отсутвуют') else {
if getfirst naklto<>tsOk then insert in naklto set naklto.nrec:=katsopr.nrec;
RescanPanel (#katsopr);
if not Ifile.OpenFile ('c:\nakltodbf.txt', stCreate) message ('Ошибка создания файла c:\nakltodbf.txt!', Error);
Ifile.writeln('Пользователем '+username+' в '+string(cur_time)+' '+string(cur_date)+' была произведена выгрузка:');
Ifile.writeln(' ');
dir:='e:\ExpImp\'+ListAptek[Apteka];
createdirectory(dir);
if not F.OpenFile (dir+'\update.txt', stCreate) message ('Ошибка создания файла! '+dir+'\update.txt', Error);
{
F.Writeln(DocBasFn866to1251('##@@&&'));
F.Writeln(DocBasFn866to1251('#'));
//Ifile.Writeln(DocBasFn866to1251('');
StartNewVisual(vtRotateVisual, vfTimer+vfBreak+vfConfirm,'Подождите, идет выгрузка ...', RecordsInTable(#naklto));
_loop naklto
{
getfirst katsopr where ((naklto.nrec==katsopr.nrec));
Ifile.writeln('Розничная накладная N'+katsopr.nsopr+' от '+string(katsopr.dsopr));
_loop rzkutprih {
code:=substr(katmc.barkod,1,6)+replace(lpad(replace(doubletostr(pprice,'6666,88'),',',''),6),' ','0');
i:=integer(substr(code,2,1))+integer(substr(code,4,1))+integer(substr(code,6,1))+integer(substr(code,8,1))+integer(substr(code,10,1))+integer(substr(code,12,1));
i:=i*3+integer(substr(code,1,1))+integer(substr(code,3,1))+integer(substr(code,5,1))+integer(substr(code,7,1))+integer(substr(code,9,1))+integer(substr(code,11,1));
i:=integer(substr(string(i),length(string(i)),1));
if i=0 then code:=code+'0' else code:=code+string(10-i);
if not isvalid(tnattrval) then insert into attrval set
attrval.vstring:=code,
attrval.wtable:=word(1430),
attrval.crec:=katparty.nrec,
attrval.cattrnam:=attrnam.nrec;
else if attrval.vstring<>code then {
Ifile.writeln('ВНИМАНИЕ МЦ '+katmc.name+' партия '+katparty.name+' переприсвоен штрихкод с '+attrval.vstring+' на '+code);
update current attrval set attrval.vstring:=code;
}
rereadrecord(tnattrval);
if (rzkutprih.pprice!=trunc(rzkutprih.pprice,1)) then atten:=1;
F.Writeln(DocBasFn866to1251(code+';'+code+';'+katmc.name+';'+katmc.name+';'+string(rzkutprih.pprice)+';'+string(round(rzkutprih.kol,2))+';;1;1;;;;;;;;1'));
Ifile.writeln(' '+substr(katmc.barkod,1,6)+' '+ attrval.vstring +' '+replace(lpad(doubletostr(pprice,'66666.88'),7),' ','0')+' '+katmc.name+' '+string(round(rzkutprih.kol,2)));
if isvalid(tndattrval) then if longint(trim(dattrval.vstring))>1 then {
// F.Writeln(DocBasFn866to1251('#'+code+';'+code+';1/'+trim(dattrval.vstring)+' '+katmc.name+';1/'+trim(dattrval.vstring)+' '+katmc.name+';'+doubletostr( round(rzkutprih.pprice/integer(trim(dattrval.vstring))+0.049,1),'66666.88')+';;;;;'+doubletostr(1/integer(trim(dattrval.vstring)),'66666.888')));
F.Writeln(DocBasFn866to1251('#'+code+';'+code+';1/'+trim(dattrval.vstring)+' '+katmc.name+';1/'+trim(dattrval.vstring)+' '+katmc.name+';'+doubletostr( round(rzkutprih.pprice/integer(trim(dattrval.vstring))+0.049,1),'66666.88')+';;;;;'+doubletostr(1/integer(trim(dattrval.vstring)),'66666.888888')));
Ifile.writeln(katmc.name+' Делитель '+trim(dattrval.vstring)+' '+doubletostr( round(rzkutprih.pprice/integer(trim(dattrval.vstring))+0.049,1),'66666.88'));
}
if (not nextvisual) break;
}
update katsopr where ((naklto.nrec==katsopr.nrec)) set mtara:=1;
}
StopVisual('Выгрузка произведена',0);
F.Close();
CopyMoveFile (dir+'\update.txt',dir+'\Updates\update.txt.'+ DateToStr(Cur_Date, 'YYYYMMDD') +'-'+TimeToStr(Cur_Time,'HHMMSS') +'-'+sGetTune('USER.DESCR'),false);
delete all from naklto;
rereadrecord(#katsopr);
Ifile.Close();
ProcessText('c:\nakltodbf.txt',vfDefault Or vfEscable Or vfNewTitle,'Отчет о выгруженных в розницу товарах');
}
}
if atten>0 then message('Внимание! В выгрузке присутствуют неокругленные цены',warning);
}
cmCancel:
{
delete all from naklto;
}
cminit:
{
SetLimit(ListAptek,RecordsInTable(#katpodrto));
i:=0;
_loop katpodrto
{
ListAptek[i]:=katpodrto.name;
i:=i+1;
}
SetEnumList(NakToBdfScr, 0 , ListAptek);
getfirst katpodrto where ((ListAptek[Apteka]==katpodrto.name));
ToNrec:=katpodrto.nrec;
getlast katsopr;
}
cmCheckField:
{
case CurField of
#Apteka:
{
if ListAptek[Apteka]<>katpodrto.name then
{
// message('delete all from naklto;');
delete all from naklto;
getfirst katpodrto where ((ListAptek[Apteka]==katpodrto.name));
ToNrec:=katpodrto.nrec;
rereadrecord(#katsopr);
}
}
end;
}
cmPrn:
{
RunWindowModal(Win_MC);
}
cmKorrect:
{
if getfirst naklto<>tsOk then message('Не выбрано ни одной накладной')
else
{
_loop naklto
{
if katsopr.dsopr=date(17,05,2005) and katsopr.nsopr='000001' then _loop rzkutprih update current rzkutprih set rzkutprih.pprice:=round(round(pprice,2),1);
if katsopr.dsopr=date(17,05,2005) and katsopr.nsopr='000002' then _loop rzkutprih update current rzkutprih set rzkutprih.pprice:=round(round(pprice,2),1);
if katsopr.dsopr=date(19,05,2005) and katsopr.nsopr='000003' then _loop rzkutprih update current rzkutprih set rzkutprih.pprice:=round(round(pprice,2),1);
if katsopr.dsopr=date(19,05,2005) and katsopr.nsopr='000004' then _loop rzkutprih update current rzkutprih set rzkutprih.pprice:=round(round(pprice,2),1);
_loop rzkutprih update current rzkutprih set rzkutprih.pprice:=trunc(pprice,1);
}
message('Цены скорректированы');
}
}
end;
end.
GetKol DIALOG
Fields
kol :longint;
Buttons
cmOk,Default;
<<'Количество'
.@@@@@@@@@@
<. ~В~вод .>
>>
// Печать на BZB
// if not Ifile.OpenFile ('c:\ez2.txt', stCreate) message ('Ошибка создания файла! c:\ez2.txt', Error);
// Ifile.writeln('sS1D3Q016?EBM15A02'+'АПТЕКА ВЕКТОР-ФАРМ');
// Ifile.writeln('M15A22{'+attrval.vstring+'}');
// Ifile.writeln('M15A02'+katmc.name);
// Ifile.writeln('M15A22'+string(round(rzkutprih.pprice,2))+'р.');
// case length(string(kolbar)) of
// 1: Ifile.writeln('EP0'+string(kolbar)+'e');
// 2: Ifile.writeln('EP'+string(kolbar)+'e');
// 3,4: Ifile.writeln('Ep'+string(kolbar)+'e');
// end;
// Ifile.close();
// CopyMoveFile('c:\ez2.txt','lpt1',false);
GetDate DIALOG
Fields
//datgodn :date, noprotect;
datgodn:date [10, 'DD/MM/YYYY'],pickbutton,noprotect;
Buttons
cmOk,Default;
cmCancel;
<<'Дата'
.@@@@@@@@@@
<. ~В~вод .> <.Отмена.>
>>
Код: Выделить всё
CopyMoveFile('c:\ez2p.txt','lpt1',false);