427 lines
14 KiB
ObjectPascal
427 lines
14 KiB
ObjectPascal
unit frmLikvidace;
|
||
|
||
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.StdCtrls, Vcl.Buttons,
|
||
Vcl.ComCtrls, ddPlugin_TLB, TBPackageU, Vcl.WinXPickers, Vcl.Mask, DBGridEhGrouping, ToolCtrlsEh, DBGridEhToolCtrls,
|
||
DynVarsEh, Data.DB, EhLibVCL, GridsEh, DBAxisGridsEh, DBGridEh, MemDS, MemTableDataEh, MemTableEh;
|
||
|
||
type
|
||
TWideStringHelper = record helper for WideString
|
||
function QuotedString: string; overload;
|
||
end;
|
||
|
||
TformLikvidace = class(TForm)
|
||
gbPolozky: TGroupBox;
|
||
btnOK: TButton;
|
||
btnRozbalit: TButton;
|
||
btnSbalit: TButton;
|
||
btnZavrit: TButton;
|
||
dSource: TDataSource;
|
||
vTab: TMemTableEh;
|
||
vTabSortimentK1: TStringField;
|
||
vTabSortimentK2: TStringField;
|
||
vTabSkupZbo: TStringField;
|
||
vTabRegCis: TStringField;
|
||
vTabNazev1: TStringField;
|
||
vTabStavSkladu: TFloatField;
|
||
vTabKeVraceni: TFloatField;
|
||
vTabNazevSort: TStringField;
|
||
Button1: TButton;
|
||
grdPol: TDBGridEh;
|
||
vTabIDStavSkladu: TIntegerField;
|
||
vTabAktDodavatel: TIntegerField;
|
||
vTabPriorita: TIntegerField;
|
||
vTabPoradiSortNazev: TStringField;
|
||
vTabK1K2: TStringField;
|
||
vTabPoradiVSort: TSingleField;
|
||
btnNuluj: TButton;
|
||
procedure FormShow(Sender: TObject);
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
procedure btnZavritClick(Sender: TObject);
|
||
procedure Button1Click(Sender: TObject);
|
||
procedure grdPolColumns4GetCellParams(Sender: TObject; EditMode: Boolean; Params: TColCellParamsEh);
|
||
procedure grdPolColumns4UpdateData(Sender: TObject; var Text: string; var Value: Variant; var UseText,
|
||
Handled: Boolean);
|
||
procedure btnRozbalitClick(Sender: TObject);
|
||
procedure btnSbalitClick(Sender: TObject);
|
||
procedure grdPolColumns4AdvDrawDataCell(Sender: TCustomDBGridEh; Cell, AreaCell: TGridCoord; Column: TColumnEh;
|
||
const ARect: TRect; var Params: TColCellParamsEh; var Processed: Boolean);
|
||
procedure btnOKClick(Sender: TObject);
|
||
procedure grdPolGetCellParams(Sender: TObject; Column: TColumnEh; AFont: TFont; var Background: TColor;
|
||
State: TGridDrawState);
|
||
procedure btnNulujClick(Sender: TObject);
|
||
private
|
||
procedure NactiData;
|
||
function ZjistiBranchID: Integer;
|
||
public
|
||
Helios: IHelios;
|
||
jeTest: boolean;
|
||
end;
|
||
|
||
var
|
||
formLikvidace: TformLikvidace;
|
||
branchId: integer;
|
||
|
||
implementation
|
||
uses System.StrUtils, System.RegularExpressions, helUtils;
|
||
|
||
{$R *.dfm}
|
||
|
||
|
||
{$IF CompilerVersion>=34} // Sydney a vys
|
||
{$ENDIF}
|
||
|
||
function TWideStringHelper.QuotedString: string;
|
||
begin
|
||
Result:= string(Self).QuotedString;
|
||
end;
|
||
|
||
|
||
|
||
|
||
function TformLikvidace.ZjistiBranchID: Integer;
|
||
var s: string;
|
||
begin
|
||
result:= -1;
|
||
s:= Helios.Sklad;
|
||
if (LeftStr(s, 3)='005') then
|
||
result:= RightStr(s, 1).ToInteger;
|
||
end;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.btnOKClick(Sender: TObject);
|
||
var lSQL, cZbo: string;
|
||
begin
|
||
if (Helios.YesNo('Opravdu ulo<6C>it doklad k likvidaci ?', false)) then
|
||
begin
|
||
lSQL:= 'IF OBJECT_ID(N''dbo._temp_TabLikvidaceR'') IS NOT NULL DELETE FROM dbo._temp_TabLikvidaceR WHERE Autor=SUSER_SNAME()' + CRLF;
|
||
lSQL:= lSQL + 'IF OBJECT_ID(N''dbo._temp_TabLikvidaceR'') IS NOT NULL' + CRLF + ' IF NOT EXISTS(SELECT * FROM dbo._temp_TabLikvidaceR)' + CRLF;
|
||
lSQL:= lSQL + ' DROP TABLE dbo._temp_TabLikvidaceR' + CRLF;
|
||
lSQL:= lSQL + 'IF OBJECT_ID(N''tempdb..#HDC_TabLikvidaceR'') IS NOT NULL DROP TABLE #HDC_TabLikvidaceR' + CRLF;
|
||
Helios.ExecSQL(lSQL);
|
||
|
||
if (vTab.RecordCount>0) then
|
||
begin
|
||
lSQL:= lSQL + 'IF OBJECT_ID(N''tempdb..#HDC_TabLikvidaceR'') IS NULL' + CRLF;
|
||
lSQL:= lSQL + ' CREATE TABLE #HDC_TabLikvidaceR (ID INT IDENTITY(1,1) NOT NULL, Sklad NVARCHAR(30), Autor NVARCHAR(80) NOT NULL DEFAULT SUSER_SNAME(), IDZboSklad INT NOT NULL';
|
||
lSQL:= lSQL + ', Mnozstvi NUMERIC(15,4) NOT NULL DEFAULT 0.0, CisloZbozi NVARCHAR(33) NOT NULL, DatPorizeni DATETIME NOT NULL DEFAULT GETDATE())';
|
||
if (jeTest) then
|
||
begin
|
||
lSQL:= lSQL.Replace('tempdb..#HDC_TabLi', 'dbo._temp_TabLi');
|
||
lSQL:= lSQL.Replace('#HDC_TabLi', 'dbo._temp_TabLi');
|
||
end;
|
||
Helios.ExecSQL(lSQL);
|
||
|
||
vTab.First;
|
||
while not(vTab.Eof) do
|
||
begin
|
||
if (vTab.FieldByName('IDStavSkladu').AsInteger>0) and (vTab.FieldByName('KeVraceni').AsFloat>0) then
|
||
begin
|
||
cZbo:= vTab.FieldByName('SkupZbo').AsString + vTab.FieldByName('RegCis').AsString;
|
||
lSQL:= 'INSERT #HDC_TabLikvidaceR (IDZboSklad, Sklad, Mnozstvi, CisloZbozi) SELECT ' + vTab.FieldByName('IDStavSkladu').AsString + ', N' + Helios.Sklad.QuotedString + ', ';
|
||
lSQL:= lSQL + vTab.FieldByName('KeVraceni').AsString.Replace(',', '.') + ', N' + cZbo.QuotedString;
|
||
if (jeTest) then
|
||
lSQL:= lSQL.Replace('#HDC_TabLi', 'dbo._temp_TabLi');
|
||
Helios.ExecSQL(lSQL);
|
||
end;
|
||
vTab.Next;
|
||
end;
|
||
|
||
if not(jeTest) then
|
||
begin
|
||
helUtils.waitStart(self, 'Prob<6F>h<EFBFBD> generov<6F>n<EFBFBD> likvidace/v<>dejky...', 0, 0);
|
||
try
|
||
Helios.ExecSQL('IF OBJECT_ID(N''dbo.ep_HDC_App_Likvidace'') IS NOT NULL EXEC dbo.ep_HDC_App_Likvidace @Sklad=N' + Helios.Sklad.QuotedString);
|
||
except
|
||
end;
|
||
helUtils.waitEnd;
|
||
end;
|
||
Close;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.btnRozbalitClick(Sender: TObject);
|
||
begin
|
||
grdPol.DataGrouping.ActiveGroupLevels[0].ExpandNodes;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.btnSbalitClick(Sender: TObject);
|
||
begin
|
||
grdPol.DataGrouping.ActiveGroupLevels[0].CollapseNodes;
|
||
end;
|
||
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.btnZavritClick(Sender: TObject);
|
||
begin
|
||
Close;
|
||
end;
|
||
|
||
|
||
|
||
procedure TformLikvidace.Button1Click(Sender: TObject);
|
||
var s: string;
|
||
begin
|
||
s:= ExtractFilePath(GetModuleName(hInstance));
|
||
s:= GetEnvironmentVariable('USERPROFILE') + '/Desktop/';
|
||
vTab.SaveToFile(s + 'data.vtd');
|
||
Helios.Info(#1'Ulo<6C>eno na plochu - data.vtd'#1);
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.btnNulujClick(Sender: TObject);
|
||
var i: integer;
|
||
begin
|
||
if (vTab.RecordCount>0) then
|
||
begin
|
||
i:= vTab.RecNo;
|
||
vTab.DisableControls;
|
||
vTab.First;
|
||
while not(vTab.Eof) do
|
||
begin
|
||
vTab.Edit;
|
||
vTab.FieldByName('KeVraceni').AsInteger:= 0;
|
||
vTab.Post;
|
||
vTab.Next;
|
||
end;
|
||
vTab.RecNo:= i;
|
||
vTab.EnableControls;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
if (vTab.Active) then
|
||
vTab.Close;
|
||
Action:= caFree;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.NactiData;
|
||
var lSQL: string;
|
||
nazevSort, nazevSort2, K1, K2: string;
|
||
idSort: integer;
|
||
poradiSort, poradiSort2: Single;
|
||
begin
|
||
lSQL:= 'SELECT DISTINCT(k.IDSortiment) AS IDSortiment, s.K1, s.K2, s.Nazev FROM ' + tblKZ + ' k INNER JOIN ' + tblSortim + ' s ON (s.ID=k.IDSortiment)';
|
||
lSQL:= lSQL + ' LEFT JOIN' + tblSortimE + ' se ON (se.ID=s.ID) INNER JOIN ' + tblSS + ' ss ON (ss.IDKmenZbozi=k.ID AND ss.IDSklad=N' + Helios.Sklad.QuotedString;
|
||
lSQL:= lSQL + ') WHERE (s.K1 IN (SELECT so.K1 FROM ' + tblSortim + ' so INNER JOIN ' + tblSortimE + ' soe ON (soe.ID=so.ID) WHERE soe._ProLikvidaci=1)';
|
||
lSQL:= lSQL + ' OR ISNULL(se._ProLikvidaci,0)=1) AND ss.Mnozstvi>0 AND ISNULL(s.K2,N'''')<>N'''' ORDER BY s.Nazev';
|
||
with Helios.OpenSQL(lSQL) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
if not(vTab.Active) then
|
||
vTab.Open;
|
||
First;
|
||
while not(EOF) do
|
||
begin
|
||
idSort:= VarToStr(FieldByNameValues('IDSortiment')).ToInteger;
|
||
K1:= VarToStr(FieldByNameValues('K1'));
|
||
K2:= VarToStr(FieldByNameValues('K2'));
|
||
|
||
lSQL:= 'SELECT ISNULL(se.';
|
||
case branchID of
|
||
1: lSQL:= lSQL + '_PoradiObj_Klas1';
|
||
2: lSQL:= lSQL + '_PoradiObj_MozPi';
|
||
3: lSQL:= lSQL + '_PoradiObj_MozVod';
|
||
else
|
||
lSQL:= lSQL + '_priorita';
|
||
end;
|
||
lSQL:= lSQL + ', ISNULL(se._priorita, 999)) FROM ' + tblSortim + ' s LEFT JOIN ' + tblSortimE + ' se ON (se.ID=s.ID) WHERE K2 IS NULL AND K1=N' + k1.QuotedString;
|
||
poradiSort:= helUtils.getHeliosFloatVal(Helios, 0, lSQL);
|
||
|
||
lSQL:= 'SELECT ISNULL(se.';
|
||
case branchID of
|
||
1: lSQL:= lSQL + '_PoradiObj_Klas1';
|
||
2: lSQL:= lSQL + '_PoradiObj_MozPi';
|
||
3: lSQL:= lSQL + '_PoradiObj_MozVod';
|
||
else
|
||
lSQL:= lSQL + '_priorita';
|
||
end;
|
||
lSQL:= lSQL + ', ISNULL(se._priorita, 999)) FROM ' + tblSortim + ' s LEFT JOIN ' + tblSortimE + ' se ON (se.ID=s.ID) WHERE K3 IS NULL AND K2=N' + k2.QuotedString;
|
||
lSQL:= lSQL + ' AND K1=N' + k1.QuotedString;
|
||
poradiSort2:= helUtils.getHeliosFloatVal(Helios, 0, lSQL);
|
||
|
||
{
|
||
nazevSort:= K2 + ' ' + VarToStr(FieldByNameValues('Nazev'));
|
||
nazevSort2:= VarToStr(FieldByNameValues('Nazev'));
|
||
vTab.Append;
|
||
vTab.FieldByName('K1').AsString:= K1;
|
||
vTab.FieldByName('K2').AsString:= K2;
|
||
vTab.FieldByName('NazevSort').AsString:= nazevSort;
|
||
vTab.Post;
|
||
}
|
||
lSQL:= 'SELECT k.SkupZbo, k.RegCis, k.Nazev1, so.Nazev, s.Mnozstvi, s.ID AS idSS, ISNULL(k.Aktualni_Dodavatel, -1) AS Aktualni_Dodavatel, ISNULL(ke._priorita, 0) AS Priorita';
|
||
lSQL:= lSQL + ', ISNULL(ke._poradivsortimentu, ISNULL(ke._poradivsortimentu, 999)) AS PoradiVSort';
|
||
lSQL:= lSQL + ' FROM ' + tblKZ;
|
||
lSQL:= lSQL + ' k INNER JOIN ' + tblKZe + ' ke ON (ke.ID=k.ID) INNER JOIN ' + tblSortim + ' so ON (so.ID=k.IDSortiment) INNER JOIN ';
|
||
lSQL:= lSQL + tblSS + ' s ON (s.IDKmenZbozi=k.ID AND s.IDSklad=N' + Helios.Sklad.QuotedString + ') WHERE so.K1=N' + K1.QuotedString;
|
||
lSQL:= lSQL + ' AND so.K2=N' + K2.QuotedString + ' AND so.K3 IS NULL AND s.Mnozstvi>0 ORDER BY k.SkupZbo, k.RegCis';
|
||
with Helios.OpenSQL(lSQL) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
First;
|
||
while not(EOF) do
|
||
begin
|
||
vTab.Append;
|
||
vTab.FieldByName('K1').AsString:= K1;
|
||
vTab.FieldByName('K2').AsString:= K2;
|
||
vTab.FieldByName('K1K2').AsString:= K1+K2;
|
||
vTab.FieldByName('PoradiSortNazev').AsString:= ((poradiSort*1000.0)+poradiSort2).ToString.Replace(',', '.') + ' ' + nazevSort2;
|
||
vTab.FieldByName('NazevSort').AsString:= nazevSort2;
|
||
vTab.FieldByName('SkupZbo').AsString:= VarToStr(FieldByNameValues('SkupZbo'));
|
||
vTab.FieldByName('RegCis').AsString:= VarToStr(FieldByNameValues('RegCis'));
|
||
vTab.FieldByName('Nazev1').AsString:= VarToStr(FieldByNameValues('Nazev1'));
|
||
vTab.FieldByName('StavSkladu').AsFloat:= VarToStr(FieldByNameValues('Mnozstvi')).ToSingle;
|
||
vTab.FieldByName('KeVraceni').AsFloat:= VarToStr(FieldByNameValues('Mnozstvi')).ToSingle;
|
||
vTab.FieldByName('IDStavSkladu').AsInteger:= VarToStr(FieldByNameValues('idSS')).ToInteger;
|
||
vTab.FieldByName('AktDodavatel').AsInteger:= VarToStr(FieldByNameValues('Aktualni_Dodavatel')).ToInteger;
|
||
vTab.FieldByName('Priorita').AsInteger:= VarToStr(FieldByNameValues('Priorita')).ToInteger;
|
||
vTab.FieldByName('PoradiVSort').AsSingle:= VarToStr(FieldByNameValues('PoradiVSort')).ToSingle;
|
||
vTab.Post;
|
||
Next;
|
||
end;
|
||
end;
|
||
|
||
Next;
|
||
end;
|
||
|
||
vTab.SortByFields('PoradiSortNazev, PoradiVSort, SkupZbo, RegCis');
|
||
|
||
vTab.First;
|
||
vTab.DisableControls;
|
||
while not(vTab.Eof) do
|
||
begin
|
||
if (vTab.FieldByName('K1').AsString='') then
|
||
vTab.Delete;
|
||
vTab.Next;
|
||
end;
|
||
vTab.First;
|
||
vTab.EnableControls;
|
||
grdPol.Invalidate;
|
||
end;
|
||
|
||
helUtils.waitEnd;
|
||
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.FormShow(Sender: TObject);
|
||
var rHeight: integer;
|
||
lSQL: string;
|
||
begin
|
||
UseLatestCommonDialogs:= true;
|
||
self.SetBounds(Screen.WorkAreaRect.Left, 0, Screen.WorkAreaRect.Width, Screen.WorkAreaRect.Height);
|
||
|
||
branchId:= ZjistiBranchID;
|
||
|
||
if (Helios.LoginName='hdc') then
|
||
Button1.Visible:= true;
|
||
|
||
{
|
||
grd.RowCount:= 2;
|
||
grd.FixedRows:= 1;
|
||
|
||
rHeight:= grd.Canvas.TextHeight('<27><>');
|
||
grd.DefaultRowHeight:= grd.Font.Size + 18;
|
||
|
||
// grd.RowHeights[1]:= grd.Canvas.TextHeight('Akce') + 4;
|
||
grd.Cells[0, 0]:= 'Akce';
|
||
grd.Cells[1, 0]:= '<27><>slo';
|
||
grd.Cells[2, 0]:= 'N<>zev';
|
||
grd.Cells[3, 0]:= 'Doporu<72>eno';
|
||
grd.Cells[4, 0]:= 'R<>no';
|
||
grd.Cells[5, 0]:= 'Poledne';
|
||
}
|
||
|
||
btnNuluj.Visible:= (Helios.LoginName='hdc');
|
||
|
||
NactiData;
|
||
end;
|
||
|
||
|
||
|
||
procedure TformLikvidace.grdPolColumns4AdvDrawDataCell(Sender: TCustomDBGridEh; Cell, AreaCell: TGridCoord;
|
||
Column: TColumnEh; const ARect: TRect; var Params: TColCellParamsEh; var Processed: Boolean);
|
||
var x: single;
|
||
begin
|
||
if (vTab.FieldByName('StavSkladu').AsSingle<>vTab.FieldByName('KeVraceni').AsSingle) then
|
||
Params.Background:= $00A4A4FF;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.grdPolColumns4GetCellParams(Sender: TObject; EditMode: Boolean; Params: TColCellParamsEh);
|
||
begin
|
||
Params.Alignment:= taCenter;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.grdPolColumns4UpdateData(Sender: TObject; var Text: string; var Value: Variant; var UseText, Handled: Boolean);
|
||
var s: single;
|
||
begin
|
||
Text:= Text.Trim.Replace(' ', '').Replace('.', ',');
|
||
if not(VarIsNull(Value)) then
|
||
if (Text='') then
|
||
begin
|
||
Helios.Error(#1'Mus<75>te zadat <20><>slo'#1);
|
||
Handled:= true;
|
||
end
|
||
else
|
||
begin
|
||
if not(TryStrToFloat(Text,s)) then
|
||
s:= 0;
|
||
if ((s<0) or (s>vTab.FieldByName('StavSkladu').AsSingle)) then
|
||
begin
|
||
Helios.Error(#1'Nelze vr<76>tit mno<6E>stv<74> men<65><6E> ne<6E> 0 a v<>t<EFBFBD><74> ne<6E> je skladem'#1);
|
||
Handled:= true;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TformLikvidace.grdPolGetCellParams(Sender: TObject; Column: TColumnEh; AFont: TFont; var Background: TColor; State: TGridDrawState);
|
||
begin
|
||
// if (State<>[]) then
|
||
// if (gdRowSelected in State) then
|
||
if (Column.FieldName='KeVraceni') then
|
||
Background:= grdPol.Color;
|
||
if (vTab.FieldByName('Priorita').AsInteger=1) or (vTab.FieldByName('Priorita').AsInteger=2) then
|
||
Background:= clSilver;
|
||
end;
|
||
|
||
|
||
|
||
|
||
end.
|