home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / WWW_OBJ.PGM < prev    next >
Text File  |  2000-03-16  |  45KB  |  1,294 lines
  1. {$$3220792584 .                              }//Program www-obj
  2.  
  3. table 
  4.  USERTAB,sys_par, default_hodnoty, objtab, cenik, s_zbozi_sk, obj_polozky, obj_header,  Obchodni_partneri, Kod_structura, S_deal_sk, obchodnici, S_DOPRAVA, S_TAB_ROUND, Rabat_header;
  5. //Cursor
  6. //  cena;
  7.  
  8. cursor  mail_seznam;
  9.  
  10. var
  11.    w_storno_objid, n_id_obj:integer;
  12.    rabat,cen_slev,cen_slev_so,prabat: real;
  13.    w_sklad,nic,storno,rp:Boolean;
  14.    storno_info:string[250];
  15.    cis_obj,W_cis_obj:string[35];
  16.    scen_slev, scen_slev_so, ww_castka:string[20]; 
  17.    w_drab, w_narok:Boolean;
  18.    pomstr:string[200];
  19.    dcena:string[10];
  20.    W_round:string[20];
  21.   // W_dan:string[20];
  22.    W_jmeno,w_heslo:string[20];
  23.    W_dan:real;
  24.    W_objdan:real;
  25.    w_datum_d:string[20];
  26.    dph:real;
  27.    x:string[50];
  28.    w_cena, w_cenaDPH : real;
  29.    w_polozka, w_objednavka:integer;
  30.    psumobj:real;
  31. //   strcena:string[80];
  32.   popis: string[2000];
  33.  
  34. {$I I_wbinet}
  35.  
  36. procedure chybacgi(pomstr:string[200]); 
  37. /*********************************************************************/
  38.  begin
  39.    log_write(pomstr);
  40.  /*  if rp then  SetSTWError(pomstr)
  41.    else*/ SetUserError(pomstr);
  42.    Halt;
  43.  end;
  44.  
  45. procedure  nahrad_pismeno(pismenoS,pismenoN:string[2]);
  46. /*********************************************************************/
  47. var
  48.  wend: short;
  49.  
  50. begin
  51.  wend:=1;
  52. while wend<>0 do 
  53.  begin
  54.    wend:=strpos(pismenoS,popis);
  55.    if wend>0 then popis[wend]:=pismenoN;
  56.  end;
  57. end;
  58.  
  59. function zjistiKS(id_obj:integer):real;
  60. /*********************************************************************/
  61. var
  62.  pocet:integer;
  63.  podminka: string[254];
  64.  curs:cursor;
  65. begin
  66.  
  67.   psumobj:=0;
  68.   podminka:= "SELECT Obj_polozky.id_dobj,SUM(Obj_polozky.mnozstvi) AS SUMA FROM Obj_polozky WHERE id_dobj="+int2str(id_obj)+"  GROUP BY `Obj_polozky`.id_dobj";
  69.   begin {otev°enφ prom∞nnΘho kurzoru curs}
  70.    if not Open_SQL_cursor(curs,podminka) then Rec_cnt(curs, pocet)  else chybacgi("Chyba  p°i b∞hu procedury zjistiKS");
  71.    if pocet>0 then
  72.      psumobj:=curs[0].SUMA  else  chybacgi("Chyba  p°i b∞hu procedury zjistiKS");
  73.      close_cursor(curs);
  74.   end;
  75.   zjistiKS:=psumobj;
  76.  end;
  77.  
  78. function zjistiKG(id_obj:integer):real;
  79. /*********************************************************************/
  80. var
  81.  pocet:integer;
  82.  podminka: string[254];
  83.  curs:cursor;
  84. begin
  85.  
  86.   psumobj:=0;
  87.   podminka:= "SELECT SUM(Obj_polozky.mnozstvi*cenik.hmotnost) AS SUMA FROM Obj_polozky, Cenik WHERE (OBJ_POLOZKY.id_cnk=Cenik.id_cenik ) AND id_dobj="+int2str(id_obj);
  88.   begin 
  89.    if not Open_SQL_cursor(curs,podminka) then Rec_cnt(curs, pocet)  else  chybacgi("Chyba p°i b∞hu procedury zjistiKG");
  90.    if pocet>0 then
  91.      psumobj:=curs[0].SUMA  else  chybacgi("Chyba p°i b∞hu procedury zjistiKG");
  92.      close_cursor(curs);
  93.   end;
  94.   zjistiKG:=psumobj;
  95.  end;
  96.  
  97.  
  98. procedure postovne(id_obj:integer);
  99. /*********************************************************************/
  100. var
  101.  u:untyped;
  102.  irec, objrec, drec:trecnum;
  103.  round_koef, dkoef:real;
  104.  stare_postovne, max_postovne, pom_cena1, pom_cena2, postovne, vaha : money;
  105.  
  106. begin
  107.   u:=id_obj;
  108.   objrec:=Look_up(OBJ_HEADER, "id_dobj", u);
  109.   pom_cena1:=obj_header[objrec].sum_cena;
  110.   postovne:=0;
  111.   max_postovne:=5000;
  112.   vaha:=zjistiKG(id_obj);
  113.   u:=obj_header[objrec].doprav;
  114.   obj_header[objrec].sumvaha:=vaha;
  115.   drec:=Look_up(S_DOPRAVA, "kod", u);
  116.   if drec>-1 then
  117.    begin
  118.      max_postovne:=S_doprava[drec].max_do ;
  119.       case S_doprava[drec].metoda of
  120.       1:      
  121.        begin
  122.          dkoef:=S_doprava[drec].dindex;
  123.          postovne:=pom_cena1*dkoef; 
  124.          if postovne>max_postovne then postovne:= max_postovne;
  125.        end;
  126.       2:      
  127.        begin
  128.          dkoef:=S_doprava[drec].castka;
  129.          pom_cena1:=zjistiKS(id_obj);
  130.          postovne:=pom_cena1*dkoef; 
  131.          if postovne>max_postovne then postovne:= max_postovne;
  132.        end;
  133.       3:      
  134.        begin
  135.          dkoef:=S_doprava[drec].castka;
  136.          postovne:=vaha*dkoef; 
  137.          if postovne>max_postovne then postovne:= max_postovne;
  138.        end;
  139.        4: postovne:=S_doprava[drec].castka;
  140.        else: postovne:=0;
  141.      end;   //case
  142.      end
  143.     else chybacgi(" p°i b∞hu procedury nenalezen kod dopravy postovne");
  144.  
  145.   u:=SYS_PAR[0].ROUND_POL;
  146.   irec := Look_up(S_TAB_ROUND,"id_round",u);
  147.   round_koef:=S_TAB_ROUND[irec].koef;
  148.   stare_postovne:=obj_header[objrec].postovne;
  149.     if round_koef>0 then obj_header[objrec].postovne:= (round(postovne/round_koef))*round_koef
  150.     else obj_header[objrec].postovne:= postovne;
  151.   obj_header[objrec].sum_obj:=obj_header[objrec].sum_obj-stare_postovne+obj_header[objrec].postovne;
  152. end;
  153.  
  154.  
  155. function vytvor_cis_obj(id:integer): string[50]; 
  156. /*********************************************************************/
  157. var
  158.  pom_cisobj, pom_c, pom_c2: string[50];
  159.  cislo:integer;
  160.  
  161.  begin
  162. /*   cislo:=day(today);
  163.    if cislo<10 then pom_c:="0"+int2str(cislo) else pom_c:=int2str(cislo);
  164. */
  165.    cislo:=month(today);
  166.    if cislo<10 then pom_c:=pom_c+"0"+int2str(cislo) else pom_c:=pom_c+int2str(cislo);
  167.    pom_cisobj:=pom_c;
  168.    cislo:=year(today);
  169.    pom_c:=int2str(cislo);
  170.    if cislo>99 then pom_c2:=strcopy(pom_c, strlength(pom_c)-1,2)  else  pom_c2:=int2str(cislo);
  171.    pom_cisobj:=pom_cisobj+pom_c2+int2str(id);
  172.    vytvor_cis_obj:=pom_cisobj;
  173.  end;
  174.  
  175.  
  176. function zjisti_deal_cenu(id_obj:integer; irec:trecnum): money; 
  177. /*********************************************************************/
  178. var
  179.  jrec:trecnum;
  180.  u:untyped;
  181.  deal_sk:integer;
  182.  
  183.  begin
  184.  
  185.    u:=id_obj;
  186.    jrec := Look_up(Obj_header,"id_dobj",u);
  187.    if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury zjisti_deal_cenu - nenalezena objednavka"); 
  188.    if Obj_header[jrec].id_org=-1 then  zjisti_deal_cenu:=cenik[irec].min_cena    else
  189.     begin
  190.       u:=Obj_header[jrec].id_org;
  191.       jrec := Look_up(Obchodni_partneri,"id",u);
  192.       if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury zjisti_deal_cenu - nenalezen obchodni partner"); 
  193.       deal_sk:= Obchodni_partneri[jrec].deal_sk;
  194.  
  195.  case deal_sk of
  196.       1    :  zjisti_deal_cenu:=cenik[irec].cena1;
  197.       2    :  zjisti_deal_cenu:=cenik[irec].cena2;
  198.       3    :  zjisti_deal_cenu:=cenik[irec].cena3;
  199.       4    :  zjisti_deal_cenu:=cenik[irec].cena4;
  200.       5    :  zjisti_deal_cenu:=cenik[irec].cena5;
  201.       6    :  zjisti_deal_cenu:=cenik[irec].cena6;
  202.       7    :  zjisti_deal_cenu:=cenik[irec].cena7;
  203.       8    :  zjisti_deal_cenu:=cenik[irec].cena8;
  204.       9    :  zjisti_deal_cenu:=cenik[irec].cena9;
  205.      else  :  zjisti_deal_cenu:=cenik[irec].min_cena;
  206.   end;      
  207.     end;
  208.  
  209.  end;
  210.  
  211. procedure dealcenaobj(id_obj:integer); 
  212. /*********************************************************************/
  213. var
  214.  jrec:trecnum;
  215.  u:untyped;
  216.  deal_sk:integer;
  217.  
  218.  begin
  219.   u:=id_obj;
  220.   jrec := Look_up(Obj_header,"id_dobj",u);
  221.   if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury dealcenaobj - nenalezena objednavka"); 
  222.   if Obj_header[jrec].id_org=-1 then  dcena:="min_cena"
  223.   else
  224.    begin
  225.     u:=Obj_header[jrec].id_org;
  226.     jrec := Look_up(Obchodni_partneri,"id",u);
  227.     if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury dealcenaobj - nenalezen obchodni partner"); 
  228.     deal_sk:= Obchodni_partneri[jrec].deal_sk;
  229.     if ((deal_sk>0) AND (deal_sk<10)) then dcena:="cena"+int2str(deal_sk) else  dcena:="min_cena";
  230.    end
  231.  end;
  232.  
  233. procedure w_doprava(zpusob:string[65];id_obj:integer);
  234. /*********************************************************************/
  235. var
  236.  irec:trecnum;
  237.  u:untyped;
  238.  numpol:integer;
  239.  podminka:string[200];
  240.  curs:cursor;
  241.  kod:string[8];
  242.  
  243. begin
  244.    u:=zpusob;
  245.    irec := Look_up(S_DOPRAVA,"zpusob",u);
  246.    if irec<>-1 then   kod:=S_DOPRAVA[irec].kod
  247.    else  chybacgi(" Chyba  p°i b∞hu procedury  w_doprava- nenalezen zp∙sob dopravy"); 
  248.    u:=id_obj;
  249.    irec := Look_up(OBJ_HEADER,"id_dobj",u);
  250.    if irec<>-1 then   OBJ_HEADER[irec].doprav:=kod
  251.    else  chybacgi(" Chyba  p°i b∞hu procedury w_doprava - nenalezena objednßvka"); 
  252. end;
  253.  
  254. procedure w_cis(id_obj:integer);
  255. /*********************************************************************/
  256. var
  257.  irec:trecnum;
  258.  u:untyped;
  259.  numpol:integer;
  260.  podminka:string[200];
  261.  curs:cursor;
  262.  
  263. begin
  264.      n_id_obj:=id_obj;
  265.      u:=id_obj;
  266.      irec := Look_up(OBJ_HEADER,"id_dobj",u);
  267.      if irec<>-1 then 
  268.      cis_obj:= OBJ_HEADER[irec].cis_eob;
  269.      if cis_obj="" then cis_obj:="nebylo zadano " ;
  270. end;
  271.  
  272. procedure posl_obj(id_obj,id_org:integer);
  273. /*********************************************************************/
  274. var
  275.  irec:trecnum;
  276.  u:untyped;
  277.  numpol:integer;
  278.  podminka:string[200];
  279.  curs:cursor;
  280.  pomint : integer;
  281.  
  282. begin
  283.  podminka:="(id_org="+int2str(id_org)+") AND (id_dobj<>"+int2str(id_obj)+") AND (potvrzena=TRUE)";
  284.  if not Open_sql_parts(curs, "Max(Obj_header.id_dobj) AS M", "OBJ_HEADER", podminka, "") then 
  285.  begin
  286.    Rec_cnt(curs,numpol);
  287.    if numpol=1 then 
  288.      begin
  289.        pomint := curs[0].M;
  290.        if pomint = noneinteger then 
  291.           irec := -1
  292.        else  begin
  293.           u:= pomint;
  294.           irec := Look_up(OBJ_HEADER,"id_dobj",u);
  295.        end;   
  296.        
  297.        if irec<>-1 then begin
  298.          cis_obj:= OBJ_HEADER[irec].cis_eob;
  299.        end else  
  300.           cis_obj:="nebylo zadßno " ;
  301.        close_cursor(curs);  
  302.      end;  
  303.   end;   
  304. end;
  305.  
  306. procedure w_posl_obj(id_obj:integer);
  307. /*********************************************************************/
  308. var
  309.  irec:trecnum;
  310.  u:untyped;
  311.  id_org:integer;
  312.  
  313. begin
  314.   u:=id_obj;
  315.   irec := Look_up(OBJ_HEADER,"id_dobj",u);
  316.   if irec<>-1 then 
  317.   begin
  318.     id_org:= OBJ_HEADER[irec].id_org;
  319.     if id_org<>-1 then  
  320.       posl_obj(id_obj,id_org)
  321.     else 
  322.       cis_obj:="1.objednßvka";
  323.   end
  324.   else
  325.     cis_obj:=" neexistujφcφ objednßvka";
  326. end;
  327.  
  328. function metoda_mn(metoda:integer; mnozstvi:real):real;
  329. /*********************************************************************/
  330. var 
  331.  podminka: string[120];
  332.  curs:cursor;
  333.  pocet,i:integer;
  334.  pom_mn:real;
  335.  
  336. begin //0
  337.  rabat:=0;
  338.  podminka:="metoda="+int2str(metoda);
  339.  if Open_sql_parts(curs, "*", "rabat", podminka, "nad_mnoz") then chybacgi(" chyba  p°i b∞hu procedury   metoda_mn - nenalezena tabulka rabat∙")
  340.  else
  341.    begin  //1
  342.      Rec_cnt(curs,pocet);
  343.      if pocet>0 then
  344.       for i:=0 to pocet-1 do
  345.         begin //2
  346.           pom_mn:=curs[i].nad_mnoz;
  347.           if (mnozstvi>pom_mn) then  rabat:=curs[i].proc;
  348.         end;  //2
  349.       metoda_mn:=rabat;
  350.       close_cursor(curs);
  351.    end;  //1
  352. end;  //0
  353.  
  354.  procedure Zjisti_rabat_tab(id_cnk:integer;mnozstvi:real);
  355. /*********************************************************************/
  356. var
  357.  irec:trecnum;
  358.  u:untyped;
  359.  mujrabat:integer;
  360.  
  361. Begin   //0
  362.    u := id_cnk;
  363.    irec := Look_up(cenik,"id_cenik",u);
  364.    if irec=-1 then   chybacgi("chyba  p°i b∞hu procedury Zjisti_rabat_tab - nenalezena polo₧ka cenφku"); 
  365.    mujrabat:=cenik[irec].rabat;
  366.    if (mujrabat=NONEINTEGER)  then 
  367.     begin  //2
  368.       u := cenik[irec].skupina_zbozi;
  369.       irec := Look_up(S_zbozi_sk,"id_skupiny",u);
  370.       if irec=-1 then chybacgi("chyba  p°i b∞hu procedury Zjisti_rabat_tab - nenalezena skupina")
  371.       else mujrabat:=S_zbozi_sk[irec].rabat;
  372.       if (mujrabat<>NONEINTEGER)  then 
  373.         begin //3
  374.          u := mujrabat;
  375.          irec := Look_up(Rabat_header,"metoda",u);
  376.          if irec=-1 then mujrabat:=0;
  377.         end   //3
  378.       else mujrabat:=0;  
  379.     end;    //2
  380.       // info_box("upozorn∞nφ","chyba  p°i b∞hu procedury  - nenalezena tabulka rabat∙") 
  381.    if mujrabat=0 then prabat:=1.0
  382.    else prabat:=metoda_mn(mujrabat,mnozstvi);
  383. end;  //0
  384.  
  385. function w_prepocet_mn(id_obj,id_pol:integer;drab:Boolean):money;
  386. /*********************************************************************/
  387. var
  388.  numpol,idc:integer;
  389.  podminka: string[120];
  390.  pom_cena1,cena_vl:money;
  391.  round_koef,mn:real;
  392.  curs:cursor;
  393.  u:untyped;
  394.  irec:trecnum;
  395.  
  396. begin  //0
  397.  podminka:="(id_dobj="+int2str(id_obj)+") AND (id_pol="+int2str(id_pol)+")";
  398.  if Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury  w_prepocet_mn - nenalezena ₧ßdnß polo₧ka objednßvky")
  399.  else 
  400.   begin  //1
  401.     Rec_cnt(curs,numpol);
  402.     if numpol=1 then 
  403.       begin //2
  404.        cena_vl:=curs[0].cena_sum;
  405.        mn:=curs[0].mnozstvi;
  406.        idc:=curs[0].id_cnk;
  407.        Zjisti_rabat_tab(idc,mn);
  408.        if ((drab) AND (prabat<>0)) then
  409.         begin //3
  410.          curs[0].cena_summn:=cena_vl*mn*prabat;
  411.         end  //3
  412.       else
  413.          curs[0].cena_summn:=cena_vl*mn;
  414.       end;  //2
  415.       u:=SYS_PAR[0].ROUND_POL;
  416.       irec := Look_up(S_TAB_ROUND,"id_round",u);
  417.       round_koef:=S_TAB_ROUND[irec].koef;
  418.       pom_cena1:=curs[0].cena_summn;
  419.       if round_koef>0 then curs[0].cena_summn:= (round(pom_cena1/round_koef))*round_koef
  420.       else curs[0].cena_summn:= pom_cena1;
  421.       w_prepocet_mn:=curs[0].cena_summn;
  422.       close_cursor(curs);
  423.    end; //1
  424. end;  //0
  425.  
  426.  
  427.  procedure  zjisti_slevu(cena_celkem:money);   
  428.  /*********************************************************************/
  429. var 
  430.  curs:cursor;
  431.  pocet,i:integer;
  432.  pom_mn:real;
  433.  delka:short;
  434.  
  435. begin  //0
  436.  cen_slev:=1.0;
  437.  scen_slev:="1.0";
  438.  if Open_sql_parts(curs, "*", "Cen_slevy", "", "nad_mnoz") then chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezena tabulka objemov²ch slev")
  439.  else
  440.    begin  //1
  441.      Rec_cnt(curs,pocet);
  442.      if pocet>0 then
  443.        begin   //2
  444.          for i:=0 to pocet-1 do
  445.            begin //3
  446.              pom_mn:=curs[i].nad_mnoz;
  447.              if (cena_celkem>pom_mn) then  cen_slev:=curs[i].proc;
  448.            end;  //3
  449.         scen_slev:=real2str(cen_slev,-5);
  450.         delka:=strlength(scen_slev);
  451.         for i:=0 to delka-1 do
  452.          if( scen_slev[i]==',' ) then
  453.           scen_slev[i]:='.';
  454.        end     //2
  455.      else w_narok:=false;
  456.      close_cursor(curs);
  457.   end; //1
  458. end;  //0
  459.  
  460.  function zjisti_DPH(id_obj:integer; cen_slev:real):real;
  461.  /*********************************************************************/
  462. var
  463.  u:untyped;
  464.  curs,curs2:cursor;
  465.  pocet1, pocet2, pocet, i, j, rok:integer;
  466.  irec:trecnum;
  467.  podminka: string[120];
  468.  sum_dan, pomdph:real;
  469.  pom_cena:money;
  470.  pomsumdph: array[1..6] of real;
  471.  pomdphsk:array[1..6] of real;
  472.  
  473. begin//0
  474.   sum_dan:=0;
  475.   for i:=0 to 6 do pomdphsk[i]:=0.0; 
  476.   for i:=0 to 6 do pomsumdph[i]:=0.0; 
  477.   rok:=year(today);
  478.   podminka:=" uc_rok="+ int2str(rok);
  479.   if Open_sql_parts(curs2, "procento", "S_DPH", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezeno DPH pro letoÜnφ rok")
  480.    else 
  481.      begin //1
  482.        Rec_cnt(curs2,pocet1);
  483.        if ((pocet1>0) AND (pocet1<7)) then 
  484.          for i:=0 to pocet1-1 do pomdphsk[i]:=curs2[i].procento; 
  485.        close_cursor(curs2);
  486.      end;  //1
  487.   pocet2:=0;
  488.   pomdph:=0;
  489.   podminka:="id_dobj="+int2str(id_obj);
  490.   if Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezena ₧ßdnß polo₧ka objednßvky")
  491.   else
  492.     begin //1
  493.       Rec_cnt(curs,pocet);
  494.       if pocet>0 then 
  495.         for i:=0 to pocet-1 do
  496.           begin //2
  497.             pom_cena:=curs[i].cena_summn;
  498.             u:=curs[i].id_cnk;
  499.             irec := Look_up(Cenik,"id_cenik",u);
  500.             if  irec<>-1  then
  501.               begin //3
  502.  //               rok:=year(today);
  503.                 podminka:="id_dph="+int2str(Cenik[irec].dph)+" AND uc_rok="+ int2str(rok);
  504.                 if Open_sql_parts(curs2, "*", "S_DPH", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezeno DPH pro letoÜnφ rok")
  505.                  else 
  506.                    begin //4
  507.                      Rec_cnt(curs2,pocet2);
  508.                      if pocet2>0 then pomdph:=curs2[0].procento
  509.                      else
  510.                        begin //5
  511.                          close_cursor(curs2);
  512.                          podminka:="id_dph="+int2str(default_hodnoty[0].dph)+" AND uc_rok="+ int2str(rok);
  513.                          if Open_sql_parts(curs2, "*", "S_DPH", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezeno defaultnφ DPH pro letoÜnφ rok")
  514.                           else 
  515.                            begin //6
  516.                              Rec_cnt(curs,pocet2);
  517.                              if pocet2>0 then pomdph:=curs2[0].procento else pomdph:=0;
  518.                            end;  //6
  519.                        end;  //5
  520.                      close_cursor(curs2);
  521.                    end;  //4
  522.              end //3
  523.        else chybacgi(" chyba  p°i b∞hu procedury zjisti_slevu - nenalezena polo₧ka cenφku");
  524. //  poldph:=(ROUND((poldph+0.04)*10.0))/10.0;
  525.        for j:=0 to pocet1-1 do begin  if pomdph=pomdphsk[j] then pomsumdph[j]:=pomsumdph[j]+pom_cena*(pomdph/100.0); end;
  526.      end; //2
  527.      close_cursor(curs);
  528.      for j:=0 to pocet1-1 do
  529.        begin
  530.         if pomsumdph[j]>0 then sum_dan:=sum_dan+(ROUND(( (cen_slev*pomsumdph[j])+0.04)*10.0))/10.0;
  531.        end;
  532.      zjisti_DPH:= sum_dan;
  533.    end;  //1
  534.  end;//0
  535.  
  536.  
  537.  
  538. procedure uhrada(id_obj:integer);
  539. /*********************************************************************/
  540. var
  541.  u: untyped;
  542.  pocet, i: integer;
  543.  podminka: string[254];
  544.  cdetail, curs, cursOS:cursor;
  545.  sumdph, dan, scena, postdph, poldph, postovne, objsleva, cenabezdph, pom_mn, round_koef: real;
  546.  objrec, drec, jrec, irec: trecnum;
  547.  narok:Boolean;
  548.  
  549. begin
  550.   cen_slev:=1.0;
  551.   psumobj:=0;
  552.   u:=id_obj;
  553.   objrec:=Look_up(OBJ_HEADER, "id_dobj", u);
  554.   postovne:= obj_header[objrec].postovne;
  555.   u:=obj_header[objrec].doprav;
  556.   drec:=Look_up(S_DOPRAVA, "kod", u);
  557.   if drec>-1 then postdph:=S_DOPRAVA[drec].dph_dopr else postdph:=0;
  558.   cenabezdph:=obj_header[objrec].sum_cena;
  559.   //zjiÜt∞nφ nßrok∙ na slevy
  560.   if Obj_header[objrec].id_org<>-1 then
  561.      begin   //1
  562.        u:=Obj_header[objrec].id_org;
  563.        jrec := Look_up(Obchodni_partneri,"id",u);
  564.        if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury uhrada - nenalezen obchodnφ partner - prepocet H"); 
  565.      
  566.        u:=Obchodni_partneri[jrec].deal_sk;
  567.        jrec := Look_up(S_deal_sk,"deal_id",u);
  568.        if jrec=-1 then chybacgi(" chyba  p°i b∞hu procedury uhrada - nenalezena dealerskß skupina"); 
  569.        narok:=S_deal_sk[jrec].obj_rab;
  570.      end    //1
  571.   else   narok:=sys_par[0].NZ_objrab;
  572.   if narok then zjisti_slevu(cenabezdph);
  573.   poldph:=zjisti_dph(id_obj,cen_slev);
  574. //  poldph:=poldph*cen_slev;
  575.   obj_header[objrec].DPH_ZBOZ:=poldph;
  576. //  poldph:=poldph+postovne*(postdph/100.0); 
  577. //  poldph:=(ROUND((poldph+0.04)*10.0))/10.0;
  578.   obj_header[objrec].DPH_POST:=(ROUND((postovne*(postdph/100.0)+0.04)*10.0))/10.0;
  579.   obj_header[objrec].DPH_SUM:=obj_header[objrec].DPH_ZBOZ+obj_header[objrec].DPH_POST;
  580. //  poldph;
  581. //  cen_slev_so:=cen_slev;
  582.   postovne:= postovne * (1.0+postdph/100.0);
  583.   scena:=obj_header[objrec].sum_obj+obj_header[objrec].DPH_SUM;
  584.   u:=SYS_PAR[0].ROUND_SUM;
  585.   irec := Look_up(S_TAB_ROUND,"id_round",u);
  586.   round_koef:=S_TAB_ROUND[irec].koef;
  587.     if round_koef>0 then obj_header[objrec].k_uhrade:=(round(scena/round_koef))*round_koef
  588.     else obj_header[objrec].k_uhrade:=scena;
  589.   obj_header[objrec].Z_ROZDIL:=obj_header[objrec].k_uhrade-scena;
  590.  // obj_header[objrec].sum_obj:=obj_header[objrec].k_uhrade-poldph;
  591.  end;
  592.  
  593.  
  594.  
  595. procedure zjisti_postovne(id_obj:integer);
  596. /*********************************************************************/
  597. begin
  598.    postovne(id_obj);
  599.    uhrada(id_obj);
  600. end;
  601.  
  602. Procedure w_prepocet(id_obj:integer);
  603. /*********************************************************************/
  604. var
  605.  irecobj,jrec:trecnum;
  606.  u:untyped;
  607.  pocet, numpol, i, id_pol: integer;
  608.  podminka: string[120];
  609.  drab, narok:Boolean;
  610.  cena_celkem, pom_cena:money;
  611.  curs:cursor;
  612.  pom_cena1:money;
  613.  objdan, objcena, dan, round_koef:real;
  614.  irec:trecnum;
  615.  
  616. begin   //0
  617.  if id_obj>-1 then
  618.   begin  //1
  619.         u:=id_obj;
  620.         cena_celkem:=0;
  621.          irecobj := Look_up(Obj_header,"id_dobj",u);
  622.         if  irecobj=-1  then chybacgi(" chyba  p°i b∞hu procedury w_prepocet - nenalezena objednßvka"); 
  623.        // datum dodßnφ nesmφ b²t menÜφ ne₧ datum vystavenφ objednßvky
  624.         if obj_header[irecobj].datum_d<=obj_header[irecobj].datum then obj_header[irecobj].datum_d:=obj_header[irecobj].datum+sys_par[0].dodani;
  625.         //zjiÜt∞nφ nßrok∙ na slevy
  626.         if Obj_header[irecobj].id_org<>-1 then
  627.            begin   //2
  628.              u:=Obj_header[ irecobj].id_org;
  629.              jrec := Look_up(Obchodni_partneri,"id",u);
  630.              if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury w_prepocet - nenalezen obchodnφ partner - prepocet H"); 
  631.            
  632.              u:=Obchodni_partneri[jrec].deal_sk;
  633.              jrec := Look_up(S_deal_sk,"deal_id",u);
  634.              if jrec=-1 then chybacgi(" chyba  p°i b∞hu procedury w_prepocet - nenalezena dealerskß skupina"); 
  635.            
  636.              drab:=S_deal_sk[jrec].mn_rab;
  637.              narok:=S_deal_sk[jrec].obj_rab;
  638.            end    //2
  639.         else 
  640.          begin     //2
  641.           drab:=sys_par[0].NZ_mnrab;
  642.           narok:=sys_par[0].NZ_objrab;
  643.          end;     //2
  644.          
  645.         w_narok:=narok;
  646.         w_drab:=drab;
  647.       
  648.         podminka:="id_dobj="+int2str(id_obj);
  649.         if Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then  chybacgi(" chyba  p°i b∞hu procedury w_prepocet - nenalezena ₧ßdnß polo₧ka objednßvky")
  650.         else 
  651.           begin  //2
  652.             Rec_cnt(curs,pocet);
  653.             if pocet>0 then 
  654.             for i:=0 to pocet-1 do
  655.               begin   //3
  656.                 id_pol:=curs[i].id_pol;
  657.                 pom_cena:=w_prepocet_mn(id_obj,id_pol,drab);  
  658.                 cena_celkem:=cena_celkem+pom_cena;
  659.               end;    //3
  660.            close_cursor(curs);
  661.            end;    //2
  662.       
  663.         Obj_header[irecobj].sum_cena:=cena_celkem;
  664.         if narok then
  665.          begin      //4
  666.            zjisti_slevu(cena_celkem);   
  667.            Obj_header[irecobj].sum_obj:=cena_celkem*cen_slev;
  668.            obj_header[irecobj].postovne:=0.0;
  669.            Obj_header[irecobj].ob_sleva:=cena_celkem*(1-cen_slev);
  670.          end        //4
  671.         else
  672.          begin      //5
  673.           cen_slev:=1.0;
  674.           scen_slev:="1.0";
  675.           Obj_header[irecobj].sum_obj:=cena_celkem;
  676.           obj_header[irecobj].postovne:=0.0;
  677.           Obj_header[irecobj].ob_sleva:=0.0;
  678.          end;       //5
  679.       
  680.          u:=SYS_PAR[0].ROUND_POL;
  681.          irec := Look_up(S_TAB_ROUND,"id_round",u);
  682.          round_koef:=S_TAB_ROUND[irec].koef;
  683.          pom_cena1:=Obj_header[irecobj].sum_cena;
  684.          if  (round_koef<>0) then    Obj_header[irecobj].sum_cena:= (round(pom_cena1/round_koef))*round_koef
  685.          else Obj_header[irecobj].sum_cena:= pom_cena1;
  686.          pom_cena1:=Obj_header[irecobj].ob_sleva;
  687.          if  (round_koef<>0) then    Obj_header[irecobj].ob_sleva:= (round(pom_cena1/round_koef))*round_koef
  688.          else Obj_header[irecobj].ob_sleva:= pom_cena1;
  689.          pom_cena1:=Obj_header[irecobj].sum_obj;
  690.          if  (round_koef<>0) then    Obj_header[irecobj].sum_obj:= (round(pom_cena1/round_koef))*round_koef
  691.          else Obj_header[irecobj].sum_obj:= pom_cena1;
  692.       
  693.          dan:=zjisti_DPH(id_obj,cen_slev);
  694. //         dan:=dan*cen_slev;
  695. //         dan:=(round((dan+0.04)*10.0))/10;
  696.          u:=SYS_PAR[0].ROUND_SUM;
  697.          irec := Look_up(S_TAB_ROUND,"id_round",u);
  698.          round_koef:=S_TAB_ROUND[irec].koef;
  699.          if narok then   objcena:= Obj_header[irecobj].sum_obj
  700.                    else  objcena:= Obj_header[irecobj].sum_cena;
  701.          objdan:= Objcena+dan; 
  702.        // datum dodßnφ nesmφ b²t menÜφ ne₧ datum vystavenφ objednßvky
  703.         if obj_header[irecobj].datum_d<=obj_header[irecobj].datum then 
  704.         begin //6
  705.         obj_header[irecobj].datum_d:=obj_header[irecobj].datum+sys_par[0].dodani;
  706.         w_datum_d:=date2str(obj_header[irecobj].datum_d,1);
  707.         end;   //6
  708.       
  709.           if round_koef>0 then obj_header[irecobj].k_uhrade:=(round(objdan/round_koef))*round_koef
  710.           else obj_header[irecobj].k_uhrade:=objdan;
  711.         obj_header[irecobj].DPH_ZBOZ:=dan;
  712.         w_cenaDPH:=obj_header[irecobj].k_uhrade;
  713.         w_cena:=objcena;
  714.   end;   //1
  715. end;  //0
  716.  
  717.  
  718. function nova_obj_h(jmeno,heslo:string[80]):integer;
  719. /*********************************************************************/
  720. var
  721.  irec,jrec:trecnum;
  722.  podminka: string[120];
  723.  u:untyped;
  724.  curs:cursor;
  725.  pocet:integer;
  726.  logname:string[80];
  727.  usernum:tobjnum;
  728.  homesrv : binary[12];
  729.  
  730.  
  731. begin 
  732.  logname:="ANONYMOUS";
  733.  irec:=Insert(obj_header);
  734.  if irec=-1 then  chybacgi("Nelze vlo₧it nov² zßznam do tabulky obj_header. Zkontrolujte prßva a obsazenφ do roli v aplikaci."); 
  735.  obj_header[irec].id_dobj:=sys_par[0].id_last_r+1;
  736.  nova_obj_h:=sys_par[0].id_last_r+1;
  737.  obj_header[irec].datum:=today; 
  738.  obj_header[irec].cis_eob:=vytvor_cis_obj(sys_par[0].id_last_r+1);
  739.  obj_header[irec].datum_d:=today+sys_par[0].dodani; 
  740.  podminka:="(intr_user="+""""+jmeno+""""+")  AND  (intr_pswd="+""""+heslo+""""+")";
  741.  if not Open_sql_parts(curs, "id, id_obchodnika, ico", "obchodni_partneri", podminka, "") then
  742.    begin   //1
  743.      Rec_cnt(curs,pocet);
  744.      if pocet>0 then 
  745.       begin   //2
  746.        obj_header[irec].id_org:=curs[0].id;
  747.        obj_header[irec].ico:=curs[0].ico;
  748.        obj_header[irec].obchodnik:=curs[0].id_obchodnika;
  749.        u:=curs[0].id_obchodnika;
  750.        jrec := Look_up(obchodnici,"id_obchodnika",u);
  751.        if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury nova_obj_h - nenalezen obchodnφk")
  752.        else logname:=obchodnici[jrec].logname;
  753.      end     //2
  754.     
  755.      else 
  756.       begin    //2
  757.        obj_header[irec].id_org:=-1;
  758.        obj_header[irec].obchodnik:=default_hodnoty[0].obchodnik;
  759.        u:=default_hodnoty[0].obchodnik;
  760.        jrec := Look_up(obchodnici,"id_obchodnika",u);
  761.        if jrec=-1 then    chybacgi(" chyba  p°i b∞hu procedury nova_obj_h - nenalezen default obchodnφk")
  762.        else logname:=obchodnici[jrec].logname;
  763.       end;    //2
  764.     close_cursor(curs);
  765.    end   //1
  766.  else  
  767.    begin  //1
  768.       obj_header[irec].id_org:=-1;
  769.       obj_header[irec].obchodnik:=default_hodnoty[0].obchodnik;
  770.       u:=default_hodnoty[0].obchodnik;
  771.       jrec := Look_up(obchodnici,"id_obchodnika",u);
  772.       if jrec=-1 then  chybacgi(" chyba  p°i b∞hu procedury nova_obj_h - nenalezen default obchodnφk")
  773.       else   logname:=obchodnici[jrec].logname;
  774.  
  775.    end;   //1
  776.  sys_par[0].id_last_r:=sys_par[0].id_last_r+1;
  777. end;
  778.  
  779.  procedure W_smaz_pol(id_obj, id_pol:integer);
  780. /*********************************************************************/
  781. var
  782.  cislo_tab : tobjnum;
  783.  irec:trecnum;
  784.  u:untyped;
  785.  pocet,limit:integer;
  786.  podminka: string[120];
  787.  curs:cursor;
  788.  
  789. begin
  790.    w_objednavka:=id_obj;
  791.    limit:=0;
  792.    podminka:="id_dobj="+int2str(id_obj)+" AND id_pol="+int2str(id_pol);
  793.    u := id_obj;
  794.    irec := Look_up(obj_header,"id_dobj",u);
  795.    if irec=-1 then   chybacgi(" chyba  p°i b∞hu procedury W_smaz_pol - nenalezena objednßvka"); 
  796.    if irec<>-1 then 
  797.      begin
  798.        if not Open_sql_parts(curs, "*", "obj_polozky", podminka, "") then 
  799.          begin
  800.            Delete_all_records(curs);
  801.            Close_cursor(curs);
  802.          end;  
  803.         podminka:="id_dobj="+int2str(id_obj);
  804.        if not Open_sql_parts(curs, "*", "obj_polozky", podminka, "") then 
  805.           begin
  806.             Rec_cnt(curs,pocet);
  807.             Close_cursor(curs);
  808.             if pocet=0 then 
  809.              begin
  810.               Delete(obj_header,irec);
  811.               w_objednavka:=-1;
  812.              end 
  813.             else w_prepocet(id_obj);
  814.           end;
  815.        
  816.      end;
  817. end;
  818.  
  819.  
  820. function max_pol(id_obj:integer):integer;
  821. /*********************************************************************/
  822. var
  823.  podminka: string[120];
  824.  curs:cursor;
  825.  pocet,pom_id,pom_id_pol,i:integer;
  826.  
  827. begin 
  828.   pom_id:=0;  
  829.   podminka:="id_dobj="+int2str(id_obj);
  830.   if not Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then Rec_cnt(curs,pocet);
  831. //  else   chybacgi(" chyba  p°i b∞hu procedury  - nenalezena ₧ßdnß polo₧ka objednßvky"); 
  832.   if pocet>0 then 
  833.     for i:=0 to pocet-1 do 
  834.       begin
  835.         pom_id_pol:=curs[i].id_pol;
  836.         if pom_id<pom_id_pol then  pom_id:=pom_id_pol;
  837.       end;
  838.   max_pol:=pom_id+1;
  839.   close_cursor(curs);
  840. end;  
  841.  
  842.  
  843.  
  844. procedure W_kopie_obj(id_objold,id_objnew:integer);
  845. /*********************************************************************/
  846. var
  847.  statement:string[1000];
  848.  pom_cisobj:string[50];
  849.  pom_str, pom_str2, pom_strd, pom_strdd:string[25];
  850.  jrec,irec,crec, novyrec:trecnum;
  851.  logname, podminka: string[120];
  852.  curs, staraobj:cursor;
  853.  pocet, pocetpol, i, j, ipolold : integer;
  854.  ipol : array[1..50] of integer;
  855.  u:untyped;
  856.  usernum:tobjnum;
  857.  homesrv : binary[12];
  858.  moje_cena:money;
  859.  
  860.  
  861. begin
  862. //hlaviΦka
  863.   rp:=FALSE;
  864.   u:=id_objold;
  865.   for i:=1 to 50 do ipol[i]:=0;
  866.   irec := Look_up(OBJ_HEADER,"id_dobj",u);
  867.   if irec<>-1 then 
  868.   begin
  869.   if id_objnew>=0 then
  870.     begin
  871.       n_id_obj:=id_objnew;
  872.     end
  873.  
  874.   else
  875.     begin
  876.       n_id_obj:=sys_par[0].id_last_r+1;
  877.       pom_cisobj:=vytvor_cis_obj(n_id_obj);
  878.       pom_str:=int2str(id_objold);
  879.       pom_str2:=int2str(n_id_obj);
  880.       pom_strd:=date2str(today,1);
  881.       pom_strdd:=date2str(today+sys_par[0].dodani,1);
  882.  
  883. /*      statement:="INSERT INTO obj_header(id_dobj,cis_eob, id_org, obchodnik,ico,datum, datum_d,doprav,sum_cena) SELECT "+pom_str2+",""" +pom_cisobj+""" ,id_org,obchodnik,ico,"+pom_strd +", "+pom_strdd +" ,doprav,sum_cena FROM  obj_header WHERE id_dobj="+pom_str;
  884.       if SQL_execute(statement) then chybacgi("Nelze vlo₧it nov² zßznam do tabulky obj_header (kopie objednßvky). Zkontrolujte prßva a obsazenφ do roli v aplikaci.");
  885.  */
  886.  // tady to nahrazuje SQL_execute(statement) / zaΦßtek
  887.       statement:="SELECT id_org,obchodnik,ico,doprav,sum_cena FROM  obj_header WHERE id_dobj="+pom_str;
  888.       if Open_SQL_cursor(staraobj,statement)  then chybacgi("Nelze otev°φt kursor do tab obj_header (kopie objednßvky). ")
  889.       else 
  890.        begin
  891.        Rec_cnt(staraobj, pocet);
  892.        if pocet>0 then
  893.         begin
  894.          novyrec:=Insert(OBJ_HEADER);
  895.           OBJ_HEADER[novyrec].id_dobj:=n_id_obj;
  896.           OBJ_HEADER[novyrec].cis_eob:=pom_cisobj;
  897.           OBJ_HEADER[novyrec].id_org:=staraobj[0].id_org;
  898.           OBJ_HEADER[novyrec].obchodnik:=staraobj[0].obchodnik;
  899.           OBJ_HEADER[novyrec].ico:=staraobj[0].ico;
  900.           OBJ_HEADER[novyrec].datum:=today;
  901.           OBJ_HEADER[novyrec].datum_d:=today+sys_par[0].dodani;
  902.           OBJ_HEADER[novyrec].doprav:=staraobj[0].doprav;
  903.           OBJ_HEADER[novyrec].sum_cena:=staraobj[0].sum_cena;
  904.          end;
  905.  // tady to nahrazuje SQL_execute(statement) / konec
  906.          close_cursor(staraobj);
  907.         end;
  908.       id_objnew:=n_id_obj;
  909.       sys_par[0].id_last_r:=sys_par[0].id_last_r+1;
  910.     end;
  911.  
  912.  
  913. //polo₧ky
  914.   podminka:="id_dobj="+int2str(id_objold);
  915.   if Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then chybacgi(" chyba  p°i b∞hu procedury  W_kopie_obj - nenalezena ₧ßdnß polo₧ka objednßvky")
  916.   else 
  917.     begin
  918.       Rec_cnt(curs,pocetpol);
  919.  
  920.       if pocetpol>0 then 
  921.        for i:=0 to pocetpol-1 do
  922.          begin
  923.             ipolold:=curs[i].id_pol;
  924.             u:=curs[i].id_cnk;
  925.             jrec := Look_up(cenik,"id_cenik",u);
  926.              if jrec<>-1 then 
  927.                begin
  928.                  irec:=Insert(obj_polozky);
  929.                  if irec=-1 then chybacgi("Nelze vlo₧it nov² zßznam do tabulky obj_polozky. Zkontrolujte prßva a obsazenφ do roli v aplikaci.");
  930.                    obj_polozky[irec].id_dobj:=n_id_obj;
  931.                    ipol[ipolold]:=max_pol(id_objnew);
  932.                    obj_polozky[irec].id_pol:=ipol[ipolold];
  933.                    obj_polozky[irec].id_cnk:=curs[i].id_cnk;
  934.                    obj_polozky[irec].mnozstvi:=trunc(curs[i].mnozstvi);
  935.   
  936.                    moje_cena:=zjisti_deal_cenu(n_id_obj, jrec); 
  937.                    obj_polozky[irec].cena_sum:=moje_cena;
  938.  
  939.                 //   obj_polozky[irec].cena_sum:=0;
  940.                    obj_polozky[irec].cena_summn:=0;
  941.                    obj_polozky[irec].nazev_vl:=curs[i].nazev_vl;
  942.                    obj_polozky[irec].hodnota_dph:=curs[i].hodnota_dph;
  943.                 end
  944.              else  ipol[ipolold]:=-1;
  945.  
  946.          end;
  947.      Close_cursor(curs);
  948.     end;
  949.  
  950.   podminka:="obj_header.id_dobj="+int2str(id_objold)+ " AND obj_header.id_org=obchodni_partneri.id";
  951.  if not Open_sql_parts(curs, "id, id_obchodnika", "obchodni_partneri, obj_header", podminka , "") then
  952.    begin
  953.      Rec_cnt(curs,pocet);
  954.      if pocet>0 then   u:=curs[0].id_obchodnika
  955.      else  u:=default_hodnoty[0].obchodnik;
  956.      close_cursor(curs);
  957.    end;
  958.  end
  959.  else  n_id_obj:=-1;
  960.  if n_id_obj>=0 then w_prepocet(n_id_obj) else 
  961.  begin
  962.   w_cena:=0.0;
  963.   w_cenaDPH:=0.0;
  964.  end;
  965. end;
  966.  
  967. Procedure W_postup(id_obj:integer);
  968. /*********************************************************************/
  969. var
  970.  irec,jrec:trecnum;
  971.  podminka: string[120];
  972.  u:untyped;
  973.  curs:cursor;
  974.  pocet:integer;
  975.  logname:string[80];
  976.  op:integer;
  977.  
  978. BEGIN    //0
  979.  logname:="ANONYMOUS";
  980.  u := id_obj;
  981.  irec := Look_up(obj_header,"id_dobj",u);
  982.  if irec=-1 then   chybacgi(" chyba  p°i b∞hu procedury W_postup - nenalezena objednßvka"); 
  983.  if irec<>-1 then 
  984.  begin  //01
  985.  op:=obj_header[irec].id_org;
  986.  podminka:="(obchodni_partneri.id ="+int2str(op)+" )";
  987.  if not Open_sql_parts(curs, "id, id_obchodnika", "obchodni_partneri", podminka, "") then
  988.    begin   //1
  989.      Rec_cnt(curs,pocet);
  990.      if pocet>0 then 
  991.       begin   //2
  992.        u:=curs[0].id_obchodnika;
  993.        jrec := Look_up(obchodnici,"id_obchodnika",u);
  994.        if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury W_postup - nenalezen obchodnφk") 
  995.               else logname:=obchodnici[jrec].logname;
  996.      end     //2
  997.     
  998.      else 
  999.       begin    //2
  1000.        u:=default_hodnoty[0].obchodnik;
  1001.        jrec := Look_up(obchodnici,"id_obchodnika",u);
  1002.        if jrec=-1 then    chybacgi(" chyba  p°i b∞hu procedury W_postup - nenalezen default obchodnφk")
  1003.        else logname:=obchodnici[jrec].logname;
  1004.       end;    //2
  1005.     close_cursor(curs);
  1006.    end   //1
  1007.  else  
  1008.    begin  //1
  1009.       u:=default_hodnoty[0].obchodnik;
  1010.       jrec := Look_up(obchodnici,"id_obchodnika",u);
  1011.       if jrec=-1 then chybacgi(" chyba  p°i b∞hu procedury W_postup - nenalezen default obchodnφk") 
  1012.       else logname:=obchodnici[jrec].logname;
  1013.    end;   //1
  1014. //  GetSet_next_user(obj_header, irec, 0, OPER_SET, VT_NAME,logname);
  1015.  end; //01
  1016. END; //0
  1017.  
  1018.  
  1019. procedure w_testdatum(dat:date;id_obj:integer);
  1020. /*********************************************************************/
  1021. var
  1022.  irec:trecnum;
  1023.  u:untyped;
  1024.  datOK:date;
  1025.  
  1026. begin
  1027.    if (dat>today+1) then datOK:=dat else datOK:= today+SYS_PAR[0].dodani; 
  1028.    if day_of_week(datOK)=0 then datOK:=datOK+1;
  1029.    if day_of_week(datOK)=6 then datOK:=datOK+2;
  1030.    u:=id_obj;
  1031.    irec := Look_up(OBJ_HEADER,"id_dobj",u);
  1032.    if irec<>-1 then  
  1033.     begin
  1034.       OBJ_HEADER[irec].datum_d:=datOK;
  1035. //      W_postup(id_obj);
  1036.     end
  1037.    else  chybacgi(" chyba p°i b∞hu procedury  w_testdatum - nenalezena objednßvka"); 
  1038.  
  1039.    
  1040. end;
  1041.  
  1042.  
  1043. Procedure W_storno_obj(id_obj:integer; inf: boolean);
  1044. /*********************************************************************/
  1045. var
  1046.  irec:trecnum;
  1047.  u:untyped;
  1048.  pom_dat, pom_datz, oldstorno_dat:date;
  1049.  storno_lze, oldstorno: Boolean;
  1050.  storno_dni:integer;
  1051.  cislo_obj:string[20];
  1052.  
  1053. begin     //0
  1054.    w_storno_objid := id_obj;
  1055.    u := id_obj;
  1056.    irec := Look_up(obj_header,"id_dobj",u);
  1057.    if irec=-1 then   chybacgi(" chyba  p°i b∞hu procedury W_storno_obj - nenalezena objednßvka"); 
  1058.    if irec<>-1 then 
  1059.      begin  //1
  1060.        cislo_obj:=obj_header[irec].cis_eob;
  1061.        pom_dat:=obj_header[irec].datum;
  1062.        oldstorno:=obj_header[irec].storno;
  1063.        oldstorno_dat:=obj_header[irec].storno_dat;
  1064.        storno_dni:=sys_par[0].enable_storno;
  1065.        storno_lze:=(today-pom_dat+1)<= storno_dni;
  1066.       if NOT (obj_header[irec].potvrzena) then
  1067.         begin  //3
  1068.            storno:=false;
  1069.            storno_info:="Objednßvka "+cislo_obj+" nebyla potvrzenß a nemß smysl ji stornovat";
  1070.         end    //3
  1071.       else
  1072.        begin   //3
  1073.        if oldstorno then
  1074.         begin   //4
  1075.            storno:=false;
  1076.            storno_info:="Objednßvku "+cislo_obj+" nelze stornovat - ji₧ byla stornovßna! " + date2str(oldstorno_dat,3);
  1077.         end     //4
  1078.        else 
  1079.         if  NOT (storno_lze) then 
  1080.           begin //nelze storno 4
  1081.             storno:=false;
  1082.             storno_info:="Objednßvku "+cislo_obj+" ji₧ nelze stornovat touto cestou, z d∙vodu p°ekroΦenφ lh∙ty pro stornovßnφ - spojte se s prodejcem.";
  1083.            pom_datz:=obj_header[irec].zpracovana;
  1084.            if pom_datz=NONEDATE then  
  1085.             begin     //5
  1086.              if not inf then obj_header[irec].potvrzena:=false; //nebyla-li zpracovßna stane se nepotvrzenou
  1087.              storno:=true;
  1088.              if not inf then storno_info:="VaÜe objednßvka "+cislo_obj+" byla oznaΦena jako nepotvrzenß a dodavatelem nebude p°ijata."
  1089.              else storno_info:="VaÜe objednßvka "+cislo_obj+" bude oznaΦena jako nepotvrzenß a dodavatelem nebude p°ijata.";
  1090.              if not inf then obj_header[irec].storno:=true;
  1091.              if not inf then obj_header[irec].storno_dat:=today;
  1092.             end;       //5
  1093.           end              //4
  1094.         else
  1095.           begin  // lze storno //4
  1096.            storno:=true;
  1097.            if not inf then storno_info:="VaÜe objednßvka "+cislo_obj+" byla stornovßna."
  1098.            else storno_info:="VaÜe objednßvka "+cislo_obj+" bude stornovßna.";
  1099.            if not inf then obj_header[irec].storno:=true;
  1100.            if not inf then obj_header[irec].storno_dat:=today;
  1101.            pom_datz:=obj_header[irec].zpracovana;
  1102.            if pom_datz=NONEDATE then  
  1103.             begin     //5
  1104.              if not inf then obj_header[irec].potvrzena:=false; //nebyla-li zpracovßna stane se nepotvrzenou
  1105.              storno:=true;
  1106.              if not inf then storno_info:="VaÜe objednßvka "+cislo_obj+" byla oznaΦena jako nepotvrzenß a dodavatelem nebude p°ijata."
  1107.              else storno_info:="VaÜe objednßvka "+cislo_obj+" bude oznaΦena jako nepotvrzenß a dodavatelem nebude p°ijata.";
  1108.             end;       //5
  1109.            if not inf then obj_header[irec].zpracovana:=NONEDATE;
  1110. //           if not inf then w_postup(id_obj);
  1111.           end;     //4
  1112.        end;      //3
  1113.   end;  //1
  1114. end;   //0
  1115.  
  1116. procedure zmen_cenu(id_obj, firma:integer);
  1117. /*********************************************************************/
  1118. var
  1119.  irec,jrec:trecnum;
  1120.  u:untyped;
  1121.  podminka: string[120];
  1122.  curs:cursor;
  1123.  pocet,i:integer;
  1124.  moje_cena:money;
  1125.  
  1126.  
  1127. begin 
  1128.   podminka:="id_dobj="+int2str(id_obj);
  1129.   if Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then chybacgi(" chyba  p°i b∞hu procedury  zmen_cenu - nenalezena ₧ßdnß polo₧ka objednßvky")
  1130.   else 
  1131.     begin
  1132.       Rec_cnt(curs,pocet);
  1133.       if pocet>0 then 
  1134.        for i:=0 to pocet-1 do
  1135.          begin
  1136.             u:=curs[i].id_cnk;
  1137.             jrec := Look_up(cenik,"id_cenik",u);
  1138.             if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury zmen_cenu - nenalezena polo₧ka cenφku") 
  1139.             else 
  1140.              begin 
  1141.               moje_cena:=zjisti_deal_cenu(id_obj, jrec); 
  1142.               curs[i].cena_sum:=moje_cena;
  1143.              end;
  1144.          end;
  1145.       close_cursor(curs);
  1146.     end;
  1147. end;
  1148.  
  1149.  
  1150.   
  1151. function Pridej_polozku(id_obj,id_cenik:integer;mn:real):boolean;
  1152. /*********************************************************************/
  1153. var
  1154.  irec,jrec:trecnum;
  1155.  u:untyped;
  1156.  podminka: string[120];
  1157.  curs:cursor;
  1158.  pocet,pom_id,i:integer;
  1159.  strnazev_vl: string[10000];
  1160.  moje_cena:money;
  1161.  
  1162.  
  1163. begin 
  1164.  strnazev_vl:="";
  1165.  irec:=Insert(obj_polozky);
  1166.  if irec <> -1 then begin
  1167.    obj_polozky[irec].id_dobj:=id_obj;
  1168.    i:=max_pol(id_obj);
  1169.    w_polozka:=i;
  1170.    obj_polozky[irec].id_pol:=i;
  1171.    obj_polozky[irec].id_cnk:=id_cenik;  /***/
  1172.    obj_polozky[irec].mnozstvi:=mn;
  1173.   
  1174.    u:=id_cenik;
  1175.    jrec := Look_up(cenik,"id_cenik",u);
  1176.    if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury Pridej_polozku - nenalezena polo₧ka cenφku"); 
  1177.   
  1178.    moje_cena:=zjisti_deal_cenu(id_obj, jrec); 
  1179.    obj_polozky[irec].cena_sum:=moje_cena;
  1180.  
  1181. //   obj_polozky[irec].nazev_vl:=cenik[jrec].nazev_zbozi;
  1182.      strinsert(cenik[jrec].kod_zbozi, strnazev_vl, 1);
  1183.      strinsert(" - ", strnazev_vl,strlength(strnazev_vl)+1);
  1184.      strinsert(cenik[jrec].nazev_zbozi, strnazev_vl,strlength(strnazev_vl)+1);
  1185.      strinsert("; ", strnazev_vl,strlength(strnazev_vl)+1);
  1186.      obj_polozky[irec].nazev_vl[0,strlength(strnazev_vl)]:= strnazev_vl;
  1187.  
  1188.    obj_polozky[irec].cena_summn:=obj_polozky[irec].cena_sum;
  1189.  
  1190.    if moje_cena>0 then
  1191.     begin
  1192.         u:=id_cenik;
  1193.         jrec := Look_up(Cenik,"id_cenik",u);
  1194.         if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury Pridej_polozku - nenalezena polo₧ka cenφku"); 
  1195.        
  1196.         pom_id:=Cenik[jrec].dph;
  1197.         podminka:="(id_dph="+int2str(pom_id)+")  AND  (uc_rok="+int2str(year(today))+")";
  1198.         if not Open_sql_parts(curs, "procento", "S_dph", podminka, "") then Rec_cnt(curs,pocet)
  1199.         else chybacgi(" chyba  p°i b∞hu procedury Pridej_polozku - nenalezeno DPH"); 
  1200.         if pocet>0 then
  1201.           obj_polozky[irec].hodnota_dph:=curs[0].procento
  1202.         else obj_polozky[irec].hodnota_dph:=0;
  1203.         close_cursor(curs);
  1204.        end;
  1205.      end else obj_polozky[irec].hodnota_dph:=0;
  1206. end;
  1207.  
  1208. procedure w_kosik2(id_obj:integer; jmeno,heslo:string[80];id_cenik:integer;mnoz:real); 
  1209. /**************************************************************************************/
  1210. var
  1211.  u:untyped;
  1212.  irec:trecnum;
  1213.  
  1214.  begin
  1215.    if id_cenik<>-1 then
  1216.     begin
  1217.      u := id_obj;
  1218.      irec := Look_up(obj_header,"id_dobj",u);
  1219.       if irec=-1 then 
  1220.        begin
  1221.         id_obj:=nova_obj_h(jmeno, heslo);
  1222.        end;
  1223.        if ((mnoz>0) AND (mnoz<=1000)) then 
  1224.         begin
  1225.           mnoz:=trunc(mnoz);
  1226.           pridej_polozku(id_obj,id_cenik,mnoz);
  1227.           W_prepocet(id_obj);
  1228.         end;
  1229.     end;
  1230.    w_objednavka:=id_obj;
  1231.  end;
  1232.  
  1233. procedure w_kosik(id_obj:integer; jmeno,heslo:string[80];id_cenik:integer; mn:string[20]); 
  1234. /*******************************************************************************************/
  1235. var
  1236. mnoz:real;
  1237.  
  1238. begin
  1239. // log_write("kosik");
  1240.  
  1241.  mnoz:=str2real(mn);
  1242.  if mnoz=NONEREAL then mnoz:=0;
  1243.  if ((id_obj=-1) AND (id_cenik=-1)) then w_objednavka:=-1
  1244.   else w_kosik2(id_obj,jmeno,heslo,id_cenik,mnoz); 
  1245.  
  1246. // log_write("kosik/end");
  1247. end;
  1248.  
  1249. procedure w_objfirma(id_obj:integer; jmeno,heslo:string[80]);
  1250. /*************************************************************/
  1251. var
  1252.  u:untyped;
  1253.  irec, jrec: trecnum;
  1254.  podminka: string[120];
  1255.  curs:cursor;
  1256.  pocet,firma:integer;
  1257.  
  1258.  begin  //0
  1259.    u := id_obj;
  1260.    irec := Look_up(obj_header,"id_dobj",u);
  1261.    if irec<>-1 then 
  1262.     begin //1
  1263.       podminka:="((intr_user="+""""+jmeno+""""+")  AND  (intr_pswd="+""""+heslo+""""+"))";
  1264.       if not Open_sql_parts(curs, "id,ico,id_obchodnika", "obchodni_partneri", podminka, "") then 
  1265.         begin //2
  1266.           Rec_cnt(curs,pocet);
  1267.            if pocet>0 then
  1268.             begin //3
  1269.               firma:=curs[0].id; 
  1270.               obj_header[irec].id_org:=firma; 
  1271.               obj_header[irec].ico:=curs[0].ico; 
  1272.               u:=curs[0].id_obchodnika;
  1273.               jrec := Look_up(obchodnici,"id_obchodnika",u);
  1274.               if jrec>-1 then  obj_header[irec].obchodnik:=curs[0].id_obchodnika
  1275.                else 
  1276.                   begin    //4
  1277.                    u:=default_hodnoty[0].obchodnik;
  1278.                    jrec := Look_up(obchodnici,"id_obchodnika",u);
  1279.                    if jrec=-1 then    chybacgi(" chyba  p°i b∞hu procedury w_objfirma - nenalezen default obchodnφk")
  1280.                    else obj_header[irec].obchodnik:=default_hodnoty[0].obchodnik;
  1281.                   end;    //4
  1282.               zmen_cenu(id_obj, firma);
  1283.               W_prepocet(id_obj);
  1284.             end; //3
  1285.           close_cursor(curs);
  1286.         end; //2
  1287.     end; //1
  1288.  end; //0 
  1289.  
  1290. begin              
  1291. end.
  1292.  
  1293.  
  1294.