Галактика в вопросах и ответах

Код: Выделить всё

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);