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, uPing; {$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Ä›ní"' + ',"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; } {$IFDEF DEBUG} i:= 0; resp:= '{"@context":"/api/contexts/Order","@id":"/api/orders/10","@type":"Order","id":10,"heliosId":null,"name":"Lecitin tekutý","skupzbo":"101","regcis":"652801"' + ',"paletovyList":"2500082","quantity":"1000.0000","items":[{"@id":"/api/material_order_items/12","@type":"MaterialOrderItem","id":12,"stockItem":{"@id":"/api/stock_items/47"' + ',"@type":"StockItem","id":47,"heliosId":250,"heliosPrijemkaId":84},"stockItemFinal":null,"order":"/api/orders/10","name":"Lecitin tekutý","sarze":"066-03-24-0220"' + ',"paletovyList":"2500082","quantity":"1000","dateExp":"2026-08-31T00:00:00+02:00","isCompleted":false,"completedAt":null}],"isCompleted":false,"isUserCompleted":false' + ',"completedAt":null,"isFinalCompleted":false}'; {$ELSE} i:= uPing.Ping (datMod.getDomainName (datMod.phServer), resp); resp:= ''; {$ENDIF} pingOK:= (i=0); if (pingOK) {$IFDEF DEBUG} and (1=0) {$ENDIF} then begin respStream:= TStringStream.Create(''); lHTTP.Post ('http://rootvin.datazone.cloud/api/helios/order', lParamList, respStream); // 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('id'); paletovyList:= ja.Items[x].GetValue('paletovyList'); sarze:= ja.Items[x].GetValue('sarze'); mnPL:= ja.Items[x].GetValue('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 if (ph1='') then ph1:= '0'; if (ph2='') then ph2:= '0'; 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('id'); paletovyList:= ja.Items[x].GetValue('paletovyList'); sarze:= ja.Items[x].GetValue('sarze'); mnPL:= ja.Items[x].GetValue('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('paletovyList'); sarze:= ja.GetValue('sarze'); mnPL:= ja.GetValue('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.