Prvni verze

This commit is contained in:
2025-05-21 21:06:33 +02:00
parent a976e7392e
commit fedc940ac4
189 changed files with 72374 additions and 17 deletions

551
frmObjednavkaMat.pas Normal file
View File

@ -0,0 +1,551 @@
unit frmObjednavkaMat;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Data.DB, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.Mask,
IdHTTP, IdSSLOpenSSL, System.JSON, IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient,
ddPlugin_TLB, JvExDBGrids, JvDBGrid;
{$I iConsts.inc}
type
TformObjednavkaMat = class(TForm)
GridPanel1: TGridPanel;
grdObjednavkaMat: TJvDBGrid;
GridPanel2: TGridPanel;
GridPanel3: TGridPanel;
edtSZ: TEdit;
edtRC: TEdit;
edtNazev1: TEdit;
GridPanel4: TGridPanel;
edtMnoz: TLabeledEdit;
edtPalet: TLabeledEdit;
edtMnozVrat: TLabeledEdit;
btnNovaObj: TButton;
btnNovaVratka: TButton;
GridPanel5: TGridPanel;
edtMJ: TLabeledEdit;
edtNaPalete: TLabeledEdit;
btnUkazSeznamPalet: TButton;
GridPanel6: TGridPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
icmpCli: TIdIcmpClient;
procedure FormShow (Sender: TObject);
procedure grdObjednavkaMatDrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure FormResize (Sender: TObject);
procedure btnNovaObjClick (Sender: TObject);
procedure grdObjednavkaMatColExit (Sender: TObject);
procedure FormClose (Sender: TObject; var Action: TCloseAction);
procedure btnNovaVratkaClick (Sender: TObject);
procedure btnUkazSeznamPaletClick (Sender: TObject);
procedure grdObjednavkaMatMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure grdObjednavkaMatCellClick (Column: TColumn);
private
public
Helios: IHelios;
idKmen: integer;
vyrobniDen: TDateTime;
end;
var
formObjednavkaMat: TformObjednavkaMat;
sz, rc: string;
aktRow, aktCol: integer;
pingOK: boolean;
implementation
uses System.StrUtils, System.Math,
datMod, helUtils, frmSeznamPalet;
{$R *.dfm}
procedure TformObjednavkaMat.btnNovaObjClick (Sender: TObject);
var lSQL, jsonText, sarze, paletovyList, ph1, ph2, mj: string;
mn, napal, mnPL, mnSum, mnIn, mnInSum: Extended;
pal, i, x: integer;
lHTTP: TIdHTTP;
ssl: TIdSSLIOHandlerSocketOpenSSL;
lParamList, respStream: TStringStream;
resp: string;
joOut, joIn, itemsObj: TJSONObject;
ja: TJSONArray;
jv: TJSONValue;
errText: byte;
mamPrepocet: boolean;
prepMJPal: Single;
begin
errText:= 0;
mj:= helUtils.getHeliosStrVal(Helios, 'SELECT MJEvidence FROM ' + tblKZ + ' WHERE ID=' + idKmen.ToString, lSQL).ToLower;
prepMJPal:= 0;
mamPrepocet:= false;
if (helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 FROM ' + tblKZ + ' WHERE ID=' + idKmen.ToString + ' AND MJEvidence=N''KA''')) then
mamPrepocet:= true;
if (mj='kg') or (mj='ks') then
begin
lSQL:= 'SELECT PocetHlavni FROM ' + tblMJZbo + ' WHERE IDKmenZbozi=' + idKmen.ToString + ' AND KodMJ1=N' + mj.QuotedString + ' AND KodMJ2=N''pal''';
prepMJPal:= getHeliosFloatVal (Helios, 0, lSQL);
mamPrepocet:= (prepMJPal>0);
end;
edtMnoz.Text:= edtMnoz.Text.Trim;
edtPalet.Text:= edtPalet.Text.Trim;
if not(TryStrToFloat(edtMnoz.Text, mn)) then
mn:= 0;
if not(TryStrToInt(edtPalet.Text, pal)) then
pal:= 0;
if not(TryStrToFloat(edtNaPalete.Text, napal)) then
napal:= 0;
if (mn>0) or (pal>0) then
begin
mnSum:= mn;
if (pal>0) then
mnSum:= pal * napal;
if (mn>0) and (pal>0) then
Helios.Error(#1'Nelze zadat kombinaci, zadejte buď množství nebo počet palet.'#1)
else
begin
try
// param je stejny
lParamList:= TStringStream.Create('');
joOut:= TJSONObject.Create;
lSQL:= 'SELECT SkupZbo, RegCis FROM ' + tblKZ + ' WHERE ID=' + idKmen.ToString;
with Helios.OpenSQL(lSQL) do
begin
joOut.AddPair('skupzbo', VarToStr(FieldByNameValues('SkupZbo')));
joOut.AddPair('regcis', VarToStr(FieldByNameValues('RegCis')));
end;
joOut.AddPair('id', 0);
lParamList.WriteString(joOut.ToString);
// http klient je stejny
lHTTP:= TIdHTTP.Create;
if (datMod.phServer.Contains('https')) then
begin
ssl:= TIdSSLIOHandlerSocketOpenSSL.Create(nil);
ssl.SSLOptions.Method:= sslvTLSv1_2;
ssl.SSLOptions.Mode:= sslmUnassigned;
lHTTP.IOHandler:= ssl;
end;
lHTTP.HTTPOptions:= [hoKeepOrigProtocol, hoForceEncodeParams, hoNoProtocolErrorException, hoWantProtocolErrorContent];
lHTTP.Request.ContentType := 'application/ld+json';
lHTTP.Request.Accept := 'application/ld+json, text/javascript, */*; q=0.01';
jsonText:= '{"@context":"/api/contexts/Order","@id":"/api/orders/14","@type":"Order","id":14,"heliosId":null,"name":"Cukr krupice - big-bag - VPEK","skupzbo":"101","regcis":'
+ '"101002","paletovyList":"2010100200005","quantity":"4260.0000","items":[{"@id":"/api/material_order_items/12","@type":"MaterialOrderItem","id":12,"stockItem":{"@id":'
+ '"/api/stock_items/16","@type":"StockItem","id":16,"heliosId":40,"heliosPrijemkaId":1940},"stockItemFinal":null,"order":"/api/orders/14","name":"Cukr krupice - big-bag'
+ ' - VPEK","sarze":"645901","paletovyList":"2010100200005","quantity":"4260","dateExp":"2030-08-15T00:00:00+02:00","isCompleted":false,"completedAt":null}],"isCompleted"'
+ ':false,"isUserCompleted":false,"completedAt":null}';
jsonText:= '{"@context":"/api/contexts/Error","@type":"hydra:Error","hydra:title":"An error occurred","hydra:description":"Nebyla nalezena další položka suroviny pro naskladnĭ"'
+ ',"trace":[{"namespace":"","short_class":"","class":"","type":"","function":"","file":"/var/www/rootvin/src/Service/Rootvin/OrderManager.php","line":230,"args":[]},{"namespace"'
+ ':"App\\Service\\Rootvin","short_class":"OrderManager","class":"App\\Service\\Rootvin\\OrderManager","type":"-\u003E","function":"createOrder","file":"/var/www/rootvin/src/Service'
+ '/Rootvin/OrderManager.php","line":167,"args":[]},{"namespace":"App\\Service\\Rootvin","short_class":"OrderManager","class":"App\\Service\\Rootvin\\OrderManager","type":"-\u003E"'
+ ',"function":"createOrderByCard","file":"/var/www/rootvin/src/Controller/Api/HeliosOrderController.php","line":23,"args":[]},{"namespace":"App\\Controller\\Api","short_class"'
+ ':"HeliosOrderController","class":"App\\Controller\\Api\\HeliosOrderController","type":"-\u003E","function":"__invoke","file":"/var/www/rootvin/vendor/symfony/http-kernel/'
+ 'HttpKernel.php","line":169,"args":[]},{"namespace":"Symfony\\Component\\HttpKernel","short_class":"HttpKernel","class":"Symfony\\Component\\HttpKernel\\HttpKernel","type"'
+ ':"-\u003E","function":"handleRaw","file":"/var/www/rootvin/vendor/symfony/http-kernel/HttpKernel.php","line":81,"args":[]},{"namespace":"Symfony\\Component\\HttpKernel"'
+ ',"short_class":"HttpKernel","class":"Symfony\\Component\\HttpKernel\\HttpKernel","type":"-\u003E","function":"handle","file":"/var/www/rootvin/vendor/symfony/http-kernel'
+ '/Kernel.php","line":201,"args":[]},{"namespace":"Symfony\\Component\\HttpKernel","short_class":"Kernel","class":"Symfony\\Component\\HttpKernel\\Kernel","type":"-\u003E"'
+ ',"function":"handle","file":"/var/www/rootvin/public/index.php","line":25,"args":[]}]}';
// zadane mnozstvi, nulove palety
if (mn>0) and (pal=0) then
begin
mnInSum:= 0; // mnozstvi nactene z prijatych PL
while (mn>mnInSum) and (errText=0) do // pokud je nactene mnozstvi mensi nez pozadovane, nacitej dalsi PL
begin
// pokud nemam prepocet na palety, loop musi probehnout jen 1x
if not(mamPrepocet) then
mnInSum:= mn;
sarze:= '';
paletovyList:= '';
try
icmpCli.Host:= datMod.getDomainName (datMod.phServer);
try
icmpCLi.Ping();
Sleep(500);
pingOK:= (icmpCli.ReplyStatus.BytesReceived>0);
except
pingOK:= False;
end;
resp:= '';
if (pingOK) then
begin
respStream:= TStringStream.Create('');
lHTTP.Post (datMod.phServer + '/order', lParamList, respStream);
resp:= respStream.DataString.Replace('\/', '/');
end;
// log
if (helUtils.SQLObjectExists(Helios, tblHDCPHLog)) and (resp<>'') then
Helios.ExecSQL ('INSERT ' + tblHDCPHLog + ' (LogText, LogTextLong) SELECT N''Dotaz na objednávku materiálu (dle mnoz)'', N' + resp.QuotedString);
if (resp.Contains('neexistuje')) then
errText:= 1;
if (ContainsText(resp,'nebyla nalezena dal')) then
errText:= 2;
// resp:= jsonText;
if (resp<>'') and (resp.IndexOf('items')>0) and (errText=0) then
begin
joIn:= TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(resp), 0) as TJSONObject;
joIn.TryGetValue('id', ph1);
if (joIn.TryGetValue('items', ja) and (ja.Count > 0)) then
begin
for x:=0 to ja.Count-1 do
begin
ph2:= ja.Items[x].GetValue<string>('id');
paletovyList:= ja.Items[x].GetValue<string>('paletovyList');
sarze:= ja.Items[x].GetValue<string>('sarze');
mnPL:= ja.Items[x].GetValue<Extended>('quantity');
mnInSum:= mnInSum + mnPL;
if (sarze<>'') and (paletovyList<>'') then
begin
lSQL:= 'INSERT ' + tblObjednavky + ' (SkupZbo, RegCis, IDKmenZbozi, PaletovyList, Sarze, Mnozstvi, IdPHIdent, IdPHIdent2) SELECT N' + sz.QuotedString;
lSQL:= lSQL + ', N' + rc.QuotedString + ', ' + idKmen.ToString + ', N' + paletovyList.QuotedString + ', N' + sarze.QuotedString + ', ' + mnPL.ToString.Replace(',', '.');
lSQL:= lSQL + ', ' + ph1 + ', ' + ph2;
try
Helios.ExecSQL(lSQL);
finally
end;
end;
end;
end;
end
else
if (sarze='') and (paletovyList='') then
begin
lSQL:= 'INSERT ' + tblObjednavky + ' (SkupZbo, RegCis, IDKmenZbozi, PaletovyList, Sarze, Mnozstvi, IdPHIdent, IdPHIdent2) SELECT N' + sz.QuotedString;
lSQL:= lSQL + ', N' + rc.QuotedString + ', ' + idKmen.ToString + ', N' + paletovyList.QuotedString + ', N' + sarze.QuotedString + ', ' + mnPL.ToString.Replace(',', '.');
lSQL:= lSQL + ', ' + ph1 + ', ' + ph2;
try
Helios.ExecSQL(lSQL);
finally
end;
end;
finally
respStream.Free;
ja.Free;
// joIn.Free;
end;
end;
end;
// zadane palety, nulove mnozstvi
if (pal>0) and (mn=0) and (errText=0) then
for i:=1 to pal do
begin
sarze:= '';
paletovyList:= '';
try
icmpCli.Host:= datMod.getDomainName (datMod.phServer);
try
icmpCLi.Ping();
Sleep(500);
pingOK:= (icmpCli.ReplyStatus.BytesReceived>0);
except
pingOK:= False;
end;
resp:= '';
if (pingOK) then
begin
respStream:= TStringStream.Create('');
lHTTP.Post (datMod.phServer + '/order', lParamList, respStream);
resp:= respStream.DataString.Replace('\/', '/');
end;
// log
if (helUtils.SQLObjectExists(Helios, tblHDCPHLog)) and (resp<>'') then
Helios.ExecSQL ('INSERT ' + tblHDCPHLog + ' (LogText, LogTextLong) SELECT N''Dotaz na objednávku materiálu (dle pal)'', N' + resp.QuotedString);
if (ContainsText(resp,'neexistuje')) then
errText:= 1;
if (ContainsText(resp,'nebyla nalezena dal')) then
errText:= 2;
// resp:= jsonText;
if (resp<>'') and (resp.IndexOf('items')>0) and (errText=0) then
begin
joIn:= TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(resp), 0) as TJSONObject;
joIn.TryGetValue('id', ph1);
if (joIn.TryGetValue('items', ja) and (ja.Count > 0)) then
begin
for x:=0 to ja.Count-1 do
begin
ph2:= ja.Items[x].GetValue<string>('id');
paletovyList:= ja.Items[x].GetValue<string>('paletovyList');
sarze:= ja.Items[x].GetValue<string>('sarze');
mnPL:= ja.Items[x].GetValue<Extended>('quantity');
mnInSum:= mnInSum + mnPL;
if (sarze<>'') and (paletovyList<>'') then
begin
lSQL:= 'INSERT ' + tblObjednavky + ' (SkupZbo, RegCis, IDKmenZbozi, PaletovyList, Sarze, Mnozstvi, IdPHIdent, IdPHIdent2) SELECT N' + sz.QuotedString;
lSQL:= lSQL + ', N' + rc.QuotedString + ', ' + idKmen.ToString + ', N' + paletovyList.QuotedString + ', N' + sarze.QuotedString + ', ' + mnPL.ToString.Replace(',', '.');
lSQL:= lSQL + ', ' + ph1 + ', ' + ph2;
try
Helios.ExecSQL(lSQL);
finally
end;
end;
end;
{
paletovyList:= ja.GetValue<string>('paletovyList');
sarze:= ja.GetValue<string>('sarze');
mnPL:= ja.GetValue<Extended>('quantity');
if (paletovyList<>'') and (sarze<>'') and (mnPL>0) then
begin
lSQL:= 'INSERT ' + tblObjednavky + ' (SkupZbo, RegCis, IDKmenZbozi, PaletovyList, Sarze, Mnozstvi) SELECT N' + sz.QuotedString + ', N' + rc.QuotedString + ', ' + idKmen.ToString;
lSQL:= lSQL + ', N' + paletovyList.QuotedString + ', N' + sarze.QuotedString + ', ' + mnPL.ToString.Replace(',', '.');
try
Helios.ExecSQL(lSQL);
finally
end;
end;
}
end;
end;
finally
respStream.Free;
ja.Free;
// joIn.Free;
end;
end;
finally
lParamList.Free;
joOut.Free;
if (ssl<>nil) then
ssl.Free;
lHTTP.Free;
end;
end;
if (errText>0) then
begin
case errText of
1: Helios.Error(#1'Položka není evidována v systému evidence šarží (PH).'#1);
2: Helios.Error(#1'V systému evidence šarží nebyla nalezena další šarže (PH).'#1);
end;
edtMnoz.Text:= '';
edtPalet.Text:= '';
end;
end
else
Helios.Error(#1'Není zadáno množství pro objednávku.'#1);
dm.NactiObjednavkyPolozky (idKmen);
dm.vtObjednavkaMat.First;
end;
procedure TformObjednavkaMat.btnNovaVratkaClick (Sender: TObject);
var lSQL: string;
mn: Extended;
begin
edtMnozVrat.Text:= edtMnozVrat.Text.Trim;
if not(TryStrToFloat(edtMnozVrat.Text, mn)) then
mn:= 0;
if (mn>0) then
begin
lSQL:= 'INSERT ' + tblObjednavky + ' (SkupZbo, RegCis, IDKmenZbozi, Mnozstvi, Vratka) SELECT N' + sz.QuotedString + ', N' + rc.QuotedString + ', ' + idKmen.ToString;
lSQL:= lSQL + ', ' + mn.ToString.Replace(',', '.') + ', 1';
try
Helios.ExecSQL(lSQL);
finally
end;
end
else
Helios.Error(#1'Není zadáno množství pro vratku.'#1);
dm.NactiObjednavkyPolozky (idKmen);
dm.vtObjednavkaMat.First;
end;
procedure TformObjednavkaMat.btnUkazSeznamPaletClick (Sender: TObject);
var f: TformSeznamPalet;
begin
f:= TformSeznamPalet.Create(nil);
try
f.Helios:= Helios;
f.idKmen:= idKmen;
f.den:= vyrobniDen;
f.typ:= 1; // seznam vyrobenych palet z VPr
f.ShowModal;
finally
f.Free;
end;
end;
procedure TformObjednavkaMat.FormClose (Sender: TObject; var Action: TCloseAction);
var i, ii: integer;
p: string;
begin
i:= dm.vtObjednavkaMat.RecNo;
dm.vtObjednavkaMat.DisableControls;
dm.vtObjednavkaMat.First;
while not(dm.vtObjednavkaMat.Eof) do
begin
ii:= dm.vtObjednavkaMat.FieldByName('colCisloObj').AsInteger;
p:= dm.vtObjednavkaMat.FieldByName('colPoznamka').AsString;
Helios.ExecSQL('UPDATE ' + tblObjednavky + ' SET Poznamka=N' + IfThen(p='', 'ULL', p.QuotedString) + ' WHERE ID=' + ii.ToString);
dm.vtObjednavkaMat.Next;
end;
end;
procedure TformObjednavkaMat.FormResize (Sender: TObject);
var i, s: integer;
begin
s:= 0;
for i:=0 to GridPanel6.ColumnCollection.Count-1 do
begin
GridPanel6.ColumnCollection.Items[i].SizeStyle:= ssAbsolute;
GridPanel6.ColumnCollection.Items[i].Value:= grdObjednavkaMat.Columns.Items[i].Width;
end;
GridPanel6.ColumnCollection.Items[0].Value:= GridPanel6.ColumnCollection.Items[0].Value + 20;
end;
procedure TformObjednavkaMat.FormShow (Sender: TObject);
var lSQL: string;
begin
grdObjednavkaMat.Font.Height:= Helios.FontHeight;
with Helios.OpenSQL('SELECT SkupZbo,RegCis,Nazev1,MJEvidence FROM ' + tblKZ + ' WHERE ID=' + idKmen.ToString) do
if (RecordCount=1) then
begin
sz:= VarToStr(FieldByNameValues('SkupZbo'));
rc:= VarToStr(FieldByNameValues('RegCis'));
edtSZ.Text:= sz;
edtRC.Text:= rc;
edtNazev1.Text:= VarToStr(FieldByNameValues('Nazev1'));
edtMJ.Text:= VarToStr(FieldByNameValues('MJEvidence'));
if (edtMJ.Text.ToUpper='KA') then
begin
lSQL:= 'SELECT PocetHlavni FROM ' + tblMJZbo + ' WHERE UPPER(KodMJ1)=N''KA'' AND KodMJ2=N''pal'' AND IDKmenZbozi=' + idKmen.ToString;
edtNaPalete.Text:= helUtils.getHeliosIntVal(Helios, 0, lSQL).ToString;
end;
if (edtMJ.Text.ToLower='kg') then
begin
lSQL:= 'SELECT PocetHlavni FROM ' + tblMJZbo + ' WHERE LOWER(KodMJ1)=N''kg'' AND KodMJ2=N''pal'' AND IDKmenZbozi=' + idKmen.ToString;
edtNaPalete.Text:= helUtils.getHeliosIntVal(Helios, 0, lSQL).ToString;
end;
end;
edtMnoz.Text:= '0';
edtPalet.Text:= '0';
edtMnozVrat.Text:= '0';
dm.NactiObjednavkyPolozky (idKmen);
dm.vtObjednavkaMat.First;
grdObjednavkaMat.Invalidate;
edtPalet.Enabled:= (edtNaPalete.Text<>'') and (edtNaPalete.Text<>'0') and (edtNaPalete.Text<>'0.0') and (edtNaPalete.Text<>'0,0');
if (edtMnoz.CanFocus) then
begin
edtMnoz.SetFocus;
edtMnoz.SelectAll;
end;
end;
procedure TformObjednavkaMat.grdObjednavkaMatCellClick(Column: TColumn);
begin
// if (grdObjednavkaMat.DataSource.DataSet.FieldByName('colMnozstvi').AsString='') then
end;
procedure TformObjednavkaMat.grdObjednavkaMatColExit (Sender: TObject);
begin
// test
end;
procedure TformObjednavkaMat.grdObjednavkaMatDrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (not(gdSelected in State)) then
begin
if (Odd(grdObjednavkaMat.DataSource.DataSet.RecNo)) then
TJvDBGrid(Sender).Canvas.Brush.Color:= clWindow
else
TJvDBGrid(Sender).Canvas.Brush.Color:= $00E0E0E0;
end;
if (Column.FieldName='colMnozstvi') then
begin
if (gdSelected in State) then
TJvDBGrid(Sender).Canvas.Font.Color:= clBlack;
TJvDBGrid(Sender).Canvas.Brush.Color:= $00D0FEC6;
end;
TJvDBGrid(Sender).DefaultDrawColumnCell (Rect, DataCol, Column, State);
end;
procedure TformObjednavkaMat.grdObjednavkaMatMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
aktRow:= TJvDBGrid(Sender).MouseCoord(X, Y).Y;
aktCol:= TJvDBGrid(Sender).MouseCoord(X, Y).X;
end;
end.