88 lines
2.4 KiB
ObjectPascal
88 lines
2.4 KiB
ObjectPascal
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.
|