278 lines
9.3 KiB
ObjectPascal
278 lines
9.3 KiB
ObjectPascal
unit frmGenTPV;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, RzEdit, TBPackageU, ddPlugin_TLB,
|
|
RxToolEdit, RzBtnEdt;
|
|
|
|
const
|
|
tblOdlitky = '[dbo].[_hdc_TabOdlitky]';
|
|
|
|
type
|
|
TformGenTPV = class(TForm)
|
|
edtNazev: TEdit;
|
|
edtCisOrg: TComboEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
edtPozice: TEdit;
|
|
Label3: TLabel;
|
|
edtMat: TComboEdit;
|
|
Label4: TLabel;
|
|
Label6: TLabel;
|
|
edtVzorTPV: TComboEdit;
|
|
lblVzorTPV: TLabel;
|
|
btnOK: TButton;
|
|
btnStorno: TButton;
|
|
edtTech: TEdit;
|
|
Label7: TLabel;
|
|
Label16: TLabel;
|
|
cboxPrvniObal: TComboBox;
|
|
cboxVOD: TComboBox;
|
|
Label5: TLabel;
|
|
cbGenSpodek: TCheckBox;
|
|
edtRegC: TEdit;
|
|
cbRCdleFin: TCheckBox;
|
|
Label8: TLabel;
|
|
Label9: TLabel;
|
|
edtRegCN: TEdit;
|
|
cbNabidka: TCheckBox;
|
|
procedure FormShow(Sender: TObject);
|
|
procedure btnOKClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure btnStornoClick(Sender: TObject);
|
|
procedure edtPoziceExit(Sender: TObject);
|
|
procedure edtCisOrgExit(Sender: TObject);
|
|
procedure edtMatExit(Sender: TObject);
|
|
procedure edtCisOrgButtonClick(Sender: TObject);
|
|
procedure edtMatButtonClick(Sender: TObject);
|
|
procedure edtVzorTPVButtonClick(Sender: TObject);
|
|
procedure edtTechExit(Sender: TObject);
|
|
procedure edtRegCNChange(Sender: TObject);
|
|
private
|
|
function Testy: string; safecall;
|
|
public
|
|
Helios: IHelios;
|
|
idKZrodic: integer;
|
|
jeTest: boolean;
|
|
end;
|
|
|
|
var
|
|
formGenTPV: TformGenTPV;
|
|
oVar: OleVariant;
|
|
skl, tech: string;
|
|
|
|
|
|
|
|
implementation
|
|
uses System.StrUtils, helUtils;
|
|
|
|
{$R *.dfm}
|
|
|
|
function TformGenTPV.Testy;
|
|
begin
|
|
result:= '';
|
|
edtRegC.Text:= Trim(edtRegC.Text);
|
|
edtMat.Text:= Trim(edtMat.Text);
|
|
edtNazev.Text:= Trim(edtNazev.Text);
|
|
edtPozice.Text:= Trim(edtPozice.Text);
|
|
if (edtPozice.Text='') then
|
|
result:= 'Není vyplnìna pozice.';
|
|
if (edtRegC.Text='') and (result='') then
|
|
result:= 'Není vyplnìno nové Registraèní èíslo';
|
|
if (cBoxVOD.Text='') and (result='') then
|
|
result:= 'Není vybrána finální Skupina karet';
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.btnOKClick(Sender: TObject);
|
|
var lSQL, nSZ, nRC, x, xx: string;
|
|
idKZ, idKZsub: integer;
|
|
genVob, genVod: Boolean;
|
|
i: integer;
|
|
begin
|
|
lSQL:= Testy;
|
|
if (lSQL='') then
|
|
begin
|
|
waitStart(self, 'Generování karet...', 1, $0000FF );
|
|
x:= '';
|
|
|
|
lSQL:= 'IF OBJECT_ID(N''dbo._temp_TabGenKartySTPV'') IS NOT NULL DELETE FROM dbo._temp_TabGenKartySTPV WHERE Autor=SUSER_SNAME()' + CRLF;
|
|
lSQL:= lSQL + 'IF OBJECT_ID(N''dbo._temp_TabGenKartySTPV'') IS NOT NULL IF NOT EXISTS(SELECT * FROM dbo._temp_TabGenKartySTPV)';
|
|
lSQL:= lSQL + ' DROP TABLE dbo._temp_TabGenKartySTPV' + CRLF + 'DROP TABLE IF EXISTS #TabGenKartySTPV';
|
|
Helios.ExecSQL(lSQL);
|
|
|
|
lSQL:= 'CREATE TABLE #TabGenKartySTPV (RegCis NVARCHAR(30) NOT NULL, RegCisNizsi NVARCHAR(30), Nazev NVARCHAR(100) DEFAULT N'''', Technologie NCHAR(5) NOT NULL';
|
|
lSQL:= lSQL + ', PrvniObal TINYINT NOT NULL, VzorCisloKarty NVARCHAR(33) NOT NULL, Sklad NVARCHAR(30), SkupZbo NVARCHAR(3) NOT NULL DEFAULT N'''', GenPxx BIT DEFAULT 1';
|
|
lSQL:= lSQL + ', RCPxxFin BIT DEFAULT 1, KodMat NVARCHAR(5) DEFAULT N'''', Autor NVARCHAR(80) NOT NULL DEFAULT SUSER_SNAME())' + CRLF;
|
|
lSQL:= lSQL + 'INSERT #TabGenKartySTPV (RegCis, RegCisNizsi, Nazev, Technologie, PrvniObal, VzorCisloKarty, SkupZbo, GenPxx, RCPxxFin, Sklad, KodMat) SELECT N';
|
|
lSQL:= lSQL + edtRegC.Text.QuotedString + ', N' + edtRegCN.Text.QuotedString + ', N' + edtNazev.Text.QuotedString + ', N' + edtTech.Text.QuotedString + ', ';
|
|
lSQL:= lSQL + cboxPrvniObal.ItemIndex.ToString + ', N' + edtVzorTPV.Text.QuotedString + ', N' + cboxVOD.Text.QuotedString + ', ' + IfThen(cbGenSpodek.Checked, '1', '0');
|
|
lSQL:= lSQL + ', ' + IfThen(cbRCdleFin.Checked, '1', '0');
|
|
for i:=0 to Helios.QueryBrowse.FieldCount-1 do
|
|
begin
|
|
xx:= Helios.QueryBrowse.Fields(i).FieldName;
|
|
if (xx='IDSklad') then
|
|
x:= VarToStr(Helios.QueryBrowse.FieldByNameValues('IDSklad'));
|
|
end;
|
|
lSQL:= lSQL + ', ' + IfThen(x='', 'NULL', 'N' + x.QuotedString);
|
|
lSQL:= lSQL + ', N' + IfThen(edtMat.Text='', 'ULL', edtMat.Text.QuotedString);
|
|
try
|
|
if (jeTest) then
|
|
lSQL:= StringReplace(lSQL, '#TabGenKar', 'dbo._temp_TabGenKar', [rfReplaceAll]);
|
|
Helios.ExecSQL(lSQL);
|
|
if not(jeTest) then
|
|
Helios.ExecSQL('IF OBJECT_ID(N''dbo.ep_TPV_GenKarty'') IS NOT NULL EXEC dbo.ep_TPV_GenKarty');
|
|
Close;
|
|
except on E:Exception do
|
|
begin
|
|
waitEnd;
|
|
Helios.Error(#1 + 'CHYBA: ' + #1 + E.Message);
|
|
end;
|
|
end;
|
|
waitEnd;
|
|
end
|
|
else
|
|
Helios.Error(#1 + 'CHYBA: ' + #1 + lSQL);
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.btnStornoClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtCisOrgButtonClick(Sender: TObject);
|
|
begin
|
|
edtCisOrg.Text:= Trim(edtCisOrg.Text);
|
|
oVar:= edtCisOrg.Text;
|
|
if Helios.Prenos(bidCisOrg, 'TabCisOrg.CisloOrg', oVar, 'TabCisOrg.CisloOrg>0', 'Vyberte zákazníka', true) then
|
|
edtCisOrg.Text:= Trim(VarToStr(oVar));
|
|
end;
|
|
|
|
procedure TformGenTPV.edtCisOrgExit(Sender: TObject);
|
|
begin
|
|
edtRegC.Text:= edtCisOrg.Text + edtPozice.Text + edtMat.Text;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtMatButtonClick(Sender: TObject);
|
|
begin
|
|
edtMat.Text:= Trim(edtMat.Text);
|
|
oVar:= edtMat.Text;
|
|
if Helios.Prenos(100052, 'hvw_Material.Kod', oVar, '', 'Vyberte materiál', true) then
|
|
edtMat.Text:= Trim(VarToStr(oVar));
|
|
edtRegC.Text:= edtCisOrg.Text + edtPozice.Text + edtMat.Text;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtMatExit(Sender: TObject);
|
|
begin
|
|
edtMat.Text:= Trim(edtMat.Text);
|
|
edtRegC.Text:= edtCisOrg.Text + edtPozice.Text + edtMat.Text;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtPoziceExit(Sender: TObject);
|
|
begin
|
|
edtPozice.Text:= Trim(StringReplace(edtPozice.Text, ' ', '', [rfReplaceAll]));
|
|
edtPozice.Text:= StringOfChar('0', 3-Length(edtPozice.Text)) + edtPozice.Text;
|
|
edtRegC.Text:= edtCisOrg.Text + edtPozice.Text + edtMat.Text;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtRegCNChange(Sender: TObject);
|
|
begin
|
|
if (edtRegCN.Text<>'') and (cbRCdleFin.Enabled) then
|
|
begin
|
|
cbRCdleFin.Enabled:= false;
|
|
cbRCdleFin.Checked:= false;
|
|
end;
|
|
if (edtRegCN.Text='') and (cbRCdleFin.Enabled=false) then
|
|
cbRCdleFin.Enabled:= true;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtTechExit (Sender: TObject);
|
|
begin
|
|
if (edtTech.Text<>tech) then
|
|
Helios.Error(#1'Zadaná technologie není stejná jako má vzorová karta.' + CRLF + '(vzor má ' + tech + ')');
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.edtVzorTPVButtonClick (Sender: TObject);
|
|
var podm, rc, tech: string;
|
|
begin
|
|
podm:= 'TabKmenZbozi.dilec=1 AND TabKmenZbozi.SkupZbo=N' + QuotedStr(cboxVOD.Text);
|
|
if (idKZrodic>0) then
|
|
oVar:= helUtils.getHeliosStrVal(Helios, '', 'SELECT CisloZbozi FROM ' + tblKZ + ' WHERE ID=' + idKZrodic.ToString);
|
|
if Helios.Prenos(bidDilce, 'TabKmenZbozi.CisloZbozi', oVar, podm, 'Vzorová karta', true) then
|
|
begin
|
|
edtVzorTPV.Text:= VarToStr(oVar);
|
|
rc:= MidStr(edtVzorTPV.Text, 4, 50);
|
|
tech:= helUtils.getHeliosStrVal(Helios, '', 'SELECT DruhTechnologie FROM ' + tblOdlitky + ' WHERE Odlitek=N' + QuotedStr(rc));
|
|
if (edtTech.Text<>'0') then
|
|
if (edtTech.Text<>tech) then
|
|
if not Helios.YesNo(#1'Vybraný vzor nemá stejnou technologii jako novì vytváøená karta.' + CRLF + 'Pøesto pokraèovat ?'#1, false) then
|
|
edtVzorTPV.Text:= '';
|
|
lblVzorTPV.Caption:= helUtils.getHeliosStrVal(Helios, '', 'SELECT Nazev1 FROM ' + tblKZ + ' WHERE CisloZbozi=N' + QuotedStr(edtVzorTPV.Text));
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
action:= caFree;
|
|
end;
|
|
|
|
|
|
|
|
procedure TformGenTPV.FormShow(Sender: TObject);
|
|
var lSQL, rc: string;
|
|
i: integer;
|
|
begin
|
|
self.Icon.Handle:= Helios.MainApplicationIconHandle;
|
|
// self.ParentWindow:= Helios.MainApplicationHandle;
|
|
for i:=0 to Self.ComponentCount-1 do
|
|
begin
|
|
if (Self.Components[i] is TButton) then
|
|
begin
|
|
(Self.Components[i] as TButton).Font.Name:= Helios.Font;
|
|
(Self.Components[i] as TButton).Font.Height:= Helios.FontHeight;
|
|
end;
|
|
end;
|
|
cboxPrvniObal.ItemIndex:= 0;
|
|
if (idKZrodic>0) then
|
|
begin
|
|
edtVzorTPV.Text:= helUtils.getHeliosStrVal(Helios, '', 'SELECT CisloZbozi FROM ' + tblKZ + ' WHERE ID=' + idKZRodic.ToString);
|
|
rc:= MidStr(edtVzorTPV.Text, 4, 50);
|
|
cboxVOD.ItemIndex:= cboxVOD.Items.IndexOf(LeftStr(edtVzorTPV.Text,3));
|
|
tech:= helUtils.getHeliosStrVal(Helios, '', 'SELECT DruhTechnologie FROM ' + tblOdlitky + ' WHERE Odlitek=N' + QuotedStr(rc));
|
|
if (helUtils.HeliosExistsTest(Helios, tblOdlitky, 'ISNULL(MatecniOdlitek,N'''')<>N''''')) then
|
|
begin
|
|
lSQL:= 'SELECT ISNULL(o1.DruhTechnologie, o.DruhTechnologie) FROM ' + tblOdlitky + ' o INNER JOIN ' + tblOdlitky;
|
|
lSQL:= lSQL + ' o1 ON (o1.Odlitek=o.MatecniOdlitek) WHERE o.Odlitek=N' + rc.QuotedString;
|
|
if (helUtils.getHeliosStrVal(Helios, '', lSQL)<>'') then
|
|
tech:= helUtils.getHeliosStrVal(Helios, '', lSQL);
|
|
end;
|
|
|
|
|
|
lblVzorTPV.Caption:= helUtils.getHeliosStrVal(Helios, '', 'SELECT Nazev1 FROM ' + tblKZ + ' WHERE CisloZbozi=N' + QuotedStr(edtVzorTPV.Text));
|
|
edtCisOrg.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
end.
|