Files
LOVATO-plugin/libSys/plgMain.pas
2026-04-07 18:23:56 +02:00

2428 lines
74 KiB
ObjectPascal
Raw Blame History

{ *************************************************************************** }
{ }
{ Jadro pluginu 2 Asseco Solutions }
{ }
{ *************************************************************************** }
unit plgMain;
interface
uses
SysUtils, Messages, Forms, DBCtrls, Classes, StdCtrls,
ddPlugin_TLB, plgType, plgKonfig;
type
TplgJakaVerze =
(jvZakladni, // '1.0'
jvMajor, // '1'
jvMinor, // '0'
jvDatumRRRRMMDD, // '20050307'
jvCela, // '1.0.2005.0307'
jvCelaUnicode, // '2.0.2009.0909 - UNICODE'
jvHexa // '010020050307' <- bez znaku $
);
TplgPorovnaniVerzi = (pvStejneVerze, pvDBMaVetsi, pvDBMaMensi);
// --- verze pluginu ----------------------------------------------------------
function plgVerzePluginu(AJakaVerze: TplgJakaVerze): String;
function plgObecnaVerze(Averze: Int64; AJakaVerze: TplgJakaVerze): String;
function plgNactiVerziPluginuZDB(Helios: IHelios; var ZmenyOK: Boolean): String;
function plgPorovnejVerziPluginuSVerziDB(const VerzeDB: String): TplgPorovnaniVerzi;
function plgVerzeSQLServeru(AVerze: Integer): String;
// --- prace s tabulkami a atributy -------------------------------------------
function plgJmenoSys2Tabulka(const AJmenoSys: String): TplgTabulka;
function plgGetTabulkaDef(aTabulka : TplgTabulka): PplgTabulkaDef;
function plgJmenoTabulky(aTabulka : TplgTabulka): String;
function plgVerejneJmenoTabulky(const AJmenoSys: String) : String;
function plgAtribut(aTabulka: TplgTabulka; const AJmenoSysAtributuBezTabulky : String): PplgAtributTabulky; overload;
function plgAtribut(const AJmenoSysAtributu : String): PplgAtributTabulky; overload;
function plgSetrideneAtributy(aTabulka : TplgTabulka): TStringList;
function plgSkupinaAtributu(ATypAtributu: TplgTypAtributu) : TplgSkupinaAtributu;
function plgMuzeBytSumovat(aTypAtributu : TplgTypAtributu): Boolean;
function plgHodnotaZKonverze(JeNULL: Boolean; const Hodnota: String; SLKonverze: TStringList): String;
// pouze cisty typ (bez IDENTITY, NULL apod.) - napr. INT, VARCHAR(20), NUMERIC(19,6)
function plgTypAtributu2Str(PA: PplgAtributTabulky): String;
function plgStr2TypAtributu(const ANazevTypu: String; APrecision, AScale: Integer): TplgTypAtributu;
// --- prehledy ---------------------------------------------------------------
function plgJmenoView2Browse(const AJmenoView: String): TplgBrowse;
function plgBrowse2BID(Helios: IHelios; Browse: TplgBrowse): Integer;
function plgBID2JmenoView(Helios: IHelios; BID: Integer): String;
function plgJeObecnyPrehled(const NazevSys: String): Boolean; overload;
function plgJeObecnyPrehled(BID: Integer): Boolean; overload;
// VBL: 21.4.2018 funkce vrac<61> BID dle syst<73>mov<6F>ho jm<6A>na
function plgJmenoView2BID(Helios: IHelios; AJmenoView: String): Integer;
// --- databaze ---------------------------------------------------------------
function plgGetDBName(Helios: IHelios): String;
function plgExistuje(Helios: IHelios; const Tabulka, Podminka: String): Boolean;
function plgSkriptProDeleteJednohoZaznamu(Tabulka: TplgTabulka; KontrolaBE: Boolean): String;
function plgAtributExistujeVDatabazi(Helios: IHelios; const Tabulka, Atribut: String): Boolean;
// --- zurnal -----------------------------------------------------------------
procedure plgZapisDoZurnalu(Helios: IHelios; Uroven: Byte; Udalost: Integer; const Akce: String);
// --- vraci nazev DLL pluginu s celou cestou ---------------------------------
function plgGetPluginPathAndName: String;
// --- vraci cestu na TEMP adresar
function plgGetTemporaryPath: string;
// --- vraci nazev docasneho souboru s danym prefixem (prvni 3 znaky) a priponou
function plgGetTemporaryFileName(Prefix, Extension : String): String;
// --- testuje existenci prepinace /XX (instalace bez preruseni) --------------
function plgJeParametrXX: Boolean;
// --- testuje existenci prepinace /X (tichy chod) ----------------------------
function plgJeParametrX: Boolean;
// --- jsem v modu tiche instalace? (vynuceno bud ExtKomID = -3 nebo /XX) -----
function plgJeTichaInstalace: Boolean;
// --- vrati nazev pocitace ---------------------------------------------------
function plgJmenoPocitace: String;
// --- produkt ----------------------------------------------------------------
function plgJeToHeliosEasy(Helios: IHelios): Boolean;
function plgJeToHeliosGermany(Helios: IHelios): Boolean;
// --- centruje form na obrazovce ---------------------------------------------
// - na rozdil od poScreenCenter bere ohled na TaskBar
procedure plgCenterForm(AForm : TForm);
// --- minimalizuje aplikaci --------------------------------------------------
function plgMinimizeApplication(AForm: TForm; var AMessage: TWMSysCommand): Boolean;
// --- nahozeni, shozeni a test priznaku blokovani editoru --------------------
// - predpoklada dotaz na jeden radek !!!
function plgZablokujZaznam(Helios: IHelios; const TabName, Where : String): Boolean;
function plgOdblokujZaznam(Helios: IHelios; const TabName, Where : String): Boolean;
function plgJeZaznamBlokovan(Helios: IHelios; const TabName, Where : String): Boolean;
// --- preklad hlasek ---------------------------------------------------------
function plgCtiOznam(const AHlaska: String): String; overload;
function plgCtiOznam(ATxt: TplgTxt): String; overload;
function plgPrepniJazykoveDLL(Helios: IHelios; Jazyk1, Jazyk2: Integer): Boolean;
// --- prelozeni vyjimek s cislem vetsim nebo rovno 5<>000<30>000 -----------------
function plgPrelozException(const Hlaska: String): String;
// --- RTTI procedury a funkce - pracuji s published atributy -----------------
function plgHasPropertyRTTI(Instance: TObject; const aProperty : String): Boolean;
function plgGetStringPropValueOfObjectRTTI(
Instance: TObject; const aProperty: String; var aValue: String): Boolean;
function plgGetObjectPropValueOfObjectRTTI(
Instance: TObject; const aProperty: String; var aValue: TObject): Boolean;
procedure plgSetPropertiesOfObjectRTTI(
Instance: TObject; const AProperty: array of string; const AValues: array of const);
procedure plgSetPropertiesOfListOfObjectsRTTI(
AObjectList: TList; const AProperty: array of string; const AValues: array of const); overload;
procedure plgSetPropertiesOfListOfObjectsRTTI(
AObjectList: TStringList; const AProperty: array of string; const AValues: array of const); overload;
procedure plgSetPropertiesOfArrayOfObjectsRTTI(
const AObjectArray: array of TObject; const AProperty: array of string; const AValues: array of const);
// --- prace s retezci --------------------------------------------------------
// - odstrani z retezce S zadanou mnozinu znaku
function plgFilterStr(const S: String; CS: TSysCharSet): String;
// - odstrani vsechny znaky krome zadanych
function plgFilterVseKrome(const S: string; CS: TSysCharSet): string;
// - vrati retezec ze Znaku o delce Delka
function plgCharStr(Znak: Char; Delka: Integer): String; inline;
// - prevede retezec do hexa vyjadreni pouzitelne pro SQL
// - napr. '012:' -> '0x3031323A'
function plgTextToBinary(const S: AnsiString): String;
// Unicode varianta QuotedStr(), tedy N'...' (pokud pou<6F><75>v<EFBFBD>m v neUnicode Delphi, tak je to to sam<61>, co QuotedStr()) }
// pou<6F><75>vat jen na SQL-typy: na NCHAR, NVARCHAR, NTEXT, ne nap<61>. na DATETIME, CHAR, VARCHAR, TEXT }
function plgNQuotedStr(const S: string): string; inline;
// zrusi z GUIDStr zavorky a pomlcky
function plgGUIDBezPomlcek(const GUIDStr: String): String;
// --- prace s Varianty -------------------------------------------------------
// - porovna 2 varianty, funguje i s variantnim polem (s dimenzi 1)
function plgVarSameValue(const A, B: Variant): Boolean;
// --- fonty ------------------------------------------------------------------
function plgFontExistuje(const FaceName: String): Boolean;
function plgTestMSSansSerifFont(const AFontName: string): String;
// --- podpora pro praci s konverzi -------------------------------------------
// - vrati obracenou konverzi: misto 1=Ano vrati Ano=1
function plgObracenaKonverze(const AKonverze : String) : TStringList;
// - plni kombo externi konverzi - stejne texty, ale nektere chybi
function plgNaplnNeDBComboZVenku(ACombo: TCustomComboBox; const AKonverze : String;
ATridit: Boolean = False) : Boolean;
// - plni kombo externi konverzi
function plgNaplnComboZVenku(ADBCombo: TDBComboBox; AKonverze : String): Boolean;
// --- podpora pro prevod hodnot do SQL skriptu -------------------------------
// - Vrati datum ve formatu nezavislem na nastaveni SET DATETIME dmy
// - Pokud je ADate rovno 0, vraci NULL !!!
function plgGetIndependentSQLDate(ADate: TDateTime): String;
function plgGetIndependentSQLDateTime(ADateTime: TDateTime; Quotovat : Boolean = True): String;
// - Vrati cislo jako string ve formatu SQL nezavislem na mistnim nastaveni
// - AMaska ... maska pro prikaz Format, napr. '%.2f'
function plgGetIndependentSQLFloat(const AMaska: String; ACislo: Extended): String;
// --- zobrazi okno s memo komponentou se zadanym textem ----------------------
procedure plgHelpForm(const ACaption, AText: String);
// --- prace s definicemi -----------------------------------------------------
function plgVratVztah(Index: Integer): PplgVztahDef;
function plgVratExtAkci(Index: Integer): PplgExtAkceDef;
function plgVratExtAttr(Index: Integer): PplgExterniAtribut;
function plgVratExtTrigger(Index: Integer): PplgExterniTrigger;
function plgVratZmenovySkript(Index : Integer): PplgZmenovySkript;
function plgVratUProc(Index: Integer): PplgUlozenaProcedura;
function plgVratUzivFunkci(Index: Integer): PplgUzivatelskaFunkce;
// - kdyz neni definovana zadna tabulka, vrati tZadna a False
function plgJeNejakaTabulka(var Prvni: TplgTabulka): Boolean;
// - kdyz neni definovana zadny prehled, vrati bZadny a False
function plgJeNejakyPrehled(var Prvni: TplgBrowse): Boolean;
// - kdyz neni definovana zadny soudek, vrati sdNeniVidet a False
function plgJeNejakySoudek(var Prvni: TplgSoudek): Boolean;
// --- konfiguracni objekt pluginu --------------------------------------------
function PluginKonfig: TPluginKonfig;
// --- zakladni inicializace --------------------------------------------------
procedure InicializaceJadraPluginu(Helios: IHelios);
// --- spusti specifickou akci nad danou tabulkou -----------------------------
// - navratova hodnota ma smysl pouze pro akci plgGlobAkce_GenerujPrehledy
// - v takovem pripade vraci skript pro vygenerovani externich akci
function SpustAkciPluginu(Helios: IHelios; Browse: TplgBrowse; const GUIDAkce: String): String;
function SpustAkciPluginuProTab(Helios: IHelios; BrowseID: Integer; const GUIDAkce: String): String;
// --- provede vygenerovani, popr. pregenerovani vsech zakladnich prehledu ----
function plgExtKomIDInstalace(Helios: IHelios): Boolean;
procedure InstalacePluginu(Helios: IHelios; TichaInstalace: Boolean);
// --- zobrazeni informace o pluginu ------------------------------------------
procedure InformaceOPluginu(Helios: IHelios);
// --- preklad hlasek ---------------------------------------------------------
procedure plgPresunHlaskyNaWeb(Helios: IHelios);
procedure plgStahniZWebuJazykovaDLL(Helios: IHelios);
// --- controller pro editory -------------------------------------------------
procedure SpustControllerEditoru(Helios: IHelios);
var
Global_Legislativa : Integer = -1;
{ =========================================================================== }
implementation
uses
Windows, Controls, Types, TypInfo, Math, ComObj, Variants,
sqIcons,
plgEdit, plgTable, plgInstalace, plgUta, plgSoudky, plgDMGlob, plgLadit,
plgUProc, plgFunkce, plgZmeny, plgExtAttr, plgExtAkce, plgExtTrigger,
plgVazby, plgHlasky, plgBrowse, plgAkce, plgAbout, plgPreklady,
plgController, plgExtController
;
var
InicializaceProbehla: Boolean = False;
Global_PluginKonfig: TPluginKonfig = nil;
AktivniJazyk1: Integer = Cplg_jJazykNedefinovan;
AktivniJazyk2: Integer = Cplg_jJazykNedefinovan;
AktivniJazyky: TStringList = nil;
type
TplgPrekladHlasekA = function(LW: LongWord): PAnsiChar;
TplgPrekladHlasekW = function(LW: LongWord): PWideChar;
TplgPrekladHlasekCP = function(LW: LongWord; var CP: Integer): PAnsiChar; stdcall;
TplgAktivniJazyk = class
protected
FHandle_JazykDLL: HINST;
public
destructor Destroy; override;
function CtiOznam(AHlaska: TplgTxt): string; virtual; abstract;
end;
TplgJazykPrekladHlasekA = class(TplgAktivniJazyk)
private
FPreklad: TplgPrekladHlasekA;
public
constructor Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekA);
function CtiOznam(AHlaska: TplgTxt): string; override;
end;
TplgJazykPrekladHlasekW = class(TplgAktivniJazyk)
private
FPreklad: TplgPrekladHlasekW;
public
constructor Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekW);
function CtiOznam(AHlaska: TplgTxt): string; override;
end;
TplgJazykPrekladHlasekCP = class(TplgAktivniJazyk)
private
FPreklad: TplgPrekladHlasekCP;
public
constructor Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekCP);
function CtiOznam(AHlaska: TplgTxt): string; override;
end;
TplgJazykPrekladHlasek04 = class(TplgAktivniJazyk)
public
function CtiOznam(AHlaska: TplgTxt): string; override;
end;
{ ########################################################################### }
destructor TplgAktivniJazyk.Destroy;
begin
if FHandle_JazykDLL <> 0 then
FreeLibrary(FHandle_JazykDLL);
inherited;
end;
{ --------------------------------------------------------------------------- }
constructor TplgJazykPrekladHlasekA.Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekA);
begin
FHandle_JazykDLL := AHandleDLL;
FPreklad := APreklad;
end;
{ --------------------------------------------------------------------------- }
function TplgJazykPrekladHlasekA.CtiOznam(AHlaska: TplgTxt): string;
var
LAnsiS: RawByteString;
begin
LAnsiS := FPreklad(GplgHlasky[AHlaska].W);
SetCodePage(LAnsiS, 1250, False); //hl<68><6C>ky "po staru" jsou v<>dy v CP1250
Result := string(LAnsiS);
end;
{ --------------------------------------------------------------------------- }
constructor TplgJazykPrekladHlasekW.Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekW);
begin
FHandle_JazykDLL := AHandleDLL;
FPreklad := APreklad;
end;
{ --------------------------------------------------------------------------- }
function TplgJazykPrekladHlasekW.CtiOznam(AHlaska: TplgTxt): string;
begin
Result := FPreklad(GplgHlasky[AHlaska].W);
end;
{ --------------------------------------------------------------------------- }
constructor TplgJazykPrekladHlasekCP.Create(AHandleDLL: HINST; APreklad: TplgPrekladHlasekCP);
begin
FHandle_JazykDLL := AHandleDLL;
FPreklad := APreklad;
end;
{ --------------------------------------------------------------------------- }
function TplgJazykPrekladHlasekCP.CtiOznam(AHlaska: TplgTxt): string;
var
LAnsiS: RawByteString;
CP: Integer;
begin
LAnsiS := FPreklad(GplgHlasky[AHlaska].W, CP);
SetCodePage(LAnsiS, CP, False);
Result := string(LAnsiS);
end;
{ --------------------------------------------------------------------------- }
function TplgJazykPrekladHlasek04.CtiOznam(AHlaska: TplgTxt): string;
begin
Result := GplgHlasky[AHlaska].SK;
end;
{ =========================================================================== }
function PluginKonfig: TPluginKonfig;
begin
if not Assigned(Global_PluginKonfig) then
Global_PluginKonfig := TPluginKonfig.Create;
Result := Global_PluginKonfig;
end;
{ --------------------------------------------------------------------------- }
function SpustAkciPluginu(Helios: IHelios; Browse: TplgBrowse; const GUIDAkce: String): String;
var
plgAkcePrehleduClass: TplgAkcePrehleduClass;
frmPlgEditorClass: TfrmPlgEditorClass;
AP: TplgAkcePrehledu;
begin
with Cplg_SeznamVychozichNastaveniBrowse[Browse] do
begin
plgAkcePrehleduClass := TplgAkcePrehleduClass(DMAkceClass);
frmPlgEditorClass := TfrmPlgEditorClass(EditorClass);
end;
if not Assigned(plgAkcePrehleduClass) then
Result := ''
else
begin
AP := plgAkcePrehleduClass.Create(Helios, Browse, frmPlgEditorClass);
plgLadit_KontrolaTridyAkce(AP);
with AP do
try
Result := SpustAkci(GUIDAkce);
finally
Free;
end;
end;
end;
{ --------------------------------------------------------------------------- }
function SpustAkciPluginuProTab(Helios: IHelios; BrowseID: Integer; const GUIDAkce: String): String;
var
EA: PplgExtAkceDef;
II: Integer;
plgAkcePrehleduClass: TplgAkcePrehleduClass;
begin
Result := '';
II := 1;
EA := plgVratExtAkci(II);
while Assigned(EA) do
begin
if EA.BrowseID = BrowseID then
begin
plgAkcePrehleduClass := TplgAkcePrehleduClass(EA.DMAkceClass);
if Assigned(plgAkcePrehleduClass) then
begin
with plgAkcePrehleduClass.CreateTab(Helios, EA) do
try
Result := SpustAkci(GUIDAkce);
finally
Free;
end;
end;
Exit;
end;
Inc(II);
EA := plgVratExtAkci(II);
end;
end;
{ --------------------------------------------------------------------------- }
function plgObecnaVerze(Averze: Int64; AJakaVerze: TplgJakaVerze): String;
var
LMajor, LMinor, LDatum : String;
{ +++++++++++++++++++++++++++ }
function UdelejCislo(ACislo: Int64): string;
begin
Result := Format('%.2x', [ACislo]);
if Result[1] = '0' then
Result := Result[2];
end;
{ +++++++++++++++++++++++++++ }
begin
LMajor := UdelejCislo(Lo(AVerze shr (32 + 4 + 4))); // '1'
LMinor := UdelejCislo(Lo(AVerze shr (32))); // '0'
LDatum := Format('%.8x', [LongWord(AVerze)]); // '19990924'
case AJakaVerze of
jvZakladni : Result := Format('%s.%s', [LMajor, LMinor]);
jvMajor : Result := LMajor;
jvMinor : Result := LMinor;
jvDatumRRRRMMDD : Result := LDatum;
jvCela,
jvCelaUnicode : Result := Format('%s.%s.%s.%s', [LMajor, LMinor, Copy(LDatum, 1, 4), Copy(LDatum, 5, MaxInt)]);
jvHexa : Result := Format('%.12x', [AVerze]);
else Result := '';
end;
if AJakaVerze = jvCelaUnicode then
Result := Result + ' - UNICODE'
{$IFDEF VER220}+' XE'{$ENDIF}
{$IFDEF VER240}+' XE3'{$ENDIF}
{$IFDEF VER280}+' XE7'{$ENDIF}
{$IFDEF VER310}+' 10.1'{$ENDIF}
{$IFDEF VER330}+' 10.3'{$ENDIF}
{$IFDEF VER340}+' 10.4'{$ENDIF}
{$IFDEF VER350}+' 11'{$ENDIF}
{$IFDEF VER360}+' 12'{$ENDIF};
end;
{ --------------------------------------------------------------------------- }
function plgVerzePluginu(AJakaVerze: TplgJakaVerze): String;
begin
Result := plgObecnaVerze(CVerzePluginu, AJakaVerze);
end;
{ --------------------------------------------------------------------------- }
function plgVerzeSQLServeru(AVerze: Integer): String;
begin
if AVerze >= Cplg_SQLVersion_2022 then
Result := '2022'
else
if AVerze >= Cplg_SQLVersion_2019 then
Result := '2019'
else
if AVerze >= Cplg_SQLVersion_2017 then
Result := '2017'
else
if AVerze >= Cplg_SQLVersion_2016 then
Result := '2016'
else
if AVerze >= Cplg_SQLVersion_2014 then
Result := '2014'
else
if AVerze >= Cplg_SQLVersion_2012_SP2 then
Result := '2012 SP2'
else
if AVerze >= Cplg_SQLVersion_2012_SP1 then
Result := '2012 SP1'
else
if AVerze >= Cplg_SQLVersion_2012 then
Result := '2012'
else
if AVerze >= Cplg_SQLVersion_2008R2_SP3 then
Result := '2008 R2 SP3'
else
if AVerze >= Cplg_SQLVersion_2008R2_SP2 then
Result := '2008 R2 SP2'
else
if AVerze >= Cplg_SQLVersion_2008R2_SP1 then
Result := '2008 R2 SP1'
else
if AVerze >= Cplg_SQLVersion_2008R2 then
Result := '2008 R2'
else
if AVerze >= Cplg_SQLVersion_2008_SP4 then
Result := '2008 SP4'
else
if AVerze >= Cplg_SQLVersion_2008_SP3 then
Result := '2008 SP3'
else
if AVerze >= Cplg_SQLVersion_2008_SP2 then
Result := '2008 SP2'
else
if AVerze >= Cplg_SQLVersion_2008_SP1 then
Result := '2008 SP1'
else
if AVerze >= Cplg_SQLVersion_2008 then
Result := '2008'
else
if AVerze >= Cplg_SQLVersion_2005_SP3 then
Result := '2005 SP3'
else
if AVerze >= Cplg_SQLVersion_2005_SP2 then
Result := '2005 SP2'
else
if AVerze >= Cplg_SQLVersion_2005_SP1 then
Result := '2005 SP1'
else
if AVerze >= Cplg_SQLVersion_2005 then
Result := '2005'
else
if AVerze >= Cplg_SQLVersion_2000_SP4 then
Result := '2000 SP4'
else
if AVerze >= Cplg_SQLVersion_2000_SP3 then
Result := '2000 SP3'
else
if AVerze >= Cplg_SQLVersion_2000_SP2 then
Result := '2000 SP2'
else
if AVerze >= Cplg_SQLVersion_2000_SP1 then
Result := '2000 SP1'
else
if AVerze >= Cplg_SQLVersion_2000 then
Result := '2000'
else
if AVerze >= Cplg_SQLVersion_7_0_SP4 then
Result := '7.00 SP4'
else
if AVerze >= Cplg_SQLVersion_7_0_SP3 then
Result := '7.00 SP3'
else
if AVerze >= Cplg_SQLVersion_7_0_SP2 then
Result := '7.00 SP2'
else
if AVerze >= Cplg_SQLVersion_7_0_SP1 then
Result := '7.00 SP1'
else
Result := '7.00';
Result := Format('MS SQL Server %s', [Result]);
end;
{ --------------------------------------------------------------------------- }
function plgNactiVerziPluginuZDB(Helios: IHelios; var ZmenyOK: Boolean): String;
var
Q: IHeQuery;
begin
Q := Helios.OpenSQL(
Format(
'IF EXISTS(SELECT*FROM TabPluginInfo WHERE NazevSys=%s)'#13+
'SELECT VerzePluginu, CAST(ZmenyOK AS INT) FROM TabPluginInfo WHERE NazevSys=%0:s'#13+
'ELSE'#13+
'SELECT %s, CAST(0 AS INT)',
[plgNQuotedStr(PluginKonfig.PluginSystemoveJmeno),
plgNQuotedStr(Cplg_VerzePluginu_Nula_Str)]));
Result := varToStr(Q.FieldValues(0));
ZmenyOK := (Q.FieldValues(1) = 1);
end;
{ --------------------------------------------------------------------------- }
function plgPorovnejVerziPluginuSVerziDB(const VerzeDB: String): TplgPorovnaniVerzi;
var
VerzePlg: String;
begin
VerzePlg := plgVerzePluginu(jvHexa);
if SameText(VerzeDB, VerzePlg) then
Result := pvStejneVerze
else
if VerzeDB > VerzePlg then
Result := pvDBMaVetsi
else
Result := pvDBMaMensi;
end;
{ --------------------------------------------------------------------------- }
function plgGetDBName(Helios: IHelios): String;
begin
Result := varToStr(Helios.OpenSQL('SELECT DB_NAME()').FieldValues(0));
end;
{ --------------------------------------------------------------------------- }
function plgExistuje(Helios: IHelios; const Tabulka, Podminka: String): Boolean;
begin
Result :=
(Helios.OpenSQL(
Format('IF EXISTS(SELECT*FROM %s WHERE %s) SELECT 1 ELSE SELECT 0',
[Tabulka, Podminka])).FieldValues(0) = 1);
end;
{ --------------------------------------------------------------------------- }
function plgAtributExistujeVDatabazi(Helios: IHelios; const Tabulka, Atribut: String): Boolean;
begin
Result :=
(Helios.OpenSQL(
Format('IF COLUMNPROPERTY(OBJECT_ID(N''%s'',N''U''),N''%s'',N''AllowsNull'')IS NOT NULL SELECT 1 ELSE SELECT 0',
[Tabulka, Atribut])).FieldValues(0) = 1);
end;
{ --------------------------------------------------------------------------- }
procedure plgZapisDoZurnalu(Helios: IHelios; Uroven: Byte; Udalost: Integer; const Akce: String);
var
InfoText: String;
begin
InfoText := Copy(PluginKonfig.PluginSystemoveJmeno + ' - ' + Akce, 1, 255);
Helios.ExecSQL(
Format('EXEC dbo.hp_ZapisDoZurnalu %d,%d,%s',
[Uroven, Udalost, plgNQuotedStr(InfoText)]));
end;
{ --------------------------------------------------------------------------- }
function plgJmenoSys2Tabulka(const AJmenoSys: String): TplgTabulka;
begin
if plgJeNejakaTabulka(Result) and (Trim(AJmenoSys) <> '') then
for Result := Result to High(TplgTabulka) do
if SameText(AJmenoSys, Cplg_SeznamTabulek[Result].JmenoSys) then Exit;
// nic jsme nenalezli
Result := tZadna;
end;
{ --------------------------------------------------------------------------- }
function plgJmenoView2Browse(const AJmenoView: String): TplgBrowse;
begin
if plgJeNejakyPrehled(Result) and (Trim(AJmenoView) <> '') then
for Result := Result to High(TplgBrowse) do
if SameText(AJmenoView, Cplg_SeznamVychozichNastaveniBrowse[Result].JmenoView) then Exit;
// nic jsme nenalezli
Result := bZadny;
end;
{ --------------------------------------------------------------------------- }
function plgBrowse2BID(Helios: IHelios; Browse: TplgBrowse): Integer;
var
Q: IHeQuery;
begin
with Cplg_SeznamVychozichNastaveniBrowse[Browse] do
begin
if JmenoView = '' then
Result := 0
else
if not plgJeObecnyPrehled(JmenoView) then
Result := 0
else
begin
Q := Helios.OpenSQL(
Format('SELECT Cislo FROM TabObecnyPrehled WHERE NazevSys=%s',
[plgNQuotedStr(JmenoView)]));
// [RK 26.07.2005] doplnena vyjimka
if Q.RecordCount = 0 then
raise Exception.Create(
Format(plgCtiOznam(plxJadroNebylNalezenPrehled_X_Y)+#13#13#1'%s'#1,
[JmenoView, Jmeno,
plgCtiOznam(plxJadroJeTrebaSpustitInstalaciPluginu)]))
else
Result := Q.FieldValues(0) + Cplg_ObecnePohledy_BID_Base;
end;
end;
end;
{ --------------------------------------------------------------------------- }
function plgBID2JmenoView(Helios: IHelios; BID: Integer): String;
var
Q: IHeQuery;
begin
if not plgJeObecnyPrehled(BID) then
Result := ''
else
begin
Q := Helios.OpenSQL(
Format('SELECT NazevSys FROM TabObecnyPrehled WHERE Cislo=%d',
[BID - Cplg_ObecnePohledy_BID_Base]));
if Q.RecordCount = 0 then
raise Exception.Create(
Format(plgCtiOznam(plxJadroNebylNalezenPrehledCislo_X)+#13#13#1'%s'#1,
[BID - Cplg_ObecnePohledy_BID_Base,
plgCtiOznam(plxJadroJeTrebaSpustitInstalaciPluginu)]))
else
Result := varToStr(Q.FieldValues(0));
end;
end;
{ --------------------------------------------------------------------------- }
function plgJeObecnyPrehled(const NazevSys: String): Boolean;
begin
Result := SameText(Cplg_View_Prefix, Copy(NazevSys, 1, Cplg_View_PrefixLen));
end;
{ --------------------------------------------------------------------------- }
function plgJeObecnyPrehled(BID: Integer): Boolean;
begin
Result := (BID >= Cplg_ObecnePohledy_BID_Base);
end;
{ --------------------------------------------------------------------------- }
function plgJmenoView2BID(Helios: IHelios; AJmenoView: String): Integer;
var
Q: IHeQuery;
begin
Result := 0;
if (Trim(AJmenoView) <> '') and plgJeObecnyPrehled(AJmenoView) then
begin
Q := Helios.OpenSQL(Format('SELECT Cislo FROM TabObecnyPrehled WHERE NazevSys=%s', [plgNQuotedStr(AJmenoView)]));
if Q.RecordCount = 0 then
raise Exception.Create(Format(plgCtiOznam(plxJadroNebylNalezenPrehled_X_Y),[AJmenoView, AJmenoView]))
else
Result := Q.FieldValues(0) + Cplg_ObecnePohledy_BID_Base;
end;
end;
{ --------------------------------------------------------------------------- }
function plgGetTabulkaDef(aTabulka : TplgTabulka): PplgTabulkaDef;
begin
Result := Cplg_SeznamTabulek[ATabulka];
end;
{ --------------------------------------------------------------------------- }
function plgJmenoTabulky(aTabulka : TplgTabulka): String;
begin
if Assigned(Cplg_SeznamTabulek[aTabulka]) then
Result := Cplg_SeznamTabulek[aTabulka].JmenoSys
else
Result := '';
end;
{ --------------------------------------------------------------------------- }
function plgMuzeBytSumovat(aTypAtributu : TplgTypAtributu): Boolean;
begin
Result := (not (aTypAtributu in [taBoolean])) and
(plgSkupinaAtributu(aTypAtributu) in [skpCelaCisla, skpDesetinnaCisla]);
end;
{ --------------------------------------------------------------------------- }
function plgHodnotaZKonverze(JeNULL: Boolean; const Hodnota: String; SLKonverze: TStringList): String;
begin
if not JeNULL then
begin
if SLKonverze.IndexOfName(Hodnota) <> -1 then
Result := SLKonverze.Values[Hodnota]
else
Result := Hodnota;
end
else
begin
if SLKonverze.IndexOfName('NULL') > -1 then
Result := SLKonverze.Values['NULL']
else
Result := plgCtiOznam(plxJadroNeni);
end;
end;
{ --------------------------------------------------------------------------- }
function plgSkupinaAtributu(ATypAtributu: TplgTypAtributu) : TplgSkupinaAtributu;
begin
case ATypAtributu of
taInt,
taIdentity,
taInt64,
taIdentity64,
taSmallInt,
taByte,
taBoolean:
Result := skpCelaCisla;
taNVarChar,
taNChar,
taNText,
taVarChar,
taChar,
taText:
Result := skpRetezce;
taDateTime,
taTime:
Result := skpDatumy;
taFloat,
taNumeric_4_2,
taNumeric_5_2,
taNumeric_7_2,
taNumeric_9_2,
taNumeric_15_0,
taNumeric_19_2,
taNumeric_19_6,
taNumeric_20_6,
taNumeric_28_0:
Result := skpDesetinnaCisla;
// taGUID,
taBinary,
taImage:
Result := skpBinarni;
else
Result := skpZadna;
end;
end;
{ --------------------------------------------------------------------------- }
function plgTypAtributu2Str(PA: PplgAtributTabulky): String;
begin
Result := UpperCase(Cplg_GTypy[PA.Typ].T);
if (Pos('CHAR', Result) > 0) or (Pos('BINARY', Result) > 0) then
begin
if PA.Delka=Cplg_DelkaNVarcharMax then
Result := Format('%s(%s)', [Result, 'MAX']) //[JAS 13.2.2018] - rozsireni o (N)VARCHAR(MAX)
else
Result := Format('%s(%d)', [Result, PA.Delka])
end
else
if SameText(Result, 'NUMERIC') then
Result := Format('%s(%d,%d)', [Result, Cplg_GTypy[PA.Typ].P, Cplg_GTypy[PA.Typ].S]);
end;
{ --------------------------------------------------------------------------- }
function plgStr2TypAtributu(const ANazevTypu: String; APrecision, AScale: Integer): TplgTypAtributu;
var
TT: TplgTypAtributu;
JeNumeric: Boolean;
begin
Result := taBlbe;
if SameText(ANazevTypu, 'BIGINT IDENTITY') then
begin
Result := taIdentity64;
Exit;
end;
if SameText(ANazevTypu, 'INT IDENTITY') then
begin
Result := taIdentity;
Exit;
end;
if APrecision = -1 then
begin
if SameText(ANazevTypu, 'NVARCHAR') then Exit(taNText);
if SameText(ANazevTypu, 'VARCHAR') then Exit(taText);
end;
JeNumeric := SameText(ANazevTypu, 'NUMERIC');
for TT := Succ(Low(TplgTypAtributu)) to High(TplgTypAtributu) do
begin
if SameText(ANazevTypu, Cplg_GTypy[TT].T) then
begin
if not JeNumeric then
begin
Result := TT;
Exit;
end;
if (Cplg_GTypy[TT].P = APrecision) and (Cplg_GTypy[TT].S = AScale) then
begin
Result := TT;
Exit;
end;
end;
end;
// pokud to je numeric a nemam ho definovany, tak vezmi ten "nejvetsi"
if JeNumeric then
Result := taNumeric_20_6;
end;
{ --------------------------------------------------------------------------- }
function plgVerejneJmenoTabulky(const AJmenoSys: String): String;
var
LTabulka: TplgTabulka;
begin
if plgJeNejakaTabulka(LTabulka) and (Trim(AJmenoSys) <> '') then
for LTabulka := LTabulka to High(TplgTabulka) do
if SameText(AJmenoSys, Cplg_SeznamTabulek[LTabulka].JmenoSys) then
begin
Result := Cplg_SeznamTabulek[LTabulka].Jmeno;
Exit; {!}
end;
Result := '';
end;
{ --------------------------------------------------------------------------- }
function plgSetrideneAtributy(aTabulka: TplgTabulka): TStringList;
var
PA : PplgAtributTabulky;
II : Integer;
begin
Result := TStringList.Create;
if Cplg_SeznamTabulek[aTabulka] = nil then Exit;
with Cplg_SeznamTabulek[aTabulka]^ do
begin
PA := Atributy;
for II := 1 to PocetAtributu do
begin
Result.AddObject(PA.JmenoSys, TObject(PA));
Inc(PA);
end;
end;
Result.Sorted := True; // setrideni az na zaver (je to nejrychlejsi)
end;
{ --------------------------------------------------------------------------- }
function plgAtribut(aTabulka : TplgTabulka;
const AJmenoSysAtributuBezTabulky : String): PplgAtributTabulky;
var
PA : PplgAtributTabulky;
II : Integer;
begin
if Cplg_SeznamTabulek[aTabulka] <> nil then
begin
with Cplg_SeznamTabulek[aTabulka]^ do
begin
PA := Atributy;
for II := 1 to PocetAtributu do
begin
if SameText(AJmenoSysAtributuBezTabulky, PA.JmenoSys) then
begin
Result := PA;
Exit; {!}
end;
Inc(PA);
end;
end;
end;
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgAtribut(const AJmenoSysAtributu : String): PplgAtributTabulky;
var
I: Integer;
LJmenoSysTabulky,
LJmenoSysAtributu: String;
LTabulka: TplgTabulka;
begin
Result := nil;
I := Pos('.', AJmenoSysAtributu);
if I = 0 then Exit;
LJmenoSysTabulky := Copy(AJmenoSysAtributu, 1, I-1);
LJmenoSysAtributu := Copy(AJmenoSysAtributu, I+1, MaxInt);
LTabulka := plgJmenoSys2Tabulka(LJmenoSysTabulky);
Result := plgAtribut(LTabulka, LJmenoSysAtributu);
end;
{ --------------------------------------------------------------------------- }
function plgSkriptProDeleteJednohoZaznamu(Tabulka: TplgTabulka; KontrolaBE: Boolean): String;
var
PD: PplgTabulkaDef;
begin
PD := plgGetTabulkaDef(Tabulka);
if KontrolaBE and (plgAtribut(Tabulka, plg_BlokovaniEditoru) <> nil) then
Result := Format('IF EXISTS(SELECT*FROM %s WHERE ' + plg_SystemoveCislo + '=@ID'+
' AND ' + plg_BlokovaniEditoru + ' IS NOT NULL)'#13+
'BEGIN'#13+
'RAISERROR(%s, 16, 1)'#13+
'RETURN'#13+
'END'#13,
[PD.JmenoSys, plgNQuotedStr(plgCtiOznam(plxJadroZaznamJeBlokovanNelzeSmazat))])
else
Result := '';
Result :=
Format(
'DECLARE @ID INT'#13+
'SET @ID = %s'#13+
'%s', // test blokovani editoru
['%s', Result]);
if PD.TriggerBeforeDelete = '' then
Result :=
Format(
'%s'#13+
'DELETE %s WHERE ' + plg_SystemoveCislo + '=@ID',
[Result, PD.JmenoSys])
else
Result :=
Format(
'%s'#13+
'DECLARE @Mazat BIT'#13+
'SET @Mazat = 1'#13+ // moznost v TriggerBeforeDelete vypnout mazani
'BEGIN TRANSACTION'#13+
'%s'#13+ // TriggerBeforeDelete
'IF @@ERROR <> 0 GOTO CHYBAROLLBACK'#13+
'IF @Mazat = 1'#13+
'BEGIN'#13+
'DELETE %s WHERE ' + plg_SystemoveCislo + '=@ID'#13+
'IF @@ERROR <> 0 GOTO CHYBAROLLBACK'#13+
'END'#13+
'IF @@TRANCOUNT <> 0 COMMIT'#13+
'RETURN'#13+
'CHYBAROLLBACK:'#13+
'IF @@TRANCOUNT <> 0 ROLLBACK',
[Result, PD.TriggerBeforeDelete, PD.JmenoSys]);
end;
{ --------------------------------------------------------------------------- }
function plgGetPluginPathAndName: String;
var
PomName: array[0..MAX_PATH] of Char;
begin
SetString(Result, PomName, GetModuleFileName(hInstance, PomName, SizeOf(PomName)));
end;
{ --------------------------------------------------------------------------- }
function plgGetTemporaryPath: string;
begin
// cesta na TEMP adresar
SetLength(Result, MAX_PATH);
SetLength(Result, Windows.GetTempPath(MAX_PATH, PChar(Result)));
end;
{ --------------------------------------------------------------------------- }
function plgGetTemporaryFileName(Prefix, Extension : String): String;
var
Temp : String;
Pocet : Integer;
Existuje : Boolean;
begin
// cesta na TEMP adresar
Temp := plgGetTemporaryPath;
Pocet := 0;
repeat
Result := StringOfChar(#0, MAX_PATH);
// tato funkce nevraci vyslednou delku jako napr. GetTempPath
GetTempFileName(PChar(Temp), PChar(Prefix), 0, PChar(Result));
Result := StrPas(PChar(Result));
if Length(Extension) > 0 then
begin
if Extension[1] <> '.' then
Extension := '.' + Extension;
Temp := Result;
Result := ChangeFileExt(Temp, Extension);
// zruseni puvodniho souboru (ma koncovku TMP)
if not SameText(Temp, Result) then
if FileExists(Temp) then SysUtils.DeleteFile(Temp);
// pokud soubor existuje, tak to projedu cele znovu (max. 10x)
Existuje := FileExists(Result);
end
else
Existuje := False;
Inc(Pocet);
until (not Existuje) or (Pocet >= 10);
if Existuje then Result := '';
end;
{ --------------------------------------------------------------------------- }
function plgJmenoPocitace: String;
var
DW: DWORD;
begin
DW := MAX_COMPUTERNAME_LENGTH + 1;
SetLength(Result, DW);
if GetComputerName(PChar(Result), DW) then
SetLength(Result, DW)
else
Result := '';
end;
{ --------------------------------------------------------------------------- }
function plgJeToHeliosEasy(Helios: IHelios): Boolean;
var
S: string;
begin
S := Copy(Helios.SerNum, 1, Cplg_SerNum_PrefixLen);
Result := SameText(S, Cplg_Prefix_SN_HEED) or SameText(S, Cplg_Prefix_SN_HEEF);
end;
{ --------------------------------------------------------------------------- }
function plgJeToHeliosGermany(Helios: IHelios): Boolean;
var
S: string;
begin
S := Copy(Helios.SerNum, 1, Cplg_SerNum_PrefixLen);
Result := SameText(S, Cplg_Prefix_SN_ASDT) or SameText(S, Cplg_Prefix_SN_ASDE);
end;
{ --------------------------------------------------------------------------- }
procedure plgCenterForm(AForm: TForm);
var
LRect: TRect;
LMon: TMonitor;
begin
// [RK 26.05.2010] centrovani na monitoru, kde okno lezi
with AForm do
begin
LMon := Monitor;
if LMon <> nil then
LRect := LMon.WorkareaRect
else
LRect := Screen.WorkareaRect;
SetBounds(LRect.Left + ((RectWidth(LRect) - Width) div 2),
LRect.Top + ((RectHeight(LRect) - Height) div 2), Width, Height);
end;
end;
{ --------------------------------------------------------------------------- }
function plgMinimizeApplication(AForm: TForm; var AMessage: TWMSysCommand): Boolean;
begin
// [RK 18.08.2011] uprava podle Heliosu
Result := ((AMessage.CmdType and $FFF0) = SC_MINIMIZE);
if Result then
begin
AMessage.Result := 0;
EnableWindow(Application.Handle, True);
ShowWindow(Application.Handle, SW_MINIMIZE);
end;
end;
{ --------------------------------------------------------------------------- }
function plgZablokujZaznam(Helios: IHelios; const TabName, Where : String): Boolean;
begin
// pokud ho neblokuje nekdo jiny, tak ho muzu zablokovat
Result :=
(Helios.OpenSQL(
Format(
'IF (SELECT ' + plg_BlokovaniEditoru + ' FROM %s WHERE %s) IS NULL'#13+
'BEGIN'#13+
'UPDATE %0:s SET ' + plg_BlokovaniEditoru + '=%2:d WHERE %1:s'#13+
'SELECT 1'#13+
'END'#13+
'ELSE'#13+
'SELECT 0',
[{0}TabName, {1}Where, {2}Helios.UserId])).FieldValues(0) = 1);
end;
{ --------------------------------------------------------------------------- }
function plgOdblokujZaznam(Helios: IHelios; const TabName, Where : String): Boolean;
begin
// pokud ho blokuji ja, tak muzu odblokovat
Result :=
(Helios.OpenSQL(
Format(
'IF (SELECT ' + plg_BlokovaniEditoru + ' FROM %s WHERE %s)=%d'#13+
'BEGIN'#13+
'UPDATE %0:s SET ' + plg_BlokovaniEditoru + '=NULL WHERE %s'#13+
'SELECT 1'#13+
'END'#13+
'ELSE'#13+
'SELECT 0',
[{0}TabName, {1}Where, {2}Helios.UserId])).FieldValues(0) = 1);
end;
{ --------------------------------------------------------------------------- }
function plgJeZaznamBlokovan(Helios: IHelios; const TabName, Where : String): Boolean;
begin
Result :=
(Helios.OpenSQL(
Format(
'IF (SELECT ' + plg_BlokovaniEditoru + ' FROM %s WHERE %s) IS NULL SELECT 0 ELSE SELECT 1',
[{0}TabName, {1}Where])).FieldValues(0) = 1);
end;
{ =========================================================================== }
function _plgCtiOznam1(AHlaska: TplgTxt): String;
begin
Result := GplgHlasky[AHlaska].H;
end;
{ --------------------------------------------------------------------------- }
function _plgCtiOznamX(AHlaska: TplgTxt): String; // cizi jazyky
var
II: Integer;
begin
for II := 0 to AktivniJazyky.Count-1 do
begin
Result := TplgAktivniJazyk(AktivniJazyky.Objects[II]).CtiOznam(AHlaska);
if Result <> '' then Exit;
end;
Result := GplgHlasky[AHlaska].H;
end;
{ --------------------------------------------------------------------------- }
var
{ default je <20>e<EFBFBD>tina s diakritikou (1) }
_plgCtiOznam : function(ATxt : TplgTxt) : String = _plgCtiOznam1;
{ --------------------------------------------------------------------------- }
function plgCtiOznam(ATxt: TplgTxt): String;
begin
Result := _plgCtiOznam(ATxt);
end;
{ --------------------------------------------------------------------------- }
function plgCtiOznam(const AHlaska: String): String;
begin
Result := AHlaska;
end;
{ =========================================================================== }
function plgPrelozException(const Hlaska: String): String;
var
LTxt: TplgTxt;
Cislo: Integer;
begin
Cislo := StrToIntDef(Hlaska, -1);
if Cislo >= Cplg_HlaskyBase then
for LTxt := Succ(Low(TplgTxt)) to High(TplgTxt) do
if Cislo = Integer(GplgHlasky[LTxt].W) then // pretypovani, aby nerval kompilator warning
begin
// [RK 18.07.2008] nebylo pres plgCtiOznam()
Result := plgCtiOznam(LTxt); //GplgHlasky[LTxt].H;
Exit;
end;
Result := Hlaska;
end;
{ --------------------------------------------------------------------------- }
function plgHasPropertyRTTI(Instance: TObject; const aProperty : String): Boolean;
begin
Result := Assigned(GetPropInfo(Instance, aProperty));
end;
{ --------------------------------------------------------------------------- }
function plgGetStringPropValueOfObjectRTTI(
Instance: TObject; const aProperty: String; var aValue: String): Boolean;
var
PropInfo : PPropInfo;
begin
PropInfo := GetPropInfo(Instance, aProperty);
if Assigned(PropInfo) then
begin
aValue := GetStrProp(Instance, PropInfo);
Result := True;
end
else
Result := False;
end;
{ --------------------------------------------------------------------------- }
function plgGetObjectPropValueOfObjectRTTI(
Instance: TObject; const aProperty: String; var aValue: TObject): Boolean;
var
PropInfo : PPropInfo;
begin
PropInfo := GetPropInfo(Instance, aProperty);
if Assigned(PropInfo) then
begin
aValue := GetObjectProp(Instance, PropInfo);
Result := True;
end
else
Result := False;
end;
{ --------------------------------------------------------------------------- }
procedure plgSetPropertiesOfObjectRTTI( Instance : TObject;
const AProperty : array of string;
const AValues : array of const);
var
JJ : Integer;
PropInfo : PPropInfo;
{ +++++++++++++++++++++++++++ }
procedure _RaiseErrorVar(const aPropKind: String; aVarKind: Integer);
begin
raise
Exception.Create(
Format('plgMain.plgSetPropertiesOfObjectRTTI: nezapojeny typ variantu (%s,%d)',
[aPropKind, aVarKind]));
end;
{ +++++++++++++++++++++++++++ }
begin
if not Assigned(Instance) then Exit;
for JJ := Low(AProperty) to High(AProperty) do
begin
PropInfo := GetPropInfo(Instance, AProperty[JJ]);
if Assigned(PropInfo) then
begin
case PropInfo^.PropType^^.Kind of
tkInteger:
case AValues[JJ].VType of
vtInteger:
SetOrdProp(Instance, PropInfo, AValues[JJ].VInteger);
else
_RaiseErrorVar('tkInteger', AValues[JJ].VType);
end;
tkEnumeration:
case AValues[JJ].VType of
vtBoolean:
SetEnumProp(Instance, PropInfo, BooleanIdents[AValues[JJ].VBoolean]);
vtString:
SetEnumProp(Instance, PropInfo, string(AValues[JJ].VString^));
vtAnsiString:
SetEnumProp(Instance, PropInfo, string(AnsiString(AValues[JJ].VAnsiString)));
vtWideString:
SetEnumProp(Instance, PropInfo, WideString(AValues[JJ].VWideString));
vtUnicodeString:
SetEnumProp(Instance, PropInfo, UnicodeString(AValues[JJ].VUnicodeString));
else
_RaiseErrorVar('tkEnumeration', AValues[JJ].VType);
end;
tkClass:
case AValues[JJ].VType of
vtObject:
SetObjectProp(Instance, PropInfo, AValues[JJ].VObject);
vtPointer:
SetObjectProp(Instance, PropInfo, TObject(AValues[JJ].VPointer));
else
_RaiseErrorVar('tkClass', AValues[JJ].VType);
end;
tkString, tkLString, tkWString, tkUString:
case AValues[JJ].VType of
vtString:
SetStrProp(Instance, PropInfo, string(AValues[JJ].VString^));
vtAnsiString:
SetAnsiStrProp(Instance, PropInfo, AnsiString(AValues[JJ].VAnsiString));
vtWideString:
SetWideStrProp(Instance, PropInfo, WideString(AValues[JJ].VWideString));
vtUnicodeString:
SetUnicodeStrProp(Instance, PropInfo, UnicodeString(AValues[JJ].VUnicodeString));
else
_RaiseErrorVar('tkString/tkLString/tkWString/tkUString', AValues[JJ].VType);
end;
else
raise
Exception.Create(
Format('plgMain.plgSetPropertiesOfObjectRTTI: nezapojeny typ property (%d)',
[Integer(PropInfo^.PropType^^.Kind)]));
end;
end;
end;
end;
{ --------------------------------------------------------------------------- }
procedure plgSetPropertiesOfListOfObjectsRTTI( AObjectList : TList;
const AProperty : array of string;
const AValues : array of const);
var
II : Integer;
begin
if Assigned(AObjectList) then
for II := 0 to AObjectList.Count - 1 do
plgSetPropertiesOfObjectRTTI(TObject(AObjectList.Items[II]), AProperty, AValues);
end;
{ --------------------------------------------------------------------------- }
procedure plgSetPropertiesOfListOfObjectsRTTI( AObjectList : TStringList;
const AProperty : array of string;
const AValues : array of const);
var
II : Integer;
begin
if Assigned(AObjectList) then
for II := 0 to AObjectList.Count - 1 do
plgSetPropertiesOfObjectRTTI(AObjectList.Objects[II], AProperty, AValues);
end;
{ --------------------------------------------------------------------------- }
procedure plgSetPropertiesOfArrayOfObjectsRTTI(const AObjectArray : array of TObject;
const AProperty : array of string;
const AValues : array of const);
var
II : Integer;
begin
for II := Low(AObjectArray) to High(AObjectArray) do
plgSetPropertiesOfObjectRTTI(TObject(AObjectArray[II]), AProperty, AValues);
end;
{ --------------------------------------------------------------------------- }
function plgFilterStr(const S: String; CS: TSysCharSet): String;
var
II : Integer;
begin
Result := '';
for II := 1 to Length(S) do
if not CharInSet(S[II], CS) then
Result := Result + S[II];
end;
{ ---------------------------------------------------------------------------- }
function plgFilterVseKrome(const S: string; CS: TSysCharSet): string;
var
II : Integer;
begin
Result := '';
for II := 1 to Length(S) do
if CharInSet(S[II], CS) then
Result := Result + S[II];
end;
{ --------------------------------------------------------------------------- }
function plgCharStr(Znak: Char; Delka: Integer): String;
begin
Result := StringOfChar(Znak, Delka);
end;
{ ---------------------------------------------------------------------------- }
function plgTextToBinary(const S: AnsiString): String;
var
BufSize: Integer;
begin
BufSize := Length(S);
SetLength(Result, 2 + (2 * BufSize));
Result[1] := '0';
Result[2] := 'x';
Classes.BinToHex(PAnsiChar(S), PWideChar(Result) + 2, BufSize);
end;
{ --------------------------------------------------------------------------- }
function plgNQuotedStr(const S: string): string; inline;
begin
Result := 'N' + SysUtils.QuotedStr(S);
end;
{ --------------------------------------------------------------------------- }
function plgGUIDBezPomlcek(const GUIDStr: String): String;
begin
Result := plgFilterStr(GUIDStr, ['{','-','}']);
end;
{ --------------------------------------------------------------------------- }
function plgVarSameValue(const A, B: Variant): Boolean;
var
II, XLo, XHi: Integer;
begin
if VarIsArray(A) or VarIsArray(B) then
begin
Result := False;
// pole a nepole jsou si v<>dy nerovna
if (not VarIsArray(A)) or
(not VarIsArray(B)) then Exit;
// ob<6F> pole mus<75> m<>t pr<70>v<EFBFBD> jednu dimenzi
if (VarArrayDimCount(A) <> 1) or
(VarArrayDimCount(B) <> 1) then Exit;
// pole se pova<76>uj<75> za shodn<64>, pokud maj<61> stejn<6A> doln<6C> a horn<72> index
XLo := VarArrayLowBound(A, 1);
XHi := VarArrayHighBound(A, 1);
if (XLo <> VarArrayLowBound(B, 1)) or
(XHi <> VarArrayHighBound(B, 1)) then Exit;
// mohu porovn<76>vat
for II := XLo to XHi do
if not VarSameValue(A[II], B[II]) then Exit;
// kdy<64> to do<64>lo a<> sem, tak se rovnaj<61>
Result := True;
end
else
// ani A ani B nen<65> pole, mohu "postaru"
Result := VarSameValue(A, B);
end;
{ --------------------------------------------------------------------------- }
function plgObracenaKonverze(const AKonverze : String) : TStringList;
var
II, JJ : Integer;
PomStr : String;
begin
Result := TStringList.Create;
Result.Text := AKonverze;
for II := 0 to Result.Count-1 do
begin
PomStr := Result[II];
JJ := Pos('=', PomStr);
Result[II] := Format('%s=%s', [Copy(PomStr, JJ+1, MaxInt), Copy(PomStr, 1, JJ-1)]);
end;
end;
{ --------------------------------------------------------------------------- }
function plgNaplnNeDBComboZVenku(ACombo : TCustomComboBox; const AKonverze : String;
ATridit: Boolean = False) : Boolean;
var
II, JJ : Integer;
SL : TStringList;
begin
Result := True;
if Trim(AKonverze) = '' then Exit;
SL := TStringList.Create;
try
SL.Text := AKonverze;
for II := 0 to SL.Count-1 do
begin
JJ := Pos('=', SL.Strings[II]);
// zapamatuj si skutecnou "DB" hodnotu
if ATridit then
SL.Objects[II] := TObject(StrToIntDef(Copy(SL.Strings[II], 1, JJ-1), -1));
SL.Strings[II] := Copy(SL.Strings[II], JJ+1, MaxInt);
end;
// setrideni seznamu
if ATridit then SL.Sorted := True;
// zde se zavola DataChange a tim se nastavi aktualni hodnota
ACombo.Items := SL;
finally
SL.Free;
end;
end;
{ --------------------------------------------------------------------------- }
function plgNaplnComboZVenku(ADBCombo : TDBComboBox; AKonverze : String): Boolean;
begin
Result := plgNaplnNeDBComboZVenku(ADBCombo, AKonverze);
// pokud se nezdari nastavit ItemIndex komponente, udelam to za ni - FM
if ADBCombo.ItemIndex = -1 then
if Assigned(ADBCombo.Field) then
ADBCombo.ItemIndex := ADBCombo.Items.IndexOf(ADBCombo.Field.Text);
end;
{ --------------------------------------------------------------------------- }
function plgGetIndependentSQLDate(ADate: TDateTime): String;
begin
if ADate = 0 then
Result := 'NULL'
else
{! NEMENIT ! Tento format data je pro SQL nezavisly !}
Result := QuotedStr(FormatDateTime('yyyymmdd', ADate));
end;
{ --------------------------------------------------------------------------- }
function plgGetIndependentSQLDateTime(ADateTime: TDateTime; Quotovat : Boolean = True): String;
begin
if ADateTime = 0 then
Result := 'NULL'
else
{! NEMENIT ! Tento format data je pro SQL nezavisly !}
begin
Result := FormatDateTime('yyyymmdd hh":"nn":"ss.zzz', ADateTime);
if Quotovat then
Result := QuotedStr(Result);
end;
end;
{ --------------------------------------------------------------------------- }
function plgGetIndependentSQLFloat(const AMaska: String; ACislo: Extended): String;
var
OldThousandSeparator : Char;
OldDecimalSeparator : Char;
begin
OldThousandSeparator := FormatSettings.ThousandSeparator;
OldDecimalSeparator := FormatSettings.DecimalSeparator;
// pro jistotu, kdyby byly nastaveny oba stejne v mistnim nastaveni
FormatSettings.ThousandSeparator := ',';
FormatSettings.DecimalSeparator := '.'; {! NEMENIT ! SQL Server pouziva tecku !}
try
// prevod cisla a vybagrovani oddelovace tisicu a prebytecnych mezer
Result := plgFilterStr(Format(AMaska, [ACislo]), [FormatSettings.ThousandSeparator, ' ']);
finally
FormatSettings.ThousandSeparator := OldThousandSeparator;
FormatSettings.DecimalSeparator := OldDecimalSeparator;
end;
end;
{ --------------------------------------------------------------------------- }
procedure plgHelpForm(const ACaption, AText: String);
var
LForm : TForm;
begin
LForm := TForm.CreateNew(nil);
try
with TButton.Create(LForm) do
begin
Parent := LForm;
Cancel := True;
ModalResult := mrCancel;
Width := 0;
Height := 0;
end;
with TMemo.Create(LForm) do
begin
Parent := LForm;
Align := alClient;
Lines.Text := AText;
ReadOnly := True;
end;
with LForm do
begin
Caption := ACaption;
Font.Height := -11;
WindowState := wsMaximized;
ShowModal;
end;
finally
LForm.Free;
end;
end;
{ --------------------------------------------------------------------------- }
function plgVratVztah(Index: Integer): PplgVztahDef;
begin
if (Index >= Low(GDefiniceVztahu)) and (Index <= High(GDefiniceVztahu)) then
Result := @GDefiniceVztahu[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratExtAkci(Index: Integer): PplgExtAkceDef;
begin
if (Index >= Low(GDefiniceExtAkci)) and (Index <= High(GDefiniceExtAkci)) then
Result := @GDefiniceExtAkci[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratExtAttr(Index: Integer): PplgExterniAtribut;
begin
if (Index >= Low(GDefiniceExtAttr)) and (Index <= High(GDefiniceExtAttr)) then
Result := @GDefiniceExtAttr[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratExtTrigger(Index: Integer): PplgExterniTrigger;
begin
if (Index >= Low(GDefiniceExtTrigger)) and (Index <= High(GDefiniceExtTrigger)) then
Result := @GDefiniceExtTrigger[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratZmenovySkript(Index : Integer): PplgZmenovySkript;
begin
if (Index >= Low(GZmenoveSkripty)) and (Index <= High(GZmenoveSkripty)) then
Result := @GZmenoveSkripty[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratUProc(Index: Integer): PplgUlozenaProcedura;
begin
if (Index >= Low(SeznamUlozenychProcedur)) and (Index <= High(SeznamUlozenychProcedur)) then
Result := @SeznamUlozenychProcedur[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgVratUzivFunkci(Index: Integer): PplgUzivatelskaFunkce;
begin
if (Index >= Low(SeznamUzivatelskychFunkci)) and (Index <= High(SeznamUzivatelskychFunkci)) then
Result := @SeznamUzivatelskychFunkci[Index]
else
Result := nil;
end;
{ --------------------------------------------------------------------------- }
function plgJeNejakaTabulka(var Prvni: TplgTabulka): Boolean;
begin
Prvni := tZadna;
Result := High(TplgTabulka) > Prvni;
if Result and (Cplg_SeznamTabulek[tZadna] = nil) then
Prvni := Succ(Prvni);
end;
{ --------------------------------------------------------------------------- }
function plgJeNejakyPrehled(var Prvni: TplgBrowse): Boolean;
begin
Prvni := bZadny;
Result := High(TplgBrowse) > Prvni;
if Result then
Prvni := Succ(Prvni);
end;
{ --------------------------------------------------------------------------- }
function plgJeNejakySoudek(var Prvni: TplgSoudek): Boolean;
begin
Prvni := sdNeniVidet;
Result := High(TplgSoudek) > Prvni;
if Result then
Prvni := Succ(Prvni);
end;
{ --------------------------------------------------------------------------- }
function FontExistsCallback(const lplf: TLogFont; const lptm: TTextMetric;
dwType: DWORD; lpData: LPARAM): Integer; stdcall;
begin
Boolean(Pointer(lpData)^) := True;
Result := 1;
end;
{ --------------------------------------------------------------------------- }
function plgFontExistuje(const FaceName: String): Boolean;
var
DC: HDC;
begin
Result := False;
DC := GetDC(0);
try
EnumFonts(DC, PChar(FaceName), @FontExistsCallback, @Result);
finally
ReleaseDC(0, DC);
end;
end;
{ --------------------------------------------------------------------------- }
function plgTestMSSansSerifFont(const AFontName: string): String;
begin
// nahrada fontu "MS Sans Serif" jinym pismem (je to hnusne rastrove pismo)
if not SameText(AFontName, 'MS Sans Serif') then
Result := AFontName
else
if plgFontExistuje('Microsoft Sans Serif') then
Result := 'Microsoft Sans Serif'
else
if plgFontExistuje('Tahoma') then
Result := 'Tahoma'
else
// if FontExists('Segoe UI') then
// Result := 'Segoe UI'
// else
Result := AFontName;
end;
{ --------------------------------------------------------------------------- }
function plgPrepniJazykoveDLL(Helios: IHelios; Jazyk1, Jazyk2: Integer): Boolean;
{ +++++++++++++++++++++++++++ }
procedure ZkusJazyk(J: Integer);
var
H: HINST;
A: TplgPrekladHlasekA;
W: TplgPrekladHlasekW;
CP: TplgPrekladHlasekCP;
DLLName: string;
OK: Boolean;
begin
// zjisteni jazykoveho DLL
DLLName := PluginKonfig.PluginJazykoveDLL_Ext(J);
// neni nastaveno jazykove DLL => jazyk nebyl prepnut
OK := (DLLName <> '');
if OK then
begin
// jazykove DLL neexistuje => jazyk nebyl prepnut
DLLName := ExtractFilePath(plgGetPluginPathAndName) + DLLName;
OK := FileExists(DLLName);
end;
if not OK then
begin
// slovenstina ma vyjimku (je primo v plgHlasky)
if J = Cplg_jSlovenctina then
AktivniJazyky.AddObject(IntToStr(J), TplgJazykPrekladHlasek04.Create);
Exit;
end;
H := LoadLibrary(PChar(DLLName));
try
if H > 0 then
begin
@A := GetProcAddress(H, 'CtiOznamID');
if Assigned(A) then
AktivniJazyky.AddObject(IntToStr(J), TplgJazykPrekladHlasekA.Create(H, A))
else
begin
@CP := GetProcAddress(H, 'TranslateCP');
if Assigned(CP) then
AktivniJazyky.AddObject(IntToStr(J), TplgJazykPrekladHlasekCP.Create(H, CP))
else
begin
@W := GetProcAddress(H, 'CtiOznamIDW');
if Assigned(W) then
AktivniJazyky.AddObject(IntToStr(J), TplgJazykPrekladHlasekW.Create(H, W))
else
begin
@W := GetProcAddress(H, 'TranslateW');
if Assigned(W) then
AktivniJazyky.AddObject(IntToStr(J), TplgJazykPrekladHlasekW.Create(H, W))
else
RaiseLastOSError;
end;
end;
end;
end
else
RaiseLastOSError;
except
on E: Exception do
begin
Helios.Error(#1'Chyba p<>i na<6E><61>t<EFBFBD>n<EFBFBD> jazykov<6F>ho DLL'#1#13+
DLLName + #13#13 + E.Message);
end;
end;
end;
{ +++++++++++++++++++++++++++ }
begin
// -2 prichazi z instalace po instalaci ruznych jazykovych mutaci do TabExtHlasky
if Jazyk1 = -2 then
Jazyk1 := AktivniJazyk1;
if Jazyk2 = -2 then
Jazyk2 := AktivniJazyk2;
// nejdrive uvolnime aktivni DLL
AktivniJazyky.Clear;
case Jazyk1 of
Cplg_jCeskyASCII, Cplg_jCesky:
begin
_plgCtiOznam := _plgCtiOznam1;
Result := True;
end;
else
begin
ZkusJazyk(Jazyk1);
if (Jazyk1 <> Jazyk2) and (Jazyk2 <> Cplg_jJazykNedefinovan) then
ZkusJazyk(Jazyk2);
Result := (AktivniJazyky.Count > 0);
if Result then
_plgCtiOznam := _plgCtiOznamX
else
_plgCtiOznam := _plgCtiOznam1;
end;
end;
end;
{ --------------------------------------------------------------------------- }
procedure InicializaceJadraPluginu(Helios: IHelios);
var
LTabulka: TplgTabulka;
LBrowse: TplgBrowse;
PA, PAOld: PplgAtributTabulky;
UA: TplgUzivatelskeAtributyDef;
II, JJ: Integer;
TD: PplgTabulkaDef;
PVD: PplgVztahDef;
AT: PplgExterniAtribut;
NewDef, OldDef: PplgTabulkaDef;
SLVyjmute: TStringList;
Q: IHeQuery;
Jaz1, Jaz2: Integer;
LSysDB: string;
begin
plgLadit_KontrolaPriInicializaci;
// --- inicializace tabulek -------------------------------------------------
if not InicializaceProbehla then
begin
InicializaceProbehla := True;
if plgJeNejakaTabulka(LTabulka) then
for LTabulka := LTabulka to High(TplgTabulka) do
begin
// nejprve se vytvori definice podle Predka
if Cplg_SeznamTabulek[LTabulka].Predek <> tZadna then
begin
NewDef := Cplg_SeznamTabulek[LTabulka];
OldDef := Cplg_SeznamTabulek[Cplg_SeznamTabulek[LTabulka].Predek];
plgLadit_KontrolaPredkaTabulky(LTabulka, NewDef, OldDef);
SLVyjmute := TStringList.Create;
try
SLVyjmute.Text := NewDef.VyjmuteAttrPredka;
SLVyjmute.Sorted := True;
// pocet atributu predka
JJ := 0;
PA := OldDef.Atributy;
for II := 1 to OldDef.PocetAtributu do
begin
if SLVyjmute.IndexOf(PA.JmenoSys) = -1 then Inc(JJ);
Inc(PA);
end;
// pridame pocet atributu nove tabulky
II := NewDef.PocetAtributu + JJ;
// vytvorime novy seznam atributu
GetMem(PA, II * SizeOf(TplgAtributTabulky));
FillChar(PA^, II * SizeOf(TplgAtributTabulky), 0);
// seznam priradime a zapamatujeme si puvodni
PAOld := NewDef.Atributy;
NewDef.Atributy := PA;
// prenos puvodni definice
if NewDef.PocetAtributu <> 0 then
begin
Move(PAOld^, NewDef.Atributy^, NewDef.PocetAtributu * SizeOf(TplgAtributTabulky));
Inc(PA, NewDef.PocetAtributu); // prvni volna pozice
end;
NewDef.PocetAtributu := II; // novy pocet atributu
// prekopirovani definice predka
PAOld := OldDef.Atributy;
for II := 1 to OldDef.PocetAtributu do
begin
if SLVyjmute.IndexOf(PAOld.JmenoSys) = -1 then
begin
plgLadit_KontrolaPrevzetiAtributuPredkaTabulky(LTabulka, PAOld);
PA^ := PAOld^;
with PA^ do
begin
if not (plg_dvtKopirovatOmezeni in NewDef.DalsiVlastnosti) then
begin
PK_UQ := puNic;
ForeignKey := '';
Check := '';
end;
if Pocitany <> '' then
Pocitany := StringReplace(Pocitany, OldDef.JmenoSys+'.', NewDef.JmenoSys+'.', [rfReplaceAll, rfIgnoreCase]);
end;
Inc(PA);
end;
Inc(PAOld);
end;
finally
SLVyjmute.Free;
end;
end;
// inicializace atributu
PA := Cplg_SeznamTabulek[LTabulka].Atributy;
for II := 1 to Cplg_SeznamTabulek[LTabulka].PocetAtributu do
begin
if PA.UTyp <> plg_utaZadny then
begin
UA := Cplg_UzivatelskeAtributy[PA.UTyp];
if PA.JmenoSys = '' then PA.JmenoSys := UA.A.JmenoSys;
if PA.JmenoVerejne = '' then PA.JmenoVerejne := UA.A.JmenoVerejne;
if PA.JmenoVerejneTxt = plxNic then PA.JmenoVerejneTxt := UA.A.JmenoVerejneTxt;
if PA.JmenoVerejneZkr = '' then PA.JmenoVerejneZkr := UA.A.JmenoVerejneZkr;
if PA.JmenoVerejneZkrTxt = plxNic then PA.JmenoVerejneZkrTxt := UA.A.JmenoVerejneZkrTxt;
if PA.Typ = taBlbe then PA.Typ := UA.A.Typ;
if PA.Delka = 0 then PA.Delka := UA.A.Delka;
if PA.Pocitany = '' then PA.Pocitany := UA.A.Pocitany;
if PA.NULL = nNic then PA.NULL := UA.A.NULL;
if PA.PK_UQ = puNic then PA.PK_UQ := UA.A.PK_UQ;
if PA.ForeignKey = '' then PA.ForeignKey := UA.A.ForeignKey;
if PA.ServerDefault = '' then PA.ServerDefault := UA.A.ServerDefault;
if PA.CHECK = '' then PA.CHECK := Format(UA.A.CHECK, [PA.JmenoSys]);
if PA.Vyzadovany = vDefault then PA.Vyzadovany := UA.A.Vyzadovany;
if PA.Verejny = vDefault then PA.Verejny := UA.A.Verejny;
if PA.Konverze = '' then PA.Konverze := UA.A.Konverze;
if PA.KonverzeTxt = plxNic then PA.KonverzeTxt := UA.A.KonverzeTxt;
if PA.SirkaSloupce = 0 then PA.SirkaSloupce := UA.A.SirkaSloupce;
if PA.MaskaDisplay = '' then PA.MaskaDisplay := UA.A.MaskaDisplay;
if not PA.Sumovat then PA.Sumovat := UA.A.Sumovat;
if PA.Hint = '' then PA.Hint := UA.A.Hint;
if PA.HintTxt = plxNic then PA.HintTxt := UA.A.HintTxt;
if PA.DalsiVlastnosti = [] then PA.DalsiVlastnosti := UA.A.DalsiVlastnosti;
if PA.HeliosAttr = '' then PA.HeliosAttr := UA.A.HeliosAttr;
// kvuli definice tabulek...
PA.UTyp := plg_utaZadny;
end;
// z nedefinovaneho stavu na definovany
if PA.NULL = nNic then PA.NULL := nNOTNULL;
if PA.Vyzadovany = vDefault then PA.Vyzadovany := vFalse;
if PA.Verejny = vDefault then PA.Verejny := vFalse;
plgLadit_KontrolaAtributu(LTabulka, PA, II);
Inc(PA);
end;
plgLadit_KontrolaMaTabulkaID(LTabulka);
end;
end;
// --- nastaveni jazyka -----------------------------------------------------
Q := Helios.OpenSQL(
'SELECT Jazyk, Jazyk2 FROM TabUziv WHERE LoginName = ' + Cplg_LoginName);
if Q.RecordCount > 0 then
begin
Jaz1 := Q.FieldValues(0);
Jaz2 := Q.FieldValues(1);
end
else
begin
Jaz1 := Cplg_jCesky;
Jaz2 := Cplg_jJazykNedefinovan;
end;
if (AktivniJazyk1 <> Jaz1) or (AktivniJazyk2 <> Jaz2) then
begin
AktivniJazyk1 := Jaz1;
AktivniJazyk2 := Jaz2;
plgPrepniJazykoveDLL(Helios, AktivniJazyk1, AktivniJazyk2);
// --- TABULKY ---
if plgJeNejakaTabulka(LTabulka) then
for LTabulka := LTabulka to High(TplgTabulka) do
begin
TD := Cplg_SeznamTabulek[LTabulka];
if Assigned(TD) then
begin
if TD.JmenoTxt <> plxNic then
TD.Jmeno := plgCtiOznam(TD.JmenoTxt);
PA := TD.Atributy;
for II := 1 to TD.PocetAtributu do
begin
if PA.JmenoVerejneTxt <> plxNic then
PA.JmenoVerejne := plgCtiOznam(PA.JmenoVerejneTxt)
else
if PA.HeliosAttr <> '' then // [RK 01.04.2010]
PA.JmenoVerejne := Helios.AttrPublicName(PA.HeliosAttr);
if PA.JmenoVerejneZkrTxt <> plxNic then
PA.JmenoVerejneZkr := plgCtiOznam(PA.JmenoVerejneZkrTxt);
if PA.KonverzeTxt <> plxNic then
PA.Konverze := plgCtiOznam(PA.KonverzeTxt)
else
if PA.HeliosAttr <> '' then // [RK 01.04.2010]
PA.Konverze := Helios.Konverze(PA.HeliosAttr);
if PA.HintTxt <> plxNic then
PA.Hint := plgCtiOznam(PA.HintTxt);
Inc(PA);
end;
end;
end;
// --- PREHLEDY ---
if plgJeNejakyPrehled(LBrowse) then
for LBrowse := LBrowse to High(TplgBrowse) do
begin
with Cplg_SeznamVychozichNastaveniBrowse[LBrowse] do
begin
if Jmeno = '*' then
begin
TD := plgGetTabulkaDef(HlavniTabulka);
if Assigned(TD) then
Jmeno := TD.Jmeno;
end
else
if JmenoTxt <> plxNic then
Jmeno := plgCtiOznam(JmenoTxt);
plgLadit_KontrolaVerejnehoJmenaPrehledu(LBrowse);
if PomocnicekTxt <> plxNic then
Pomocnicek := plgCtiOznam(PomocnicekTxt);
end;
end;
// --- VAZBY ---
II := 1;
PVD := plgVratVztah(II);
while Assigned(PVD) do
begin
if PVD.NazevLPTxt <> plxNic then
PVD.NazevLP := plgCtiOznam(PVD.NazevLPTxt)
else
if PVD.NazevLP = '' then
PVD.NazevLP := Cplg_SeznamVychozichNastaveniBrowse[plgJmenoView2Browse(PVD.TabPStr)].Jmeno;
if PVD.NazevPLTxt <> plxNic then
PVD.NazevPL := plgCtiOznam(PVD.NazevPLTxt)
else
if PVD.NazevPL = '' then
PVD.NazevPL := Cplg_SeznamVychozichNastaveniBrowse[plgJmenoView2Browse(PVD.TabLStr)].Jmeno;
plgLadit_KontrolaVazby(PVD);
Inc(II);
PVD := plgVratVztah(II);
end;
// --- EXTERNI ATRIBUTY ---
II := 1;
AT := plgVratExtAttr(II);
while Assigned(AT) do
begin
if AT.JmenoVerejneTxt <> plxNic then
AT.JmenoVerejne := plgCtiOznam(AT.JmenoVerejneTxt);
if AT.JmenoVerejneZkrTxt <> plxNic then
AT.JmenoVerejneZkr := plgCtiOznam(AT.JmenoVerejneZkrTxt);
if AT.KonverzeTxt <> plxNic then
AT.Konverze := plgCtiOznam(AT.KonverzeTxt);
if AT.PoznamkaTxt <> plxNic then
AT.Poznamka := plgCtiOznam(AT.PoznamkaTxt);
if AT.BublinaTxt <> plxNic then
AT.Bublina := plgCtiOznam(AT.BublinaTxt);
if AT.ExtEd_ZalozkaTxt <> plxNic then
AT.ExtEd_Zalozka := plgCtiOznam(AT.ExtEd_ZalozkaTxt);
Inc(II);
AT := plgVratExtAttr(II);
end;
end;
// --- nacteni ikonek -------------------------------------------------------
if not Assigned(DataModuleGlobPLG) then
begin
// barevne ikonky jsou implementovany az od verze 3.0.2020.0152
if Helios.HeVersion >= $030020200152 then
begin
LSysDB := Helios.SystemDB;
if LSysDB <> '' then
begin
if not IsValidIdent(LSysDB) then
begin
LSysDB := AnsiQuotedStr(LSysDB, ']');
LSysDB[1] := '[';
end;
try
G_SadaIkonekKterouChci := Helios.OpenSQL('SELECT SadaIkonek FROM ' + LSysDB + '..TabUserCfg WHERE LoginName = '+ Cplg_LoginName).FieldValues(0);
except
G_SadaIkonekKterouChci := C_SadaIkonek_Default;
end;
end;
end;
DataModuleGlobPLG := TDataModuleGlobPLG.Create(Application);
end;
// --- nastaveni legislativy ------------------------------------------------
if Global_Legislativa = -1 then
Global_Legislativa := Helios.OpenSQL('SELECT Legislativa FROM TabHGlob').FieldValues(0);
end;
{ --------------------------------------------------------------------------- }
function plgJeParametrXX: Boolean;
var
II: Integer;
S: String;
begin
for II := 1 to ParamCount do
begin
S := ParamStr(II);
if (Length(S) >= 3) and CharInSet(S[1], ['/','-']) and (UpperCase(Copy(S,2,2)) = 'XX') then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
{ --------------------------------------------------------------------------- }
function plgJeParametrX: Boolean;
begin
Result := FindCmdLineSwitch('X', ['/','-'], True);
end;
{ --------------------------------------------------------------------------- }
var
G_TichaInstalace: Boolean;
function plgJeTichaInstalace: Boolean;
begin
Result := G_TichaInstalace or plgJeParametrXX;
end;
{ --------------------------------------------------------------------------- }
function plgExtKomIDInstalace(Helios: IHelios): Boolean;
begin
Result := (Helios.ExtKomID = Cplg_ExtKomID_Instalace) or
(Helios.ExtKomID = Cplg_ExtKomID_TichaInstalace);
end;
{ --------------------------------------------------------------------------- }
procedure InstalacePluginu(Helios: IHelios; TichaInstalace: Boolean);
begin
G_TichaInstalace := TichaInstalace;
with TfrmInstalace.Create(Application) do
try
ShowModalEx(Helios);
finally
Free;
end;
end;
{ --------------------------------------------------------------------------- }
procedure InformaceOPluginu(Helios: IHelios);
begin
with TfrmAbout.Create(Application) do
try
ShowModalEx(Helios);
finally
Free;
end;
end;
{ --------------------------------------------------------------------------- }
procedure plgPresunHlaskyNaWeb(Helios: IHelios);
begin
with TfrmPreklady.Create(Application) do
try
ShowModalEx(Helios, sphNaWeb);
finally
Free;
end;
end;
{ --------------------------------------------------------------------------- }
procedure plgStahniZWebuJazykovaDLL(Helios: IHelios);
begin
with TfrmPreklady.Create(Application) do
try
ShowModalEx(Helios, sphDoDLL);
finally
Free;
end;
end;
{ --------------------------------------------------------------------------- }
procedure SpustControllerEditoru(Helios: IHelios);
var
LControllerClass: TplgEditorControllerClass;
LController: TplgEditorController;
II: Integer;
LKlicProDB: string;
begin
LControllerClass := nil;
LKlicProDB := Helios.FormIdent;
II := Low(GDefiniceControlleru) + 1; // prvni prvek je defaultne prazdny
while II <= High(GDefiniceControlleru) do
begin
if LKlicProDB = GDefiniceControlleru[II].FormIdent then
begin
LControllerClass := TplgEditorControllerClass(GDefiniceControlleru[II].ControllerClass);
Break;
end;
Inc(II);
end;
if LControllerClass <> nil then
begin
LController := LControllerClass.Create (Helios);
Helios.RegisterPluginController (LController);
end
{$IFnDEF BezLadit}
else
Helios.Error(plgCtiOznam('{Ladit} - Controller nenalezen!'))
{$ENDIF}
;
end;
{ ########################################################################### }
initialization
AktivniJazyky := TStringList.Create(True);
{ ########################################################################### }
end.