1154 lines
34 KiB
ObjectPascal
1154 lines
34 KiB
ObjectPascal
{ *************************************************************************** }
|
||
{ }
|
||
{ Jadro pluginu 2 Asseco Solutions }
|
||
{ }
|
||
{ *************************************************************************** }
|
||
|
||
unit plgAkce;
|
||
|
||
interface
|
||
|
||
uses
|
||
plgType, Classes, Forms, DB, plgQuery, ddPlugin_TLB;
|
||
|
||
type
|
||
TplgJednaAkce = procedure of object;
|
||
|
||
TKdyZapsatParametry =
|
||
(kzpNikdy,
|
||
kzpInsert{akce neexistuje - prvni instalace nebo byla smazana},
|
||
kzpInsertUpdate{akce (ne)existuje - parametry se pri kazde (re)instalaci prepisi});
|
||
|
||
TplgAkctionContainer = class
|
||
NazevSys: string;
|
||
Nazev: string;
|
||
NazevTxt: TplgTxt;
|
||
Akce: TplgJednaAkce;
|
||
GUID: string;
|
||
HotKey: Integer;
|
||
Verejna: Boolean;
|
||
NazevPodmenu: string;
|
||
NazevPodmenuTxt: TplgTxt;
|
||
KdyZapsatParametry: TKdyZapsatParametry;
|
||
Parametry: string;
|
||
PridatOddelovacMenu: Boolean;
|
||
Napoveda: string;
|
||
NapovedaTxt: TplgTxt;
|
||
end;
|
||
|
||
{ +++++++++++++++++++++++++++ }
|
||
|
||
TplgAkcePrehleduClass = class of TplgAkcePrehledu;
|
||
TplgAkcePrehledu = class(TplgAkcePrehleduBase)
|
||
private
|
||
FBrowse: TplgBrowse;
|
||
FTabulka: TplgTabulka;
|
||
FSetrideneAtributy: TStringList;
|
||
FSeznamAkci: TStringList;
|
||
|
||
FDataSourceEdit : TDataSource;
|
||
FMemDataSet: TplgQuery;
|
||
|
||
FPlgEditor: TForm;
|
||
FHelios : IHelios;
|
||
|
||
procedure _VolejEditor(AQuery: TDataSet);
|
||
procedure CreateMemDataSet;
|
||
procedure My_OnGetText(Sender: TField; var Text: string; DisplayText: Boolean);
|
||
procedure My_OnSetText(Sender: TField; const Text: string);
|
||
|
||
procedure MemDataSet_BeforePost(DataSet: TDataSet);
|
||
procedure MemDataSet_AfterCancel(DataSet: TDataSet);
|
||
|
||
procedure Field_OnChange(Sender: TField);
|
||
|
||
procedure ZrusUdalostiDataSetu;
|
||
function NahodBlokovaniEditoru(NacteniPoInsertu: Boolean): Boolean;
|
||
procedure NovyRadekDataSetu;
|
||
procedure NactiRadek_Z_DB(const IDStr: string);
|
||
|
||
protected
|
||
FLastID: Variant;
|
||
|
||
procedure VytvorSetrideneAtributy;
|
||
function TestNaTabulku: Boolean; dynamic;
|
||
function _GetValueFromField(F: TField): string;
|
||
function TestPredStandardnimiAkcemi(ChciID: Boolean): Boolean;
|
||
procedure AddAkce(const NazevSys, NazevVerejny: string; Akce: TplgJednaAkce;
|
||
const GUID: string; const NazevPodmenu: string = ''; HotKey: Integer = 0;
|
||
KdyZapsatParametry: TKdyZapsatParametry = kzpNikdy;
|
||
const Parametry: string = ''; AVerejna: Boolean = True); overload;
|
||
procedure AddAkce(const NazevSys: string; NazevVerejnyTxt: TplgTxt; Akce: TplgJednaAkce;
|
||
const GUID: string; NazevPodmenuTxt: TplgTxt = plxNic; HotKey: Integer = 0;
|
||
KdyZapsatParametry: TKdyZapsatParametry = kzpNikdy; const Parametry: string = '';
|
||
PridatOddelovacMenu: Boolean = False; Napoveda: TplgTxt = plxNic;
|
||
AVerejna: Boolean = True); overload;
|
||
|
||
function PripravProEditaci: Boolean;
|
||
function PripravProNova: Boolean;
|
||
procedure ProvedRefresh(NovaVeta: Boolean);
|
||
|
||
public
|
||
FPlgEditorClass: TFormClass;
|
||
|
||
constructor Create(aHelios: IHelios; aBrowse: TplgBrowse; aPlgEditorClass: TFormClass); virtual;
|
||
constructor CreateTab(AHelios: IHelios; AExtAkceDef: PplgExtAkceDef); virtual;
|
||
destructor Destroy; override;
|
||
|
||
procedure ActionNew; dynamic;
|
||
procedure ActionEdit; dynamic;
|
||
procedure ActionDelete; dynamic;
|
||
|
||
function SpustAkci(const GUIDAkce: string): string;
|
||
function FieldWasChanged(F: TField): Boolean;
|
||
|
||
function NajdiPrvniVolny(ATabulka : TplgTabulka;
|
||
const AAtribut : string;
|
||
const AWHERE : string;
|
||
{ klauzule WHERE, kterou se dosahne unikatnosti atributu }
|
||
{ ocekavan je syntaxe pr.: RadaDokladu='101' AND DruhPohybuZbo=0 AND IDSklad='001' }
|
||
{ nebo prazdny String - nefiltruje se }
|
||
AMin, AMax : Integer;
|
||
APlnitMezery: boolean = True): Integer;
|
||
|
||
function GetIDHlavicky(var IDHlavicky: Integer): Boolean;
|
||
function NastavIDHlavickyDoRadku(FieldNaRadku: TField): Boolean;
|
||
|
||
procedure OnNovaVeta( AFields : TFields;
|
||
var Prerusit : Boolean;
|
||
PrvniPruchod : Boolean); virtual; // dedit - override;
|
||
|
||
function AfterInsertSkript: string; dynamic;
|
||
function AfterUpdateSkript: string; dynamic;
|
||
|
||
property Browse: TplgBrowse read FBrowse;
|
||
property Helios: IHelios read FHelios;
|
||
property HlavniTabulka: TplgTabulka read FTabulka;
|
||
property PlgEditor: TForm read FPlgEditor;
|
||
property SetrideneAtributy: TStringList read FSetrideneAtributy;
|
||
end;
|
||
|
||
{ =========================================================================== }
|
||
|
||
implementation
|
||
|
||
uses
|
||
SysUtils, Windows, Controls, Variants, Generics.Collections,
|
||
plgMain, plgEdit, plgBrowse, plgSpravce, plgInstalace, plgLadit;
|
||
|
||
{ ########################################################################### }
|
||
|
||
constructor TplgAkcePrehledu.Create(aHelios : IHelios;
|
||
aBrowse : TplgBrowse;
|
||
aPlgEditorClass: TFormClass);
|
||
begin
|
||
inherited Create;
|
||
|
||
FHelios := aHelios;
|
||
FBrowse := aBrowse;
|
||
FTabulka := Cplg_SeznamVychozichNastaveniBrowse[FBrowse].HlavniTabulka;
|
||
FPlgEditorClass := aPlgEditorClass;
|
||
|
||
SpravceHeliosu.NastavAkce(FHelios, Self);
|
||
|
||
VytvorSetrideneAtributy;
|
||
|
||
FSeznamAkci := TStringList.Create; // NETRIDIT !!
|
||
|
||
with Cplg_SeznamVychozichNastaveniBrowse[FBrowse] do
|
||
begin
|
||
if GUID_ActionNew <> '' then
|
||
AddAkce('ActionNew', plxJadroAkceNovy, ActionNew, GUID_ActionNew, plxJadroMenuEditace, VK_F2);
|
||
|
||
if GUID_ActionEdit <> '' then
|
||
AddAkce('ActionEdit', plxJadroAkceOprava, ActionEdit, GUID_ActionEdit, plxJadroMenuEditace, VK_RETURN);
|
||
|
||
if GUID_ActionDelete <> '' then
|
||
AddAkce('ActionDelete', plxJadroAkceZrusit, ActionDelete, GUID_ActionDelete, plxJadroMenuEditace, VK_DELETE);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
constructor TplgAkcePrehledu.CreateTab(AHelios: IHelios; AExtAkceDef: PplgExtAkceDef);
|
||
begin
|
||
Create(AHelios, bZadny, AExtAkceDef.EditorClass);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
destructor TplgAkcePrehledu.Destroy;
|
||
var
|
||
II: Integer;
|
||
begin
|
||
SpravceHeliosu.NastavAkce(FHelios, nil);
|
||
|
||
for II := 0 to FSeznamAkci.Count-1 do
|
||
TplgAkctionContainer(FSeznamAkci.Objects[II]).Free;
|
||
FSeznamAkci.Free;
|
||
FSetrideneAtributy.Free;
|
||
|
||
inherited;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.VytvorSetrideneAtributy;
|
||
begin
|
||
FreeAndNil(FSetrideneAtributy);
|
||
FSetrideneAtributy := plgSetrideneAtributy(FTabulka);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.AddAkce(const NazevSys, NazevVerejny: string;
|
||
Akce: TplgJednaAkce; const GUID: string; const NazevPodmenu: string = '';
|
||
HotKey: Integer = 0; KdyZapsatParametry: TKdyZapsatParametry = kzpNikdy;
|
||
const Parametry: string = ''; AVerejna: Boolean = True);
|
||
var
|
||
XX: TplgAkctionContainer;
|
||
begin
|
||
plgLadit_KontrolaGUIDInstalace(GUID);
|
||
|
||
XX := TplgAkctionContainer.Create;
|
||
XX.NazevSys := NazevSys;
|
||
XX.Nazev := NazevVerejny;
|
||
XX.Akce := Akce;
|
||
XX.GUID := GUID;
|
||
XX.HotKey := HotKey;
|
||
XX.NazevPodmenu := NazevPodmenu;
|
||
XX.KdyZapsatParametry := KdyZapsatParametry;
|
||
XX.Parametry := Parametry;
|
||
XX.Verejna := AVerejna;
|
||
FSeznamAkci.AddObject(GUID, XX);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.AddAkce(const NazevSys: string; NazevVerejnyTxt: TplgTxt;
|
||
Akce: TplgJednaAkce; const GUID: string; NazevPodmenuTxt: TplgTxt = plxNic;
|
||
HotKey: Integer = 0; KdyZapsatParametry: TKdyZapsatParametry = kzpNikdy;
|
||
const Parametry: string = ''; PridatOddelovacMenu: Boolean = False;
|
||
Napoveda: TplgTxt = plxNic; AVerejna: Boolean = True);
|
||
var
|
||
XX: TplgAkctionContainer;
|
||
begin
|
||
plgLadit_KontrolaGUIDInstalace(GUID);
|
||
|
||
XX := TplgAkctionContainer.Create;
|
||
XX.NazevSys := NazevSys;
|
||
XX.NazevTxt := NazevVerejnyTxt;
|
||
XX.Nazev := plgCtiOznam(XX.NazevTxt);
|
||
XX.Akce := Akce;
|
||
XX.GUID := GUID;
|
||
XX.HotKey := HotKey;
|
||
XX.NazevPodmenuTxt := NazevPodmenuTxt;
|
||
XX.NazevPodmenu := plgCtiOznam(XX.NazevPodmenuTxt);
|
||
XX.KdyZapsatParametry := KdyZapsatParametry;
|
||
XX.Parametry := Parametry;
|
||
XX.PridatOddelovacMenu := PridatOddelovacMenu;
|
||
XX.NapovedaTxt := Napoveda;
|
||
XX.Napoveda := plgCtiOznam(XX.Napoveda);
|
||
XX.Verejna := AVerejna;
|
||
FSeznamAkci.AddObject(GUID, XX);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.GetIDHlavicky(var IDHlavicky: Integer): Boolean;
|
||
var
|
||
HeliosVlastnik: IHelios;
|
||
AkceVlastnika: TplgAkcePrehledu;
|
||
begin
|
||
Result := False;
|
||
|
||
HeliosVlastnik := SpravceHeliosu.VratVlastnika(FHelios);
|
||
|
||
// pokud neni navazan vlastnik, tak neni co priradit
|
||
if not Assigned(HeliosVlastnik) then
|
||
begin
|
||
FHelios.Error('NastavIDHlavickyDoRadku: Nen<65> p<>i<EFBFBD>azen HeliosVlastnik!');
|
||
Exit;
|
||
end;
|
||
|
||
AkceVlastnika := SpravceHeliosu.VratAkcePrehledu(HeliosVlastnik);
|
||
|
||
if Assigned(AkceVlastnika) and Assigned(AkceVlastnika.FPlgEditor) then
|
||
IDHlavicky := TfrmPlgEditor(AkceVlastnika.FPlgEditor).DataSourceEdit.DataSet.FieldByName(plg_SystemoveCislo).AsInteger
|
||
else
|
||
IDHlavicky := HeliosVlastnik.CurrentRecordID;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.NastavIDHlavickyDoRadku(FieldNaRadku: TField): Boolean;
|
||
var
|
||
IDHlavicky: Integer;
|
||
begin
|
||
Result := GetIDHlavicky(IDHlavicky);
|
||
if Result then
|
||
FieldNaRadku.AsInteger := IDHlavicky;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.OnNovaVeta( AFields : TFields;
|
||
var Prerusit : Boolean;
|
||
PrvniPruchod : Boolean);
|
||
begin
|
||
// dedi se
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.NajdiPrvniVolny(ATabulka : TplgTabulka;
|
||
const AAtribut : string;
|
||
const AWHERE : string;
|
||
AMin, AMax : Integer;
|
||
APlnitMezery: Boolean = True): Integer;
|
||
var
|
||
TabulkaStr: string;
|
||
PomInt: Integer;
|
||
Q: IHeQuery;
|
||
begin
|
||
Result := -1;
|
||
|
||
TabulkaStr := plgJmenoTabulky(ATabulka);
|
||
if ((AMin > AMax) or (TabulkaStr = '')) then Exit;
|
||
|
||
Q := FHelios.OpenSQL(
|
||
Format('EXEC dbo.hp_NajdiPrvniVolny %s,%s,%d,%d,%s,0,%d',
|
||
[plgNQuotedStr(TabulkaStr), plgNQuotedStr(AAtribut), AMin, AMax,
|
||
plgNQuotedStr(AWHERE), Integer(APlnitMezery)]));
|
||
if not varIsNull(Q.FieldValues(0)) then
|
||
begin
|
||
PomInt := Q.FieldValues(0);
|
||
if (AMin <= PomInt) and (PomInt <= AMax) then Result := PomInt;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
var
|
||
OnGetText_PomSL: TStringList = nil;
|
||
|
||
procedure TplgAkcePrehledu.My_OnGetText( Sender : TField;
|
||
var Text : String;
|
||
DisplayText : Boolean);
|
||
var
|
||
PA: PplgAtributTabulky;
|
||
begin
|
||
if Sender.Tag <> 0 then
|
||
PA := PplgAtributTabulky(Sender.Tag)
|
||
else
|
||
PA := plgAtribut(Sender.Origin);
|
||
|
||
if Assigned(PA) then
|
||
begin
|
||
if not Assigned(OnGetText_PomSL) then
|
||
OnGetText_PomSL := TStringList.Create;
|
||
|
||
OnGetText_PomSL.Text := PA.Konverze;
|
||
Text := plgHodnotaZKonverze(Sender.IsNULL, Sender.AsString, OnGetText_PomSL);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.My_OnSetText(Sender: TField; const Text: string);
|
||
var
|
||
PomSL : TStringList;
|
||
S : String;
|
||
PA : PplgAtributTabulky;
|
||
begin
|
||
if Sender.Tag <> 0 then
|
||
PA := PplgAtributTabulky(Sender.Tag)
|
||
else
|
||
PA := plgAtribut(Sender.Origin);
|
||
|
||
PomSL := plgObracenaKonverze(PA.Konverze);
|
||
try
|
||
if PomSL.IndexOfName(Text) = -1 then // je v obracenem StringListu
|
||
Sender.AsString := Text // neni - nekonvertuj
|
||
else
|
||
begin // je - konvertuj s ohledem na hodnotu NULL
|
||
S := PomSL.Values[Text];
|
||
if SameText(S, 'NULL') then
|
||
Sender.Clear
|
||
else
|
||
Sender.AsString := S;
|
||
end;
|
||
finally
|
||
PomSL.Free;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.Field_OnChange(Sender: TField);
|
||
begin
|
||
if Assigned(Sender.DataSet.BeforePost) then
|
||
Sender.ImportedConstraint := '1';
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.FieldWasChanged(F: TField): Boolean;
|
||
begin
|
||
//toto zlobi v pripade blobu
|
||
//Result := not plgVarSameValue(F.OldValue, F.Value);
|
||
Result := (F.ImportedConstraint = '1');
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.CreateMemDataSet;
|
||
var
|
||
PA : PplgAtributTabulky;
|
||
II : Integer;
|
||
TabName: string;
|
||
|
||
{ +++++++++++++++++++++++++++ }
|
||
|
||
function CreateField(FC: TFieldClass): TField;
|
||
begin
|
||
Result := FC.Create(FMemDataSet);
|
||
with Result do
|
||
begin
|
||
FieldName := PA.JmenoSys;
|
||
Origin := TabName + '.' + PA.JmenoSys;
|
||
DataSet := FMemDataSet;
|
||
Tag := Integer(PA);
|
||
Required := False;
|
||
|
||
OnChange := Field_OnChange;
|
||
|
||
if PA.Konverze <> '' then
|
||
begin
|
||
OnGetText := My_OnGetText;
|
||
OnSetText := My_OnSetText;
|
||
Alignment := taLeftJustify;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ +++++++++++++++++++++++++++ }
|
||
|
||
begin
|
||
FMemDataSet := TplgQuery.Create(nil);
|
||
try
|
||
with plgGetTabulkaDef(FTabulka)^ do
|
||
begin
|
||
TabName := JmenoSys;
|
||
|
||
PA := Atributy;
|
||
for II := 1 to PocetAtributu do
|
||
begin
|
||
// pocitane a abstraktni neexistuji, binary nejde zpravne zobrazit...
|
||
if (PA.Pocitany = '') and (PA.Typ <> taBinary) and
|
||
(not(dvAbstraktni in PA.DalsiVlastnosti)) then
|
||
case PA.Typ of
|
||
taInt, // ftInteger
|
||
taIdentity:
|
||
with TIntegerField(CreateField(TIntegerField)) do
|
||
begin
|
||
ValidChars := ValidChars - ['+','-'];
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
end;
|
||
|
||
taInt64, // ftLargeint
|
||
taIdentity64:
|
||
with TLargeintField(CreateField(TLargeintField)) do
|
||
begin
|
||
ValidChars := ValidChars - ['+','-'];
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
end;
|
||
|
||
// taGUID: // ftString
|
||
// with TStringField(CreateField(TStringField)) do
|
||
// Size := 36; // napr. 85AA05CC-9D09-4BA9-B07B-7A25319BE5F4
|
||
|
||
taSmallInt: // ftSmallint
|
||
with TSmallIntField(CreateField(TSmallIntField)) do
|
||
begin
|
||
ValidChars := ValidChars - ['+','-'];
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
end;
|
||
|
||
taByte: // ftByte
|
||
with TByteField(CreateField(TByteField)) do
|
||
begin
|
||
ValidChars := ValidChars - ['+','-'];
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
end;
|
||
|
||
taBoolean: // ftBoolean
|
||
with TBooleanField(CreateField(TBooleanField)) do
|
||
DisplayValues := 'A;N';
|
||
|
||
taVarChar, // ftString
|
||
taChar:
|
||
begin
|
||
//[JAS 13.2.2018] - rozsireni o (N)VARCHAR(MAX)
|
||
if PA.Delka=Cplg_DelkaNVarcharMax then
|
||
CreateField(TMemoField)
|
||
else
|
||
with TStringField(CreateField(TStringField)) do
|
||
Size := PA.Delka;
|
||
end;
|
||
|
||
taText: // ftMemo
|
||
CreateField(TMemoField);
|
||
|
||
taNVarChar, // ftWideString
|
||
taNChar:
|
||
begin
|
||
//[JAS 13.2.2018] - rozsireni o (N)VARCHAR(MAX)
|
||
if PA.Delka=Cplg_DelkaNVarcharMax then
|
||
CreateField(TWideMemoField)
|
||
else
|
||
with TWideStringField(CreateField(TWideStringField)) do
|
||
Size := PA.Delka;
|
||
end;
|
||
|
||
taNText: // ftWideMemo
|
||
CreateField(TWideMemoField);
|
||
|
||
taDateTime: // ftDateTime
|
||
CreateField(TDateTimeField);
|
||
|
||
taTime: // ftTime
|
||
CreateField(TTimeField);
|
||
|
||
taImage: // ftBlob
|
||
CreateField(TBlobField);
|
||
|
||
taFloat: // ftFloat
|
||
with TFloatField(CreateField(TFloatField)) do
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
|
||
else
|
||
if PA.Typ in Cplg_SkupinaAtributuNumeric then // ftFloat
|
||
with TFloatField(CreateField(TFloatField)) do
|
||
begin
|
||
DisplayFormat := PA.MaskaDisplay;
|
||
Precision := 6;
|
||
end;
|
||
end;
|
||
|
||
Inc(PA);
|
||
end;
|
||
end;
|
||
except
|
||
FreeAndNil(FMemDataSet);
|
||
raise;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu._VolejEditor(AQuery : TDataSet);
|
||
begin
|
||
if not Assigned(FPlgEditorClass) then Exit;
|
||
|
||
FDataSourceEdit := TDataSource.Create(AQuery);
|
||
try
|
||
FDataSourceEdit.DataSet := AQuery;
|
||
try
|
||
FPlgEditor := TfrmPlgEditor(FPlgEditorClass.NewInstance).Create(Application, FHelios, Self, FDataSourceEdit);
|
||
try
|
||
Screen.Cursor := crDefault;
|
||
FPlgEditor.ShowModal;
|
||
finally
|
||
FreeAndNil(FPlgEditor);
|
||
end;
|
||
finally
|
||
if FDataSourceEdit.State <> dsBrowse then
|
||
FDataSourceEdit.DataSet.Cancel;
|
||
end;
|
||
finally
|
||
FreeAndNil(FDataSourceEdit);
|
||
ProvedRefresh(Lo(AQuery.Tag) = Cplg_tagNovaVeta);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.ProvedRefresh(NovaVeta: Boolean);
|
||
var
|
||
PomID: Integer;
|
||
begin
|
||
FHelios.Refresh(NovaVeta);
|
||
if NovaVeta and (not varIsNull(FLastID)) then
|
||
begin
|
||
PomID := FLastID;
|
||
FHelios.Locate(plg_SystemoveCislo, PomID);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu._GetValueFromField(F: TField): string;
|
||
begin
|
||
if F.IsNull then
|
||
Result := 'NULL'
|
||
else
|
||
case F.DataType of
|
||
ftInteger,
|
||
ftLargeInt,
|
||
ftSmallint,
|
||
ftShortint,
|
||
ftWord,
|
||
ftByte:
|
||
Result := F.AsString;
|
||
|
||
ftBoolean:
|
||
if F.AsBoolean then
|
||
Result := '1'
|
||
else
|
||
Result := '0';
|
||
|
||
ftString,
|
||
ftMemo:
|
||
Result := QuotedStr(string(F.AsAnsiString));
|
||
|
||
ftWideString,
|
||
ftWideMemo:
|
||
Result := plgNQuotedStr(F.AsString);
|
||
|
||
ftBlob:
|
||
Result := plgTextToBinary(F.AsAnsiString);
|
||
|
||
ftDateTime:
|
||
Result := plgGetIndependentSQLDateTime(F.AsDateTime);
|
||
|
||
ftFloat:
|
||
Result := plgGetIndependentSQLFloat('%.6f', F.AsFloat);
|
||
|
||
else
|
||
Result := 'NULL'; // sem by to ale prijit nemelo
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.MemDataSet_AfterCancel(DataSet: TDataSet);
|
||
var
|
||
LF: TField;
|
||
begin
|
||
LF := DataSet.FieldByName(plg_SystemoveCislo);
|
||
|
||
case Lo(FMemDataSet.Tag) of
|
||
Cplg_tagNovaVeta:
|
||
FHelios.ExecSQL(
|
||
Format(plgSkriptProDeleteJednohoZaznamu(FTabulka, False), [_GetValueFromField(LF)]));
|
||
|
||
Cplg_tagOpravaVety:
|
||
FHelios.ExecSQL(
|
||
Format('UPDATE %s SET ' + plg_BlokovaniEditoru + '=NULL WHERE %s=%s',
|
||
[plgJmenoTabulky(FTabulka), LF.FieldName, _GetValueFromField(LF)]));
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.AfterInsertSkript: string;
|
||
begin
|
||
Result := '';
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.AfterUpdateSkript: string;
|
||
begin
|
||
Result := '';
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.MemDataSet_BeforePost(DataSet: TDataSet);
|
||
var
|
||
Skript, Hodnoty: string;
|
||
II: Integer;
|
||
LF: TField;
|
||
AfterSkript, Deklarace: string;
|
||
PridatZmenu: Boolean;
|
||
begin
|
||
Skript := '';
|
||
Hodnoty := '';
|
||
|
||
case DataSet.State of
|
||
dsInsert:
|
||
begin
|
||
Deklarace := 'INT';
|
||
for II := 0 to DataSet.Fields.Count-1 do
|
||
begin
|
||
LF := DataSet.Fields[II];
|
||
if (LF <> TplgQuery(DataSet).RecIdField) and (LF.Tag <> 0) then
|
||
begin
|
||
if (not LF.IsNull) and (not (PplgAtributTabulky(LF.Tag).Typ in Cplg_MnozinaIdentity)) then
|
||
begin
|
||
Skript := Format('%s,%s', [Skript, LF.FieldName]);
|
||
Hodnoty := Format('%s,%s', [Hodnoty, _GetValueFromField(LF)]);
|
||
end
|
||
else
|
||
if PplgAtributTabulky(LF.Tag).Typ = taIdentity64 then
|
||
Deklarace := 'BIGINT';
|
||
end;
|
||
end;
|
||
|
||
if Skript <> '' then
|
||
begin
|
||
// zrus carky na zacatku
|
||
Delete(Skript, 1, 1);
|
||
Delete(Hodnoty, 1, 1);
|
||
|
||
Skript := Format('INSERT %s(%s)VALUES(%s)',
|
||
[plgJmenoTabulky(FTabulka), Skript, Hodnoty]);
|
||
|
||
AfterSkript := AfterInsertSkript;
|
||
if AfterSkript = '' then
|
||
Skript := Format('%s'#13'SELECT SCOPE_IDENTITY()', [Skript])
|
||
else
|
||
Skript :=
|
||
Format('BEGIN TRANSACTION'#13+
|
||
'DECLARE @ID %s'#13+
|
||
'%s'#13+ // INSERT
|
||
'IF @@ERROR<>0 GOTO CHYBAROLLBACK'#13+
|
||
'SET @ID=SCOPE_IDENTITY()'#13+
|
||
'%s'#13+ // AFTER INSERT SKRIPT
|
||
'IF @@ERROR<>0 GOTO CHYBAROLLBACK'#13+
|
||
'COMMIT'#13+
|
||
'SELECT @ID'#13+
|
||
'GOTO KONEC'#13+
|
||
'CHYBAROLLBACK:'#13+
|
||
'ROLLBACK'#13+
|
||
'KONEC:',
|
||
[Deklarace, Skript, AfterSkript]);
|
||
end;
|
||
end;
|
||
|
||
dsEdit:
|
||
begin
|
||
// [RK 17.01.2007] doplnen test na skutecnou zmenu
|
||
if Assigned(FPlgEditor) and (FPlgEditor is TfrmPlgEditor) then
|
||
PridatZmenu := TfrmPlgEditor(FPlgEditor).BylaZmena
|
||
else
|
||
// [RK 20.10.2008] zmeneno na False, jelikoz to nastavovalo i pri editaci
|
||
// pri nahazovani BlokovaniEditoru
|
||
PridatZmenu := False;
|
||
|
||
for II := 0 to DataSet.Fields.Count-1 do
|
||
begin
|
||
LF := DataSet.Fields[II];
|
||
if (LF <> TplgQuery(DataSet).RecIdField) and (LF.Tag <> 0) and
|
||
(not(PplgAtributTabulky(LF.Tag).Typ in Cplg_MnozinaIdentity)) then
|
||
begin
|
||
if SameText(LF.FieldName, plg_Zmenil) and PridatZmenu then
|
||
Skript := Format('%s,'#13'%s=%s', [Skript, LF.FieldName, Cplg_LoginName])
|
||
else
|
||
if SameText(LF.FieldName, plg_DatZmeny) and PridatZmenu then
|
||
Skript := Format('%s,'#13'%s=%s', [Skript, LF.FieldName, Cplg_GetDate])
|
||
else
|
||
if SameText(LF.FieldName, plg_BlokovaniEditoru) then
|
||
Skript := Format('%s,'#13'%s=%s', [Skript, LF.FieldName, _GetValueFromField(LF)])
|
||
else
|
||
if FieldWasChanged(LF) then
|
||
Skript := Format('%s,'#13'%s=%s', [Skript, LF.FieldName, _GetValueFromField(LF)]);
|
||
end;
|
||
end;
|
||
|
||
if Skript <> '' then
|
||
begin
|
||
// zrus carku na zacatku
|
||
Delete(Skript, 1, 1);
|
||
|
||
LF := DataSet.FieldByName(plg_SystemoveCislo);
|
||
Hodnoty := _GetValueFromField(LF);
|
||
|
||
Skript := Format('UPDATE %s SET %s'#13'WHERE %s=%s',
|
||
[plgJmenoTabulky(FTabulka), Skript, LF.FieldName, Hodnoty]);
|
||
|
||
// [RK 05.09.2012] AfterUpdateSkript pouze pri skutecne zmene, nikoliv pri nahozeni BlokovaniEditoru
|
||
if PridatZmenu then
|
||
AfterSkript := AfterUpdateSkript
|
||
else
|
||
AfterSkript := '';
|
||
|
||
if AfterSkript = '' then
|
||
Skript := Format('%s'#13'SELECT %s', [Skript, Hodnoty])
|
||
else
|
||
Skript :=
|
||
Format('BEGIN TRANSACTION'#13+
|
||
'DECLARE @ID INT'#13+
|
||
'%s'#13+ // UPDATE
|
||
'IF @@ERROR<>0 GOTO CHYBAROLLBACK'#13+
|
||
'SET @ID=%s'#13+
|
||
'%s'#13+ // AFTER UPDATE SKRIPT
|
||
'IF @@ERROR<>0 GOTO CHYBAROLLBACK'#13+
|
||
'COMMIT'#13+
|
||
'SELECT @ID'#13+
|
||
'GOTO KONEC'#13+
|
||
'CHYBAROLLBACK:'#13+
|
||
'ROLLBACK'#13+
|
||
'KONEC:',
|
||
[Skript, Hodnoty, AfterSkript]);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if Skript = '' then
|
||
FLastID := NULL
|
||
else
|
||
try
|
||
FLastID := FHelios.OpenSQL(Skript).FieldValues(0);
|
||
finally
|
||
Screen.Cursor := crDefault;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.NahodBlokovaniEditoru(NacteniPoInsertu: Boolean): Boolean;
|
||
var
|
||
LF: TField;
|
||
TD: PplgTabulkaDef;
|
||
begin
|
||
FMemDataSet.BeforePost := MemDataSet_BeforePost;
|
||
|
||
TD := plgGetTabulkaDef(FTabulka);
|
||
|
||
// blokovani editoru - pri oprave vzdy, pri nove vete pouze pokud neni vypnuto
|
||
// [RK 20.10.2008] plg_dvtBlokovaniJenOprava
|
||
LF := FMemDataSet.FindField(plg_BlokovaniEditoru);
|
||
Result := Assigned(LF) and
|
||
((Lo(FMemDataSet.Tag) = Cplg_tagOpravaVety) or
|
||
((Lo(FMemDataSet.Tag) = Cplg_tagNovaVeta) and
|
||
(not (plg_dvtBlokovaniJenOprava in TD.DalsiVlastnosti))));
|
||
|
||
if Result then
|
||
begin
|
||
if (Lo(FMemDataSet.Tag) = Cplg_tagOpravaVety) and (not LF.IsNull) then
|
||
begin
|
||
// nastav Hi(Tag) na 1 - blokovano
|
||
FMemDataSet.Tag := FMemDataSet.Tag or $00000100;
|
||
LF := nil;
|
||
end
|
||
else
|
||
begin
|
||
// nastav Hi(Tag) na 0 - neblokovano
|
||
FMemDataSet.Tag := FMemDataSet.Tag and $FFFF00FF;
|
||
LF.AsInteger := FHelios.UserId;
|
||
|
||
// [RK 05.09.2012] je treba signalizovat, ze zmena nebyla - kvuli datu zmeny !!
|
||
LF.ImportedConstraint := '';
|
||
|
||
with FMemDataSet do
|
||
begin
|
||
if not NacteniPoInsertu then
|
||
begin
|
||
Post; // toto jde do DB, ale pouze pri INSERTu !
|
||
Edit;
|
||
end;
|
||
AfterCancel := MemDataSet_AfterCancel; // pro budouci shozeni priznaku v DB
|
||
end;
|
||
|
||
// nacteni ID nove vety
|
||
if Lo(FMemDataSet.Tag) = Cplg_tagNovaVeta then
|
||
FMemDataSet.FieldByName(plg_SystemoveCislo).Value := FLastID;
|
||
end;
|
||
|
||
if Assigned(LF) then
|
||
begin
|
||
with FMemDataSet do
|
||
begin
|
||
// ulozeni ID a BlokovaniEditoru, ale ne do DB !!
|
||
BeforePost := nil;
|
||
|
||
// BlokovaniEditoru opet vynullujeme
|
||
// [RK 05.09.2012] presunuto az za BeforePost := nil -> jinak nahodi zmenu na True
|
||
LF.Clear;
|
||
|
||
// bez ulozeni by se to ptalo na zmenu a v ID by bylo NULL po Cancel
|
||
Post;
|
||
Edit;
|
||
|
||
// obnovime update DB
|
||
BeforePost := MemDataSet_BeforePost;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
FMemDataSet.SetModified(False);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.ZrusUdalostiDataSetu;
|
||
var
|
||
II: Integer;
|
||
begin
|
||
with FMemDataSet do
|
||
begin
|
||
ReadOnly := False;
|
||
BeforePost := nil;
|
||
AfterCancel := nil;
|
||
|
||
// zrus priznak zmeny atributu - viz Field_OnChange
|
||
for II := 0 to Fields.Count-1 do
|
||
Fields[II].ImportedConstraint := '';
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.NovyRadekDataSetu;
|
||
begin
|
||
with FMemDataSet do
|
||
begin
|
||
Open;
|
||
while RecordCount > 0 do Delete;
|
||
Insert;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.PripravProNova: Boolean;
|
||
var
|
||
II: Integer;
|
||
PA: PplgAtributTabulky;
|
||
LPrerusit: Boolean;
|
||
LF: TField;
|
||
begin
|
||
Result := False;
|
||
|
||
// nastaveni Lo(Tag) - signalizuj Nova
|
||
FMemDataSet.Tag := (FMemDataSet.Tag and $FFFFFF00) or Lo(Cplg_tagNovaVeta);
|
||
|
||
ZrusUdalostiDataSetu;
|
||
NovyRadekDataSetu;
|
||
|
||
for II := FMemDataSet.Fields.Count-1 downto 0 do
|
||
begin
|
||
LF := FMemDataSet.Fields[II];
|
||
if (LF <> FMemDataSet.RecIdField) and (LF.Tag <> 0) then
|
||
begin
|
||
PA := PplgAtributTabulky(LF.Tag);
|
||
|
||
// kdyz nebyla zmena a nema povoleno NULL a nema DEFAULT -> pokus se vyplnit
|
||
if (LF.IsNULL) and (PA.NULL <> nNULL) and (PA.ServerDEFAULT = '') then
|
||
if (not(PA.Typ in Cplg_MnozinaIdentity)) or (Trim(PA.Pocitany) <> '') then
|
||
begin
|
||
if LF is TStringField then
|
||
LF.AsString := ''
|
||
else
|
||
if LF is TNumericField then
|
||
LF.AsInteger := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
LPrerusit := False;
|
||
OnNovaVeta(FMemDataSet.Fields, LPrerusit, True);
|
||
if LPrerusit then Exit;
|
||
|
||
if NahodBlokovaniEditoru(False) then
|
||
begin
|
||
ZrusUdalostiDataSetu;
|
||
NactiRadek_Z_DB(varToStr(FLastID));
|
||
NahodBlokovaniEditoru(True);
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.TestNaTabulku: Boolean;
|
||
begin
|
||
Result := plgJeObecnyPrehled(FHelios.MainBrowseTable);
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.TestPredStandardnimiAkcemi(ChciID: Boolean): Boolean;
|
||
var
|
||
TD: PplgTabulkaDef;
|
||
begin
|
||
Result := False;
|
||
|
||
if not TestNaTabulku then Exit;
|
||
|
||
TD := plgGetTabulkaDef(FTabulka);
|
||
if not Assigned(TD) then Exit;
|
||
if plg_dvtAbstraktni in TD.DalsiVlastnosti then Exit;
|
||
|
||
if ChciID then
|
||
if varToStr(FHelios.CurrentRecordID) = '' then Exit;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.ActionNew;
|
||
begin
|
||
if not TestPredStandardnimiAkcemi(False) then Exit;
|
||
|
||
CreateMemDataSet;
|
||
try
|
||
if not PripravProNova then Exit;
|
||
_VolejEditor(FMemDataSet);
|
||
finally
|
||
FreeAndNil(FMemDataSet);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.NactiRadek_Z_DB(const IDStr: string);
|
||
var
|
||
II: Integer;
|
||
SelectStr: string;
|
||
LF: TField;
|
||
LFieldList: TList<TField>;
|
||
Q: IHeQuery;
|
||
begin
|
||
NovyRadekDataSetu;
|
||
|
||
LFieldList := TList<TField>.Create;
|
||
try
|
||
// sestaveni selectu pro nacteni hodnot
|
||
SelectStr := '';
|
||
for II := 0 to FMemDataSet.Fields.Count-1 do
|
||
begin
|
||
LF := FMemDataSet.Fields[II];
|
||
if (LF <> FMemDataSet.RecIdField) and (LF.Tag <> 0) then
|
||
begin
|
||
SelectStr := Format('%s,%s', [SelectStr, LF.FieldName]);
|
||
LFieldList.Add(LF);
|
||
end;
|
||
end;
|
||
Delete(SelectStr, 1, 1);
|
||
|
||
Q := FHelios.OpenSQL(Format('SELECT %s FROM %s WHERE %s=%s',
|
||
[SelectStr, plgJmenoTabulky(FTabulka),
|
||
plg_SystemoveCislo, IDStr]));
|
||
if Q.EOF then Exit;
|
||
|
||
for II := 0 to LFieldList.Count-1 do
|
||
begin
|
||
LF := LFieldList[II];
|
||
// if PplgAtributTabulky(LF.Tag).Typ = taGUID then
|
||
// LF.AsString := varToStr(Q.FieldValues(II))
|
||
// else
|
||
LF.Value := Q.FieldValues(II);
|
||
end;
|
||
finally
|
||
LFieldList.Free;
|
||
end;
|
||
|
||
// zplatneni hodnot v datasetu
|
||
with FMemDataSet do
|
||
begin
|
||
Post; First; Edit;
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.PripravProEditaci: Boolean;
|
||
var
|
||
IDStr: string;
|
||
begin
|
||
Result := False;
|
||
|
||
IDStr := varToStr(FHelios.CurrentRecordID);
|
||
if IDStr = '' then Exit;
|
||
|
||
// nastaveni Lo(Tag) - signalizuj Oprava
|
||
FMemDataSet.Tag := (FMemDataSet.Tag and $FFFFFF00) or Lo(Cplg_tagOpravaVety);
|
||
|
||
ZrusUdalostiDataSetu;
|
||
NactiRadek_Z_DB(IDStr);
|
||
NahodBlokovaniEditoru(False);
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.ActionEdit;
|
||
begin
|
||
if not TestPredStandardnimiAkcemi(True) then Exit;
|
||
|
||
CreateMemDataSet;
|
||
try
|
||
if not PripravProEditaci then Exit;
|
||
_VolejEditor(FMemDataSet);
|
||
finally
|
||
FreeAndNil(FMemDataSet);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
procedure TplgAkcePrehledu.ActionDelete;
|
||
var
|
||
PomStr: string;
|
||
SL: TStringList;
|
||
II: Integer;
|
||
begin
|
||
if not TestPredStandardnimiAkcemi(True) then Exit;
|
||
|
||
SL := TStringList.Create;
|
||
try
|
||
PomStr := FHelios.SelectedRecordIDs;
|
||
if PomStr <> '' then
|
||
SL.CommaText := PomStr
|
||
else
|
||
SL.Add(varToStr(FHelios.CurrentRecordID));
|
||
|
||
if SL.Count > 1 then
|
||
PomStr := Format('%s (%d) ?', [plgCtiOznam(plxJadroOprPrejSmazVse), SL.Count])
|
||
else
|
||
PomStr := plgCtiOznam(plxJadroOprPrejSmazAkt);
|
||
|
||
if not FHelios.YesNo(PomStr, False) then Exit;
|
||
|
||
PomStr := plgSkriptProDeleteJednohoZaznamu(FTabulka, True);
|
||
for II := 0 to SL.Count-1 do
|
||
FHelios.ExecSQL(Format(PomStr, [SL.Strings[II]]));
|
||
finally
|
||
SL.Free;
|
||
FHelios.Refresh(True);
|
||
end;
|
||
end;
|
||
|
||
{ --------------------------------------------------------------------------- }
|
||
|
||
function TplgAkcePrehledu.SpustAkci(const GUIDAkce: string): string;
|
||
var
|
||
II: Integer;
|
||
begin
|
||
Result := '';
|
||
|
||
if SameText(GUIDAkce, Cplg_GUID_Instalace) then
|
||
Result := GetInstallScriptForAction(Helios, FSeznamAkci, Self.ClassName)
|
||
else
|
||
begin
|
||
II := FSeznamAkci.IndexOf(GUIDAkce);
|
||
if II = -1 then Exit;
|
||
|
||
if Assigned(FSeznamAkci.Objects[II]) then
|
||
TplgAkctionContainer(FSeznamAkci.Objects[II]).Akce;
|
||
end;
|
||
end;
|
||
|
||
{ ########################################################################### }
|
||
|
||
end.
|