348 lines
17 KiB
ObjectPascal
348 lines
17 KiB
ObjectPascal
unit Globalni;
|
|
|
|
interface
|
|
|
|
uses System.SysUtils, System.Win.ComObj, ddPlugin_TLB;
|
|
|
|
const strLov = '40755509 LOVATO spol.s r.o.';
|
|
CRLF = #13#10;
|
|
sklVyroba = '200';
|
|
|
|
//vytvoøeno 10.6.2022// z funkce ExportKoopObj v ComObject upravené 6.5.2020
|
|
function ExportKoopObjXls(const Helios: IHelios; idKObj: integer; ZobrTypKooObj: boolean; NadpisTypuKoopObj: string; vlastTbl: string; Cesta: string; Nazev: string; ZobrazInfoKonec: Integer): string; safecall;
|
|
|
|
|
|
implementation
|
|
|
|
uses Vcl.Controls, System.Win.ComServ, Vcl.Graphics, Vcl.Forms, System.Variants, System.StrUtils, Vcl.Dialogs,
|
|
Vcl.Clipbrd, System.Classes, Winapi.Windows, System.DateUtils, Vcl.StdActns, Winapi.ShlObj, Vcl.StdCtrls,
|
|
Vcl.ComCtrls, myUtils, helUtils, XLSReadWriteII5, XLSSheetData5, Xc12DataStyleSheet5, Xc12Utils5//, // nExcel,
|
|
;
|
|
|
|
//procedure ExportKoopObj(const Helios: IHelios; idKObj: integer; ZobrTypKooObj: boolean; NadpisTypuKoopObj: string; vlastTbl: string); safecall; // upraveno 6.5.2020
|
|
|
|
// upraveno 6.5.2020
|
|
function ExportKoopObjXls (const Helios: IHelios; idKObj: integer; ZobrTypKooObj: boolean; NadpisTypuKoopObj: string; vlastTbl: string; Cesta: string; Nazev: string; ZobrazInfoKonec: Integer): string;
|
|
var lSQL, fld: string;
|
|
jCena: Extended;
|
|
xls: TXLSReadWriteII5;
|
|
wSheet1, wSheet2: TXLSWorksheet;
|
|
poz: IHeQuery;
|
|
idPolKObj, idKZ, idx, idDZCenik: integer;
|
|
cObj, cOrg, dodav, dat, datKO: string;
|
|
listSumace: boolean;
|
|
VybranyAdresar: boolean; // pøidáno 10.6.2022
|
|
NazevSouboru: String; // pøidáno 10.6.2022
|
|
Vysledek: String; // pøidáno 10.6.2022
|
|
begin
|
|
|
|
// Helios.Info('ID: "' + IntToStr(idKObj) + '", ZobrTypKooObj:"' + BoolToStr(ZobrTypKooObj) + '", NadpisTypuKoopObj"' + NadpisTypuKoopObj + '", Zarovnani: "' + vlastTbl + '", cesta: "' + Cesta + '", Nazev: "' + Nazev + '", ZobrazInfoKonec: "'+ IntToStr(ZobrazInfoKonec) + '"');
|
|
|
|
listSumace:= false;
|
|
|
|
Vysledek := '**_CHYBA_**';
|
|
if (idKObj>0) then
|
|
begin
|
|
|
|
// lSQL:= 'SELECT p.Polozka,p.Kusy,p.PozadTerDod_X,k.RegCis FROM ' + tblPKObj + ' p INNER JOIN ' + tblPrikaz + ' pr ON (p.IDPrikaz=pr.id)';
|
|
// lSQL:= lSQL + ' INNER JOIN ' + tblKZ + ' k ON (pr.IdTabKmen=k.id) WHERE p.IDObjednavky=' + IntToStr(idKObj);
|
|
// lSQL:= lSQL + ' ORDER BY p.Polozka';
|
|
|
|
// lSQL:= 'SELECT DISTINCT(kz.RegCis),pko.PozadTerDod,SUM(pko.Kusy) FROM ' + tblPKObj + ' pko'; // zakomentováno 6.5.2020
|
|
lSQL:= 'SELECT DISTINCT(kz.RegCis), pko.PozadTerDod,SUM(pko.Kusy), dbo._ef_NTS_TypObjednavkyKZKooP(kz.id, pko.id) FROM ' + tblPKObj + ' pko'; // pøidáno 6.5.2020
|
|
lSQL:= lSQL + ' INNER JOIN ' + tblPrikaz + ' p ON (pko.IDPrikaz=p.id) INNER JOIN ' + tblKZ + ' kz ON (p.IDTabKmen=kz.id)';
|
|
lSQL:= lSQL + ' WHERE pko.IDObjednavky=' + IntToStr(idKObj) + ' GROUP BY kz.RegCis,pko.PozadTerDod, dbo._ef_NTS_TypObjednavkyKZKooP(kz.id, pko.id) ORDER BY pko.PozadTerDod'; // kz.RegCis'; // pøidáno 6.5.2020
|
|
// lSQL:= lSQL + ' WHERE pko.IDObjednavky=' + IntToStr(idKObj) + ' GROUP BY kz.RegCis,pko.PozadTerDod ORDER BY pko.PozadTerDod'; // kz.RegCis'; // zakomentováno 6.5.2020
|
|
|
|
poz:= Helios.OpenSQL(lSQL);
|
|
if (poz.RecordCount>0) then
|
|
begin
|
|
cOrg:= '';
|
|
datKO:= '';
|
|
|
|
lSQL:= 'SELECT c.CisloOrg, k.TerminOdeslani FROM ' + tblKObj + ' k INNER JOIN ' + tblCOrg + ' c ON (k.IDOrganizace=c.id) WHERE k.id=' + IntToStr(idKObj);
|
|
with Helios.OpenSQL(lSQL) do
|
|
if (RecordCount=1) then
|
|
begin
|
|
if not(VarIsNull(FieldByNameValues('CisloOrg'))) then
|
|
cOrg:= VarToStr(FieldByNameValues('CisloOrg'));
|
|
if not(VarIsNull(FieldByNameValues('TerminOdeslani'))) then
|
|
datKO:= VarToStr(FieldByNameValues('TerminOdeslani'));
|
|
end;
|
|
|
|
idDZCenik:= 0;
|
|
if (cOrg<>'') and (datKO<>'') then
|
|
begin
|
|
lSQL:= 'DECLARE @dat DATETIME, @cnt INT' + CRLF + 'SET @dat=CONVERT(datetime,N' + datKO.QuotedString + ', 104)' + CRLF
|
|
+ 'SELECT COUNT(d.ID) AS Pocet FROM ' + tblDZ + ' d INNER JOIN ' + tblDZe + ' de ON (de.ID=d.ID)'
|
|
+ ' WHERE d.IDSklad=N' + sklVyroba.QuotedString + ' AND d.CisloOrg=' + cOrg + ' AND d.RadaDokladu=N''220'' AND d.DruhPohybuZbo=11'
|
|
+ ' AND @dat BETWEEN d.Splatnost AND d.DatUhrady AND dbo.hfx_SD_AktualniUrovenSchvalovani(d.ID, 0)=9999';
|
|
with Helios.OpenSQL(lSQL) do
|
|
if (RecordCount>0) then
|
|
if (VarToStr(FieldByNameValues('Pocet')).ToInteger)>1 then
|
|
begin
|
|
Helios.Error('Pro daného dodavatele existuje víc platných Nabídkových ceníkù !' + CRLF + 'Export nebude proveden');
|
|
Exit;
|
|
end;
|
|
|
|
lSQL:= 'DECLARE @idDZ INT=0, @dat DATETIME' + CRLF
|
|
+ 'SET @dat=CONVERT(datetime,N' + datKO.QuotedString + ', 104)' + CRLF
|
|
+ 'IF EXISTS(SELECT 1 FROM ' + tblDZ + ' d INNER JOIN ' + tblDZe + ' de ON (de.ID=d.ID)'
|
|
+ ' WHERE d.IDSklad=N' + sklVyroba.QuotedString + ' AND d.CisloOrg=' + cOrg + ' AND d.RadaDokladu=N''220'' AND d.DruhPohybuZbo=11'
|
|
+ ' AND @dat BETWEEN d.Splatnost AND d.DatUhrady AND dbo.hfx_SD_AktualniUrovenSchvalovani(d.ID, 0)=9999)' + CRLF
|
|
+ ' SET @idDZ=(SELECT d.ID FROM ' + tblDZ + ' d INNER JOIN ' + tblDZe + ' de ON (de.ID=d.ID)'
|
|
+ ' WHERE d.IDSklad=N' + sklVyroba.QuotedString + ' AND d.CisloOrg=' + cOrg + ' AND d.RadaDokladu=N''220'' AND d.DruhPohybuZbo=11'
|
|
+ ' AND @dat BETWEEN d.Splatnost AND d.DatUhrady AND dbo.hfx_SD_AktualniUrovenSchvalovani(d.ID, 0)=9999)' + CRLF + 'SELECT @idDZ AS idDoklad';
|
|
with Helios.OpenSQL(lSQL) do
|
|
idDZCenik:= VarToStr(FieldByNameValues('idDoklad')).ToInteger;
|
|
end;
|
|
|
|
|
|
// pøidáno 10.6.2022
|
|
VybranyAdresar := false;
|
|
|
|
if trim(cesta) <> '' then
|
|
begin
|
|
fld := cesta;
|
|
VybranyAdresar := true;
|
|
end
|
|
else
|
|
begin
|
|
// fld:= GetEnvironmentVariable('USERPROFILE') + '\Desktop';
|
|
VybranyAdresar := VyberAdresar(fld, 'Umístìní exportního souboru');
|
|
end;
|
|
// konec pøidání 10.6.2022
|
|
|
|
cObj:= '';
|
|
dodav:= '';
|
|
|
|
// if VyberAdresar(fld, 'Umístìní exportního souboru') then // zakomentováno 10.6.2022
|
|
if VybranyAdresar then // pøidáno 10.6.202
|
|
begin
|
|
lSQL:= 'SELECT k.Objednavka, (c.ICO + N' + QuotedStr(' ') + ' + c.Nazev) AS Nazev, k.TerminOdeslani FROM ' + tblKObj;
|
|
lSQL:= lSQL + ' k INNER JOIN ' + tblCOrg + ' c ON (k.IDOrganizace=c.id) WHERE k.id=' + IntToStr(idKObj);
|
|
with Helios.OpenSQL(lSQL) do
|
|
begin
|
|
cObj:= VarToStr(FieldByNameValues('Objednavka'));
|
|
dodav:= VarToStr(FieldByNameValues('Nazev'));
|
|
datKO:= VarToStr(FieldByNameValues('TerminOdeslani'));
|
|
end;
|
|
cObj:= StringReplace(cObj,'/','',[rfReplaceAll]);
|
|
|
|
xls:= TXLSReadWriteII5.Create(nil);
|
|
try
|
|
xls.Version:= xvExcel97;
|
|
if (listSumace) then
|
|
begin
|
|
wSheet2:= xls.Sheets[0];
|
|
wSheet2.Name:= 'Sumace';
|
|
// xls[1].InsertRows(0,poz.RecordCount);
|
|
// xls[1].InsertColumns(0,7);
|
|
wSheet2.AsString[0,0]:= 'Objednavatel';
|
|
wSheet2.AsString[2,0]:= strLov;
|
|
wSheet2.AsString[0,2]:= 'Dodavatel:';
|
|
wSheet2.AsString[2,2]:= dodav;
|
|
wSheet2.AsString[0,4]:= 'Datum vystavení:';
|
|
wSheet2.AsString[2,4]:= datKO;
|
|
wSheet2.AsString[0,6]:= 'Èís.obj.';
|
|
wSheet2.AsString[1,6]:= 'Poø.è.';
|
|
wSheet2.Columns.Items[1].NumberFormat:= '##0';
|
|
wSheet2.Columns.Items[1].HorizAlignment:= chaCenter;
|
|
wSheet2.AsString[2,6]:= 'Èíslo výrobku';
|
|
wSheet2.AsString[3,6]:= 'Množství';
|
|
wSheet2.Columns.Items[3].NumberFormat:= '###,##0.###';
|
|
wSheet2.AsString[4,6]:= 'Splnit do';
|
|
wSheet2.Columns.Items[4].NumberFormat:= 'DD.MM.YYYY';
|
|
wSheet2.Columns.Items[4].HorizAlignment:= chaCenter;
|
|
|
|
// pøidáno 6.5.2020
|
|
if ZobrTypKooObj then
|
|
begin
|
|
wSheet2.AsString[5,6]:= NadpisTypuKoopObj;
|
|
if (vlastTbl='NaStred') then
|
|
wSheet2.Columns.Items[5].HorizAlignment:= chaCenter;
|
|
if (vlastTbl='Vpravo') then
|
|
wSheet2.Columns.Items[5].HorizAlignment:= chaRight;
|
|
end;
|
|
// konec pøidáno 6.5.2020
|
|
|
|
idx:= 7;
|
|
poz.First;
|
|
while not(poz.EOF) do
|
|
begin
|
|
wSheet2.AsString[0, idx]:= cObj;
|
|
wSheet2.AsInteger[1, idx]:= idx-6; // VarToStr(poz.FieldValues(0));
|
|
wSheet2.AsString[2, idx]:= VarToStr(poz.FieldValues(0)); // RegCis
|
|
wSheet2.AsFloat[3, idx]:= StrToFloat(VarToStr(poz.FieldValues(2))); // mnozstvi
|
|
|
|
dat:= VarToStr(poz.FieldValues(1));
|
|
if (dat<>'') then
|
|
wSheet2.AsString[4, idx]:= dat;
|
|
|
|
// pøidáno 6.5.2020
|
|
if ZobrTypKooObj then
|
|
wSheet2.AsString[5, idx]:= VarToStr(poz.FieldValues(3)); // Typ objednávky - poznámka z kmenové karty
|
|
// konec pøidáno 6.5.2020
|
|
|
|
Inc(idx);
|
|
poz.Next;
|
|
end;
|
|
wSheet2.AutoWidthCols(0, 4);
|
|
end;
|
|
|
|
|
|
// if Helios.YesNo('Mám pøerovnat položky objednávky podle datumu a reg.èísla ?',false) then
|
|
// PrerovnejPolozkyKoopObj(Helios,idKObj);
|
|
|
|
// lSQL:= 'SELECT pko.Polozka,kz.RegCis,pko.Kusy,pko.PozadTerDod_X FROM ' + tblPKObj + ' pko'; // zakomentováno 6.5.2020
|
|
lSQL:= 'SELECT pko.Polozka, kz.RegCis, pko.Kusy, pko.PozadTerDod_X, dbo._ef_NTS_TypObjednavkyKZKooP(kz.id, pko.id), kz.ID AS IDKmen'
|
|
+ ' FROM ' + tblPKObj + ' pko' // pøidáno 6.5.2020
|
|
+ ' INNER JOIN ' + tblPrikaz + ' p ON (pko.IdPrikaz=p.id)'
|
|
+ ' INNER JOIN ' + tblKZ + ' kz ON (p.IdTabKmen=kz.id)'
|
|
+ ' WHERE pko.IDObjednavky=' + IntToStr(idKObj);
|
|
|
|
{
|
|
lSQL:= 'CREATE TABLE #Vystup (Pozice INT IDENTITY(1,1),RegCis NVARCHAR(20),Polozka INT,Kusu NUMERIC(19,6)) ' + CRLF;
|
|
lSQL:= lSQL + 'INSERT INTO #Vystup (RegCis,Polozka,Kusu) ';
|
|
lSQL:= lSQL + 'SELECT DISTINCT(kz.RegCis),pko.Polozka,SUM(pko.Kusy) FROM ' + tblPKObj + ' pko';
|
|
lSQL:= lSQL + ' INNER JOIN ' + tblPrikaz + ' p ON (pko.IDPrikaz=p.id) INNER JOIN ' + tblKZ + ' kz ON (p.IDTabKmen=kz.id)';
|
|
lSQL:= lSQL + ' WHERE pko.IDObjednavky=' + IntToStr(idKObj) + ' GROUP BY kz.RegCis,pko.Polozka ORDER BY pko.Polozka' + CRLF;
|
|
lSQL:= lSQL + 'SELECT * FROM #Vystup';
|
|
}
|
|
poz:= Helios.OpenSQL(lSQL);
|
|
if (poz.RecordCount>0) then
|
|
begin
|
|
poz.First;
|
|
idx:= 7;
|
|
if (listSumace) then
|
|
wSheet1:= xls.Add
|
|
else
|
|
wSheet1:= xls.Sheets[0];
|
|
wSheet1.Name:= 'Detail';
|
|
wSheet1.AsString[0,0]:= 'Objednavatel';
|
|
wSheet1.AsString[2,0]:= strLov;
|
|
wSheet1.AsString[0,2]:= 'Dodavatel:';
|
|
wSheet1.AsString[2,2]:= dodav;
|
|
wSheet1.AsString[0,4]:= 'Datum vystavení:';
|
|
wSheet1.AsString[2,4]:= datKO;
|
|
wSheet1.AsString[0,6]:= 'Èís.obj.';
|
|
wSheet1.AsString[1,6]:= 'Poø.è.';
|
|
wSheet1.Columns.Items[1].NumberFormat:= '##0';
|
|
wSheet1.Columns.Items[1].HorizAlignment:= chaCenter;
|
|
wSheet1.AsString[2,6]:= 'Èíslo výrobku';
|
|
wSheet1.AsString[3,6]:= 'Množství';
|
|
wSheet1.Columns.Items[3].NumberFormat:= '###,##0.###';
|
|
wSheet1.AsString[4,6]:= 'Splnit do';
|
|
wSheet1.Columns.Items[4].NumberFormat:= 'DD.MM.YYYY';
|
|
wSheet1.Columns.Items[4].HorizAlignment:= chaCenter;
|
|
|
|
// pøidáno 6.5.2020
|
|
if ZobrTypKooObj then
|
|
begin
|
|
wSheet1.AsString[5,6]:= NadpisTypuKoopObj;
|
|
if (vlastTbl='NaStred') then
|
|
wSheet1.Columns.Items[5].HorizAlignment:= chaCenter;
|
|
if (vlastTbl='Vpravo') then
|
|
wSheet1.Columns.Items[5].HorizAlignment:= chaRight;
|
|
|
|
wSheet1.AsString[6,6]:= 'JCena';
|
|
wSheet1.Columns.Items[6].NumberFormat:= '###,##0.###';
|
|
end
|
|
// konec pøidáno 6.5.2020
|
|
else
|
|
begin
|
|
wSheet1.AsString[5,6]:= 'JCena';
|
|
wSheet1.Columns.Items[5].NumberFormat:= '###,##0.###';
|
|
end;
|
|
|
|
|
|
while not(poz.EOF) do
|
|
begin
|
|
wSheet1.AsString[0, idx]:= cObj;
|
|
wSheet1.AsInteger[1, idx]:= VarToStr(poz.FieldByNameValues('Polozka')).ToInteger; // polozka
|
|
wSheet1.AsString[2, idx]:= VarToStr(poz.FieldByNameValues('RegCis')); // RegCis
|
|
wSheet1.AsFloat[3, idx]:= StrToFloat(VarToStr(poz.FieldByNameValues('Kusy'))); // mnozstvi
|
|
|
|
dat:= '';
|
|
if not(VarIsNull(poz.FieldByNameValues('PozadTerDod_X'))) then
|
|
dat:= VarToStr(poz.FieldByNameValues('PozadTerDod_X'));
|
|
if (dat<>'') then
|
|
wSheet1.AsString[4, idx]:= dat;
|
|
|
|
idKZ:= VarToStr(poz.FieldByNameValues('IDKmen')).ToInteger;
|
|
jCena:= 0;
|
|
if (idDZCenik>0) then
|
|
begin
|
|
lSQL:= 'SELECT TOP(1) CASE WHEN d.Mena=N''CZK'' THEN pz.JCbezDaniKcPoS ELSE pz.JCBezDaniValPoS END AS JCPolozky FROM '
|
|
+ tblPZ + ' pz INNER JOIN ' + tblSS + ' ss ON (ss.ID=pz.IDZboSklad) INNER JOIN ' + tblDZ
|
|
+ ' d ON (d.ID=pz.IDDoklad) WHERE d.ID=' + idDZCenik.ToString + ' AND ss.IDKmenZbozi=' + idKZ.ToString;
|
|
with Helios.OpenSQL (lSQL) do
|
|
if (RecordCount>0) then
|
|
jCena:= VarToStr(FieldByNameValues('JCPolozky')).ToDouble;
|
|
end;
|
|
|
|
// pøidáno 6.5.2020
|
|
if ZobrTypKooObj then
|
|
begin
|
|
wSheet1.AsString[5, idx]:= VarToStr(poz.FieldValues(4)); // Typ objednávky - poznámka z kmenové karty
|
|
if (jCena>0) then
|
|
wSheet1.AsFloat[6, idx]:= jCena;
|
|
end
|
|
// konec pøidáno 6.5.2020
|
|
else
|
|
if (jCena>0) then
|
|
wSheet1.AsFloat[5, idx]:= jCena;
|
|
|
|
|
|
Inc(idx);
|
|
poz.Next;
|
|
end;
|
|
wSheet1.AutoWidthCols(0, 4);
|
|
end;
|
|
|
|
if (listSumace) then
|
|
begin
|
|
xls.Sheets[0].Rows.Items[6].FontStyle:= [xfsBold];
|
|
xls.Sheets[0].Columns.Items[1].HorizAlignment:= chaCenter;
|
|
xls.Sheets[0].Columns.Items[3].HorizAlignment:= chaCenter;
|
|
xls.Sheets[0].Columns.Items[4].HorizAlignment:= chaCenter;
|
|
end;
|
|
|
|
if not(listSumace) then
|
|
xls.Sheets[0].Rows.Items[6].FontStyle:= [xfsBold]
|
|
else
|
|
xls.Sheets[1].Rows.Items[6].FontStyle:= [xfsBold];
|
|
|
|
//pøidáno 10.6.2022
|
|
if (Nazev.Trim<>'') then
|
|
NazevSouboru:= Nazev.Trim
|
|
else
|
|
NazevSouboru:= 'Obj-' + cObj + '.xls';
|
|
//konec pøidání 10.6.2022
|
|
|
|
//xls.SaveToFile(fld + '\Obj-' + cObj + '.xls'); // zakomentováno 10.6.2022
|
|
xls.SaveToFile(fld + '\' + NazevSouboru); // pøidáno 10.6.2022
|
|
Vysledek:= NazevSouboru; // pøidáno 10.6.2022
|
|
|
|
finally
|
|
xls.Free;
|
|
end;
|
|
|
|
if (ZobrazInfoKonec=1) then
|
|
Helios.Info('Export souboru ukonèen.');
|
|
end;
|
|
end
|
|
else
|
|
Helios.Error(#1'Kooperaèní objednávka neobsahuje žádnou položku.'#1);
|
|
end
|
|
else
|
|
Helios.Error(#1'Nelze identifikovat Kooperaèní objednávku.'#1);
|
|
|
|
ExportKoopObjXls := Vysledek;
|
|
|
|
end;
|
|
|
|
|
|
|
|
end.
|