Prvotni verze pro Giteu
33
.gitignore
vendored
@ -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.
|
||||
#
|
||||
@ -21,27 +20,17 @@
|
||||
# Deployment Manager configuration file for your project. Added in Delphi XE2.
|
||||
# Uncomment this if it is not mobile development and you do not use remote debug feature.
|
||||
#*.deployproj
|
||||
#
|
||||
#
|
||||
# C++ object files produced when C/C++ Output file generation is configured.
|
||||
# Uncomment this if you are not using external objects (zlib library for example).
|
||||
#*.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/
|
||||
|
||||
643
ComObjekt.pas
Normal 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.
|
||||
1395
datModul.dfm
Normal file
1545
datModul.pas
Normal file
355
frmCalc.dfm
Normal 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
|
||||
187
frmCalc.pas
Normal 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.
|
||||
36
frmKeyb.dfm
Normal 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
|
||||
52
frmKeyb.pas
Normal 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.
|
||||
58631
frmMain.dfm
Normal file
5029
frmMain.pas
Normal file
46
frmObrazekKZ.dfm
Normal 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
|
||||
77
frmObrazekKZ.pas
Normal 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.
|
||||
315
frmPolozkyMD.dfm
Normal 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
|
||||
328
frmPolozkyMD.pas
Normal 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.
|
||||
BIN
imgs/2023-08-10_102418.png
Normal file
|
After Width: | Height: | Size: 15 KiB |
BIN
imgs/double_red_right_arrow.png
Normal file
|
After Width: | Height: | Size: 2.8 KiB |
BIN
imgs/left-arrow.png
Normal file
|
After Width: | Height: | Size: 13 KiB |
BIN
imgs/left-arrow2.png
Normal file
|
After Width: | Height: | Size: 15 KiB |
BIN
imgs/pause_green_button_icon_227843.png
Normal file
|
After Width: | Height: | Size: 6.7 KiB |
BIN
imgs/pause_red_button_icon_227844.png
Normal file
|
After Width: | Height: | Size: 6.5 KiB |
BIN
imgs/print.png
Normal file
|
After Width: | Height: | Size: 2.5 KiB |
BIN
imgs/right-arrow(1).png
Normal file
|
After Width: | Height: | Size: 20 KiB |
BIN
imgs/right-arrow(2).png
Normal file
|
After Width: | Height: | Size: 10 KiB |
BIN
imgs/right-arrow.png
Normal file
|
After Width: | Height: | Size: 20 KiB |
BIN
imgs/right.png
Normal file
|
After Width: | Height: | Size: 16 KiB |
80
plgEMPDeleniTrubek.dpr
Normal 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<72>ch Delphi tu bylo PChar, proto<74>e PChar a PAnsiChar
|
||||
// bylo to sam<61>, od Delphi 2009 to ji<6A> neplat<61>
|
||||
{
|
||||
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.
|
||||
1001
plgEMPDeleniTrubek.dproj
Normal file
1
plgEMPDeleniTrubek.inc
Normal file
@ -0,0 +1 @@
|
||||
//{$DEFINE OMNITHREAD}
|
||||