Prvni verze
This commit is contained in:
551
frmObjednavkaMat.pas
Normal file
551
frmObjednavkaMat.pas
Normal 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Ä›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;
|
||||
|
||||
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.
|
||||
Reference in New Issue
Block a user