unit frmImportKusovnik; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Mask, Data.DB, Vcl.Grids, Vcl.DBGrids, JvExDBGrids, JvDBGrid, System.UITypes, Vcl.BaseImageCollection, Vcl.ImageCollection, ddPlugin_TLB; const IDI_ELIPSIS = 32516; type TformImportKusovnik = class(TForm) selZakazka: TButtonedEdit; Label1: TLabel; edtStanice: TLabeledEdit; btnImport: TButton; grdKusovnik: TJvDBGrid; btnStorno: TButton; btnZapis: TButton; procedure selZakazkaRightButtonClick (Sender: TObject); procedure btnImportClick (Sender: TObject); procedure grdKusovnikCanEditCell (Grid: TJvDBGrid; Field: TField; var AllowEdit: Boolean); procedure btnStornoClick (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure grdKusovnikMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure grdKusovnikDblClick (Sender: TObject); procedure btnZapisClick (Sender: TObject); procedure grdKusovnikDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); procedure FormShow(Sender: TObject); private public Helios: IHelios; jeTest: boolean; retVal: integer; end; var formImportKusovnik: TformImportKusovnik; oVar1: OleVariant; aktRow, aktCol: integer; implementation uses System.StrUtils, dataModul, nExcel, xlsxwrite, helUtils; {$R *.dfm} procedure TformImportKusovnik.btnImportClick (Sender: TObject); var lSQL, lSQL2: string; initDir, titulek, filtr1, filtr2, fName: string; xls: IXLSWorkBook; shKarty: IXLSWorksheet; karta: TKmen; iTemp, idKZ, idKZFin: integer; sTemp: string; podm, colName, readVal, lastNRC, lastVRC, rcFin, sz, rc: string; insId, idxR, iRowMax, iCol, iColMax, cEmptyRadek: integer; mnoz, ztraty: Extended; i_Poz, i_CisloDilu, i_Nazev, i_Ks, i_Vyrobce, i_Norma, i_Rozmer, i_Material, i_PU, i_Ziskani, i_Zprac, i_Pozn: integer; radekV00, jeProblem: boolean; begin initDir:= GetEnvironmentVariable('USERPROFILE') + '\Desktop'; titulek := 'Vyberte soubor pro import'; filtr1 := 'Soubory MS Excel'; filtr2 := '*.xls;*.xlsx'; fName := ''; if (helUtils.OtevriSoubor (titulek, filtr1, filtr2, initDir, fName)) then if (FileExists(fName)) then begin Screen.Cursor:= crHourGlass; xls:= TXLSWorkbook.Create; try xls.Open(fName); shKarty:= xls.Sheets.Entries[1]; i_Poz:= 0; lastNRC:= ''; lastVRC:= ''; iRowMax:= 0; cEmptyRadek:= 0; try for idxR:=1 to 60000 do begin if (cEmptyRadek>5) then begin iRowMax:= idxR; Break; end; if (VarIsNull(shKarty.Cells.Item[idxR, 1].Value)) then Inc(cEmptyRadek) else if (VarToStr(shKarty.Cells.Item[idxR, 1].Value)='') then Inc(cEmptyRadek) else cEmptyRadek:= 0; end; except on E:Exception do Helios.Error(#1'idxR: ' + idxR.ToString + CRLF + E.Message + #1) end; for idxR:=iRowMax downto 1 do begin if (not VarIsNull(shKarty.Cells.Item[idxR, 1].Value)) then if (VarToStr(shKarty.Cells.Item[idxR, 1].Value)<>'') then begin iRowMax:= idxR; Break; end; end; if (iRowMax>1) then begin rcFin:= ''; i_Poz := -1; i_CisloDilu := -1; i_Nazev := -1; i_Ks := -1; i_Vyrobce := -1; i_Norma := -1; i_Rozmer := -1; i_Material := -1; i_PU := -1; i_Ziskani := -1; i_Zprac := -1; i_Pozn := -1; for iCol:=1 to 30 do begin { if (VarIsNull(shKarty.Cells.Item[1, iCol].Value)) then begin iColMax:= iCol-1; Break; end; if (VarToStr(shKarty.Cells.Item[1, iCol].Value)='') then begin iColMax:= iCol-1; Break; end; } if (shKarty.Cells.Item[1, iCol].Value='POZ') then i_Poz:= iCol; if (shKarty.Cells.Item[1, iCol].Value='Číslo dílu') then i_CisloDilu:= iCol; if (shKarty.Cells.Item[1, iCol].Value='Název') then i_Nazev:= iCol; if (shKarty.Cells.Item[1, iCol].Value='KS') then i_Ks:= iCol; if (shKarty.Cells.Item[1, iCol].Value='Výrobce') then i_Vyrobce:= iCol; if (shKarty.Cells.Item[1, iCol].Value='NORMA') then i_Norma:= iCol; if (shKarty.Cells.Item[1, iCol].Value='ROZMĚR') then i_Rozmer:= iCol; if (shKarty.Cells.Item[1, iCol].Value='MATER.') then i_Material:= iCol; if (shKarty.Cells.Item[1, iCol].Value='PÚ') then i_PU:= iCol; if (shKarty.Cells.Item[1, iCol].Value='získání') then i_Ziskani:= iCol; if (shKarty.Cells.Item[1, iCol].Value='Zpracování') then i_Zprac:= iCol; if (VarToStr(shKarty.Cells.Item[1, iCol].Value).Trim='Pozn před') then i_Pozn:= iCol; end; if (i_Poz=0) or (i_CisloDilu=0) or (i_Norma=0) then begin Helios.Error(#1'Tabulka není v požadovaném formátu'#1); Exit; end; if (i_Poz>0) and (i_CisloDilu>0) and (i_Norma>0) then begin if not(dataModul.datModul.tblImportKusovnik.Active) then dataModul.datModul.tblImportKusovnik.Open; dataModul.datModul.tblImportKusovnik.EmptyDataSet; idxR:= 2; // nacti radky while (idxR<=iRowMax) do begin karta.Clear; if not(VarIsNull(shKarty.Cells.Item[idxR, i_Poz].Value)) then begin if not(TryStrToInt(shKarty.Cells.Item[idxR, i_Poz].Value, karta.poz)) then karta.poz := 0; if (i_CisloDilu>0) then karta.cislo := IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_CisloDilu].Value), VarToStr(shKarty.Cells.Item[idxR, i_CisloDilu].Value), '').Replace(#10, ''); if (i_Nazev>0) then karta.nazev := IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Nazev].Value), VarToStr(shKarty.Cells.Item[idxR, i_Nazev].Value), '').Replace(#10, ''); if not(TryStrToFloat(shKarty.Cells.Item[idxR, i_Ks].Value, karta.mnoz)) then karta.mnoz := 0; if (i_Norma>0) then karta.norma := IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Norma].Value), VarToStr(shKarty.Cells.Item[idxR, i_Norma].Value), '').Replace(#10, ''); if (i_PU>0) then karta.pu := IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_PU].Value), VarToStr(shKarty.Cells.Item[idxR, i_PU].Value), '').Replace(#10, ''); if (i_Zprac>0) then karta.zprac := IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Zprac].Value), VarToStr(shKarty.Cells.Item[idxR, i_Zprac].Value), '').Replace(#10, ''); if (i_Material>0) then karta.material:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Material].Value), VarToStr(shKarty.Cells.Item[idxR, i_Material].Value), '').Replace(#10, ''); { if (i_Vyrobce>0) then begin karta.vyrobce:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Vyrobce].Value), VarToStr(shKarty.Cells.Item[idxR, i_Vyrobce].Value), '').Replace(#10, ''); if (karta.vyrobce<>'') then begin lSQL2:= 'SELECT TOP(1) c.CisloOrg FROM ' + tblCOrg + ' c INNER JOIN ' + tblCOrgE + ' ce ON (ce.ID=c.ID) WHERE ce._NazevProImportKusovniku=N' + karta.vyrobce.QuotedString; karta.vyrobceCisOrg:= helUtils.getHeliosIntVal(Helios, 0, lSQL2); end; end; if (i_Rozmer>0) then karta.rozmer:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Rozmer].Value), VarToStr(shKarty.Cells.Item[idxR, i_Rozmer].Value), '').Replace(#10, ''); if (i_ziskani>0) then karta.jakObj:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_ziskani].Value), VarToStr(shKarty.Cells.Item[idxR, i_ziskani].Value), ''); if (i_pozn>0) then karta.pozn:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_pozn].Value), VarToStr(shKarty.Cells.Item[idxR, i_pozn].Value), '').Replace(#10, CRLF); } end; idKZ := 0; iTemp := 0; jeProblem := false; if (karta.poz>=300) and (karta.poz<500) and (karta.norma<>'') then begin lSQL := 'SELECT COUNT(ID) AS Pocet FROM ' + tblKZe + ' WITH(NOLOCK) WHERE _VyhledavaniKody=N' + karta.norma.QuotedString; with Helios.OpenSQL(lSQL) do if not(EOF) then iTemp := VarToStr(FieldByNameValues('Pocet')).ToInteger; if (iTemp=1) then idKZ := helUtils.getHeliosIntVal (Helios, 0, lSQL.Replace('COUNT(ID) AS Pocet', 'ID')) else if (iTemp=0) then begin lSQL := 'SELECT COUNT(ID) AS Pocet FROM ' + tblKZe + ' WITH(NOLOCK) WHERE _VyhledavaniKody LIKE N' + QuotedStr('%' + karta.norma + '%'); with Helios.OpenSQL(lSQL) do if not(EOF) then iTemp := VarToStr(FieldByNameValues('Pocet')).ToInteger; if (iTemp=1) then idKZ := helUtils.getHeliosIntVal (Helios, 0, lSQL.Replace('COUNT(ID) AS Pocet', 'ID')) else jeProblem := true; end else jeProblem := true; end; if (idKZ=0) and not(jeProblem) and (karta.poz>=300) and (karta.poz<500) and (karta.cislo<>'') then begin iTemp := 0; lSQL := 'SELECT COUNT(ID) AS Pocet FROM ' + tblKZe + ' WITH(NOLOCK) WHERE _VyhledavaniKody=N' + karta.cislo.QuotedString; with Helios.OpenSQL(lSQL) do if not(EOF) then iTemp := VarToStr(FieldByNameValues('Pocet')).ToInteger; if (iTemp=1) then idKZ := helUtils.getHeliosIntVal (Helios, 0, lSQL.Replace('COUNT(ID) AS Pocet', 'ID')) else if (iTemp=0) then begin lSQL := 'SELECT COUNT(ID) AS Pocet FROM ' + tblKZe + ' WITH(NOLOCK) WHERE _VyhledavaniKody LIKE N' + QuotedStr('%' + karta.cislo + '%'); with Helios.OpenSQL(lSQL) do if not(EOF) then iTemp := VarToStr(FieldByNameValues('Pocet')).ToInteger; if (iTemp=1) then idKZ := helUtils.getHeliosIntVal (Helios, 0, lSQL.Replace('COUNT(ID) AS Pocet', 'ID')) else jeProblem := true; end else jeProblem := true; end; sz := ''; rc := ''; if (idKZ>0) then with Helios.OpenSQL('SELECT SkupZbo, RegCis FROM ' + tblKZ + ' WHERE ID=' + idKZ.ToString) do if not(EOF) then begin sz := VarToStr(FieldByNameValues('SkupZbo')); rc := VarToStr(FieldByNameValues('RegCis')); end; dataModul.datModul.tblImportKusovnik.Append; try dataModul.datModul.tblImportKusovnik.FieldByName('IDKmen').AsInteger := idKZ; dataModul.datModul.tblImportKusovnik.FieldByName('SZ').AsString := sz; dataModul.datModul.tblImportKusovnik.FieldByName('RegCis').AsString := rc; dataModul.datModul.tblImportKusovnik.FieldByName('Pozice').AsInteger := karta.poz; dataModul.datModul.tblImportKusovnik.FieldByName('Oznaceni').AsString := karta.cislo; dataModul.datModul.tblImportKusovnik.FieldByName('Popis').AsString := karta.nazev; dataModul.datModul.tblImportKusovnik.FieldByName('Mnozstvi').AsExtended := karta.mnoz; dataModul.datModul.tblImportKusovnik.FieldByName('Norma').AsString := karta.norma; dataModul.datModul.tblImportKusovnik.FieldByName('Material').AsString := karta.material; dataModul.datModul.tblImportKusovnik.FieldByName('PU').AsString := karta.pu; dataModul.datModul.tblImportKusovnik.FieldByName('Zpracovani').AsString := karta.zprac; dataModul.datModul.tblImportKusovnik.FieldByName('JeProblem').AsBoolean := jeProblem or (idKZ=0); dataModul.datModul.tblImportKusovnik.Post; except dataModul.datModul.tblImportKusovnik.Cancel; end; Inc(idxR); end; dataModul.datModul.tblImportKusovnik.First; end; end; finally {$IF CompilerVersion < 34.0} // SYDNEY FreeAndNil(xls); {$ENDIF} end; Screen.Cursor:= crDefault; end; end; procedure TformImportKusovnik.btnStornoClick (Sender: TObject); begin retVal:= 10; Close; end; procedure TformImportKusovnik.btnZapisClick (Sender: TObject); var lSQL: string; canCont: boolean; begin canCont := true; selZakazka.Text := selZakazka.Text.Trim; edtStanice.Text := edtStanice.Text.Trim; if (selZakazka.Text='') then begin Helios.Error(#1'Není vybrána Zakázka'#1); self.ActiveControl := selZakazka; canCont := false; end; if not helUtils.sqlExistsTestGeneral(Helios, 'SELECT 1 FROM ' + tblZak + ' WHERE CisloZakazky=N' + selZakazka.Text.QuotedString) then begin Helios.Error(#1'Vybrána Zakázka neexistuje'#1); self.ActiveControl := selZakazka; canCont := false; end; if (edtStanice.Text='') then begin Helios.Error(#1'Není zadána Stanice'#1); self.ActiveControl := selZakazka; canCont := false; end; if (canCont) then begin if (datModul.tblImportKusovnik.RecordCount>0) then begin lSQL := 'DROP TABLE IF EXISTS #TabCADKusovnik' + CRLF + 'CREATE TABLE #TabCADKusovnik (ID INT IDENTITY(1,1) NOT NULL, NovaKarta BIT DEFAULT 0, Pozice INT, IDKmen INT, CisloDilce NVARCHAR(100), Nazev NVARCHAR(100)' + ', Mnozstvi NUMERIC(19,6) DEFAULT 0.0, Zpracovani NVARCHAR(200), Vyrobce NVARCHAR(200), Norma NVARCHAR(200), PU NVARCHAR(200), Material NVARCHAR(200)' + ', Tloustka NUMERIC(8,2) DEFAULT 0.0)' + CRLF; datModul.tblImportKusovnik.DisableControls; datModul.tblImportKusovnik.First; while not(datModul.tblImportKusovnik.Eof) do begin lSQL := lSQL + 'INSERT #TabCADKusovnik (NovaKarta, IDKmen, Pozice, CisloDilce, Nazev, Mnozstvi, PU, Zpracovani, Vyrobce, Norma, Material, Tloustka) SELECT ' + IfThen(datModul.tblImportKusovnik.FieldByName('NovaKarta').AsBoolean, ',', '0') + ', ' + datModul.tblImportKusovnik.FieldByName('IDKmen').AsString + ', ' + datModul.tblImportKusovnik.FieldByName('Pozce').AsString + ', N' + datModul.tblImportKusovnik.FieldByName('Oznaceni').AsString.QuotedString + ', N' + datModul.tblImportKusovnik.FieldByName('Popis').AsString.QuotedString + ', ' + datModul.tblImportKusovnik.FieldByName('Mnozstvi').AsString.Replace(',', '.') + ', N' + datModul.tblImportKusovnik.FieldByName('PU').AsString.QuotedString + ', N' + datModul.tblImportKusovnik.FieldByName('Zpracovani').AsString.QuotedString + ', N' + datModul.tblImportKusovnik.FieldByName('Vyrobce').AsString.QuotedString + ', N' + datModul.tblImportKusovnik.FieldByName('Norma').AsString.QuotedString + ', N' + datModul.tblImportKusovnik.FieldByName('Material').AsString.QuotedString + ', ' + datModul.tblImportKusovnik.FieldByName('Tloustka').AsString.Replace(',', '.') + CRLF; datModul.tblImportKusovnik.Next; end; lSQL := lSQL + 'IF OBJECT_ID(N''dbo.ep_HDC_ImportCADKusovnik'', ''P'') IS NOT NULL EXEC dbo.ep_HDC_ImportCADKusovnik @Zakazka=N' + selZakazka.Text.QuotedString + ', @Stanice=N' + edtStanice.Text.QuotedString; try try Helios.ExecSQL (lSQL); except on E: Exception do Helios.Error (#1'Chyba zpracování: ' + E.Message + #1); end; finally end; end; Close; end; end; procedure TformImportKusovnik.FormClose (Sender: TObject; var Action: TCloseAction); begin if (datModul.tblImportKusovnik.Active) then datModul.tblImportKusovnik.EmptyDataSet; Action:= TCloseAction.caHide; end; procedure TformImportKusovnik.FormShow(Sender: TObject); begin self.ClientHeight := 715; self.ClientWidth := 1115; end; procedure TformImportKusovnik.grdKusovnikCanEditCell (Grid: TJvDBGrid; Field: TField; var AllowEdit: Boolean); begin AllowEdit := (Field.FieldName='NovaKarta'); end; procedure TformImportKusovnik.grdKusovnikDblClick (Sender: TObject); var i, idKZ, poz: integer; titulek, sz, rc, nazev1: string; begin i := datModul.tblImportKusovnik.RecNo; poz := datModul.tblImportKusovnik.FieldByName('Pozice').AsInteger; if (poz>=300) and (poz<500) and (aktCol<>7) then // pokud kliknu na "Nova", nic neukazuj begin titulek := 'Vyberte kmenovou kartu pro dílec/materiál: číslo "' + datModul.tblImportKusovnik.FieldByName('Oznaceni').AsString + '" / norma "' + datModul.tblImportKusovnik.FieldByName('Norma').AsString + '" / pozice ' + poz.ToString; if (Helios.Prenos (bidKZ, 'TabKmenZbozi.ID', oVar1, 'TabKmenZbozi.Sluzba=0 AND TabKmenZbozi.Blokovano=0', titulek, true)) then begin idKZ := VarToStr(oVar1).ToInteger; with Helios.OpenSQL ('SELECT SkupZbo, RegCis, Nazev1 FROM ' + tblKZ + ' WHERE ID=' + idKZ.ToString) do begin sz := FieldByNameValues('SkupZbo'); rc := FieldByNameValues('RegCis'); nazev1 := FieldByNameValues('Nazev1'); datModul.tblImportKusovnik.Edit; try datModul.tblImportKusovnik.FieldByName('IDKmen').AsInteger := idKZ; datModul.tblImportKusovnik.FieldByName('SZ').AsString := sz; datModul.tblImportKusovnik.FieldByName('RegCis').AsString := rc; datModul.tblImportKusovnik.FieldByName('JeProblem').AsBoolean := false; // datModul.tblImportKusovnik.FieldByName('Nazev1').AsString := nazev1; datModul.tblImportKusovnik.Post; except on E:Exception do datModul.tblImportKusovnik.Cancel; end; end; end; end; end; procedure TformImportKusovnik.grdKusovnikDrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var poz: integer; begin poz := grdKusovnik.DataSource.DataSet.FieldByName('Pozice').AsInteger; if (gdSelected in State) then grdKusovnik.Canvas.Font.Color := clBlack; if (poz>=300) and (poz<500) then begin if (Assigned(Column.Field) and (System.SysUtils.SameText(Column.FieldName, 'Popis'))) then if (grdKusovnik.DataSource.DataSet.FieldByName('JeProblem').AsBoolean) then grdKusovnik.Canvas.Brush.Color := clRed; end; grdKusovnik.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; procedure TformImportKusovnik.grdKusovnikMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin aktRow := TJvDBGrid(Sender).MouseCoord (X, Y).Y; aktCol := TJvDBGrid(Sender).MouseCoord (X, Y).X; end; procedure TformImportKusovnik.selZakazkaRightButtonClick (Sender: TObject); begin if (Helios.Prenos(bidZak,'TabZakazka.CisloZakazky', oVar1, '', 'Vyberte zakázku', true)) then begin selZakazka.Text := VarToStr (oVar1); self.ActiveControl := edtStanice; end; end; end.