home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / PROCEDURY.PGM < prev    next >
Text File  |  2000-03-16  |  49KB  |  1,458 lines
  1. {$$3220792583                                }INCLUDE
  2. table S_typ_uziv, RABAT;
  3.  
  4.  
  5. type
  6.    privil = array [1..65] of char;
  7.  
  8. type
  9.   user = record
  10.    n1 : string[16];  //jmeno
  11.    n2 : string[2];   //2.jmeno
  12.    n3 : string[20];  //prijmeni
  13.    id : string[80];  //uuid
  14.   end;
  15.  
  16. cursor  dcenik, d_cenik, obch_partneri, useri, Dhp_today;
  17.  
  18. var
  19. id_POHLEDa,id_POHLEDb:window_id;
  20. recobj, noveid, moje: integer;
  21.  pom_ds,pom_typ,pom_obch, pom_dph, pom_zp: integer;
  22. //p_nova_c, p_nova_cimp: trecnum;
  23.  
  24. procedure nastav_default();
  25. {*******************************************************************}
  26. var 
  27.   pocet, value:array [1..10] of integer;
  28.   curs:cursor;
  29.   n,i, pominteger :integer;
  30.   irec:trecnum;
  31.  
  32.  
  33.  begin  //0
  34. //Vybranß skupina DPH bude implicitn∞ dosazena u polo₧ek s neurΦen²m DPH
  35.    if Open_sql_cursor(curs, "SELECT Real2str(procento,-1), id_dph FROM S_dph where uc_rok=year(today)") then Signalize
  36.     else
  37.       begin   //1
  38.         Rec_cnt(curs,pocet[1]);
  39.         if pocet[1]>0 then value[1]:=curs[0].id_dph else value[1]:=0;
  40.         if pocet[1]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","DPH pro letoÜnφ rok");
  41.         close_cursor(curs);
  42.       end;    //1
  43. //Implicitnφ za°azenφ pro novΘ zßkaznφky z Internetu
  44.    if Open_sql_cursor(curs, "SELECT deal_skupina, deal_id FROM S_deal_sk") then Signalize
  45.     else
  46.       begin   //1
  47.         Rec_cnt(curs,pocet[2]);
  48.         if pocet[2]>0 then value[2]:=curs[0].deal_id else value[2]:=0;
  49.         if pocet[2]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","Dealerskß skupina");
  50.         close_cursor(curs);
  51.       end;    //1
  52. // Defautn∞ nabφzen² zp∙sob dodßnφ p°i prvnφ objednßvce.
  53.    if Open_sql_cursor(curs, "SELECT zpusob, id_doprava FROM S_doprava") then Signalize
  54.     else
  55.       begin   //1
  56.         Rec_cnt(curs,pocet[3]);
  57.         if pocet[3]>0 then value[3]:=curs[0].id_doprava else value[3]:=0;
  58.         if pocet[3]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","Zp∙sob dodßnφ");
  59.         close_cursor(curs);
  60.       end;    //1
  61. //Defaultn∞ p°id∞len² typ zßkaznφka p°i registraci.
  62.    if Open_sql_cursor(curs, "SELECT nazev_typ, id_typ FROM S_typ_uziv") then Signalize
  63.     else
  64.       begin   //1
  65.         Rec_cnt(curs,pocet[4]);
  66.         if pocet[4]>0 then value[4]:=curs[0].id_typ else value[4]:=0;
  67.         if pocet[4]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","Typ zßkaznφka p°i registraci");
  68.         close_cursor(curs);
  69.       end;    //1
  70. //Defaultnφ m∞rnß jednotka polo₧ek
  71.    if Open_sql_cursor(curs, "SELECT  nazev,idj FROM Jednotka") then Signalize
  72.     else
  73.       begin   //1
  74.         Rec_cnt(curs,pocet[5]);
  75.         if pocet[5]>0 then value[5]:=curs[0].idj else value[5]:=0;
  76.         if pocet[5]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","M∞rnß jednotka");
  77.         close_cursor(curs);
  78.  
  79.       end;    //1
  80. //Obchodnφk zpracovßvajφcφ objednßvky nov²ch zßkaznφk∙
  81.    if Open_sql_cursor(curs, "SELECT prijmeni, id_obchodnika FROM Obchodnici") then Signalize
  82.     else
  83.       begin   //1
  84.         Rec_cnt(curs,pocet[6]);
  85.         if pocet[6]>0 then value[6]:=curs[0].id_obchodnika else value[6]:=0;
  86.         if pocet[6]=0 then Info_box("Nenφ vypln∞n² Φφselnφk","Obchodnφci");
  87.         close_cursor(curs);
  88.       end;    //1
  89.     
  90.      n:=1;
  91.      for i:= 1 to 6 do  n:=n*pocet[i]; 
  92.      if n>0 then 
  93.       begin  //1
  94.        if Open_sql_cursor(curs, "SELECT * FROM Default_hodnoty") then Signalize
  95.         else
  96.          begin   //2
  97.            Rec_cnt(curs,pocet[7]);
  98.            if pocet[7]<1 then
  99.             begin   //3
  100.             irec:=Insert(Default_hodnoty);
  101.             pominteger:=Default_hodnoty[irec].DPH;
  102.             If pominteger=NONEINTEGER then Default_hodnoty[irec].DPH:=value[1];
  103.             pominteger:=Default_hodnoty[irec].DEAL_SK;
  104.             If pominteger=NONEINTEGER then Default_hodnoty[irec].DEAL_SK:=value[2];
  105.             pominteger:=Default_hodnoty[irec].ZP_DOPRAV;
  106.             If pominteger=NONEINTEGER then Default_hodnoty[irec].ZP_DOPRAV:=value[3];
  107.             pominteger:=Default_hodnoty[irec].TYP_UZIV;
  108.             If pominteger=NONEINTEGER then Default_hodnoty[irec].TYP_UZIV:=value[4];
  109.             pominteger:=Default_hodnoty[irec].JEDNOTKA;
  110.             If pominteger=NONEINTEGER then Default_hodnoty[irec].JEDNOTKA:=value[5];
  111.             pominteger:=Default_hodnoty[irec].OBCHODNIK;
  112.             If pominteger=NONEINTEGER then Default_hodnoty[irec].OBCHODNIK:=value[6];
  113.     
  114.             
  115.             end     //3
  116.             else
  117.               begin   //3
  118.                pominteger:=curs[0].DPH;
  119.                If pominteger=NONEINTEGER then curs[0].DPH:=value[1];
  120.                pominteger:=curs[0].DEAL_SK;
  121.                If pominteger=NONEINTEGER then curs[0].DEAL_SK:=value[2];
  122.                pominteger:=curs[0].ZP_DOPRAV;
  123.                If pominteger=NONEINTEGER then curs[0].ZP_DOPRAV:=value[3];
  124.                pominteger:=curs[0].TYP_UZIV;
  125.                If pominteger=NONEINTEGER then curs[0].TYP_UZIV:=value[4];
  126.                pominteger:=curs[0].JEDNOTKA;
  127.                If pominteger=NONEINTEGER then curs[0].JEDNOTKA:=value[5];
  128.                pominteger:=curs[0].OBCHODNIK;
  129.                If pominteger=NONEINTEGER then curs[0].OBCHODNIK:=value[6];
  130.               end;      //3
  131.             close_cursor(curs);
  132.  
  133.           end;     //2
  134.             Open_view("*cis_default",NO_REDIR,0,0,0, nil)
  135.       end //1
  136.      else   Info_box("Upozorn∞nφ","Nejd°φve vypl≥te Φφselnφky");
  137.  
  138.  
  139.  
  140. end;   //0
  141.  
  142.  
  143. procedure nastav_EB();
  144. {*******************************************************************}
  145. var
  146.   pocet:integer;
  147.   podminka: string[200];
  148.   curtyp:cursor;
  149.   irec:trecnum;
  150.  
  151. begin   //0
  152.   if pomtr>1 then 
  153.    begin  //1
  154.    pocet:=0;
  155.    if Open_sql_parts(curtyp, "*", "EP_EXPANDIA",podminka,"") then Signalize
  156.     else
  157.       begin   //2
  158.         Rec_cnt(curtyp,pocet);
  159.         if (pocet>0) then  Open_view("*Expandia",curtyp,AUTO_CURSOR,0,0, nil)
  160.         else
  161.           begin //3
  162.              irec:= Insert(EP_EXPANDIA);
  163.              Ep_setkb[irec].SET_SERVER:="https://klient2.ebanka.cz/test_shop/owa/shop.payment";
  164.              Open_view("*Expandia",NO_REDIR,0,irec,0, nil);
  165.           end;  //3
  166.       end;   //2
  167.    end    //1
  168.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  169. end;     //0
  170.  
  171.  
  172. procedure nastav_SET(typ:string[10]);
  173. {*******************************************************************}
  174. var
  175.   pocet:integer;
  176.   podminka: string[200];
  177.   curtyp:cursor;
  178.   irec:trecnum;
  179.  
  180. begin   //0
  181.   if pomtr>1 then 
  182.    begin  //1
  183.    pocet:=0;
  184.    podminka:= " typ= "+""""+typ+"""";
  185.    if Open_sql_parts(curtyp, "*", "Ep_setkb",podminka,"") then Signalize
  186.     else
  187.       begin   //2
  188.         Rec_cnt(curtyp,pocet);
  189.         if (pocet>0) then  Open_view("*Setparam",curtyp,AUTO_CURSOR,0,0, nil)
  190.         else
  191.           begin //3
  192.              irec:= Insert(Ep_setkb);
  193.              Ep_setkb[irec].typ:=typ;
  194.              if typ="INET" then  Ep_setkb[irec].SET_SERVER:="https://proxy.set.cz/pub/WakeUp"
  195.              else Ep_setkb[irec].SET_SERVER:="https://etill.paynet.cz/servlet/muzo.Pay2";
  196.              Open_view("*Setparam",NO_REDIR,0,irec,0, nil);
  197.           end;  //3
  198.       end;   //2
  199.    end    //1
  200.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  201. end;     //0
  202.  
  203.  
  204. procedure menuzal();
  205. {*******************************************************************}
  206. begin
  207.   if pomtr>1 then 
  208.    begin
  209.      preZaloha();
  210.      Open_view("*Zaloha_spec",NO_REDIR,0,0,0, nil);
  211.    end
  212.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  213. end;
  214.  
  215. procedure menuimp();
  216. {*******************************************************************}
  217. var 
  218.   pocet:integer;
  219.   podminka: string[200];
  220.   curs:cursor;
  221.  
  222.  begin  //0
  223.    pocet:=0;
  224.    if Open_sql_parts(curs, "*", "CENIK","","") then Signalize
  225.     else
  226.       begin   //1
  227.         Rec_cnt(curs,pocet);
  228.         close_cursor(curs);
  229.         if ((pomtr>1) OR (pocet=0)) then 
  230.          begin   //3
  231.            E_Table:=1;
  232.            Open_view("*Imp",NO_REDIR,0,0,0, nil);
  233.          end     //3
  234.         else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  235.       end;  //1
  236. end;   //0
  237.  
  238.  procedure menuexpall();
  239. {*******************************************************************}
  240. begin
  241.   if pomtr>1 then 
  242.    begin
  243.      E_VYBER:=1;
  244.      Open_view("*Export",NO_REDIR,0,0,0, nil);
  245.    end
  246.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  247. end;
  248.  
  249.  
  250.  procedure menuexpsel();
  251. {*******************************************************************}
  252. begin
  253.   if pomtr>1 then  aktualrec()
  254.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  255. end;
  256.  
  257.  procedure menuexb();
  258. {*******************************************************************}
  259. begin
  260.   if pomtr>1 then 
  261.    begin
  262.      Open_view("*Expandia",NO_REDIR,0,0,0, nil);
  263.    end
  264.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  265. end;
  266.  
  267.  
  268.  procedure menutarae();
  269. {*******************************************************************}
  270. begin
  271.   if pomtr>1 then 
  272.    begin
  273.      Open_view("*Edit_rab",NO_REDIR,0,0,0, nil);
  274.    end
  275.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  276. end;
  277.  
  278.  procedure menutaras();
  279. {*******************************************************************}
  280. begin
  281.   if pomtr>1 then 
  282.    begin
  283.      Open_view("*Skup_rabat",NO_REDIR,0,0,0, nil);
  284.    end
  285.   else Open_view("*liteok",NO_REDIR,0,0,0, nil);
  286. end;
  287.  
  288. procedure kdo();
  289. {*******************************************************************}
  290.  var
  291.   logname:string[80];
  292.   u:untyped;
  293.   jarec:trecnum;
  294.  
  295.  begin
  296.    moje:=-1;
  297.    logname:=who_am_I;
  298.    u:=logname;
  299.    jarec:=look_up(OBCHODNICI, "logname", u);
  300.    if jarec>-1 then moje:=OBCHODNICI[jarec].ID_OBCHODNIKA;
  301.  end;
  302.  
  303.  procedure otevri_cis(tabname:string[50]);
  304. {*******************************************************************}
  305. var
  306. curs: cursor;
  307. limit:integer;
  308. irec:trecnum;
  309. query: string[255];
  310.  
  311. begin
  312.   if not Open_sql_parts(curs, "*", tabname, "", "") then Rec_cnt(curs, limit);
  313.   close_cursor(curs);
  314.   if limit<1 then 
  315.    begin
  316.     query:="INSERT INTO "+tabname+" DEFAULT VALUES";
  317.     if  sql_execute(query) then Signalize;
  318.   end;
  319.  
  320. end;
  321.  
  322.  procedure nova_pol_cis(tabname:string[50]);
  323. {*******************************************************************}
  324. var
  325.  query: string[255];
  326.  
  327. begin
  328.     query:="INSERT INTO "+tabname+" DEFAULT VALUES";
  329.     if  sql_execute(query) then Signalize;
  330. end;
  331.  
  332.  procedure nova_pol_rab(met:integer);
  333. {*******************************************************************}
  334. var
  335.  query: string[255];
  336.  
  337. begin
  338.     query:="INSERT INTO RABAT (METODA,NAD_MNOZ,PROC) VALUES ("+int2str(met)+",0,1.0)";
  339.     if  sql_execute(query) then Signalize;
  340. end;
  341.  
  342.  
  343.  
  344.  procedure vloz_obr();
  345. {*******************************************************************}
  346. var
  347.  query: string[255];
  348.  
  349. begin
  350.     query:="UPDATE CENIK SET htwobr="+""""+SYS_PAR[0].adr_htwobr+SYS_PAR[0].obr_ext+"""";
  351.     if  sql_execute(query) then Signalize;
  352. end;
  353.  
  354.  
  355.  procedure nacti_deal_ceny(id_cnk:integer);
  356. {*******************************************************************}
  357. var
  358.  U:untyped;
  359.  irec:trecnum;
  360.  
  361. begin
  362.   u := id_cnk;
  363.   irec := Look_up(cenik,"id_cenik",u);
  364.   if irec=-1 then Info_box("","")
  365.    else
  366.     begin
  367.      deal_cena[0]:=cenik[irec].min_cena;
  368.      deal_cena[1]:=cenik[irec].cena1;
  369.      deal_cena[2]:=cenik[irec].cena2;
  370.      deal_cena[3]:=cenik[irec].cena3;
  371.      deal_cena[4]:=cenik[irec].cena4;
  372.      deal_cena[5]:=cenik[irec].cena5;
  373.      deal_cena[6]:=cenik[irec].cena6;
  374.      deal_cena[7]:=cenik[irec].cena7;
  375.      deal_cena[8]:=cenik[irec].cena8;
  376.      deal_cena[9]:=cenik[irec].cena9;
  377.      Open_view("*deal_ceny", NO_REDIR, 0, 0, 0,nil);
  378.    end;
  379. end;
  380.  
  381.  
  382.  procedure dealsktab();
  383. {*******************************************************************}
  384.  var
  385.   i,pocet:integer;
  386.   cislo_tab:tobjnum;
  387.  
  388.  begin
  389. /* if not Find_object("S_deal_sk", CATEG_TABLE, cislo_tab)
  390.     then Free_deleted(cislo_tab);
  391. */ Rec_cnt(S_deal_sk, pocet); 
  392.  if pocet>0 then
  393.  for i:=0 to pocet-1 do
  394.   begin
  395.    if  S_deal_sk[i].DEAL_ID<>i then S_deal_sk[i].DEAL_ID:=i;
  396.   end;
  397.  if pocet<10 then
  398.  for i:=pocet to 9 do
  399.   begin
  400.     irec:=Insert(S_deal_sk); 
  401.     S_deal_sk[irec].DEAL_ID:=i;
  402.     if i=0 then  S_deal_sk[irec].DEAL_SKUPINA:="Koncov² zßkaznφk";
  403.    end;
  404.  end;
  405.  
  406.  procedure prepocet_ceniku();
  407. {*******************************************************************}
  408.  var
  409.   i,j,pocet:integer;
  410.   vyraz: string[200];
  411.   SQLprikaz: string[2000];
  412.   koef:string[30];
  413.  
  414.  begin  //0
  415.   if sys_par[0].dealkoef then
  416.     begin //01
  417.       Rec_cnt(cenik, pocet);
  418.       if pocet>0 then
  419.         begin  //1
  420.          strinsert("UPDATE cenik SET ", SQLprikaz, 1);
  421.           begin   //2
  422.            for i:=1 to 9 do 
  423.             IF S_deal_sk[i].cena_proc<>nonereal THEN
  424.              begin   //3
  425.                koef:=real2str(S_deal_sk[i].cena_proc,-3);
  426.                for j:=0 to strlength(koef) do  if koef[j]=',' then koef[j]:='.';
  427.                vyraz:="cena"+int2str(i)+"= min_cena*"+koef+", ";
  428.                strinsert(vyraz,SQLprikaz,strlength(SQLprikaz)+1);
  429.              end;    //3
  430.             strdelete(SQLprikaz,strlength(SQLprikaz)-1,2);
  431.             if SQL_execute(SQLprikaz) then Signalize;
  432.           end;    //2
  433.         end   //1
  434.      else Info_box("UPOZORN╠N═", "Nelze provΘst p°epoΦet dealersk²ch cen podle zadan²ch koeficient∙, dosud nenφ cenφk napln∞n,"#10#13" vra¥te se k tomuto kroku po napln∞nφ Cenφku"); 
  435.    end;  //01
  436.  end;   //0
  437.  
  438.  procedure delable(atr,tabname:string[100];id:integer);
  439. {*******************************************************************}
  440.  var
  441.   pocet:integer;
  442.   podminka: string[200];
  443.   curs:cursor;
  444.  
  445.  begin
  446.       pocet:=0;
  447. //     podminka:="id_obchodnika="+int2str(id_obch); 
  448.        podminka:=atr+"="+int2str(id); 
  449.       if Open_sql_parts(curs, "*", tabname,podminka,"") then Signalize
  450.       else
  451.         begin
  452.           Rec_cnt(curs,pocet);
  453.           close_cursor(curs);
  454.           if pocet>0 then lze_mazat:=false
  455.           // Info_box('Upozorn∞nφ','Nelze smazat obchodnφka, je na n∞j odkaz v tabulce obchodnφch partner∙.')  
  456.           else lze_mazat:=true;            
  457.         end;  
  458.  end;
  459.  
  460.  
  461.  procedure postupobj(/*name:string[20];recobj*/id_obchodnika:integer);
  462. {*******************************************************************}
  463.  var
  464.   usernum:tobjnum; 
  465.   urec,recnum:trecnum;
  466.   u:untyped;
  467.  
  468.  begin
  469.    u:=recobj;
  470.    urec:=look_up(obj_header,'id_dobj',u);
  471.    if urec=-1 then  Info_box('Nelze','Nenalezena objednßvka.')
  472.    else
  473.   /* if Find_object(name,CATEG_USER,usernum) then  Info_box('Nelze','U₧ivatel nenalezen. Nelze postoupit.')
  474.    else  
  475.     if  GetSet_next_user(obj_header, urec, 0, OPER_SET, VT_NAME, name) then Signalize;
  476.    */
  477.    obj_header[urec].obchodnik:=id_obchodnika;
  478.  end;
  479.  
  480.  
  481.  
  482.  procedure uziv1(namerole:string[20]);
  483. {*******************************************************************}
  484.  var
  485.   pocet, n, i, stav :integer;
  486.   name: string[20];
  487.   usernum, rolenum:tobjnum; 
  488.   urec,recnum:trecnum;
  489.   u:untyped;
  490.   
  491.  begin
  492.       pocet:=0;
  493.       if Open_cursor(useri) then Signalize
  494.       else  
  495.         begin
  496.           Rec_cnt(useri,pocet);
  497.           if pocet>0 then
  498.           for i:=0 to pocet-1 do
  499.             begin
  500.               name:=useri[i].logname;
  501.               if Find_object(name,CATEG_USER,usernum) then  Info_box('Nelze','U₧ivatel nenalezen. Nelze zjistit prßva.');
  502.               if Find_object(namerole,CATEG_ROLE,rolenum) then  Info_box('Nelze','Role OBCHODNICI asi byla zruÜena. Nelze zjistit prßva.')
  503.               else  
  504.                 if GetSet_group_role(usernum,rolenum, CATEG_ROLE,OPER_GET,stav) then Signalize
  505.                 else 
  506.                 if stav=1 then 
  507.                   begin
  508.                     u:=name;
  509.                     urec:=look_up(uziv,'logname',u);
  510.                     if urec<>-1 then   uziv[urec].role:=namerole
  511.                      else
  512.                       begin
  513.                         recnum:=Insert(uziv);
  514.                         uziv[recnum].logname:=name;
  515.                         uziv[recnum].role:=namerole;
  516.                       end;
  517.                   end;
  518.             end;
  519.           close_cursor(useri);
  520.         end;  
  521.  end;
  522.  
  523.  
  524.  procedure uziv0();
  525. {*******************************************************************}
  526.  var
  527.    cislo_tab:tobjnum; 
  528.  
  529.  begin
  530.    if not Find_object("uziv", CATEG_TABLE, cislo_tab) then 
  531.      begin  //1
  532.        Delete_all_records(cislo_tab);
  533.        Free_deleted(cislo_tab); 
  534.      end;  //1
  535.    uziv1('obchodnici');
  536.    uziv1('administrator');
  537.  end;
  538.  
  539.  
  540.  procedure op();
  541. {*******************************************************************}
  542.  var
  543.   pocet, pocet2: integer;
  544.   curs:cursor;
  545.   query:string[500];
  546.   logname:string[80];
  547.   u:untyped;
  548.   jarec:trecnum;
  549.  
  550.  begin
  551.    moje:=-1;
  552.    pocet:=0;
  553.    logname:=who_am_I;
  554.    u:=logname;
  555.    jarec:=look_up(OBCHODNICI, "logname", u);
  556.    if jarec>-1 then moje:=OBCHODNICI[jarec].ID_OBCHODNIKA;
  557.    Rec_cnt(Obchodni_partneri,pocet);
  558.    if pocet>0 then  
  559.     begin
  560.       case vsichni of 
  561.        0: begin        
  562.             query:="SELECT * FROM OBCHODNI_PARTNERI WHERE deal_sk="+ int2str(dsk);
  563.             if open_SQL_cursor(curs,query) then Signalize
  564.             else Rec_cnt(curs, pocet2);
  565.             if pocet2>0 then Open_view("*obch_partneri", curs, AUTO_CURSOR, 0, 0,nil) else Info_box("UPOZORN╠N═"," Pro zvolenou dealerskou skupinu neni seznamu ₧ßdn² zßkaznφk.");
  566.           end;
  567.        1:          Open_view("*obch_partneri", NO_REDIR, 0, 0, 0,nil);
  568.        
  569.        2: begin        
  570.             query:="SELECT * FROM OBCHODNI_PARTNERI WHERE nazev1.=."+""""+findcomp+"""";
  571.             if open_SQL_cursor(curs,query) then Signalize
  572.             else Rec_cnt(curs, pocet2);
  573.             if pocet2>0 then Open_view("*obch_partneri", curs, AUTO_CURSOR, 0, 0,nil) else Info_box("UPOZORN╠N═"," Nßzev ₧ßdnΘho zßkaznφka neobsahuje zapsan² text.");
  574.           end;
  575.        3: begin        
  576.             query:="SELECT * FROM OBCHODNI_PARTNERI WHERE typ="+ int2str(tuz);
  577.             if open_SQL_cursor(curs,query) then Signalize
  578.             else Rec_cnt(curs, pocet2);
  579.             if pocet2>0 then Open_view("*obch_partneri", curs, AUTO_CURSOR, 0, 0,nil) else Info_box("UPOZORN╠N═"," Pro zvolen² typ u₧ivatele neni seznamu ₧ßdn² zßkaznφk.");
  580.           end;
  581.  
  582.       end;
  583.    
  584.     end
  585.    else    Open_view("*nova_firma", NO_REDIR, 0, 0, 0,nil);
  586.  end;
  587.  
  588.  procedure optisk();
  589. {*******************************************************************}
  590.  var
  591.   pocet, pocet2:integer;
  592.   curs:cursor;
  593.   query:string[500];
  594.  
  595.  begin
  596.       case vsichni of 
  597.        0: begin        
  598.             query:="SELECT Obchodni_partneri.*,S_deal_sk.deal_skupina,S_typ_uziv.nazev_typ FROM  Obchodni_partneri, S_deal_sk, S_typ_uziv WHERE  S_typ_uziv.id_typ=Obchodni_partneri.typ AND S_deal_sk.deal_id=Obchodni_partneri.deal_sk AND deal_sk="+ int2str(dsk);
  599.             if open_SQL_cursor(curs,query) then Signalize
  600.             else
  601.               begin
  602.                 Rec_cnt(curs, pocet2);
  603.                 if pocet2>0 then Print_view("*T2_seznam_zak", curs, -1, -1) else Info_box("UPOZORN╠N═"," Pro zvolenou dealerskou skupinu neni seznamu ₧ßdn² zßkaznφk.");
  604.                 close_cursor(curs);
  605.               end;
  606.        end;
  607.        1:         Print_view("*T2_seznam_zak", NO_REDIR, -1, -1);
  608.        
  609.        2: begin        
  610.             query:="SELECT Obchodni_partneri.*,S_deal_sk.deal_skupina,S_typ_uziv.nazev_typ FROM  Obchodni_partneri, S_deal_sk, S_typ_uziv WHERE   S_typ_uziv.id_typ=Obchodni_partneri.typ AND S_deal_sk.deal_id=Obchodni_partneri.deal_sk AND nazev1.=."+""""+findcomp+"""";
  611.             if open_SQL_cursor(curs,query) then Signalize
  612.             else 
  613.               begin
  614.                 Rec_cnt(curs, pocet2);
  615.                 if pocet2>0 then Print_view("*T2_seznam_zak", curs, -1, -1) else Info_box("UPOZORN╠N═"," Nßzev ₧ßdnΘho zßkaznφka neobsahuje zapsan² text.");
  616.                 close_cursor(curs);
  617.               end;
  618.           end;
  619.        3: begin        
  620.             query:="SELECT Obchodni_partneri.*,S_deal_sk.deal_skupina,S_typ_uziv.nazev_typ FROM  Obchodni_partneri, S_deal_sk, S_typ_uziv WHERE   S_typ_uziv.id_typ=Obchodni_partneri.typ AND S_deal_sk.deal_id=Obchodni_partneri.deal_sk AND  typ="+ int2str(tuz);
  621.             if open_SQL_cursor(curs,query) then Signalize
  622.             else 
  623.               begin
  624.                 Rec_cnt(curs, pocet2);
  625.                 if pocet2>0 then Print_view("*T2_seznam_zak", curs, -1, -1) else Info_box("UPOZORN╠N═"," Pro zvolen² typ u₧ivatele neni seznamu ₧ßdn² zßkaznφk.");
  626.                 close_cursor(curs);
  627.               end;
  628.           end;
  629.  
  630.       end;
  631.    
  632.  end;
  633.  
  634.  
  635.  
  636.  procedure Stat();
  637. {*******************************************************************}
  638.  var
  639.   query:string[1000];
  640.   podminka: string[120];
  641.   curs:cursor;
  642.  
  643.  begin
  644.  if statnumdat=2 then  podminka:="AND (datum>="+date2str(sdat_od,1)+") AND (datum<="+date2str(sdat_do,1)+")"
  645.                  else  podminka:="";
  646.  
  647.  case statnum of 
  648.   1: 
  649.    begin
  650.      strinsert("SELECT Obchodni_partneri.nazev1,Obj_header.id_org,SUM(Obj_header.sum_cena) AS cena,COUNT(Obj_header.id_dobj) AS POCET,MAX(Obj_header.datum) AS POSLEDNI FROM Obchodni_partneri, Obj_header WHERE Obj_header.id_org=Obchodni_partneri.id AND (Obj_header.potvrzena=true AND Obchodni_partneri.intr_user<>"""")  ", query, 1);
  651.      strinsert(podminka,query,strlength(query));
  652.      strinsert(  " GROUP BY Obj_header.ID_ORG ORDER BY cena DESC",query,strlength(query)); 
  653.    end;
  654.   11: 
  655.    begin
  656.      strinsert("SELECT Obchodnici.prijmeni,Obchodni_partneri.id_obchodnika,SUM(Obj_header.sum_cena) AS cena,COUNT(Obj_header.id_dobj) AS POCET,MAX(Obj_header.datum) AS POSLEDNI FROM Obchodni_partneri, Obj_header, Obchodnici WHERE Obchodni_partneri.id_obchodnika=Obchodnici.id_obchodnika AND Obj_header.id_org=Obchodni_partneri.id AND (Obj_header.potvrzena=true AND Obchodni_partneri.intr_user<>"""") ", query, 1);
  657.      strinsert(podminka,query,strlength(query));
  658.      strinsert(  " GROUP BY Obchodni_partneri.id_obchodnika ORDER BY cena DESC",query,strlength(query)); 
  659.    end;
  660.   2: 
  661.    begin
  662.        strinsert("SELECT Obj_polozky.id_cnk,SUM(Obj_polozky.cena_summn) AS cena,cenik.nazev_zbozi,cenik.kod_zbozi,COUNT(Obj_polozky.id_dobj) AS POCET_OBJ,SUM(Obj_polozky.mnozstvi) AS MNOZ,MAX(Obj_header.datum) AS POSLEDNI FROM Obj_polozky, cenik, Obj_header, Obchodni_partneri WHERE Obchodni_partneri.id=Obj_header.id_org AND Obj_header.id_dobj=Obj_polozky.id_dobj AND Obj_polozky.id_cnk=cenik.id_cenik AND (Obj_header.potvrzena=true AND Obchodni_partneri.intr_user<>"""")  ", query, 1); 
  663.        strinsert(podminka,query,strlength(query));
  664.        strinsert(" GROUP BY Obj_polozky.id_cnk ORDER BY cena DESC", query, strlength(query));
  665.    end;
  666.  
  667.  end; //case
  668.  
  669.  if Open_SQL_cursor(curs,query) then Signalize; 
  670.  
  671.  case statnum of 
  672.   1:   Open_view("*Sum_firma",curs,AUTO_CURSOR/*MODAL_VIEW*/,0,0,nil); 
  673.   11:   Open_view("*Sum_obch",curs,AUTO_CURSOR/*MODAL_VIEW*/,0,0,nil); 
  674.  
  675.   2:   Open_view("*Sum_cnk",curs,AUTO_CURSOR/*MODAL_VIEW*/,0,0,nil); 
  676.  end; //case
  677. // Close_cursor(curs);
  678.  end;
  679.  
  680.  
  681. function Stav_podpisu(id: window_id; nrec: trecnum): csstring[180];
  682. {*******************************************************************}
  683.  var
  684.   n: integer;
  685.   user1 : binary[122];
  686.   user2 : user;
  687.  
  688.  begin
  689.    n:=Signature_state(id,nrec,"podpis");
  690.    if n>0 then
  691.      begin
  692.        user1 := USERTAB[n].identif;      // zjiÜt∞nφ jmΘna, p°φjmenφ u₧ivatele z tabulky USERTAB
  693.        memcpy(user2,user1,122);          // zkopφrovßnφ do struktury user     
  694.        Stav_podpisu:= "podepsal: "+ user2.n1+" " + user2.n2 + ". " + user2.n3;
  695.      end    
  696. //   Stav_podpisu:= "podepsal: "+USERTAB[n].logname
  697.  
  698.    else
  699.     case n of
  700.        0 : Stav_podpisu:="nenφ podepsßno (podpis vymazßn)";
  701.       -1 : Stav_podpisu:="FaleÜn² podpis";
  702.       -2 : Stav_podpisu:="Zm∞n∞no po podpisu";
  703.       -3 : Stav_podpisu:="Nelze ov∞°it, u₧ivatel nenφ znßm²";
  704.       -4 : Stav_podpisu:="Podpis snad platn², neov∞°ena identita";
  705.       -5 : Stav_podpisu:="Dokument podepsßn po zneplatn∞nφ certifikßtu";
  706.       -6 : Stav_podpisu:="Identita ov∞°ena nikoli certifikaΦnφ autoritou";
  707.       -7 : Stav_podpisu:="Rezervovßno";
  708.       -8 : Stav_podpisu:="Chyba v podpisu nebo nenφ dosud podepsßno";
  709.     else : Stav_podpisu:=" neznßm²"  
  710.     end;
  711.  end;
  712.  
  713.  
  714. procedure mojetr();
  715. /*********************************************************************/
  716.  var 
  717.   dent, cojeto, cojeto2, pocetlct:integer;
  718.   s,sh:string[200];
  719.  
  720.  begin //0
  721.    cojeto := get_devel_lic(pocetlct);
  722.    sh:="WinBase - runtime";
  723.    if pocetlct>1 then Begin pomtr:=pocetlct; if pocetlct >= 1000 then sh:="SQL server s neomezenou licencφ" else sh:="SQL server s "+int2str(pocetlct)+" licencemi"; end
  724.    else
  725.     begin  //1
  726.       cojeto2 :=cojeto mod 65536;
  727.       if odd(cojeto2) then
  728.         begin  //2
  729.           dent := get_expir_state();
  730.           if dent>60 then begin pomtr:=2; sh:="Personßlnφ databßze";  end else begin pomtr:=0; sh:="Personßlnφ databßze - TRIAL!" end;
  731.         end;   //2
  732.     end;   //1
  733.  s:= int2str(pocetlct)+"/"+ int2str(cojeto2)+"/"+int2str(dent)+" = "+int2str(pomtr);
  734. // info_box(sh,s);
  735.  if pomtr<=1 then sys_par[0].mailovat:=false;
  736.  end;   //0
  737.  
  738.  
  739.  
  740. function act_menu():Integer;
  741. {*******************************************************************}
  742. var
  743. usernum,rolenum:tobjnum;
  744. stav:integer;
  745. name:string[80];
  746.  
  747. begin
  748. stav:=0;
  749. act_menu:=-100;
  750. activni:=100;
  751. if Am_I_Db_Admin() then begin /*act_menu:=0;*/ activni:=0; end
  752. else
  753.   begin  //1
  754.     name:=who_am_I;
  755.     if Find_object(name,CATEG_USER,usernum) then  Info_box('Nelze','U₧ivatel nenalezen. Nelze zjistit prßva.') 
  756.     else
  757.       begin //2
  758.                  if Find_object('Internet_user',CATEG_ROLE,rolenum) then  Info_box('Nelze','Role Internet_user asi byla zruÜena. Nelze zjistit prßva.')
  759.                  else  
  760.                  if GetSet_group_role(usernum,rolenum, CATEG_ROLE,OPER_GET,stav) then Signalize
  761.                  else 
  762.                  if stav=1  then begin /*act_menu:=3;*/ activni:=3; end;
  763.              if Find_object('Obchodnici',CATEG_ROLE,rolenum) then  Info_box('Nelze','Role OBCHODNICI asi byla zruÜena. Nelze zjistit prßva.')
  764.              else  
  765.              if GetSet_group_role(usernum,rolenum, CATEG_ROLE,OPER_GET,stav) then Signalize
  766.              else 
  767.              if stav=1 then begin /*act_menu:=2;*/activni:=2; end;
  768.         if Find_object('Administrator',CATEG_ROLE,rolenum) then  Info_box('Nelze','Role Administrator asi byla zruÜena. Nelze zjistit prßva.')
  769.         else  
  770.         if GetSet_group_role(usernum,rolenum, CATEG_ROLE,OPER_GET,stav) then Signalize
  771.         else 
  772.         if stav=1 then activni:=1; 
  773. //                  else  activni:=100;
  774.       end //2  
  775.   end;   //1
  776. // mojetr();
  777. end;
  778.  
  779.  
  780. function act_menuold():Boolean;
  781. {*******************************************************************}
  782. var
  783. usernum,rolenum:tobjnum;
  784. stav:integer;
  785. name:string[80];
  786. begin
  787. stav:=0;
  788. act_menuold:=false;
  789. if Am_I_Db_Admin() then act_menuold:=true
  790. else
  791.   begin
  792.     name:=who_am_I;
  793.     if Find_object(name,CATEG_USER,usernum) then  Info_box('Nelze','U₧ivatel nenalezen. Nelze zjistit prßva.');
  794.     if Find_object('Obchodnici',CATEG_ROLE,rolenum) then  Info_box('Nelze','Role OBCHODNICI asi byla zruÜena. Nelze zjistit prßva.')
  795.     else  
  796.     if GetSet_group_role(usernum,rolenum, CATEG_ROLE,OPER_GET,stav) then Signalize
  797.     else 
  798.     if stav=1 then act_menuold:=true
  799.     else act_menuold:=false;
  800.   end;
  801. end;
  802.  
  803.  
  804.  procedure  Novy_obch();
  805. /*********************************************************************/
  806. var
  807. // irec:trecnum;
  808.  curs:cursor;
  809.  pom_def, limit, pom_id :integer;
  810.  
  811. begin
  812.   if not Open_sql_parts(curs, "*", "default_hodnoty","", "") then  Info_box("upozorn∞nφ", "Nejsou zadßny default hodnoty(odd∞lenφ) - nelze zalo₧it nov² zßznam")
  813.   else 
  814.    begin //1
  815.     Rec_cnt(curs, limit);
  816.     close_cursor(curs);
  817.     if limit>0 then Open_view("*novy_obch",NO_REDIR,MODAL_VIEW,-1,0,nil); 
  818.    end; //1
  819. end;
  820.  
  821.  procedure  Nova_d();
  822. /*********************************************************************/
  823. var
  824.  irec:trecnum;
  825.  u:untyped;
  826.  limit:integer;
  827.  
  828. begin   //1
  829.  u:="Bez formulß°e";
  830.  irec:=Look_up(S_platba,"nazev",u); 
  831.  if irec>-1 then 
  832.   begin   //2
  833.     pom_zp:=S_platba[irec].id; 
  834.     if pom_zp<>NONEINTEGER then
  835.       begin //3
  836.        if  Open_cursor(Dhp_today) then Signalize
  837.         else Rec_cnt(Dhp_today,limit);
  838.         if limit>0 then
  839.           begin //4
  840.            pom_dph:=Dhp_today[0].id_dph;
  841.            close_cursor(Dhp_today);
  842.            if pom_dph<>NONEINTEGER then  Open_view("*Nova_dopr",NO_REDIR,MODAL_VIEW,-1,0,nil) 
  843.             else  Info_box("upozorn∞nφ", "Nejsou zadßny  DPH pro letoÜnφ rok - nelze zalo₧it nov² zßznam")
  844.           end //4
  845.          else  Info_box("upozorn∞nφ", "Nejsou zadßny DPH pro letoÜnφ rok - nelze zalo₧it nov² zßznam")
  846.       end //3
  847.     else  Info_box("upozorn∞nφ", "Nejsou zadßny zp∙sob platby nebo DPH pro letoÜnφ rok - nelze zalo₧it nov² zßznam")
  848.   end //2
  849.   else  Info_box("upozorn∞nφ", "Nejsou zadßny zp∙sob platby nebo DPH pro letoÜnφ rok - nelze zalo₧it nov² zßznam")
  850. end; //1
  851.  
  852.  
  853.  procedure  Nova_f();
  854. /*********************************************************************/
  855. var
  856. // irec:trecnum;
  857.  curs:cursor;
  858.  pom_def, limit, pom_id :integer;
  859.  
  860. begin
  861.   if Open_sql_parts(curs, "*", "default_hodnoty","", "") then  Info_box("upozorn∞nφ", "Nejsou zadßny default hodnoty (typ u₧ivatele, dealerskß skupina, nebo obchodnφk) - nelze zalo₧it nov² zßznam")
  862.   else 
  863.    begin //1
  864.   Rec_cnt(curs, limit);
  865.   if limit>0 then
  866.     begin   //2
  867.  pom_ds:=curs[0].deal_sk; 
  868.  if pom_ds<>NONEINTEGER then
  869.  begin //3
  870.  pom_typ:=curs[0].typ_uziv; 
  871.  if pom_typ<>NONEINTEGER then
  872.  begin //4
  873.  pom_obch:=curs[0].obchodnik; 
  874.  if pom_obch<>NONEINTEGER then
  875.  begin //5
  876.  noveid:=pridel_id();
  877.  Open_view("*nova_firma",NO_REDIR,MODAL_VIEW,-1,0,nil); 
  878.   end; //5
  879.   end; //4
  880.   end; //3
  881.   end //2
  882.   else  Info_box("upozorn∞nφ", "Nejsou zadßny default hodnoty(typ u₧ivatele, dealerskß skupina, nebo obchodnφk) - nelze zalo₧it nov² zßznam")
  883.   end; //1
  884.   close_cursor(curs);
  885. end;
  886.  
  887. procedure smaz_firmu(id:integer; nazev:string[200]);
  888. /*********************************************************************/
  889. var
  890.  podminka: string[120];
  891.  curs:cursor;
  892.  pocet:integer;
  893.  i: integer;
  894.  ok:Boolean;
  895.  u:untyped;
  896.  s:string[254];
  897.  
  898. begin
  899. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  900.   podminka:="id_org="+int2str(id);
  901.    if not Open_sql_parts(curs, "*", "Obj_header", podminka, "") then  Rec_cnt(curs,pocet);
  902.    close_cursor(curs);
  903.    s:= "V tabulce Objednßvek existujφ objednßvky obchodnφho partnera:"#10" "+nazev+" "#10" Obchodnφho partnera nelze smazat.";
  904.    if pocet>0 then Info_box("UPOZORN╠N═",s)
  905.    else
  906.      begin
  907. //smazßnφ zßznamu v tabulce
  908.           u := id;
  909.           irec := Look_up(Obchodni_partneri,"id",u);
  910.           if irec<>-1 then if delete(Obchodni_partneri,irec) then Signalize;
  911.      end; 
  912. end;
  913.  
  914.  
  915.  
  916. procedure smaz_DPH(id, uc_rok:integer);
  917. /*********************************************************************/
  918. var
  919.  podminka: string[120];
  920.  curs, curs1:cursor;
  921.  pocet:integer;
  922.  i: integer;
  923.  ok:Boolean;
  924.  u:untyped;
  925.  
  926. begin
  927. if uc_rok=year(today) then 
  928.  begin
  929. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  930.   podminka:="dph="+int2str(id);
  931.      if not Open_sql_parts(curs, "*", "Cenik", podminka, "") then  Rec_cnt(curs,pocet);
  932.    if pocet>0 then ok:=YesNo_box("UPOZORN╠N═", "V Cenφku  existuje odkaz na mazanΘ DPH,"#10"chcete oznaΦenΘ DPH opravdu smazat? (bude nahrazen defaultnφm)")
  933.    else  ok:=true;
  934.    if ok then
  935.      begin
  936. //smazßnφ zßznamu v tabulce
  937.        if id<>default_hodnoty[0].DPH then 
  938.         begin
  939.           for i:=0 to pocet-1 do curs[i].dph:=default_hodnoty[0].dph;
  940.            podminka:="dph="+int2str(id)+ " AND uc_rok=year(today)";
  941.            if Open_sql_parts(curs1, "*", "S_DPH", podminka, "") then Signalize
  942.           else  Delete_all_records(curs1);
  943.           close_cursor(curs1) 
  944.         end
  945.         else info_box("UPOZORN╠N═", "mazanΘ DPH je defaultnφ, nelze smazat") ;
  946.      end; 
  947.    close_cursor(curs);
  948.  end
  949.  else 
  950.    begin
  951.      podminka:="dph="+int2str(id)+ " AND uc_rok="+ int2str(uc_rok);
  952.      if Open_sql_parts(curs1, "*", "S_DPH", podminka, "") then Signalize
  953.      else  Delete_all_records(curs1);
  954.      close_cursor(curs1);
  955.  
  956.    end;  
  957.  
  958. end;
  959.  
  960.  
  961. procedure smaz_typ_uziv(id:integer);
  962. /*********************************************************************/
  963. var
  964.  podminka: string[120];
  965.  curs:cursor;
  966.  pocet:integer;
  967.  i: integer;
  968.  ok:Boolean;
  969.  u:untyped;
  970.  
  971. begin
  972. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  973.   podminka:="typ="+int2str(id);
  974.      if not Open_sql_parts(curs, "*", "Obchodni_partneri", podminka, "") then  Rec_cnt(curs,pocet);
  975.    if pocet>0 then ok:=YesNo_box("UPOZORN╠N═", "Vybran² typ u₧ivatele je pou₧it v tabulce Obchodnφch partner∙, "#10" chcete oznaΦen² typ u₧ivatele opravdu smazat?"#10" (bude nahrazen defaultnφm)")
  976.    else  ok:=true;
  977.    if ok then
  978.      begin
  979. //smazßnφ zßznamu v tabulce
  980.        if id<>default_hodnoty[0].TYP_UZIV then 
  981.         begin
  982.           for i:=0 to pocet-1 do curs[i].typ:=default_hodnoty[0].TYP_UZIV;
  983.           u := id;
  984.           irec := Look_up(S_typ_uziv,"id_typ",u);
  985.           if irec<>-1 then if delete(S_typ_uziv,irec) then Signalize;
  986.         end
  987.         else info_box("UPOZORN╠N═", "Vybran² typ u₧ivatele je defaultnφ, nelze smazat") ;
  988.      end; 
  989.    close_cursor(curs);
  990.  
  991. end;
  992.  
  993.  
  994.  
  995. procedure smaz_deal_sk(id:integer);
  996. /*********************************************************************/
  997. var
  998.  podminka: string[120];
  999.  curs:cursor;
  1000.  pocet:integer;
  1001.  i: integer;
  1002.  ok:Boolean;
  1003.  u:untyped;
  1004.  
  1005. begin
  1006. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  1007.   podminka:="deal_sk="+int2str(id);
  1008.      if not Open_sql_parts(curs, "*", "Obchodni_partneri", podminka, "") then  Rec_cnt(curs,pocet);
  1009.    if pocet>0 then ok:=YesNo_box("UPOZORN╠N═", "Tato dealerskß skupina obsahuje obchodnφ partnery,"#10" chcete oznaΦenou dealerskou skupinu opravdu smazat?"#10"- obchodnφ partne°i budou za°azeni do defaultnφ dealerskΘ skupiny")
  1010.    else  ok:=true;
  1011.    if ok then
  1012.      begin
  1013. //smazßnφ zßznamu v tabulce
  1014.        if id<>default_hodnoty[0].deal_sk then 
  1015.         begin
  1016.           for i:=0 to pocet-1 do curs[i].deal_sk:=default_hodnoty[0].deal_sk;
  1017.           u := id;
  1018.           irec := Look_up(S_deal_sk,"deal_id",u);
  1019.           if irec<>-1 then if delete(S_deal_sk,irec) then Signalize;
  1020.         end
  1021.         else info_box("UPOZORN╠N═", "RuÜenß dealerskß skupina je defaultnφ, nelze ji smazat") ;
  1022.      end; 
  1023.    close_cursor(curs);
  1024. end;
  1025.  
  1026.  
  1027.  
  1028.  
  1029. procedure smaz_kod_level(uroven:integer);
  1030. /*********************************************************************/
  1031. var
  1032.  podminka: string[120];
  1033.  curs:cursor;
  1034.  id_sub:window_id;
  1035.  curs1:cursor;
  1036.  intcis,extcis, pocet:integer;
  1037.  nad_mnoz: integer;
  1038.  res:untyped;
  1039.  ok:Boolean;
  1040.  
  1041. begin
  1042. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  1043.   if (uroven<>noneinteger) then podminka:="uroven="+int2str(uroven)
  1044.    else podminka:="uroven=NULL";
  1045.       if not Open_sql_parts(curs, "*", "S_zbozi_sk", podminka, "") then  Rec_cnt(curs,pocet);
  1046.       close_cursor(curs);
  1047.       if pocet>0 then ok:=YesNo_box("UPOZORN╠N═", "V tabulce Skupin zbo₧φ existujφ vybranΘ urovn∞ struktury vno°enφ,"#10" chcete oznaΦenou polo₧ku ·rove≥ opravdu smazat?")
  1048.       else  ok:=true;
  1049.       if ok then
  1050.         begin
  1051.     //otev°enφ prom∞nnΘho kurzoru curs a  zruÜenφ vÜech zßznam∙ vácursoru curs  
  1052.           if not Open_sql_parts(curs, "*", "kod_structura", podminka, "") then  Delete_all_records(curs);
  1053.           close_cursor(curs);
  1054.         end;
  1055.   
  1056. end;
  1057.  
  1058. procedure smaz_pol_rab(id:window_id;mnoz : integer; metoda:integer);
  1059. /*********************************************************************/
  1060. var
  1061.  podminka: string[120];
  1062.  curs:cursor;
  1063.  id_sub:window_id;
  1064.  curs1:cursor;
  1065.  intcis,extcis, pocet0, pocet:integer;
  1066.  i, nad_mnoz: integer;
  1067.  res,u:untyped;
  1068.  ok:Boolean;
  1069.  cislo_tab:tobjnum;
  1070.  
  1071. begin
  1072. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  1073.   close_view(id);
  1074.   podminka:="rabat="+int2str(metoda);
  1075.      if not Open_sql_parts(curs, "*", "S_zbozi_sk", podminka, "") then  Rec_cnt(curs,pocet);
  1076.    close_cursor(curs);
  1077.    if pocet>0 then ok:=YesNo_box("UPOZORN╠N═", "V tabulce Skupin zbo₧φ je odkaz na vybranou metodu rabat∙,"#10" chcete oznaΦenou polo₧ku metody opravdu smazat?")
  1078.    else  ok:=true;
  1079.    if ok then
  1080.      begin
  1081.           podminka:="metoda="+int2str(metoda);
  1082.           if not Open_sql_parts(curs, "*", "rabat", podminka, "") then  Rec_cnt(curs,pocet0);
  1083.           close_cursor(curs);
  1084.           podminka:="metoda="+int2str(metoda)+" AND nad_mnoz="+int2str(mnoz);
  1085.     //otev°enφ prom∞nnΘho kurzoru curs a  zruÜenφ vÜech zßznam∙ vácursoru curs  
  1086.           if not Open_sql_parts(curs, "*", "rabat", podminka, "") then 
  1087.            begin
  1088. /*            if ((metoda=default_hodnoty[0].RABATOVA_METODA) AND (pocet0<2)) then   info_box("UPOZORN╠N═", "RuÜenß RABATOVA METODA je defaultnφ, nelze ji celou smazat")
  1089.             else 
  1090.             begin
  1091. */             Delete_all_records(curs);
  1092.              if (pocet0<2) then  
  1093.               begin
  1094.                u := METODA;
  1095.                irec := Look_up(Rabat_header,"metoda",u);
  1096.                if irec<>-1 then if delete(Rabat_header,irec) then Signalize;
  1097.               end; 
  1098.  //           end;
  1099.             close_cursor(curs);
  1100.            end;
  1101. /* if not Find_object("Rabat", CATEG_TABLE, cislo_tab)
  1102.     then Free_deleted(cislo_tab);
  1103.  if not Find_object("Rabat_header", CATEG_TABLE, cislo_tab)
  1104.     then Free_deleted(cislo_tab);
  1105. */     end;     
  1106.     //otev°enφ prom∞nnΘho kurzoru curs a  zruÜenφ vÜech zßznam∙ vácursoru curs  
  1107.  podminka:="rabat.metoda=rabat_header.metoda AND metoda="+int2str(metoda);
  1108.  
  1109.  if not Open_sql_parts(curs, "rabat.*,rabat_header.kod", "rabat, rabat_header", podminka, "") then   Rec_cnt(curs,pocet);
  1110.  if pocet>0 then Open_view("*cis_rabat",curs,AUTO_CURSOR,0,0,nil) else close_cursor(curs); 
  1111.  
  1112. end;
  1113.  
  1114.  
  1115. procedure metoda_del(metoda:integer; pohled:window_id);
  1116. /*********************************************************************/
  1117.  
  1118.  var
  1119.  podminka: string[120];
  1120.  curs:cursor;
  1121.  pocet:integer;
  1122.  i: integer;
  1123.  ano:Boolean;
  1124.  u:untyped;
  1125.  s:string[254];
  1126.  cislo_tab:tobjnum;
  1127.  
  1128. begin //0
  1129.  close_view(pohled);
  1130. //otev°enφ prom∞nnΘho kurzoru curs a zjiÜt∞nφ zda metodu lze zruÜit   
  1131. // cenφk.rabat(integer) + skupiny.rabat(integer)
  1132.  
  1133.   podminka:="rabat="+int2str(metoda);
  1134.    if not Open_sql_parts(curs, "*", "S_zbozi_sk", podminka, "") then  Rec_cnt(curs,pocet);
  1135.    close_cursor(curs);
  1136.    s:= "V tabulce S_zbozi_sk existujφ skupiny  s odkazem na tabulku rabat∙:"#10" "+int2str(metoda)+" "#10" Tabulku rabat∙ nelze smazat.";
  1137.    if pocet>0 then Info_box("UPOZORN╠N═",s)
  1138.    else
  1139.      begin //1
  1140.  
  1141.    podminka:="rabat="+int2str(metoda);
  1142.    if not Open_sql_parts(curs, "*", "Cenik", podminka, "") then  Rec_cnt(curs,pocet);
  1143.    close_cursor(curs);
  1144.    s:= "V tabulce CENIK existujφ polo₧ky s odkazem na tabulku rabat∙:"#10" "+int2str(metoda)+" "#10" Tabulku rabat∙ nelze smazat.";
  1145.    if pocet>0 then Info_box("UPOZORN╠N═",s)
  1146.    else
  1147.      begin    //2
  1148. //smazßnφ zßznamu v tabulce
  1149.       Ano:= YesNo_box("Potv∩te"," Opravdu chcete smazat celou tabulku rabat∙?");
  1150.       podminka:="metoda="+int2str(metoda);
  1151.       if not Open_sql_parts(curs, "*", "Rabat", podminka, "") then  Rec_cnt(curs,pocet);
  1152.       if pocet>0 then  Delete_all_records(curs);
  1153.       close_cursor(curs);
  1154.       u := METODA;
  1155.       irec := Look_up(Rabat_header,"metoda",u);
  1156.       if irec<>-1 then if delete(Rabat_header,irec) then Signalize;
  1157.      end;  //2
  1158. /* if not Find_object("Rabat", CATEG_TABLE, cislo_tab)
  1159.     then Free_deleted(cislo_tab);
  1160.  if not Find_object("Rabat_header", CATEG_TABLE, cislo_tab)
  1161.     then Free_deleted(cislo_tab);
  1162. */  Open_view("*Edit_rab",NO_REDIR,0,0,0,nil); 
  1163.  
  1164.  end;   //1
  1165. end;  //0
  1166.  
  1167.  
  1168.  
  1169. procedure metoda_edit(ed,met:integer);
  1170. /*********************************************************************/
  1171. var 
  1172.  podminka: string[120];
  1173.  curs:cursor;
  1174.  pocet:integer;
  1175.  metoda:integer;
  1176.  irec:trecnum;
  1177.  
  1178. begin //0
  1179.  podminka:="metoda="+int2str(met);
  1180.  if not Open_sql_parts(curs, "*", "rabat_header", podminka, "") then Rec_cnt(curs, pocet);
  1181.  close_cursor(curs);
  1182.  podminka:="rabat.metoda=rabat_header.metoda AND metoda="+int2str(met);
  1183.  
  1184.  if pocet>0 then 
  1185.  if not Open_sql_parts(curs, "rabat.*,rabat_header.kod", "rabat, rabat_header", podminka, "") then Rec_cnt(curs, pocet);
  1186.  if pocet>0 then
  1187.   begin  //1
  1188.     if ed=0 then
  1189.       begin //2
  1190.         Open_view("*cis_rabat",curs,AUTO_CURSOR,0,0,nil); 
  1191.       end    //2
  1192.     else
  1193.      begin   //2
  1194.        if ed=2 then  Open_view("*c_rabat",curs,MODAL_VIEW+AUTO_CURSOR,0,0,nil) 
  1195.                else
  1196.                 begin //3
  1197.                  Open_view("*c_rabat",curs,AUTO_CURSOR,-irec,0,id_POHLED); 
  1198.                  repeat Peek_message until id_POHLED = 0;
  1199.                 end;  //3
  1200.      end;    //2
  1201.    end  //1
  1202.   else  
  1203.    begin //1
  1204.      nova_pol_rab(met);
  1205.      if not Open_sql_parts(curs, "rabat.*,rabat_header.kod", "rabat, rabat_header", podminka, "") then Rec_cnt(curs, pocet);
  1206.      if pocet>0 then Open_view("*cis_rabat",curs,AUTO_CURSOR,0/*-irec*/,0,nil); 
  1207.    end;   //1
  1208. end;   //0
  1209.  
  1210.  
  1211. procedure metoda_nova(pohled:window_id);
  1212. /*********************************************************************/
  1213. var 
  1214.  podminka: string[120];
  1215.  curs:cursor;
  1216.  pocet:integer;
  1217.  metoda:integer;
  1218.  irec, jrec:trecnum;
  1219.  
  1220. begin
  1221.      close_view(pohled);
  1222.      jrec:=Insert(RABAT_header);
  1223. //     irec:=Insert(RABAT);
  1224.      metoda:=Rabat_header[jrec].metoda;
  1225.      nova_pol_rab(metoda);
  1226.      Open_view("*Edit_rab",NO_REDIR,AUTO_CURSOR,0,0,nil); 
  1227. end;
  1228.  
  1229.  
  1230.  procedure Zjisti_rabat(ed:integer;id_skupiny, rabat:integer);
  1231. /*********************************************************************/
  1232. var
  1233.  irec, rab:trecnum;
  1234.  u:untyped;
  1235.  
  1236. Begin
  1237.    rab:=0;
  1238.    if rabat>0 then rab:=rabat else
  1239.    if rabat=NONEINTEGER then
  1240.    begin
  1241.      u := id_skupiny;
  1242.      irec := Look_up(S_zbozi_sk,"id_skupiny",u);
  1243.      rab:= S_zbozi_sk[irec].rabat;
  1244.      if rab =NONEINTEGER then rab:=0;
  1245.    end;  
  1246.      if rab=0 then Info_box("upozorn∞nφ", "pro vybranou polo₧ku  nenφ stanovena"#10"tabulka mno₧stevnφch rabat∙,"#10"cena nenφ zßvislß na mno₧stvφ")
  1247.      else metoda_edit(ed,rab);
  1248.  end;
  1249.  
  1250.  procedure Zjisti_rabat_nova(pohled:window_id;id_skupiny, rabat, id_cenik:integer);
  1251. /***********************************************************************************/
  1252. var
  1253.  irec, rab, crec: trecnum;
  1254.  u:untyped;
  1255.  
  1256. Begin
  1257.    rab:=0;
  1258.    if rabat>0 then rab:=rabat else
  1259.    begin
  1260.      u := id_skupiny;
  1261.      irec := Look_up(S_zbozi_sk,"id_skupiny",u);
  1262.      rab:= S_zbozi_sk[irec].rabat;
  1263.      if rab =NONEINTEGER then rab:=0;
  1264.    end;  
  1265.  
  1266.    Close_view(pohled);
  1267.  
  1268.    if rab=0 then Info_box("upozorn∞nφ", "pro vybranou polo₧ku  nenφ stanovena"#10"tabulka mno₧stevnφch rabat∙,"#10"cena nenφ zßvislß na mno₧stvφ")
  1269.    else metoda_edit(2,rab);
  1270.  
  1271.    u:=id_cenik;
  1272.    crec := Look_up(cenik,"id_cenik",u);
  1273.    Open_view("*nova_pol_cen",NO_REDIR,MODAL_VIEW,-crec,0,nil)
  1274.  
  1275.  end;
  1276.  
  1277.  procedure pridel_rabat(ed:integer;id_skupiny, id_cenik:integer);
  1278. /*********************************************************************/
  1279. var
  1280.  crec,irec, rab:trecnum;
  1281.  u:untyped;
  1282.  
  1283. Begin
  1284.   u := id_cenik;
  1285.   crec := Look_up(cenik,"id_cenik",u);
  1286.   if crec>-1 then
  1287.    begin 
  1288.     if ed=0 then cenik[crec].rabat:= 0  
  1289.      else
  1290.        begin
  1291.         u := id_skupiny;
  1292.         irec := Look_up(S_zbozi_sk,"id_skupiny",u);
  1293.         cenik[crec].rabat:= S_zbozi_sk[irec].rabat
  1294.        end;  
  1295.    end 
  1296.   else Info_box("Upozorn∞nφ", "Nenalezena polo₧ka cenφku");
  1297.  end;
  1298.  
  1299.  
  1300.  procedure zarad(nova:integer;id_pohled:window_id;id_cenik:integer);
  1301. /*********************************************************************/
  1302.  var
  1303.  crec:trecnum;
  1304.  c:cursor;
  1305.  u:untyped;
  1306.  limit:integer;
  1307.   
  1308.  begin
  1309.    Close_view(id_pohled);
  1310.    Open_view("*skup_zarad", NO_REDIR, MODAL_VIEW, 0, 0, nil);
  1311.    if Open_SQL_cursor(c,"select id_skupiny from S_zbozi_sk where vybrano=TRUE") then Signalize
  1312.    else  Rec_cnt(c,limit);
  1313.    u:=id_cenik;
  1314.    crec := Look_up(cenik,"id_cenik",u);
  1315.  
  1316.    if limit=1 then 
  1317.     begin
  1318.      if crec<>-1 then 
  1319.      cenik[crec].skupina_zbozi:=c[0].id_skupiny;
  1320.      zarazeno:=true;
  1321.     end
  1322.    else if limit<1 then info_box("upozorn∞nφ" , "nebyla vybrßna ₧ßdnß skupina") else  info_box("upozorn∞nφ" , "vybrali jste vφce skupin, za°adit lze pouze do 1");
  1323.    close_cursor(c);
  1324.                                  
  1325.    if nova=0 then Open_view("*nova_pol_cen",NO_REDIR,MODAL_VIEW,-crec,0,nil)
  1326.    else Open_view("*cenik",NO_REDIR,MODAL_VIEW,-crec,0,nil)
  1327.  end;
  1328.  
  1329.  procedure vyber_poradi();
  1330. /*********************************************************************/
  1331.  var
  1332.  crec:trecnum;
  1333.  c:cursor;
  1334.  u:untyped;
  1335.  limit:integer;
  1336.   
  1337.  begin
  1338.    Open_view("*skup_zarad", NO_REDIR, MODAL_VIEW, 0, 0, nil);
  1339.    if Open_SQL_cursor(c,"select id_skupiny from S_zbozi_sk where vybrano=TRUE") then Signalize
  1340.    else  Rec_cnt(c,limit);
  1341.    close_cursor(c);
  1342.  
  1343.    if limit<1 then info_box("upozorn∞nφ" , "nebyla vybrßna ₧ßdnß skupina")
  1344.    else Open_view("*PORADI",NO_REDIR,MODAL_VIEW,0,0,nil);
  1345.                                
  1346.  end;
  1347.  
  1348.  
  1349.  
  1350.  procedure  Nova_cen();
  1351. /*********************************************************************/
  1352.  
  1353. var
  1354.  jedrec, irec, jrec:trecnum;
  1355.  podminka:string[250];
  1356.  curs, vyrdef:cursor;
  1357.  pom_def, limit, pom_id, pocet, pomvyrobce :integer;
  1358.  u:untyped;
  1359.  
  1360. begin
  1361.  if Open_sql_parts(curs, "*", "default_hodnoty","", "") then  Info_box("upozorn∞nφ", "Nejsou zadßny default hodnoty (DPH, rab. metoda)- nelze zalo₧it nov² zßznam")
  1362.   else 
  1363.    begin //1
  1364.   Rec_cnt(curs, limit);
  1365.   close_cursor(curs);
  1366.   if limit>0 then
  1367.     begin   //2a
  1368.   if sys_par[0].vyrobci then
  1369.    begin
  1370.     if Open_SQL_cursor(vyrdef,"SELECT id FROM Vyrobci") then Signalize
  1371.     else  
  1372.      begin   //2b
  1373.        Rec_cnt(vyrdef,pocet);
  1374.        if pocet>0 then  pomvyrobce:=vyrdef[0].id ;
  1375.        close_cursor(vyrdef);
  1376.      end;    //2b
  1377.    end;
  1378.   if ((pocet>0) AND (pomvyrobce<>NONEINTEGER)) OR NOT sys_par[0].vyrobci then
  1379.     begin     //2b
  1380.        pom_def:=default_hodnoty[0].DPH; 
  1381.        if pom_def<>NONEINTEGER then
  1382.        begin //3
  1383.        zarazeno:=false;
  1384.        irec:=Insert(cenik);
  1385.       // p_nova_c:=irec;
  1386.       
  1387.        pom_id :=sys_par[0].id_last_c+1;
  1388.        cenik[irec].min_cena:=0.0;
  1389.        cenik[irec].id_cenik:=pom_id;
  1390.        cenik[irec].novinka:=true;
  1391.        cenik[irec].sleva:=false;
  1392.        cenik[irec].top:=false;
  1393.        cenik[irec].skladem:=true;
  1394.        if sys_par[0].vyrobci then cenik[irec].vyrobce:=pomvyrobce; 
  1395.        cenik[irec].dph:=default_hodnoty[0].dph;
  1396.        u:=default_hodnoty[0].jednotka;
  1397.        jedrec := Look_up(Jednotka,"idj",u);
  1398.        if jedrec<>-1 then  pjednotka:=Jednotka[jedrec].nazev
  1399.        else 
  1400.         begin
  1401.           pjednotka:="ks";
  1402.           Info_box("UPOZORN╠N═", "V tabulce jednotek nebyla nalezena Default jednotka");  
  1403.         end;
  1404.       //  cenik[irec].jednotka:=pjednotka;
  1405.        Open_view("*nova_pol_cen",NO_REDIR,MODAL_VIEW,-irec,0,nil); 
  1406.          end   //3
  1407.     end   //2b
  1408.    else Info_box("v tabulce vyrobci nenφ ₧ßdn² zßznam","zadejte v²robce nebo v zßkladnφm nastavenφ rozhodn∞te v²robce nepou₧φvat");
  1409.   end   //2a
  1410.   else  Info_box("upozorn∞nφ", "Nejsou zadßny default hodnoty(DPH, rab. metoda) - nelze zalo₧it nov² zßznam");
  1411.  end;    //1
  1412. end;
  1413.  
  1414.  
  1415.  
  1416. procedure smaz_pol_cen(id_cen:integer;id_pohled:window_id);
  1417. /*********************************************************************/
  1418. var
  1419.  irec:trecnum;
  1420.  podminka: string[120];
  1421.  c,curs:cursor;
  1422.  u:untyped;
  1423.  i,limit2,limit:integer;
  1424.  ok:boolean;
  1425.  
  1426. begin
  1427.   close_view(id_pohled);
  1428.   podminka:="id_cenik="+int2str(id_cen);
  1429.   ok:=yesno_box("UPOZORN╠N═", "chcete opravdu smazat vybranou polo₧ku cenφku?");
  1430.    if OK then
  1431.     begin
  1432. //smazßnφ zßznamu v tabulce Cenik
  1433.       u := id_cen;
  1434.       irec := Look_up(cenik,"id_cenik",u);
  1435.       if irec<>-1 then delete(cenik,irec);
  1436.     end;
  1437.     Open_view("*cenik",NO_REDIR,MODAL_VIEW+AUTO_CURSOR,0,0,nil) ;
  1438. end;
  1439.  
  1440.  
  1441. procedure smaz_nova_cen(id_cen:integer;id_pohled:window_id);
  1442. /*********************************************************************/
  1443. var
  1444.  irec:trecnum;
  1445.  podminka: string[120];
  1446.  u:untyped;
  1447.  
  1448. begin
  1449.   close_view(id_pohled);
  1450.   podminka:="id_cenik="+int2str(id_cen);
  1451. //smazßnφ zßznamu v tabulce Cenik
  1452.    u := id_cen;
  1453.    irec := Look_up(cenik,"id_cenik",u);
  1454.    if irec<>-1 then delete(cenik,irec);
  1455.   Open_view("*cenik",NO_REDIR,MODAL_VIEW+AUTO_CURSOR,0,0,nil) ;
  1456. end;
  1457.  
  1458.