Prvni verze na Git

2026-04-07 18:23:56 +02:00
parent d314d0524b
commit c0aa420ae0
92 changed files with 59472 additions and 2 deletions
--- a/frmMaterial.pas
+++ b/frmMaterial.pas
@ -0,0 +1,87 @@
+unit frmMaterial;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, ddPlugin_TLB, Data.DB, FireDAC.Comp.Client,
+  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error,
+  FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Comp.DataSet;
+
+type
+  TformMaterial = class(TForm)
+    ds: TDataSource;
+    vTab: TFDMemTable;
+    vTabId: TIntegerField;
+    vTabParentId: TIntegerField;
+    vTabSZ: TStringField;
+    vTabRegCis: TStringField;
+    vTabNazev: TStringField;
+    vTabMnoz: TFloatField;
+    treeMat: TTreeView;
+    procedure FormShow(Sender: TObject);
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
+   private
+    procedure NactiTree;
+   public
+    Helios: IHelios;
+    idMat: integer;
+  end;
+
+var
+  formMaterial: TformMaterial;
+
+implementation
+uses helUtils;
+
+{$R *.dfm}
+
+ procedure TformMaterial.NactiTree;
+  var lSQL: string;
+      id: integer;
+      root,uzel: TTreeNode;
+      cont: boolean;
+  begin
+   with Helios.OpenSQL('SELECT SkupZbo,RegCis,Nazev1 FROM ' + tblKZ + ' WHERE id=' + IntToStr(idMat)) do
+    begin
+     treeMat.Items.AddFirst(nil, VarToStr(FieldValues(0)) + ' ' + VarToStr(FieldValues(1)) + '   ' + VarToStr(FieldValues(2)));
+     root:= treeMat.Items.GetFirstNode;
+    end;
+   id:= idMat;
+   lSQL:= 'SELECT kz.id, kz.SkupZbo, kz.RegCis, kz.Nazev1, v.MnozstviSeZtratou/v.DavkaTPV FROM ' + tblKVaz;
+   lSQL:= lSQL + ' v INNER JOIN ' + tblKZ + ' kz ON (kz.id=v.vyssi)';
+   lSQL:= lSQL + ' LEFT JOIN ' + tblParKZ + ' p ON (p.IdKmenZbozi=kz.id) WHERE v.nizsi=';
+   cont:= true;
+   while (cont) do
+    begin
+     with Helios.OpenSQL(lSQL + IntToStr(id)) do
+      if (RecordCount=0) then
+        cont:= false
+       else
+        begin
+         First;
+         while not(EOF) do
+          begin
+           treeMat.Items.AddChild(root, VarToStr(FieldValues(1)) + ' ' + VarToStr(FieldValues(2)) + '   ' + VarToStr(FieldValues(3)));
+           Next;
+          end;
+         cont:= false;
+        end;
+    end;
+  end;
+
+ procedure TformMaterial.FormClose(Sender: TObject; var Action: TCloseAction);
+  begin
+   Action:= caFree;
+  end;
+
+ procedure TformMaterial.FormShow(Sender: TObject);
+  begin
+   Self.Icon.Handle:= Helios.MainApplicationIconHandle;
+   Self.Font.Name:= Helios.Font;
+   Self.Font.Height:= Helios.FontHeight;
+
+   NactiTree;
+  end;
+
+end.