unit frmOrder; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Types, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.ImageList, Vcl.ImgList, Vcl.StdCtrls, Vcl.Buttons, Vcl.ComCtrls, ddPlugin_TLB, TBPackageU, Vcl.WinXPickers, Vcl.Mask, RxToolEdit, Vcl.NumberBox, Vcl.Grids, VirtualTrees; type PPolozka = ^TPolozka; TPolozka = packed record idKZ: integer; regCislo, nazev: string; k1, k2: string; mnRano, mnPoledne, mnDoporuceno: smallint; {$IF CompilerVersion>=34} // Sydney a vys class operator Initialize(out Dest: TPolozka); {$ENDIF} end; TTreeData = record regCislo: string[35]; PNodePolozka: Pointer; end; TformOrder = class(TForm) gbDodavatel: TGroupBox; gbPolozky: TGroupBox; selCOrg: TComboEdit; selOrg: TComboEdit; Label1: TLabel; dtZavoz: TDateTimePicker; btnOK: TButton; Label2: TLabel; lblDodAdresa: TLabel; lblDodICO: TLabel; cbSortiment: TComboBox; Label3: TLabel; edtCisloObj: TNumberBox; Label4: TLabel; btnTisk: TButton; btnPoslat: TButton; btnRozbalit: TButton; btnSbalit: TButton; btnZavrit: TButton; Panel1: TPanel; Panel2: TPanel; polTree: TVirtualStringTree; pnlAkce: TPanel; pnlCislo: TPanel; pnlNazev: TPanel; pnlDoporuceno: TPanel; pnlRano: TPanel; pnlPoledne: TPanel; cbSortimentX: TComboBox; procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure cbSortimentChange(Sender: TObject); procedure polTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); private public Helios: IHelios; jeTest: boolean; end; var formOrder: TformOrder; implementation uses helUtils; {$R *.dfm} {$IF CompilerVersion>=34} // Sydney a vys class operator TPolozka.Initialize(out Dest: TPolozka); begin dest.idKZ:= 0; dest.regCislo:= ''; dest.nazev:= ''; dest.k1:= ''; dest.k2:= ''; dest.mnRano:= 0; dest.mnPoledne:= 0; dest.mnDoporuceno:= 0; end; {$ENDIF} procedure TformOrder.cbSortimentChange(Sender: TObject); var lSQL: string; idSort: integer; rNode, pNode: PVirtualNode; myRec: PPolozka; begin cbSortimentX.ItemIndex:= cbSortiment.ItemIndex; lSQL:= 'SELECT s.ID FROM ' + tblSortim + ' s INNER JOIN ' + tblSortimE + ' se ON (se.ID=s.ID) WHERE se._Objednavky_Zobrazit=1'; lSQL:= lSQL + ' AND s.K1=N' + cbSortimentX.Items[0].QuotedString + ' AND s.K2 IS NOT NULL'; with Helios.OpenSQL(lSQL) do begin polTree.BeginUpdate; polTree.Clear; if (RecordCount>0) then begin idSort:= VarToStr(FieldByNameValues('ID')).ToInteger; lSQL:= 'SELECT ID, SkupZbo, RegCis, Nazev1 FROM ' + tblKZ + ' WHERE IDSortiment=' + idSort.ToString + ' ORDER BY SkupZbo, RegCis'; with Helios.OpenSQL(lSQL) do if (RecordCount>0) then begin First; rNode:= polTree.AddChild(nil); // root while not(EOF) do begin pNode:= polTree.AddChild(nil); myRec:= polTree.GetNodeData(pNode); myRec.idKZ:= VarToStr(FieldByNameValues('ID')).ToInteger; myRec.regCislo:= VarToStr(FieldByNameValues('RegCis')); myRec.nazev:= VarToStr(FieldByNameValues('Nazev1')); pNode:= polTree.AddChild(rNode, myRec); Next; end; end; end; polTree.EndUpdate; end; end; procedure TformOrder.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:= caFree; end; procedure TformOrder.FormShow(Sender: TObject); var rHeight: integer; lSQL: string; begin UseLatestCommonDialogs:= true; self.SetBounds(Screen.WorkAreaRect.Left, Screen.WorkAreaRect.Top, Screen.WorkAreaRect.Width, Screen.WorkAreaRect.Height); { grd.RowCount:= 2; grd.FixedRows:= 1; rHeight:= grd.Canvas.TextHeight('Áý'); grd.DefaultRowHeight:= grd.Font.Size + 18; // grd.RowHeights[1]:= grd.Canvas.TextHeight('Akce') + 4; grd.Cells[0, 0]:= 'Akce'; grd.Cells[1, 0]:= 'Číslo'; grd.Cells[2, 0]:= 'Název'; grd.Cells[3, 0]:= 'Doporučeno'; grd.Cells[4, 0]:= 'Ráno'; grd.Cells[5, 0]:= 'Poledne'; } polTree.NodeDataSize:= SizeOf(TPolozka); polTree.DefaultNodeHeight:= polTree.Canvas.TextHeight('Áý') + 8; polTree.Header.Columns[0].Width:= pnlAkce.Width-1; polTree.Header.Columns[1].Width:= pnlCislo.Width-1; polTree.Header.Columns[2].Width:= pnlNazev.Width-1; polTree.Header.Columns[3].Width:= pnlDoporuceno.Width-1; polTree.Header.Columns[4].Width:= pnlRano.Width-1; polTree.Header.Columns[5].Width:= pnlPoledne.Width-1; polTree.RootNodeCount:= 1; cbSortiment.Items.Clear; cbSortimentX.Items.Clear; lSQL:= 'SELECT DISTINCT(s.K1), ISNULL(e._priorita, 999) AS PoradiSort FROM ' + tblSortim + ' s INNER JOIN ' + tblSortimE + ' e ON (e.ID=s.ID) WHERE e._Objednavky_Zobrazit=1 GROUP BY s.K1'; with Helios.OpenSQL(lSQL) do if (RecordCount>0) then begin First; while not(EOF) do begin cbSortimentX.Items.Add(VarToStr(FieldValues(0))); lSQL:= helUtils.getHeliosStrVal(Helios, '', 'SELECT Nazev FROM ' + tblSortim + ' WHERE K2 IS NULL AND K1=N' + VarToStr(FieldValues(0)).QuotedString); cbSortiment.Items.Add(lSQL); Next; end; cbSortiment.ItemIndex:= 0; cbSortimentChange(Sender); end; end; procedure TformOrder.polTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var myRec: PPolozka; begin myRec:= Sender.GetNodeData(Node); case Column of 0: CellText:= ''; 1: CellText:= myRec.regCislo; 2: CellText:= myRec.nazev; end; end; end.