TomBuzin/EMPolar-plgEMPDeleniTrubek
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Prvotni verze pro Giteu

Browse Source
This commit is contained in:
TomBuz
2025-09-13 09:14:20 +02:00
parent fbe784e708
commit 641c81f487
30 changed files with 69739 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+16 -15
View File
@@ -1,4 +1,3 @@
# ---> Delphi
# Uncomment these types if you want even more clean repository. But be careful.
# It can make harm to an existing project source. Read explanations below.
#
@@ -27,21 +26,11 @@
#*.obj
#
# Default Delphi compiler directories
# Content of this directories are generated with each Compile/Construct of a project.
# Most of the time, files here have not there place in a code repository.
#Win32/
#Win64/
#OSX64/
#OSXARM64/
#Android/
#Android64/
#iOSDevice64/
#Linux64/
.git*
# Delphi compiler-generated binaries (safe to delete)
*.exe
*.dll
*.bak
*.bpl
*.bpi
*.dcp
@@ -78,6 +67,18 @@ __recovery/
# Castalia statistics file (since XE7 Castalia is distributed with Delphi)
*.stat
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
modules/
*.otares
*.cmds
*.skincfg
*.bmp
*.mp3
*.mes
*.vtd
*.xls
*.xlsx
*.vlb
*.tmp
*.xml
bak/
ComObjekt.pas
+643
View File
@@ -0,0 +1,643 @@
unit ComObjekt;
INTERFACE
uses System.SysUtils, System.Win.ComObj, Vcl.Dialogs, ddPlugin_TLB;
const
Class_EMPDeleniTrubek: TGUID = '{2857E134-4CA9-457C-85BD-EDDE86029314}';
plgSysName = 'plgEMPDeleniTrubek';
CRLF = #13#10;
tblPredpisH = '[dbo].[_hdc_TabRezaciPredpis]';
tblPredpisR = '[dbo].[_hdc_TabRezaciPredpisR]';
tblTemp = 'tempdb..';
CF_TEXT = 1;
type
TplgEMPDeleniTrubek = class(TComObject, IHePlugin)
private
FHelios: IHelios;
procedure OnException (Sender: TObject; E: Exception);
procedure Run (const Helios: IHelios); safecall;
procedure VytvorRezaciPredpis (const Helios: IHelios; arrID: System.TArray<integer>); // v arrID jsou vybrane radky
end;
IMPLEMENTATION
uses Vcl.StdActns, VCL.Forms, Win.ComServ, Winapi.Windows, System.Variants, System.StrUtils, datModul,
frmMain, helUtils;
var
verText, verText2: string;
jeTest: boolean;
oVar1, oVar2: OleVariant;
dm: Tdm;
idPrac: integer;
function VratTabName(tbl: string): string;
begin
result:= tbl.Replace('[', '').Replace(']', '').Replace('dbo.', '');
end;
function HexToString(H: AnsiString): AnsiString;
{ var I,L: Integer;
begin
result:= '';
L:= length(H);
for I:= 1 to L div 2 do
result:= result + Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));
end;
}
const Convert: array['0'..'f'] of byte =
(0, 1, 2, 3, 4, 5, 6, 7, 8, 9,16,16,16,16,16,16,
16,10,11,12,13,14,15,16,16,16,16,16,16,16,16,16,
16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,
16,10,11,12,13,14,15);
var FPos, Check, len, len2: Integer;
ch: AnsiChar;
begin
FPos:= 0;
Check:= 0;
len:= Length(H);
len2:= len div 2;
SetLength(Result, len2);
if len < 2 then Exit; {Too small}
repeat
ch := H[2*FPos+1];
if (not(ch in['0'..'f']))or(Convert[ch]>15) then break;
Result[FPos+1]:= AnsiChar((Convert[ch] shl 4));
ch:= H[2*FPos+2];
if (not(ch in['0'..'f']))or(Convert[ch]>15) then break;
inc(FPos);
Result[FPos]:= AnsiChar(ord(Result[FPos])+Convert[ch]);
Check:= Check + ord(Result[FPos]);
Dec(len2);
until (len2=0);
SetLength(Result, FPos);
end;
function OtevriSoubor(const adresar, flt1, flt2: string; var nazev: string): Boolean;
var dlgOpenW7: TFileOpenDialog; // dialog pro Windows Vista a novejsi
titulek, filtr1, filtr2: string;
iniDir: string;
begin
result:= false;
titulek:= 'Vyberte soubor pro import';
filtr1:= IfThen(flt1<>'',flt1,'XLS/X soubory');
filtr2:= IfThen(flt2<>'',flt2,'*.xls, *.xlsx');
nazev:= '';
if (adresar<>'') then
begin
if (DirectoryExists(adresar)) then
iniDir:= adresar;
end
else
iniDir:= GetEnvironmentVariable('USERPROFILE') + '\Desktop';
try
dlgOpenW7:= TFileOpenDialog.Create(nil);
dlgOpenW7.Title:= titulek;
dlgOpenW7.OkButtonLabel:= 'Vybrat';
with dlgOpenW7.FileTypes.Add do
begin
DisplayName:= filtr1;
FileMask:= filtr2;
end;
dlgOpenW7.DefaultFolder:= iniDir;
if dlgOpenW7.Execute then
begin
nazev:= dlgOpenW7.FileName;
result:= true;
end;
finally
dlgOpenW7.Free;
end;
end;
function VyberAdresar(var Foldr: string; Title: string): Boolean;
var bf: TBrowseForFolder;
begin
bf:= TBrowseForFolder.Create(nil);
try
if (Foldr<>'') then
bf.Folder:= Foldr;
if (Title<>'') then
bf.DialogCaption:= Title;
bf.BrowseOptions := [bifEditBox, bifNewDialogStyle, {bifNoTranslateTargets, bifReturnFSAncestors,} bifUseNewUI];
bf.Execute; // pozor návratová hodnota Execute znamená jen že se nepodařilo akci spusti nebo tak
if (bf.Folder<>'') then
Foldr:= bf.Folder;
finally
FreeAndNil(bf);
end;
end;
procedure TplgEMPDeleniTrubek.OnException (Sender: TObject; E: Exception);
begin
try
LockWindowUpdate (0);
FHelios.Error (E.Message);
except
Application.ShowException(E); //pro jistotu
end;
end;
procedure TplgEMPDeleniTrubek.VytvorRezaciPredpis(const Helios: IHelios; arrID: System.TArray<Integer>);
var lSQL: string;
i: integer;
begin
if (Length(arrID)>0) then // INT0000187
begin
lSQL:= 'IF OBJECT_ID(N''temp..#RezaciPredpisR'', N''U'') IS NOT NULL DROP TABLE #RezaciPredpisR' + CRLF;
lSQL:= lSQL + 'CREATE TABLE #RezaciPredpisR (ID INT IDENTITY(1,1) NOT NULL, IDPrKVazba INT NOT NULL)' + CRLF;
for i in arrID do
lSQL:= lSQL + 'INSERT #RezaciPredpisR (IDPrKVazba) SELECT ' + i.ToString + CRLF;
lSQL:= lSQL + 'DECLARE @x INT=NULL' + CRLF + 'IF OBJECT_ID(N''dbo.ep_hdc_RezaciPredpis_NewEdit'', N''P'') IS NOT NULL EXEC dbo.ep_hdc_RezaciPredpis_NewEdit @jeEdit=0, @ID=@x OUT';
Helios.ExecSQL(lSQL);
end;
end;
procedure TplgEMPDeleniTrubek.Run (const Helios: IHelios);
const MinVerzeHelios = $030020240902;
var typAkce: byte;
browID, cRec, cRecRodic, cntID, l_loop, idDZ, idDZrodic, dpz, cOrg, newBid: integer;
lSQL, autor, radDokl, IDcka, IDckaRodic, params, paramsBak, vlastPar, vlastPar2, contInfo, sz, podm, sTemp: string;
arrID, arrID2, arrIdRodic: System.TArray<integer>;
term, canCont: boolean;
verMoje, verDB: Int64;
fMain: TformMain;
tmpInt: integer;
bidRezaciPredpis, filtrPolozek: integer;
retBool: boolean;
idTiskForm: integer;
PomHandle: THandle;
begin
try
FHelios:= Helios;
Application.OnException:= Self.OnException;
// ReportMemoryLeaksOnShutdown:= true;
// inicializace datoveho modulu
if (dm=nil) then
dm:= Tdm.Create (nil);
dm.Helios:= Helios;
datModul.devID:= dm.ZjistiDeviceID;
datModul.tiskJenPlgRP:= false;
datModul.sqlUserName:= helUtils.getHeliosStrVal(Helios, '', 'SELECT SUSER_SNAME()');
lSQL:= 'IF OBJECT_ID(' + QuotedStr('tempdb..#TabExtKom') + ') IS NULL CREATE TABLE #TabExtKom (Poznamka NVARCHAR(255), Typ TINYINT DEFAULT NULL)' + CRLF;
lSQL:= lSQL + 'IF OBJECT_ID(N' + QuotedStr('tempdb..#TabTempUziv') + ') IS NULL CREATE TABLE #TabTempUziv (Tabulka';
lSQL:= lSQL + ' NVARCHAR(255) NOT NULL, SCOPE_IDENTITY INT NULL, Datum DATETIME NULL)';
Helios.ExecSQL(lSQL);
term:= false;
jeTest:= false;
if (Helios.HeVersion<MinVerzeHelios) then
raise Exception.Create('Plugin vyžaduje min verzi Heliosu ' + IntToHex(MinVerzeHelios, 12))
else
begin
with Helios.OpenSQL('SELECT CONVERT(nvarchar(128),CONTEXT_INFO(),2)') do
if VarIsNull(FieldValues(0)) then
contInfo:= 'NULL'
else
contInfo:= VarToStr(FieldValues(0));
Helios.ExecSQL('SET CONTEXT_INFO 0x48444334454D506F6C617244656C656E6954727562656B'); // nastav context v sys.sysprocesses (hexadecimalne HDC4EMPolarDeleniTrubek)
UseLatestCommonDialogs:= true;
// LocalFormatSettings:= TFormatSettings.Create;
lSQL:= 'IF OBJECT_ID(N''tempdb..#TabExtKom'') IS NOT NULL DROP TABLE #TabExtKom' + CRLF;
lSQL:= lSQL + 'CREATE TABLE #TabExtKom (Poznamka nvarchar(255), Typ TINYINT DEFAULT NULL)';
Helios.ExecSQL(lSQL);
// lSQL:= 'IF OBJECT_ID(''tempdb..#TabExtKom'') IS NULL CREATE TABLE #TabExtKom (Poznamka NVARCHAR(255))' + CRLF;
lSQL:= 'IF OBJECT_ID(N''tempdb..#TabTempUziv'') IS NULL CREATE TABLE #TabTempUziv (Tabulka';
lSQL:= lSQL + ' NVARCHAR(255) NOT NULL, SCOPE_IDENTITY INT NULL, Datum DATETIME NULL)';
Helios.ExecSQL(lSQL);
params:= '';
vlastPar:= '';
vlastPar2:= '';
typAkce:= 0;
if (Helios.ExtKomID>-1) then
begin
with Helios.OpenSQL('SELECT Parametry FROM ' + tblExtKom + ' WHERE ID=' + IntToStr(Helios.ExtKomID)) do
begin
params:= VarToStr(FieldValues(0));
paramsBak:= VarToStr(FieldValues(0));
if Pos(';',params)>0 then
begin
typAkce:= StrToInt(LeftStr(params,Pos(';',params)-1));
params:= MidStr(params,Pos(';',params)+1,255);
if Pos(';',params)>0 then
browID:= StrToInt(LeftStr(params,Pos(';',params)-1))
else
browID:= StrToInt(params);
if Pos(';',params)>0 then // zadany 3 parametry (akce, browID, vlastnikID)
begin
params:= MidStr(params,Pos(';',params)+1,255);
if Pos(';', params)>0 then
begin
vlastPar:= LeftStr(params,Pos(';',params)-1);
vlastPar2:= MidStr(params,Pos(';',params)+1,255);
end
else
vlastPar:= params;
end;
end
else
raise Exception.Create('Nemám potřebný počet parametrů !');
end;
end
else
begin // instalace
end;
// kontrola verze pluginu
verText:= GetFileVersion2(GetModuleName(HInstance));
if Length(verText)=12 then
verText:= LeftStr(verText,9) + '0' + RightStr(verText,3);
verText2:= verText.Replace('.', '');
if (Length(verText2)=10) then
verText2:= '0' + LeftStr(verText2,1) + '0' + RightStr(verText2, 9);
verMoje:= verText2.ToInt64;
lSQL:= 'IF NOT EXISTS(SELECT ID FROM ' + tblPlgInfo + ' WHERE NazevSys=N' + plgSysName.QuotedString + ') INSERT ' + tblPlgInfo;
lSQL:= lSQL + ' (NazevSys, NazevObjektu, NazevVerejny, VerzePluginu, ZmenyOK) SELECT N' + plgSysName.QuotedString + ', N''runMe'',';
lSQL:= lSQL + ' N''HDC - plugin Deleni trubek pro EM Polar Blatna'', N' + verText2.QuotedString + ', 1';
Helios.ExecSQL(lSQL);
verDB:= helUtils.getHeliosStrVal(Helios, verText2, 'SELECT VerzePluginu FROM ' + tblPlgInfo + ' WHERE NazevSys=N' + plgSysName.QuotedString).ToInt64;
if (verMoje<verDB) then
begin
Helios.Error(#1'Vaše verze pluginu je nižší než je verze v databázi'#1 + CRLF + 'Prosím kontaktujte administrátory a nechce si instalovat novou verzi (' + #1 + plgSysName + #1 + ')');
Exit;
end;
vlastPar:= Trim(vlastPar);
vlastPar2:= Trim(vlastPar2);
// vnucene ID pily (_hdc_TabRezaciPredpisPily)
datModul.idPilaForce:= 0;
if (vlastPar<>'') then
if not(TryStrToInt(vlastPar, datModul.idPilaForce)) then
datModul.idPilaForce:= 0;
if (vlastPar2<>'') then
if not(TryStrToInt(vlastPar2, datModul.idTiskForm)) then
datModul.idTiskForm:= 0;
// lSQL:= 'SELECT TOP(1) ID FROM ' + tblRezPredpisPily + ' WHERE Aktivni=1 AND DeviceID=N' + datModul.devID.QuotedString;
lSQL:= 'SELECT TOP(1) ID FROM ' + tblRezPredpisPily + ' WHERE Aktivni=1 AND LoginName=SUSER_SNAME()';
datModul.idPila:= helUtils.getHeliosIntVal(Helios, 0, lSQL);
// vnucene ID pily, z pevnych parametru externi akce
if (datModul.idPilaForce>0) then
datModul.idPila:= datModul.idPilaForce;
if (datModul.idPila=0) and not(helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 FROM ' + tblRezPredpisPily + ' WHERE Aktivni=1 AND LoginName=SUSER_SNAME()')) then
begin
lSQL:= 'INSERT ' + tblRezPredpisPily + ' (DeviceID, LoginName) SELECT N' + datModul.devID.QuotedString + ', SUSER_SNAME()' + CRLF + 'SELECT SCOPE_IDENTITY() AS newID';
with Helios.OpenSQL(lSQL) do
datModul.idPila:= VarToStr(FieldByNameValues('newID')).ToInteger;
end;
jeTest:= UpperCase(vlastPar)='TEST';
if (vlastPar2<>'') then
jeTest:= UpperCase(vlastPar2)='TEST';
if AnsiContainsText(UpperCase(paramsBak), ';TEST') then
jeTest:= true;
if AnsiContainsText(UpperCase(paramsBak), ';JENRP') then
datModul.tiskJenPlgRP:= true;
end;
if (Helios.BrowseID<>browID) then
begin
typAkce:= 0;
Helios.Error('Tento plugin lze volat pouze z přehledu: '#1 + IntToStr(browID) + #1'.');
end;
IDcka:= '';
cRec:= 0;
SetLength(arrId, 0);
if (Helios.SelectedRecordIDs<>'') then
IDcka:= Helios.SelectedRecordIDs
else
if not VarIsNull(Helios.CurrentRecordID) then
begin
cRec:= StrToInt(VarToStr(Helios.CurrentRecordID));
IDcka:= IntToStr(cRec);
end;
if (IDcka<>'') then
begin
cntID:= 1 + Length(IDcka)-Length(StringReplace(IDcka,',','',[rfReplaceAll]));
SetLength(arrID, cntID);
for l_loop:=0 to cntID-1 do
begin
if Pos(',',IDcka)>0 then
begin
arrID[l_loop]:= StrToInt(LeftStr(IDcka, Pos(',',IDcka)-1));
IDcka:= MidStr(IDcka, Pos(',',IDcka)+1,262140) // 65535 * 4 (max. delka pole)
end
else
arrID[l_loop]:= StrToInt(IDcka);
end;
cRec:= arrID[0];
end;
cRecRodic:= -1;
IDckaRodic:= '';
SetLength(arrIdRodic, 0);
if (Helios.HeliosVlastnik<>nil) then
begin
if (Helios.HeliosVlastnik.SelectedRecordIDs<>'') then
IDckaRodic:= Helios.HeliosVlastnik.SelectedRecordIDs
else
if not VarIsNull(Helios.HeliosVlastnik.CurrentRecordID) then
cRecRodic:= StrToInt(VarToStr(Helios.HeliosVlastnik.CurrentRecordID));
SetLength(arrIdRodic, 1);
arrIdRodic[0]:= cRecRodic;
if (IDckaRodic<>'') then
begin
cntID:= 1 + Length(IDckaRodic)-Length(StringReplace(IDckaRodic, ',', '', [rfReplaceAll]));
SetLength(arrIDRodic, cntID);
for l_loop:=0 to cntID-1 do
begin
if Pos(',', IDckaRodic)>0 then
begin
arrIDRodic[l_loop]:= StrToInt(LeftStr(IDckaRodic, Pos(',',IDckaRodic)-1));
IDckaRodic:= MidStr(IDckaRodic, Pos(',',IDckaRodic)+1, 262140) // 65535 * 4 (max. delka pole)
end
else
arrIDRodic[l_loop]:= StrToInt(IDckaRodic);
end;
end;
end;
case typAkce of
// 0: Helios.PrintForm3 (11050, datModul.idTiskFormStitek, 'TabPrKVazby.ID=3284');
1: begin
// ohlidej jednorazove prihlaseni
lSQL:= 'SELECT 1 AS A FROM ' + tblRezPredpisPily + ' WHERE ID<>' + datModul.idPila.ToString + ' AND Aktivni=1 AND LoginName=SUSER_SNAME() AND Prihlasen=1';
if (datModul.idPila>0) and (helUtils.sqlExistsTestGeneral(Helios, lSQL)) then
begin
Helios.Error('Uživatele ' + #1 + datModul.sqlUserName + #1 + ' lze do systému přihlásit jen jedenkrát !' + CRLF + 'Pokud jste si jistí že přihlášen není, změňte příznak v přehledu Pily');
Exit;
end;
Helios.ExecSQL('UPDATE ' + tblRezPredpisPily + ' SET Prihlasen=1, PosledniPrihlaseni=GETDATE(), PocetTisku=0, PocetTiskuMimo=0 WHERE LoginName=SUSER_SNAME() AND Aktivni=1');
// colPokracujVTisku
// datModul.tiskarnaNazev:= ''; // ZDesigner ZD421 PILA
if (datModul.idPila>0) then
begin
datModul.tiskarnaNazev:= helUtils.getHeliosStrVal(Helios, '', 'SELECT TiskFronta FROM ' + tblRezPredpisPily + ' WHERE ID=' + datModul.idPila.ToString);
if (datModul.idTiskForm=0) then
datModul.idTiskForm:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT ISNULL(IDTiskFormStitek,0) FROM ' + tblRezPredpisPily + ' WHERE ID=' + datModul.idPila.ToString);
end;
if (datModul.idTiskForm=0) then
begin
lSQL:= 'SELECT TOP(1) ID FROM ' + tblFormDef + ' WHERE Nazev=N''EMP - Štítek pro pilu'' AND Skupina=2043 AND PlatnostDo IS NULL'; // 2043 = materialy VPr, 2101 = evidence operaci
datModul.idTiskForm:= helUtils.getHeliosIntVal(Helios, 0, lSQL);
end;
if (datModul.idTiskForm=0) then
datModul.idTiskForm:= datModul.idTiskFormStitek;
if (datModul.tiskarnaNazev='') then
begin
lSQL:= 'SELECT TOP(1) TiskFronta FROM ' + tblTiskDef + ' WHERE FormDefID=' + datModul.idTiskForm.ToString;
lSQL:= lSQL + ' AND Implicitni=0 AND LoginName IS NULL OR LoginName=SUSER_SNAME() ORDER BY ISNULL(LoginName, N'''')';
datModul.tiskarnaNazev:= helUtils.getHeliosStrVal(Helios, '', lSQL);
end;
if not(helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 FROM ' + tblTiskDef + ' WHERE TiskDoSouboru=1 AND FormDefID=' + datModul.idTiskForm.ToString)) then
if (datModul.idTiskForm>0) and (datModul.tiskarnaNazev<>'') then
if (helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 AS A FROM ' + tblTiskDef + ' WHERE FormDefID=' + datModul.idTiskForm.ToString + ' AND Implicitni=0')) then
if not(dm.IsPrinterActiveFrmId (datModul.tiskarnaNazev, datModul.idTiskForm)) then
Helios.Error('POZOR !! Přednastavená tiskárna "' + datModul.tiskarnaNazev + '" nenalezena nebo není aktivní');
idPrac:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT ID FROM ' + tblCPrac + ' WHERE TRIM(Pracoviste)=N''30'' AND IDTabStrom=N''101001''');
datModul.idPracovistePila:= idPrac;
lSQL:= 'SELECT pp.ID, mvaz.ID AS IDMVaz, kzvp.SkupZbo, kzvp.RegCis, kzvp.Nazev1, kzmvaz.SkupZbo AS SkupZboMat, kzmvaz.RegCis AS RegCisMat, kzmvaz.Nazev1 AS Nazev1Mat, mvaz.pozice' + CRLF;
lSQL:= lSQL + ', zak.Nazev AS CisloNadoby, kzf.Nazev1, kzf.Vykres, pp.operace, mvaz.mnozstvi*1000 AS MnozMat, mvaz.mnoz_Nevydane*1000 AS MnozMatCelkem' + CRLF;
lSQL:= lSQL + ', ISNULL(mvazv.mnoz_Nevydane, (mvaz.mnoz_Nevydane/mvaz.mnozstvi)) AS MnozVys, vp.RadaPrikaz, ISNULL(kzmvazE._Rozmer, N'''') AS Rozmer' + CRLF;
lSQL:= lSQL + ', ISNULL(pp.Plan_zadani, vp.Plan_zadani) AS Datum, vp.RadaPrikaz, ISNULL(kzmvazE._JakostMaterialu, N'''') AS JakostMat' + CRLF;
lSQL:= lSQL + ', ISNULL(kzmvazE._S1_X, N'''') AS SilaMat' + CRLF;
lSQL:= lSQL + ' FROM ' + tblPrPost + ' pp INNER JOIN ' + tblPrikaz + ' vp ON (vp.ID=pp.IDPrikaz) INNER JOIN ' + tblKZ + ' kzvp ON (kzvp.ID=vp.IdTabKmen)' + CRLF;
lSQL:= lSQL + ' LEFT JOIN ' + tblPrikaz + ' vpv ON (vpv.ID=vp.IDPrikazVyssi) LEFT JOIN ' + tblPrikaz + ' vpf ON (vpf.ID=vp.IDPrikazRidici)' + CRLF;
lSQL:= lSQL + ' INNER JOIN ' + tblPrVaz + ' mvaz ON (mvaz.Splneno=0 AND mvaz.IDPrikaz=vp.ID AND mvaz.operace=pp.operace AND mvaz.IDOdchylkyDo IS NULL)' + CRLF;
lSQL:= lSQL + ' LEFT JOIN ' + tblZak + ' zak ON (zak.ID=vpf.IDZakazka) INNER JOIN ' + tblKZ + ' kzf ON (kzf.ID=vpf.IdTabKmen)' + CRLF;
lSQL:= lSQL + ' LEFT JOIN ' + tblPrVaz + ' mvazv ON (mvazv.IDPrikaz=vpv.ID AND mvazv.IDOdchylkyDo IS NULL AND mvazv.nizsi=mvaz.vyssi)' + CRLF;
lSQL:= lSQL + ' LEFT JOIN ' + tblKZ + ' kzmvaz ON (kzmvaz.ID=mvaz.nizsi) LEFT JOIN ' + tblKZe + ' kzmvazE ON (kzmvazE.ID=kzmvaz.ID)' + CRLF;
lSQL:= lSQL + ' LEFT JOIN ' + tblSZ + ' szkzm ON (szkzm.SkupZbo=kzmvaz.SkupZbo) LEFT JOIN ' + tblSZe + ' szkzme ON (szkzme.ID=szkzm.ID)' + CRLF;
lSQL:= lSQL + ' WHERE vp.StavPrikazu=30 AND pp.prednastaveno=1 AND pp.splneno=0 AND pp.IDOdchylkyDo IS NULL AND pp.pracoviste=' + idPrac.ToString + CRLF;
lSQL:= lSQL + ' AND szkzme._MaterialProPilu=1' + CRLF;
lSQL:= lSQL + ' ORDER BY ISNULL(pp.Plan_zadani, vp.Plan_zadani)';
with helios.OpenSQL(lSQL) do
if (RecordCount=0) then
Helios.Error(#1'Žádný hutní materiál, požadovaný na zadaných výrobních příkazech,'#1 + CRLF + #1'není zaplánován do výroby.'#1)
// Helios.Error(#1'Žádný hutní materiál, požadovaný na zadaných výrobních příkazech,'#1 + CRLF + #1'na sobě nemá navázanou operaci.'#1)
else
begin
fMain:= TformMain.Create(nil);
try
try
fMain.Helios:= Helios;
fMain.dm:= dm;
fmain.idDP:= 0;
fMain.ShowModal;
except
end;
finally
fMain.Free;
end;
end;
// zrus priznak prihlaseni
Helios.ExecSQL('UPDATE ' + tblRezPredpisPily + ' SET Prihlasen=0 WHERE LoginName=SUSER_SNAME() AND Aktivni=1');
end;
3: begin
Helios.Info('Krok 1');
if (datModul.idPila>0) then
begin
datModul.tiskarnaNazev:= helUtils.getHeliosStrVal(Helios, '', 'SELECT TiskFronta FROM ' + tblRezPredpisPily + ' WHERE ID=' + datModul.idPila.ToString);
if (datModul.idTiskForm=0) then
datModul.idTiskForm:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT IDTiskFormStitek FROM ' + tblRezPredpisPily + ' WHERE ID=' + datModul.idPila.ToString);
end;
if (datModul.idTiskForm=0) then
begin
lSQL:= 'SELECT TOP(1) ID FROM ' + tblFormDef + ' WHERE Nazev=N''EMP - Štítek pro pilu'' AND Skupina=2043 AND PlatnostDo IS NULL';
datModul.idTiskForm:= helUtils.getHeliosIntVal(Helios, 0, lSQL);
end;
if (datModul.idTiskForm=0) then
datModul.idTiskForm:= datModul.idTiskFormStitek;
if (datModul.tiskarnaNazev= '') then // ZDesigner ZD421 PILA
begin
lSQL:= 'SELECT TOP(1) TiskFronta FROM ' + tblTiskDef + ' WHERE FormDefID=' + datModul.idTiskForm.ToString;
lSQL:= lSQL + ' AND Implicitni=0 AND LoginName IS NULL OR LoginName=SUSER_SNAME() ORDER BY ISNULL(LoginName, N'''')';
datModul.tiskarnaNazev:= helUtils.getHeliosStrVal(Helios, '', lSQL);
end;
if not(dm.IsPrinterActive(datModul.tiskarnaNazev)) then
Helios.Error('POZOR !! Přednastavená tiskárna "' + datModul.tiskarnaNazev + '" nenalezena nebo není aktivní');
Helios.Info('Krok 2');
fMain:= TformMain.Create(nil);
try
try
fMain.Helios:= Helios;
fMain.dm:= dm;
fMain.idDP:= cRec; // id Delici/Rezaci plan
fMain.ShowModal;
except
end;
finally
fMain.Free;
end;
Helios.Info('Krok 3');
end;
2: begin
bidRezaciPredpis:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT DPBID FROM ' + tblObecPrehled + ' WHERE NazevSys=N''hvw_RezaciPredpis''');
if (bidRezaciPredpis>0) then
begin
if (Helios.BrowseID=bidRezaciPredpis) then
begin
filtrPolozek:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT ID FROM ' + tblFiltr + ' WHERE Nazev=N''Řezací plán - materiál pro výběr'' AND BrowseID=' + bidPrKVaz.ToString);
podm:= '<$PR_WhereSys>TabPrKVazby.IDOdchylkyDo IS NULL</$PR_WhereSys><$PR_MultiSelect>1</$PR_MultiSelect>';
podm:= podm + IfThen(filtrPolozek>0, '<$PR_IDFiltr>' + filtrPolozek.ToString + '</$PR_IDFiltr>', '');
if (Helios.Prenos(bidPrKVaz, 'ID', oVar1, podm, 'Vyberte položky pro Řezací předpis', false)) then
begin
SetLength(arrID2, 0);
IDcka:= VarToStr(oVar1);
if (IDcka<>'') then
begin
tmpInt:= 1 + Length(IDcka)-Length(StringReplace(IDcka,',','',[rfReplaceAll]));
SetLength(arrID2, tmpInt);
for l_loop:=0 to tmpInt-1 do
begin
if Pos(',',IDcka)>0 then
begin
arrID2[l_loop]:= StrToInt(LeftStr(IDcka, Pos(',',IDcka)-1));
IDcka:= MidStr(IDcka, Pos(',',IDcka)+1,262140) // 65535 * 4 (max. delka pole)
end
else
arrID2[l_loop]:= StrToInt(IDcka);
end;
end;
VytvorRezaciPredpis (Helios, arrID2);
end;
end
else
Helios.Error(#1'Akci lze spouštět jen z přehledu Řezací předpis'#1);
end
else
Helios.Error(#1'Nebyl nalezen definovaný přehled Řezací předpis'#1);
end;
end;
Helios.Refresh (true);
try
if (helUtils.HeliosObjectExists(Helios, '#TabExtKom', '')) then
with Helios.OpenSQL('SELECT Poznamka FROM #TabExtKom') do
if (RecordCount>0) then
Helios.OpenBrowse(541,'');
finally
end;
if (dm<>nil) then
FreeAndNil(dm);
except
// neni to pres Application.HandleException() kvuli probublani vyjimky
// do Heliosu (konkretni pouziti napr. v Automatu)
on E: EExternal do
begin
LockWindowUpdate(0); // jistota, kdyby nekde zustalo viset
raise EExternal.Create (E.Message);
end;
on E: Exception do
begin
LockWindowUpdate(0); // jistota, kdyby nekde zustalo viset
raise;
end;
end;
end;
INITIALIZATION
TComObjectFactory.Create(ComServer, TplgEMPDeleniTrubek, Class_EMPDeleniTrubek, 'runMe', '', ciMultiInstance, tmSingle);
END.
README.md
+1 -1
View File
@@ -1,2 +1,2 @@
# EMPolar-plgEMPDeleniTrubek
# EMPolar-plgDeleniTrubek
datModul.dfm
+1395
View File
File diff suppressed because it is too large Load Diff
datModul.pas
+1545
View File
File diff suppressed because it is too large Load Diff
frmCalc.dfm
+355
View File
@@ -0,0 +1,355 @@
object formCalc: TformCalc
Left = 0
Top = 0
BorderIcons = []
BorderStyle = bsNone
Caption = 'formCalc'
ClientHeight = 517
ClientWidth = 483
Color = clActiveBorder
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
Position = poOwnerFormCenter
Visible = True
OnCreate = FormCreate
OnShow = FormShow
TextHeight = 15
object lblCalcPnl: TLabel
Left = 3
Top = 65
Width = 475
Height = 29
Alignment = taCenter
AutoSize = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object advKbd: TAdvTouchKeyboard
Left = 6
Top = 100
Width = 463
Height = 415
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -40
Font.Name = 'Tahoma'
Font.Style = []
KeyboardType = ktCustom
KeyDistance = 10
Keys = <
item
Caption = '0'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 5
Y = 310
end
item
Caption = '1'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 5
Y = 205
end
item
Caption = '2'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 110
Y = 205
end
item
Caption = '3'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 220
Y = 205
end
item
Caption = '4'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 5
Y = 105
end
item
Caption = '5'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 110
Y = 105
end
item
Caption = '6'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 220
Y = 105
end
item
Caption = '7'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 5
Y = 5
end
item
Caption = '8'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 110
Y = 5
end
item
Caption = '9'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 220
Y = 5
end
item
Caption = 'OK'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 180
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = 59392
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 360
Y = 230
end
item
Caption = '<-'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = 4567546
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 360
Y = 105
end
item
Caption = '.'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 110
Y = 310
end
item
Caption = 'Smazat'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = 5460991
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 360
Y = 5
end
item
Caption = '"'
KeyValue = -1
ShiftKeyValue = -1
AltGrKeyValue = -1
Height = 100
Width = 100
SpecialKey = skNone
BorderColor = clGray
BorderColorDown = clBlack
Color = clSilver
ColorDown = clGray
TextColor = clBlack
TextColorDown = clBlack
ImageIndex = -1
X = 220
Y = 310
end>
SmallFont.Charset = DEFAULT_CHARSET
SmallFont.Color = clWindowText
SmallFont.Height = -19
SmallFont.Name = 'Tahoma'
SmallFont.Style = []
Version = '2.0.2.6'
OnKeyClick = advKbdKeyClick
end
object edtNum: TEdit
Left = 129
Top = 8
Width = 178
Height = 41
Alignment = taRightJustify
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
Text = '5.25'
end
object btnCalcPnlClose: TButton
Left = 423
Top = 6
Width = 55
Height = 52
Caption = 'X'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
OnClick = btnCalcPnlCloseClick
end
end
frmCalc.pas
+187
View File
@@ -0,0 +1,187 @@
unit frmCalc;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, AdvTouchKeyboard,
Vcl.ExtCtrls;
type
TformCalc = class(TForm)
lblCalcPnl: TLabel;
advKbd: TAdvTouchKeyboard;
edtNum: TEdit;
btnCalcPnlClose: TButton;
procedure advKbdKeyClick(Sender: TObject; Index: Integer);
procedure btnCalcPnlCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{
procedure NastavMsgWin(b1Vis: Boolean; b2Vis: Boolean; b3Vis: Boolean; b1Res: Integer; b2Res: Integer; b3Res: Integer; timerInt: Integer; timerRes: Integer;
b1Lbl: string; b2Lbl: string; b3Lbl: string; titulek: string; msg: string; memoMsg: string);
}
public
pnlAkce, mrVal: integer;
retVal: string;
edtNumAlign: TAlignment;
mnMax: Single;
end;
var
formCalc: TformCalc;
implementation
{$R *.dfm}
uses System.StrUtils,
datModul, funkceTB, frmMain;
{
procedure TformCalc.NastavMsgWin(b1Vis: Boolean; b2Vis: Boolean; b3Vis: Boolean; b1Res: Integer; b2Res: Integer; b3Res: Integer; timerInt: Integer; timerRes: Integer;
b1Lbl: string; b2Lbl: string; b3Lbl: string; titulek: string; msg: string; memoMsg: string);
begin
end;
}
procedure TformCalc.advKbdKeyClick (Sender: TObject; Index: Integer);
var i: integer;
m, mnOdeslat, mnOK, mnZmIO, mnZmNeopr: Extended;
msg: string;
rI: Integer;
rE: Extended;
begin
i:= -1;
if (RightStr(edtNum.Text.Trim,1)='"') and (Index<>10) and (Index<>11) and (Index<>13) then
Exit;
case Index of
10: begin // enter
edtNum.Text:= Trim(edtNum.Text);
case pnlAkce of
1,3,5: begin // osobni cislo / cislo nadoby / DN
if not(TryStrToInt(edtNum.Text, rI)) then
rI:= 0;
retVal:= rI.ToString;
end;
2,7: begin
if not(TryStrToFloat(edtNum.Text, rE)) then // mnozstvi do srotu (mm) / sila (tloustka)
rE:= 0;
retVal:= rE.ToString;
end;
4,6: retVal:= edtNum.Text; // material / prumer
end;
mrVal:= 0;
Close;
end;
11: begin
edtNum.Text:= LeftStr(edtNum.Text, Length(edtNum.Text)-1);
// if (edtNum.Text='') then
// edtNum.Text:= '0';
end;
12: if (edtNum.Text<>'') and (Pos(',', edtNum.Text)=0) then
edtNum.Text:= edtNum.Text + ',';
13: edtNum.Text:= '';
else
edtNum.Text:= edtNum.Text + advKbd.Keys[Index].Caption;
end;
if (Length(edtNum.Text)=2) and (edtNum.Text.LeftStr(1)='0') and (edtNum.Text<>'0.') then
edtNum.Text:= RightStr(edtNum.Text, 1);
end;
procedure TformCalc.btnCalcPnlCloseClick (Sender: TObject);
begin
mrVal:= 10;
Close;
end;
procedure TformCalc.FormCreate (Sender: TObject);
begin
self.Visible:= false;
end;
procedure TformCalc.FormShow (Sender: TObject);
begin
Self.Left:= (Screen.WorkAreaWidth - self.Width) div 2;
Self.Top:= (Screen.WorkAreaHeight - self.Height) div 2;
if (btnCalcPnlClose.CanFocus) then
btnCalcPnlClose.SetFocus;
// desetinna tecka
advKbd.Keys.Items[12].Width:= 0;
advKbd.Keys.Items[12].Height:= 0;
// znak "
advKbd.Keys.Items[14].Width:= 0;
advKbd.Keys.Items[14].Height:= 0;
if (pnlAkce=1) then
begin
lblCalcPnl.Caption:= 'Osobní číslo zaměstnance:';
end;
if (pnlAkce=2) then
begin
advKbd.Keys.Items[12].Width:= 100;
advKbd.Keys.Items[12].Height:= 100;
lblCalcPnl.Caption:= 'Množství do šrotu (mm)';
end;
if (pnlAkce=3) then
begin
lblCalcPnl.Caption:= 'Číslo nádoby';
end;
if (pnlAkce=4) then
begin
lblCalcPnl.Caption:= 'Materiál';
end;
if (pnlAkce=5) then
begin
lblCalcPnl.Caption:= 'DN';
end;
if (pnlAkce=6) then
begin
lblCalcPnl.Caption:= 'Průměr';
advKbd.Keys.Items[12].Width:= 100; // desetinna tecka
advKbd.Keys.Items[12].Height:= 100;
advKbd.Keys.Items[14].Width:= 100; // znak "
advKbd.Keys.Items[14].Height:= 100;
end;
if (pnlAkce=7) then
begin
lblCalcPnl.Caption:= 'Síla (tloušťka)';
advKbd.Keys.Items[12].Width:= 100; // desetinna tecka
advKbd.Keys.Items[12].Height:= 100;
advKbd.Keys.Items[14].Width:= 100; // znak "
advKbd.Keys.Items[14].Height:= 100;
end;
end;
end.
frmKeyb.dfm
+36
View File
@@ -0,0 +1,36 @@
object formKeyb: TformKeyb
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsNone
Caption = 'formKeyb'
ClientHeight = 711
ClientWidth = 1459
Color = clGradientActiveCaption
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -35
Font.Name = 'Segoe UI'
Font.Style = []
Position = poOwnerFormCenter
OnShow = FormShow
TextHeight = 47
object keyb1: TTouchKeyboard
Left = 8
Top = 122
Width = 1443
Height = 581
GradientEnd = clSilver
GradientStart = clGray
Layout = 'Standard'
end
object edtPopis: TEdit
Left = 122
Top = 28
Width = 1215
Height = 60
AutoSize = False
TabOrder = 1
OnKeyDown = edtPopisKeyDown
end
end
frmKeyb.pas
+52
View File
@@ -0,0 +1,52 @@
unit frmKeyb;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Touch.Keyboard, Vcl.StdCtrls;
type
TformKeyb = class(TForm)
keyb1: TTouchKeyboard;
edtPopis: TEdit;
procedure FormShow (Sender: TObject);
procedure edtPopisKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
public
text: string;
end;
var
formKeyb: TformKeyb;
implementation
{$R *.dfm}
procedure TformKeyb.edtPopisKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key=VK_RETURN) then
begin
text:= Trim(edtPopis.Text);
Close;
end;
if (Key=VK_ESCAPE) then
begin
text:= '';
Close;
end;
end;
procedure TformKeyb.FormShow (Sender: TObject);
begin
edtPopis.Text:= '';
edtPopis.SetFocus;
end;
end.
frmMain.dfm
+58631
View File
File diff suppressed because it is too large Load Diff
frmMain.pas
+5029
View File
File diff suppressed because it is too large Load Diff
frmObrazekKZ.dfm
+46
View File
@@ -0,0 +1,46 @@
object formObrazekKZ: TformObrazekKZ
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsNone
Caption = 'formObrazekKZ'
ClientHeight = 285
ClientWidth = 463
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = []
Position = poOwnerFormCenter
OnShow = FormShow
TextHeight = 32
object Panel1: TPanel
Left = 0
Top = 0
Width = 463
Height = 285
Align = alClient
Color = clGradientActiveCaption
ParentBackground = False
TabOrder = 0
ExplicitHeight = 319
object Image1: TImage
Left = 12
Top = 12
Width = 263
Height = 263
Proportional = True
Stretch = True
end
object btnKonec: TButton
Left = 292
Top = 114
Width = 155
Height = 65
Caption = 'Konec'
TabOrder = 0
OnClick = btnKonecClick
end
end
end
frmObrazekKZ.pas
+77
View File
@@ -0,0 +1,77 @@
unit frmObrazekKZ;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
ddPlugin_TLB;
type
TformObrazekKZ = class(TForm)
Image1: TImage;
btnKonec: TButton;
Panel1: TPanel;
procedure btnKonecClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure NactiObrazekZKmene;
public
Helios: IHelios;
idKZ: integer;
end;
var
formObrazekKZ: TformObrazekKZ;
implementation
uses datModul, helUtils;
{$R *.dfm}
function HexStringToMemoryStream (const HexStr: string): TMemoryStream;
begin
result:= TMemoryStream.Create;
try
result.Size:= Length(HexStr) div 2;
if (result.Size>0) then
HexToBin(PChar(HexStr), result.Memory, result.Size);
except
end;
end;
procedure TformObrazekKZ.FormShow(Sender: TObject);
begin
NactiObrazekZKmene;
end;
procedure TformObrazekKZ.NactiObrazekZKmene;
var lSQL, data: string;
Stream: TStream;
begin
if (idKZ>0) and (helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 FROM ' + tblKZ + ' WHERE Obrazek IS NOT NULL AND ID=' + idKZ.ToString)) then
begin
lSQL:= 'SELECT CONVERT(Varchar(max), Obrazek, 2) AS ObrazekData FROM ' + tblKZ + ' WHERE ID=' + idKZ.ToString;
with Helios.OpenSQL(lSQL) do
begin
data:= FieldByNameValues('ObrazekData');
Image1.Picture.LoadFromStream(HexStringToMemoryStream(data));
self.Invalidate;
end;
end;
end;
procedure TformObrazekKZ.btnKonecClick(Sender: TObject);
begin
Close;
end;
end.
frmPolozkyMD.dfm
+315
View File
@@ -0,0 +1,315 @@
object formPolozkyMD: TformPolozkyMD
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
Caption = 'Test'
ClientHeight = 829
ClientWidth = 781
Color = clSkyBlue
CustomTitleBar.CaptionAlignment = taCenter
CustomTitleBar.Control = custTitleBar
CustomTitleBar.Enabled = True
CustomTitleBar.Height = 31
CustomTitleBar.SystemColors = False
CustomTitleBar.BackgroundColor = 9074280
CustomTitleBar.ForegroundColor = clYellow
CustomTitleBar.InactiveBackgroundColor = clWhite
CustomTitleBar.InactiveForegroundColor = 10066329
CustomTitleBar.ButtonForegroundColor = clWhite
CustomTitleBar.ButtonBackgroundColor = 9074280
CustomTitleBar.ButtonHoverForegroundColor = 65793
CustomTitleBar.ButtonHoverBackgroundColor = 10456447
CustomTitleBar.ButtonPressedForegroundColor = 65793
CustomTitleBar.ButtonPressedBackgroundColor = 12168612
CustomTitleBar.ButtonInactiveForegroundColor = 65793
CustomTitleBar.ButtonInactiveBackgroundColor = 13551038
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = []
GlassFrame.Enabled = True
GlassFrame.Top = 31
Position = poOwnerFormCenter
StyleElements = [seFont, seClient]
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
781
829)
TextHeight = 32
object Label1: TLabel
AlignWithMargins = True
Left = 7
Top = 34
Width = 95
Height = 32
Caption = 'Materi'#225'l'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
end
object lblMaterial: TLabel
Left = 119
Top = 34
Width = 270
Height = 32
AutoSize = False
Caption = 'lblMaterial'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
end
object lblRegCis: TLabel
Left = 8
Top = 67
Width = 616
Height = 32
AutoSize = False
Caption = 'lblRegCis'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
object Label4: TLabel
Left = 408
Top = 34
Width = 93
Height = 32
Caption = 'skladem:'
end
object lblAltMatCapt: TLabel
Left = 8
Top = 108
Width = 196
Height = 32
Caption = 'N'#225'hradn'#237' materi'#225'l:'
end
object lblSkladem: TLabel
Left = 510
Top = 34
Width = 118
Height = 32
AutoSize = False
Caption = '0123,45'
end
object lblDelkaCelkem: TLabel
Left = 153
Top = 744
Width = 523
Height = 32
Alignment = taCenter
Anchors = [akRight, akBottom]
AutoSize = False
Caption = 'lblDelkaCelkem'
ExplicitLeft = 8
end
object Panel1: TPanel
Left = 6
Top = 170
Width = 769
Height = 571
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0
ExplicitWidth = 624
DesignSize = (
769
571)
object Label2: TLabel
Left = 214
Top = 0
Width = 110
Height = 32
Caption = 'V'#253'r. p'#345#237'kaz'
end
object Label3: TLabel
Left = 460
Top = 0
Width = 69
Height = 32
Caption = 'D'#283'len'#237
end
object lblNadobaSort: TLabel
Left = 612
Top = 0
Width = 90
Height = 32
Caption = 'N'#225'doba'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 22
Top = 0
Width = 120
Height = 32
Caption = 'P'#345#237'kaz '#345#237'd'#237'c'#237
end
object ctrlPolozkyMD: TControlList
AlignWithMargins = True
Left = 2
Top = 35
Width = 761
Height = 661
Anchors = [akLeft, akTop, akRight]
ItemHeight = 60
ItemMargins.Left = 0
ItemMargins.Top = 0
ItemMargins.Right = 0
ItemMargins.Bottom = 0
ParentColor = False
TabOrder = 0
OnBeforeDrawItem = ctrlPolozkyMDBeforeDrawItem
ExplicitWidth = 616
object lblDeleni: TLabel
Left = 455
Top = -2
Width = 102
Height = 32
Alignment = taRightJustify
Caption = 'lblDeleni'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
end
object lblNadoba: TLabel
Left = 609
Top = -2
Width = 110
Height = 32
Alignment = taRightJustify
Caption = 'lblNadoba'
end
object lblRegCisPrikaz: TLabel
Left = 217
Top = 25
Width = 243
Height = 32
AutoSize = False
Caption = 'lblRegCisPrikaz'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
object lblRadaPrikaz: TLabel
Left = 217
Top = -2
Width = 124
Height = 30
Caption = 'lblRadaPrikaz'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
object lblRezatUhel: TLabel
Left = 598
Top = 25
Width = 131
Height = 32
Alignment = taRightJustify
Caption = 'lblRezatUhel'
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = [fsItalic]
ParentFont = False
end
object lblRadaPrikazFin: TLabel
Left = 18
Top = -2
Width = 151
Height = 30
Caption = 'lblRadaPrikazFin'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
object lblRegCisPrikazFin: TLabel
Left = 18
Top = 25
Width = 243
Height = 32
AutoSize = False
Caption = 'lblRegCisPrikazFin'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
end
end
object btnNaPilu: TButton
Left = 218
Top = 778
Width = 146
Height = 47
Anchors = [akRight, akBottom]
Caption = 'Na PILU'
TabOrder = 1
OnClick = btnNaPiluClick
ExplicitLeft = 73
end
object btnStorno: TButton
Left = 609
Top = 778
Width = 146
Height = 47
Anchors = [akRight, akBottom]
Caption = 'Storno'
TabOrder = 2
OnClick = btnStornoClick
ExplicitLeft = 464
end
object custTitleBar: TTitleBarPanel
Left = 0
Top = 0
Width = 781
Height = 30
CustomButtons = <>
ExplicitWidth = 636
end
object grdAltMaterial: TStringGrid
Left = 210
Top = 108
Width = 563
Height = 58
Anchors = [akLeft, akTop, akRight]
ColCount = 3
FixedCols = 0
RowCount = 2
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goFixedRowDefAlign]
TabOrder = 4
OnDrawCell = grdAltMaterialDrawCell
OnMouseUp = grdAltMaterialMouseUp
ExplicitWidth = 418
end
end
frmPolozkyMD.pas
+328
View File
@@ -0,0 +1,328 @@
unit frmPolozkyMD;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, ddPlugin_TLB,
Vcl.ControlList, ES.ControlListControls,
datModul, Vcl.TitleBarCtrls, Vcl.Grids;
type
TformPolozkyMD = class(TForm)
Panel1: TPanel;
btnNaPilu: TButton;
btnStorno: TButton;
ctrlPolozkyMD: TControlList;
lblDeleni: TLabel;
lblNadoba: TLabel;
lblRegCisPrikaz: TLabel;
lblRadaPrikaz: TLabel;
lblRezatUhel: TLabel;
Label2: TLabel;
Label3: TLabel;
lblNadobaSort: TLabel;
custTitleBar: TTitleBarPanel;
Label1: TLabel;
lblMaterial: TLabel;
lblRegCis: TLabel;
Label4: TLabel;
grdAltMaterial: TStringGrid;
lblAltMatCapt: TLabel;
lblSkladem: TLabel;
lblDelkaCelkem: TLabel;
Label5: TLabel;
lblRadaPrikazFin: TLabel;
lblRegCisPrikazFin: TLabel;
procedure btnStornoClick (Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnNaPiluClick(Sender: TObject);
procedure ctrlPolozkyMDBeforeDrawItem(AIndex: Integer; ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState);
procedure FormShow(Sender: TObject);
procedure grdAltMaterialDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure grdAltMaterialMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
procedure NactiAlternativy;
public
Helios: IHelios;
idMatDavky: integer;
mrVal: integer;
dm: Tdm;
mForm: TForm;
selRC: string;
end;
var
formPolozkyMD: TformPolozkyMD;
idKZMatDavky: integer;
idKZ, idKZAlt, idPrKVazby: integer;
aktR, aktC: integer;
implementation
uses Vcl.Clipbrd, helUtils;
{$R *.dfm}
procedure TformPolozkyMD.NactiAlternativy;
var lSQL, popisMat: string;
i, idAlt: integer;
mnozSkl: Extended;
begin
lblAltMatCapt.Font.Color:= clWindowText;
idKZAlt:= 0;
idKZ:= idKZMatDavky;
lSQL:= 'SELECT IDKZNahrada FROM ' + tblAlterKZ + ' WHERE IDKmeneZbozi=' + idKZMatDavky.ToString;
lSQL:= lSQL + ' ORDER BY Priorita';
with Helios.OpenSQL(lSQL) do
begin
lblAltMatCapt.Visible:= (RecordCount>0);
grdAltMaterial.Visible:= lblAltMatCapt.Visible;
Panel1.Top:= lblRegCis.Top + lblRegCis.Height + 5;
lblDelkaCelkem.Top:= Panel1.Top + Panel1.Height + 5;
btnNaPilu.Top:= lblDelkaCelkem.Top + lblDelkaCelkem.Height + 10;
btnStorno.Top:= btnNaPilu.Top;
if (RecordCount>0) then
begin
lblAltMatCapt.Font.Color:= clRed;
grdAltMaterial.RowCount:= RecordCount;
First;
i:= 0;
while not(EOF) do
begin
idAlt:= VarToStr(FieldByNameValues('IDKZNahrada')).ToInteger;
idKZAlt:= idAlt;
grdAltMaterial.Cells[0, i]:= helUtils.getHeliosStrVal(Helios, '', 'SELECT RegCis FROM ' + tblKZ + ' WHERE ID=' + idAlt.ToString);
lSQL:= 'SELECT ISNULL(_Rozmer, N'''') + N'' '' + ISNULL(_S1_X, N'''') + N'' / '' + ISNULL(_JakostMaterialu, N'''') FROM ' + tblKZe + ' WHERE ID=' + idAlt.ToString;
lSQL:= 'SELECT ISNULL(_JakostMaterialu, N'''') FROM ' + tblKZe + ' WHERE ID=' + idAlt.ToString;
popisMat:= helUtils.getHeliosStrVal(Helios, '', lSQL);
if (popisMat<>'') then
grdAltMaterial.Cells[1, i]:= ' ' + popisMat
else
grdAltMaterial.Cells[1, i]:= ' ' + helUtils.getHeliosStrVal(Helios, '', 'SELECT Nazev1 FROM ' + tblKZ + ' WHERE ID=' + idAlt.ToString);
lSQL:= 'SELECT Mnozstvi FROM ' + tblSS + ' WHERE IDSklad=N' + datModul.sklMat.QuotedString + ' AND Mnozstvi>0 AND IDKmenZbozi=' + idAlt.ToString;
mnozSkl:= helUtils.getHeliosFloatVal(Helios, 0, lSQL);
grdAltMaterial.Cells[2, i]:= ' ' + mnozSkl.ToString + ' ' + helUtils.getHeliosStrVal(Helios, '', 'SELECT MJEvidence FROM ' + tblKZ + ' WHERE ID=' + idAlt.ToString);
Inc(i);
Next;
end;
grdAltMaterial.Height:= (grdAltMaterial.DefaultRowHeight * grdAltMaterial.RowCount) + 10;
Panel1.Top:= grdAltMaterial.Top + grdAltMaterial.Height + 5;
lblDelkaCelkem.Top:= Panel1.Top + Panel1.Height + 5;
btnNaPilu.Top:= lblDelkaCelkem.Top + lblDelkaCelkem.Height + 10;
btnStorno.Top:= btnNaPilu.Top;
end;
end;
end;
procedure TformPolozkyMD.btnNaPiluClick (Sender: TObject);
var lSQL, d: string;
begin
if not(dm.tblPila.Active) then
dm.tblPila.Open;
d:= helUtils.getHeliosStrVal(Helios, '', 'SELECT CisloDavky FROM ' + tblRezPredpisPily + ' WHERE CisloDavky IS NOT NULL AND LoginName=SUSER_SNAME() AND Aktivni=1');
lSQL:= 'SELECT 1 AS A FROM ' + tblMatDavkyH + ' WHERE LoginName=SUSER_SNAME() AND NaPile=1';
if (helUtils.sqlExistsTestGeneral(Helios, lSQL)) then
Helios.Error ('Uživatel ' + #1 + datModul.sqlUserName + #1 + ' už má zahájenou dávku č.' + d + ', nelze zpracovat další dávku !')
else
begin
// dopln vazby na alternativu
mrVal:= 1;
Close;
end;
end;
procedure TformPolozkyMD.btnStornoClick (Sender: TObject);
begin
Close;
end;
procedure TformPolozkyMD.ctrlPolozkyMDBeforeDrawItem (AIndex: Integer; ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState);
var lSQL, sz, rc, oper, szFin, rcFin: string;
uhel, mnoz: Extended;
idPrKV, idVPr, idKZFin, dokl, idDilec: integer;
begin
{ // pokud je povoleno, neni videt vyber polozky v seznamu
// Nastavení barvy pera pro rámeček
ACanvas.Pen.Color:= clBlack;
ACanvas.Pen.Width:= 1; // Šířka rámečku
// Nakreslení rámečku kolem položky
ACanvas.Rectangle(ARect);
}
try
dm.tblPolozkyMD.RecNo:= AIndex + 1; // AIndex zero-based
// lblMaterial.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colNazev1').Value).Trim;
// lblPozice.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colPozice').Value).Trim;
// lblRegCis.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colRegCis').Value) + ' ' + VarToStr(dm.tblPolozkyMD.FieldByName('colRozmer').Value).Trim
// + '/' + VarToStr(dm.tblPolozkyMD.FieldByName('colSilaMat').Value) + ' ' + VarToStr(dm.tblPolozkyMD.FieldByName('colJakostMat').Value);
lblDeleni.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colKs').Value) + ' x ' + VarToStr(dm.tblPolozkyMD.FieldByName('colDelka').Value) + ' mm ';
lblNadoba.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colNadoba').Value);
lblRegCisPrikaz.Caption:= '' + VarToStr(dm.tblPolozkyMD.FieldByName('colRegCisPrikaz').Value).Trim;
lblRadaPrikaz.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colRadaPrikaz').Value).Trim;
// lblPrumer.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colPrumer').Value).Trim;
// lblTloustka.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colSilaMat').Value).Trim;
idPrKV:= dm.tblPolozkyMD.FieldByName('colIDPrKVazby').AsInteger;
idVPr:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT IDPrikaz FROM ' + tblPrKVaz + ' WHERE ID=' + idPrKV.ToString);
with Helios.OpenSQL('SELECT RadaPrikaz, IDTabKmen FROM ' + tblVPr + ' WHERE ID=(SELECT IDPrikazRidici FROM ' + tblVPr + ' WHERE ID=' + idVPr.ToString + ')') do
if (RecordCount=1) then
begin
lblRadaPrikazFin.Caption:= VarToStr(FieldByNameValues('RadaPrikaz'));
idKZFin:= VarToStr(FieldByNameValues('IDTabKmen')).ToInteger;
lblRegCisPrikazFin.Caption:= helUtils.getHeliosStrVal(Helios, '', 'SELECT SkupZbo + N'' '' + RegCis FROM ' + tblKZ + ' WHERE ID=' + idKZfin.ToString);
end;
if (idKZ<>idKZAlt) and (idKZAlt>0) then
begin
lSQL:= '';
oper:= helUtils.getHeliosStrVal(Helios, '', 'SELECT operace FROM ' + tblPrKVaz + ' WHERE ID=' + idPrKV.ToString);
dokl:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT Doklad FROM ' + tblPrKVaz + ' WHERE ID=' + idPrKV.ToString);
idDilec:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT vyssi FROM ' + tblPrKVaz + ' WHERE ID=' + idPrKV.ToString);
mnoz:= helUtils.getHeliosFloatVal(Helios, 0, 'SELECT mnoz_zad FROM ' + tblPrKVaz + ' WHERE ID=' + idPrKV.ToString);
lSQL:= 'SELECT 1 FROM ' + tblPrKVaz + ' WHERE IDPrikaz=' + idVPr.ToString + ' AND IDOdchylkyDo IS NULL AND Doklad=' + dokl.ToString + ' AND nizsi=' + idKZAlt.ToString;
lSQL:= lSQL + ' AND vyssi=' + idDilec.ToString;
if not(helUtils.sqlExistsTestGeneral(Helios, lSQL)) and (oper<>'') then
begin
lSQL:= 'EXEC dbo.hp_NewPozadavek_TabPrKVazby @IDPrikaz=' + idVPr.ToString + ', @IDKmenZbozi=' + idKZAlt.ToString + ', @Operace=N' + oper.QuotedString + ', @Mnozstvi=';
lSQL:= lSQL + mnoz.ToString.Replace(',', '.') + ', @Mnoz_zad=' + mnoz.ToString.Replace(',', '.') + ', @Alt_K_Dokladu=' + dokl.ToString;
try
Helios.ExecSQL (lSQL);
finally
end;
end;
end;
lblRezatUhel.Caption:= '';
sz:= VarToStr(dm.tblPolozkyMD.FieldByName('colSZPrikaz').Value).Trim;
rc:= VarToStr(dm.tblPolozkyMD.FieldByName('colRegCisPrikaz').Value).Trim;
if (sz<>'') and (rc<>'') then
begin
lSQL:= 'SELECT TOP(1) Uhel FROM dbo.hvw_ADE_INSERT_VYROBA WHERE SkupZbo=N' + sz.QuotedString + ' AND RegCis=N' + rc.QuotedString + ' AND LastRec=1 AND StavPolozky=N''50''';
uhel:= helUtils.getHeliosFloatVal(Helios, 0, lSQL);
if (uhel>1) then
lblRezatUhel.Caption:= 'úhel ' + uhel.ToString;
end;
except
end;
end;
procedure TformPolozkyMD.FormCreate (Sender: TObject);
begin
mrVal:= 0;
end;
procedure TformPolozkyMD.FormShow (Sender: TObject);
var lSQL, c, mj, pr: string;
begin
grdAltMaterial.ColWidths[0]:= 150;
grdAltMaterial.ColWidths[1]:= 130;
grdAltMaterial.ColWidths[2]:= 110;
idKZMatDavky:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT IDKmenZboziMat FROM ' + tblMatDavkyH + ' WHERE ID=' + idMatDavky.ToString);
lSQL:= 'SELECT Mnozstvi FROM ' + tblSS + ' WHERE IDKmenZbozi=' + idKZMatDavky.ToString + ' AND IDSklad=N' + QuotedStr('1030');
c:= helUtils.getHeliosStrVal(Helios, '0', lSQL);
mj:= helUtils.getHeliosStrVal(Helios, '', 'SELECT MJEvidence FROM ' + tblKZ + ' WHERE ID=' + idKZMatDavky.ToString);
lblSkladem.Caption:= c + ' ' + mj;
if (c='0') then
lblSkladem.Font.Color:= clRed
else
lblSkladem.Font.Color:= clWindowText;
dm.NactiPolozkyMatDavky (idMatDavky, self);
ctrlPolozkyMD.ItemCount:= dm.tblPolozkyMD.RecordCount;
c:= ' Materiálová dávka č. ' + helUtils.getHeliosStrVal(Helios, '', 'SELECT Cislo FROM ' + tblMatDavkyH + ' WHERE ID=' + idMatDavky.ToString);
{
if (dm.tblPolozkyMD.RecordCount>0) then
c:= c + ' / materiál ' + dm.tblPolozkyMD.FieldByName('colSZ').AsString + ' ' + dm.tblPolozkyMD.FieldByName('colRegCis').AsString
+ ' - ' + dm.tblPolozkyMD.FieldByName('colNazev1').AsString + ' / jakost ' + dm.tblPolozkyMD.FieldByName('colJakostMat').AsString
+ ' / prumer ' + dm.tblPolozkyMD.FieldByName('colPrumer').AsString;
}
self.Caption:= c;
dm.tblPolozkyMD.First;
lblMaterial.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colNazev1').Value).Trim;
// lblPozice.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colPozice').Value).Trim;
lblRegCis.Caption:= VarToStr(dm.tblPolozkyMD.FieldByName('colRegCis').Value) + ' ' + VarToStr(dm.tblPolozkyMD.FieldByName('colRozmer').Value).Trim
+ '/' + VarToStr(dm.tblPolozkyMD.FieldByName('colSilaMat').Value) + ' ' + VarToStr(dm.tblPolozkyMD.FieldByName('colJakostMat').Value);
pr:= dm.tblPolozkyMD.FieldByName('colPrumer').AsString;
if (pr<>'') then
lblRegCis.Caption:= lblRegCis.Caption + ' / průměr ' + pr;
NactiAlternativy;
lblDelkaCelkem.Caption:= 'celkem ' + (dm.SumaDelkyMatDavky (idMatDavky)/1000).ToString + ' ' + mj;
end;
procedure TformPolozkyMD.grdAltMaterialDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var o: string;
begin
grdAltMaterial.Canvas.Font.Color:= clWindowText;
if (ACol=2) then
begin
o:= grdAltMaterial.Cells[ACol, ARow];
if (o.Trim='0 m') then
grdAltMaterial.Canvas.Font.Color:= clRed;
grdAltMaterial.Canvas.FillRect (Rect);
grdAltMaterial.Canvas.TextRect(Rect, Rect.Left, Rect.Top-4, o);
end;
end;
procedure TformPolozkyMD.grdAltMaterialMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (ssShift in Shift) then
begin
grdAltMaterial.MouseToCell (X, Y, aktC, aktR);
selRC:= grdAltMaterial.Cells[aktC, aktR].Trim;
Clipboard.AsText:= selRC;
end;
end;
end.
imgs/2023-08-10_102418.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

imgs/double_red_right_arrow.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.8 KiB

imgs/left-arrow.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 13 KiB

imgs/left-arrow2.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

imgs/pause_green_button_icon_227843.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.7 KiB

imgs/pause_red_button_icon_227844.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.5 KiB

imgs/print.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.5 KiB

imgs/right-arrow(1).png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

imgs/right-arrow(2).png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 10 KiB

imgs/right-arrow.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

imgs/right.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 16 KiB

plgEMPDeleniTrubek.dpr
+80
View File
@@ -0,0 +1,80 @@
library plgEMPDeleniTrubek;
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$IFOPT D-}
{$SetPEFlags $AC0E}
{$SetPEOptFlags $AC0E}
{$ELSE}
{$SetPEFlags $AA02}
{$SetPEOptFlags $AA02}
{$ENDIF}
// IMAGE_FILE_RELOCS_STRIPPED = $0001
// IMAGE_FILE_EXECUTABLE_IMAGE = $0002 *
// IMAGE_FILE_LINE_NUMS_STRIPPED = $0004 *
// IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008 *
// IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010
// IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020
// IMAGE_FILE_BYTES_REVERSED_LO = $0080
// IMAGE_FILE_32BIT_MACHINE = $0100
// IMAGE_FILE_DEBUG_STRIPPED = $0200
// IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400 *
// IMAGE_FILE_NET_RUN_FROM_SWAP = $0800 *
// IMAGE_FILE_SYSTEM = $1000
// IMAGE_FILE_DLL = $2000 *
// IMAGE_FILE_UP_SYSTEM_ONLY = $4000
// IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000 *
{$I plgEMPDeleniTrubek.inc}
uses
madExcept,
madLinkDisAsm,
madListHardware,
madListProcesses,
madListModules,
System.Win.ComServ,
System.AnsiStrings,
System.Types,
ddPlugin_TLB,
VCL.Dialogs,
ComObjekt in 'ComObjekt.pas',
frmMain in 'frmMain.pas' {formMain},
frmCalc in 'frmCalc.pas' {formCalc},
datModul in 'datModul.pas' {dm: TDataModule},
frmObrazekKZ in 'frmObrazekKZ.pas' {formObrazekKZ},
frmKeyb in 'frmKeyb.pas' {formKeyb},
frmPolozkyMD in 'frmPolozkyMD.pas' {formPolozkyMD};
//uses
// System.Win.ComServ,
// ddPlugin_TLB,
// ComObjekt in 'ComObjekt.pas' {/ ,frmMain in 'frmMain.pas' {formMain}},
// Unit1 in 'Unit1.pas' {Form1};
//* v neunicode verzích Delphi tu bylo PChar, protože PChar a PAnsiChar
// bylo to samé, od Delphi 2009 to již neplatí
{
function PluginGetSysAndClassName(Vysl: PAnsiChar): DWORD; stdcall;
const C_ProgID = 'plgEMPDeleniTrubek.runMe';
begin
Result := Length(C_ProgID);
if Assigned(Vysl) then
StrPCopy(Vysl, C_ProgID);
end;
}
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.RES}
BEGIN
END.
plgEMPDeleniTrubek.dproj
+1001
View File
File diff suppressed because it is too large Load Diff
plgEMPDeleniTrubek.inc
+1
View File
@@ -0,0 +1 @@
//{$DEFINE OMNITHREAD}
plgEMPDeleniTrubek.res
BIN
View File
Binary file not shown.