Prvotni verze pro Giteu

2025-09-05 12:22:48 +02:00
parent fdc66e476a
commit cab52aaa5a
29 changed files with 14982 additions and 0 deletions
--- a/datModPrij.pas
+++ b/datModPrij.pas
@ -0,0 +1,142 @@
+unit datModPrij;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, MemTableDataEh, Data.DB, MemTableEh, ddPlugin_TLB;
+
+type
+  TdmPrij = class(TDataModule)
+    vTabPrij: TMemTableEh;
+    dsPrij: TDataSource;
+    vTabPoradiSort: TSingleField;
+    vTabPoradi: TSmallintField;
+    vTabPoradiSortNazev: TStringField;
+    vTabNazev1: TStringField;
+    vTabRegCis: TStringField;
+    vTabSkupZbo: TStringField;
+    vTabIDZboSklad: TIntegerField;
+    vTabMnozstvi: TFloatField;
+    vTabIDPohybZboziObj: TIntegerField;
+    vTabSortiment: TStringField;
+    vTabK2: TStringField;
+    vTabK1: TStringField;
+    vTabTypZavozu: TStringField;
+    vTabPoradiExt: TSingleField;
+    vTabK1K2: TStringField;
+    vTabJCbezDaniKc: TSingleField;
+    procedure vTabFilterRecord(DataSet: TDataSet; var Accept: Boolean);
+    procedure vTabMnozstviValidate(Sender: TField);
+    procedure vTabRanoValidate(Sender: TField);
+    procedure vTabPoledneValidate(Sender: TField);
+   private
+   public
+    Helios: IHelios;
+  end;
+
+var
+  dmPrij: TdmPrij;
+
+
+implementation
+uses frmPrijem;
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+{$R *.dfm}
+
+
+ procedure TdmPrij.vTabFilterRecord(DataSet: TDataSet; var Accept: Boolean);
+  var t: string;
+  begin
+   if (vTabPrij.RecordCount>0) then
+    begin
+     t:= vTabPrij.FieldByName('TypZavozu').AsString;
+     case formPrijem.cbZavoz.ItemIndex of
+      0: Accept:= (t='R');
+      1: Accept:= (t='P');
+     end;
+    end;
+  end;
+
+
+
+
+ procedure TdmPrij.vTabMnozstviValidate(Sender: TField);
+  var canCont: Boolean;
+      mv, mm: Single;
+  begin
+   canCont:= true;
+   mv:= TField(Sender).AsFloat;
+   if (mv<0) then
+    canCont:=false;
+
+   if not(canCont) then
+    TField(Sender).DataSet.Cancel;
+  end;
+
+
+
+
+ procedure TdmPrij.vTabPoledneValidate(Sender: TField);
+  var canCont: Boolean;
+      mv, mm: Single;
+  begin
+   canCont:= true;
+   mv:= TField(Sender).AsFloat;
+   mm:= TField(Sender).DataSet.FieldByName('Minimum').AsSingle;
+
+   if (TField(Sender).AsInteger<>0) and (TField(Sender).DataSet.FieldByName('JenRano').AsInteger=1) then
+    begin
+     TField(Sender).DataSet.Cancel;
+     Helios.Error(#1'Položka "' + TField(Sender).DataSet.FieldByName('RegCis').AsString +'" je určena jen pro ranní závoz.'#1);
+     canCont:= false;
+    end;
+
+   if (canCont) and (TField(Sender).AsInteger<0) then
+    begin
+     canCont:= false;
+     Helios.Error(#1'Položka "' + TField(Sender).DataSet.FieldByName('RegCis').AsString +'" je určena jen pro ranní závoz.'#1);
+    end;
+
+   if (canCont) and (mv<mm) then
+    begin
+     canCont:= false;
+     Helios.Error(#1'Minimální množství je ' + FormatFloat('#,##0.###', mm) + #1);
+    end;
+
+   if not(canCont) then
+    TField(Sender).DataSet.Cancel;
+
+  end;
+
+
+
+
+ procedure TdmPrij.vTabRanoValidate(Sender: TField);
+  var canCont: Boolean;
+      mv, mm: Single;
+  begin
+   canCont:= true;
+   mv:= TField(Sender).AsFloat;
+   mm:= TField(Sender).DataSet.FieldByName('Minimum').AsSingle;
+
+   if (TField(Sender).AsInteger<0) then
+    begin
+     canCont:= false;
+     Helios.Error(#1'Lze zadávat jen kladná čísla.'#1);
+    end;
+
+   if (canCont) and (mv<mm) then
+    begin
+     canCont:= false;
+     Helios.Error(#1'Minimální množství je ' + FormatFloat('#,##0.###', mm) + #1);
+    end;
+
+   if not(canCont) then
+    TField(Sender).DataSet.Cancel;
+
+  end;
+
+
+end.