home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / OBJEDNAVKY.PGM < prev    next >
Text File  |  2000-03-16  |  33KB  |  922 lines
  1. {$$3220792583                                }Include
  2.  
  3. cursor seznam_obj, obj_headn, obj_head, Objpol_cenik, cena, tobj1, t_seznam_obj;
  4.  
  5. var
  6.  cen_slev,cen_slev_so,prabat: real;
  7.  tisk_obch:integer;
  8.  cis_obj:string[20];
  9.  mn:real;
  10.  idc, IDobj, IDpol:integer;
  11.  p_nazev1:string[35];
  12.  nobj_head: cursor;
  13.  drab,narok:Boolean;
  14.  poprve,all: Boolean;
  15.  psumobj:real;
  16.  curstisk:cursor;
  17.  
  18.  
  19. procedure suma_obj(id_obj:integer);
  20. /*********************************************************************/
  21. var
  22.  pocet:integer;
  23.  podminka: string[254];
  24.  curs:cursor;
  25.  u:untyped;
  26.  irec:trecnum;
  27.  round_koef:real;
  28.  pom_cena1:money;
  29.  
  30. begin
  31.   psumobj:=0;
  32.   podminka:= "SELECT Obj_polozky.id_dobj,SUM(Obj_polozky.cena_summn) AS SUMA FROM Obj_polozky WHERE id_dobj="+int2str(id_obj)+"  GROUP BY `Obj_polozky`.id_dobj";
  33.   begin {otev°enφ prom∞nnΘho kurzoru curs}
  34.    if not Open_SQL_cursor(curs,podminka) then Rec_cnt(curs, pocet)  else info_box("Chyba", "");
  35.    if pocet>0 then
  36.      psumobj:=curs[0].SUMA  else info_box("Chyba", "");
  37.      close_cursor(curs);
  38.   end;
  39.   u:=SYS_PAR[0].ROUND_SUM;
  40.   irec := Look_up(S_TAB_ROUND,"id_round",u);
  41.   round_koef:=S_TAB_ROUND[irec].koef;
  42.   pom_cena1:=psumobj;
  43.     if round_koef>0 then psumobj:= (round(pom_cena1/round_koef))*round_koef
  44.     else psumobj:= pom_cena1;
  45. end;
  46.  
  47. procedure prevod_doprava1(id_obj:integer);
  48. /*********************************************************************/
  49. var
  50.  irec:trecnum;
  51.  u:untyped;
  52.  numpol:integer;
  53.  podminka:string[200];
  54.  curs:cursor;
  55.  kod:string[8];
  56.  
  57. begin
  58.    u:=id_obj;
  59.    irec := Look_up(OBJ_HEADER,"id_dobj",u);
  60.    if irec<>-1 then  u:= OBJ_HEADER[irec].doprav
  61.    else Info_box("Upozorn∞nφ","Nenalezena objednßvka"); 
  62.    irec := Look_up(S_DOPRAVA,"kod",u);
  63.    if irec<>-1 then   pdoprava:=S_DOPRAVA[irec].zpusob
  64.    else  Info_box("Upozorn∞nφ","Nenalezen zp∙sob dopravy"); 
  65. end;
  66.  
  67. procedure prevod_doprava2(id_obj:integer);
  68. /*********************************************************************/
  69. var
  70.  irec:trecnum;
  71.  u:untyped;
  72.  numpol:integer;
  73.  podminka:string[200];
  74.  curs:cursor;
  75.  kod:string[8];
  76.  
  77. begin
  78.    u:=pdoprava;
  79.    irec := Look_up(S_DOPRAVA,"zpusob",u);
  80.    if irec<>-1 then   kod:=S_DOPRAVA[irec].kod
  81.    else  Info_box("Upozorn∞nφ","Nenalezen zp∙sob dopravy"); 
  82.    u:=id_obj;
  83.    irec := Look_up(OBJ_HEADER,"id_dobj",u);
  84.    if irec<>-1 then   OBJ_HEADER[irec].doprav:=kod
  85.    else Info_box("Upozorn∞nφ","Nnenalezena objednßvka"); 
  86. end;
  87.  
  88. procedure info_obchpar(id:integer);
  89. /*********************************************************************/
  90. var
  91.  id_pohled:window_id;
  92.  podminka: string[120];
  93.  curs:cursor;
  94.  query:string[2000];
  95. begin
  96.   query:="";
  97.   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 Obchodni_partneri.id=";
  98.   podminka:=int2str(id);
  99.   strinsert(podminka,query,strlength(query)+1);
  100.      begin {otev°enφ prom∞nnΘho kurzoru curs}
  101.         if not Open_sql_cursor(curs, query) then
  102.         begin {otev°enφ pohledu do kurzoru curs}
  103.           Open_view("*info_op", curs, AUTO_CURSOR+NO_INSERT+NO_DELETE, 0, 0, id_pohled);
  104.           repeat Peek_message until id_POHLED = 0;
  105.         end
  106.         else begin info_box("Chyba", "");   close_cursor(curs); end;
  107.       end;
  108. end;
  109.  
  110. function zjisti_deal_cenu(id_obj:integer; irec:trecnum): money; 
  111. /*********************************************************************/
  112. var
  113.  jrec:trecnum;
  114.  u:untyped;
  115.  deal_sk:integer;
  116.  
  117.  begin
  118.  
  119.    u:=id_obj;
  120.    jrec := Look_up(Obj_header,"id_dobj",u);
  121.    if jrec=-1 then  Info_box("upozorn∞nφ","Nenalezena objednavka-zjisti_deal_cenu"); 
  122.    if Obj_header[jrec].id_org=-1 then  zjisti_deal_cenu:=cenik[irec].min_cena    else
  123.     begin
  124.       u:=Obj_header[jrec].id_org;
  125.       jrec := Look_up(Obchodni_partneri,"id",u);
  126.       if jrec=-1 then   Info_box("upozorn∞nφ","Nenalezen obchodni partner-zjisti_deal_cenu"); 
  127.       deal_sk:= Obchodni_partneri[jrec].deal_sk;
  128.  
  129.  case deal_sk of
  130.       1    :  zjisti_deal_cenu:=cenik[irec].cena1;
  131.       2    :  zjisti_deal_cenu:=cenik[irec].cena2;
  132.       3    :  zjisti_deal_cenu:=cenik[irec].cena3;
  133.       4    :  zjisti_deal_cenu:=cenik[irec].cena4;
  134.       5    :  zjisti_deal_cenu:=cenik[irec].cena5;
  135.       6    :  zjisti_deal_cenu:=cenik[irec].cena6;
  136.       7    :  zjisti_deal_cenu:=cenik[irec].cena7;
  137.       8    :  zjisti_deal_cenu:=cenik[irec].cena8;
  138.       9    :  zjisti_deal_cenu:=cenik[irec].cena9;
  139.      else  :  zjisti_deal_cenu:=cenik[irec].min_cena;
  140.   end;      
  141.     end;
  142.  end;
  143.  
  144. procedure ukonci_kolobeh(id_obj:integer);
  145. /*********************************************************************/
  146. var
  147.  irec:trecnum;
  148.  u:untyped;
  149.  num:integer;
  150.  
  151. begin
  152.      NUM:=-1;
  153.      u:=id_obj;
  154.      irec := Look_up(OBJ_HEADER,"id_dobj",u);
  155.      if irec<>-1 then 
  156.      obj_header[irec].obchodnik:=default_hodnoty[0].obchodnik;
  157. //     if GetSet_next_user(OBJ_HEADER, irec, 0, OPER_SET, VT_OBJNUM, num) then Signalize;
  158. end;
  159.  
  160.  
  161. procedure potvrd(id_obj:integer);
  162. /*********************************************************************/
  163. var
  164.  irec:trecnum;
  165.  u:untyped;
  166.  numpol:integer;
  167.  
  168. begin
  169.      u:=id_obj;
  170.      irec := Look_up(OBJ_HEADER,"id_dobj",u);
  171.      if irec<>-1 then 
  172.      OBJ_HEADER[irec].potvrzena:=TRUE;
  173.      close_cursor(nobj_head);  
  174.  
  175. end;
  176.  
  177.  
  178.  
  179. procedure posl_obj(id_obj,id_org:integer);
  180. /*********************************************************************/
  181. var
  182.  irec:trecnum;
  183.  u:untyped;
  184.  numpol:integer;
  185.  podminkax:string[200];
  186.  curs:cursor;
  187.  
  188. begin
  189.   podminkax:="(id_org="+int2str(id_org)+") AND (id_dobj<>"+int2str(id_obj)+") AND (potvrzena=TRUE)";
  190.   if Open_sql_parts(curs, "id_dobj", "OBJ_HEADER", podminkax, "") then Signalize
  191.   else begin
  192.     Rec_cnt(curs,numpol);
  193.     Close_cursor(curs);
  194.     if numpol = 0 then cis_obj:="nebylo zadano " 
  195.     else begin
  196.       if Open_sql_parts(curs, "MAX(id_dobj) AS M", "OBJ_HEADER", podminkax, "") then Signalize
  197.       else begin
  198.         u:=curs[0].M;
  199.         irec := Look_up(OBJ_HEADER,"id_dobj",u);
  200.         if irec<>-1 then begin
  201.           cis_obj:= OBJ_HEADER[irec].cis_eob;
  202.           if cis_obj="" then cis_obj:="nebylo zadano " ;
  203.         end else cis_obj:="nebylo zadano2 ";  
  204. //        info_box("VaÜe poslednφ Φφslo objednßvky je",cis_obj);
  205.         Close_cursor(curs);  
  206.       end;
  207.     end;
  208.   end;
  209. end;
  210.  
  211.  
  212. procedure login_exist(id_obchodnika:integer;intr_user:string[35];ID_POHLED2:window_id);
  213. /*****************************************************************************************/
  214. var
  215.  podminka,s,s2:string[200];
  216.  curs:cursor;
  217.  numpol, i :integer;
  218.  
  219. begin
  220.       s:="LOGIN - kter² jste zadali je ji₧ p°id∞leno ";
  221.       podminka:="intr_user="+""""+intr_user+"""" ;
  222.       if not Open_sql_parts(curs, "intr_user, nazev1", "obchodni_partneri", podminka, "") then Rec_cnt(curs,numpol);
  223.       if numpol>0 then
  224.        begin
  225.          for i:=0 to numpol-1 do
  226.           s2:=curs[i].nazev1;
  227.           s:= s+s2+"  ";
  228.          Info_box("upozorn∞nφ",s);
  229.        end
  230.       else
  231.        begin
  232.         if Commit_view(ID_POHLED2,false,true) then Close_view(ID_POHLED2);
  233.        end;
  234.       close_cursor(curs);
  235.  end;
  236.  
  237. function metoda_mn(metoda:integer; mnozstvi:real):real;
  238. /*********************************************************************/
  239. var 
  240.  podminka: string[120];
  241.  curs:cursor;
  242.  pocet,i:integer;
  243.  pom_mn:real;
  244.  
  245. begin
  246.  prabat:=1;
  247.  podminka:="metoda="+int2str(metoda);
  248.  if not Open_sql_parts(curs, "*", "rabat", podminka, "nad_mnoz") then Rec_cnt(curs,pocet)
  249.  else  info_box("upozorn∞nφ","chyba WinBase - nenalezena tabulka rabat∙"); 
  250.  if pocet>0 then
  251.    for i:=0 to pocet-1 do
  252.      begin
  253.        pom_mn:=curs[i].nad_mnoz;
  254.        if (mnozstvi>pom_mn) then  prabat:=curs[i].proc;
  255.      end;  
  256.  metoda_mn:=prabat;
  257.  close_cursor(curs);
  258. end;
  259.  
  260.  
  261.  procedure Zjisti_rabat_tab(id_cnk:integer;mnozstvi:real);
  262. /*********************************************************************/
  263. var
  264.  irec:trecnum;
  265.  u:untyped;
  266.  mujrabat:integer;
  267.  
  268. Begin
  269.    u := id_cnk;
  270.    irec := Look_up(cenik,"id_cenik",u);
  271.    if irec=-1 then  info_box("upozorn∞nφ","chyba WinBase - nenalezena polo₧ka cenφku-procedure Zjisti_rabat"); 
  272.    mujrabat:=cenik[irec].rabat;
  273.    if (mujrabat=NONEINTEGER)  then 
  274.     begin
  275.       u := cenik[irec].skupina_zbozi;
  276.       irec := Look_up(S_zbozi_sk,"id_skupiny",u);
  277.       if irec=-1 then  info_box("upozorn∞nφ","chyba WinBase - nenalezena skupina - rabat") 
  278.       else mujrabat:=S_zbozi_sk[irec].rabat;
  279.      end;
  280.       u := mujrabat;
  281.       irec := Look_up(Rabat_header,"metoda",u);
  282.       if irec=-1 then mujrabat:=0;
  283.       
  284.       // info_box("upozorn∞nφ","chyba WinBase - nenalezena tabulka rabat∙") 
  285.    if mujrabat=0 then prabat:=1.0
  286.    else prabat:=metoda_mn(mujrabat,mnozstvi);
  287. end;
  288.  
  289.  
  290. function prepocet_mn(id_obj,id_pol:integer;drab:Boolean):money;
  291. /*********************************************************************/
  292. var
  293.  numpol:integer;
  294.  podminka: string[120];
  295.  pom_cena1,cena_vl:money;
  296.  round_koef,mn:real;
  297.  curs:cursor;
  298.  u:untyped;
  299.  irec:trecnum;
  300.  
  301. begin
  302.  podminka:="(id_dobj="+int2str(id_obj)+") AND (id_pol="+int2str(id_pol)+")";
  303.  if not Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then Rec_cnt(curs,numpol)
  304.  else   info_box("upozorn∞nφ","chyba WinBase - nenalezena ₧ßdnß polo₧ka objednßvky"); 
  305.  if numpol>0 then 
  306.    begin
  307.      cena_vl:=curs[0].cena_sum;
  308.      mn:=curs[0].mnozstvi;
  309.      Zjisti_rabat_tab(curs[0].id_cnk,curs[0].mnozstvi);
  310.      if ((drab) AND (prabat<>0)) then
  311.        begin
  312.          curs[0].cena_summn:=cena_vl*mn*prabat;
  313.        end
  314.      else
  315.          curs[0].cena_summn:=cena_vl*mn;
  316.    end;
  317.      if ((drab) AND (prabat<>0)  AND (prabat<>NONEREAL)) then prepocet_mn:=cena_vl*mn*prabat
  318.      else  prepocet_mn:=cena_vl*mn;
  319.   u:=SYS_PAR[0].ROUND_POL;
  320.   irec := Look_up(S_TAB_ROUND,"id_round",u);
  321.   round_koef:=S_TAB_ROUND[irec].koef;
  322.   pom_cena1:=curs[0].cena_summn;
  323.     if round_koef>0 then curs[0].cena_summn:= (round(pom_cena1/round_koef))*round_koef
  324.     else curs[0].cena_summn:= pom_cena1;
  325.   prepocet_mn:=curs[0].cena_summn;
  326.  
  327.  close_cursor(curs);
  328. end;
  329.  
  330.  
  331.  
  332.  procedure  w_sleva_so(id_obj:integer);   
  333.  /*********************************************************************/
  334. var 
  335.  u:untyped;
  336.  curs:cursor;
  337.  pocet,i:integer;
  338.  pom_mn:real;
  339.  delka:short;
  340.  sumcena, cena_celkem, pom_cena: money;
  341.  irec:trecnum;
  342.  podminka: string[120];
  343.  
  344. begin
  345.   u:=id_obj;
  346.   sumcena:=0;
  347.   irec := Look_up(Obj_header,"id_dobj",u);
  348.   if irec=-1 then   info_box("upozorn∞nφ","chyba WinBase - nenalezena objednßvka"); 
  349.   cena_celkem:=Obj_header[irec].sum_cena;
  350.  
  351.   podminka:="id_dobj="+int2str(id_obj);
  352.   if not Open_sql_parts(curs, "*", "Obj_polozky", podminka, "") then Rec_cnt(curs,pocet)
  353.   else  info_box("upozorn∞nφ","chyba WinBase - nenalezena ₧ßdnß polo₧ka objednßvky"); 
  354.   if pocet>0 then 
  355.     for i:=0 to pocet-1 do
  356.       begin
  357.         pom_cena:=curs[i].cena_summn;
  358.         sumcena:=sumcena+pom_cena;
  359.       end;
  360.   cen_slev_so:=cena_celkem/sumcena;
  361. end; 
  362.  
  363.  
  364.  
  365.  procedure  zjisti_slevu(cena_celkem:money);   
  366.  /*********************************************************************/
  367. var 
  368.  curs:cursor;
  369.  pocet,i:integer;
  370.  pom_mn:real;
  371.  delka:short;
  372.  
  373. begin
  374.  cen_slev:=1.0;
  375.  if not Open_sql_parts(curs, "*", "Cen_slevy", "", "nad_mnoz") then Rec_cnt(curs,pocet)
  376.  else  info_box("upozorn∞nφ","chyba WinBase - nenalezena tabulka objemov²ch slev"); 
  377.  if pocet>0 then
  378.   begin   //1
  379.    for i:=0 to pocet-1 do
  380.      begin //2
  381.        pom_mn:=curs[i].nad_mnoz;
  382.        if (cena_celkem>pom_mn) then  cen_slev:=curs[i].proc;
  383.      end;  //2
  384.   end     //1
  385.  else narok:=false;
  386.  close_cursor(curs);
  387. end;
  388.  
  389.  
  390. procedure detail_obj(pohl:window_id;s,id_obj:integer);
  391. /*********************************************************************/
  392. var
  393.  limit:integer;
  394.  podminka: string[500];
  395.  cdetail:cursor;
  396.  
  397. begin
  398.  
  399.   if s=1 then close_view(pohl);
  400.    limit:=0;
  401.    podminka:=" Obj_polozky.ID_CNK=Cenik.ID_CENIK AND S_dph.ID_DPH=Cenik.DPH AND (S_dph.uc_rok=year(today))  AND id_dobj="+int2str(id_obj) ;
  402.    if not Open_SQL_parts(cdetail, "Obj_polozky.id_dobj,Obj_polozky.id_pol","OBJ_POLOZKY, CENIK, S_DPH", podminka, "" ) then
  403.     begin
  404.      Rec_cnt(cdetail,limit);
  405.      Close_cursor(cdetail);
  406.     end; 
  407.    if limit>0 then 
  408.     begin   //1
  409.       podminka:="  Obchodni_partneri.id=Obj_header.id_org AND Obj_header.id_dobj="+int2str(id_obj) ;
  410.       if not  Open_SQL_parts(cdetail, "Obj_header.*,Obchodni_partneri.*,S_doprava.zpusob",
  411.       "Obj_header LEFT OUTER JOIN S_doprava ON (Obj_header.doprav=S_doprava.kod), Obchodni_partneri", podminka, "" ) then
  412.          begin //2
  413.            if s=1 then
  414.              begin //3
  415.               if cu=2 then
  416.                Open_view("*detail_obj_nu", cdetail, MODAL_VIEW+AUTO_CURSOR, 0, 0, nil)
  417.               else
  418.                Open_view("*detail_obj", cdetail, MODAL_VIEW+AUTO_CURSOR, 0, 0, nil);
  419.              end    //3
  420.            else
  421.              Open_view("*detail_obj_s", cdetail, MODAL_VIEW+AUTO_CURSOR, 0, 0, nil);
  422.          end; //2
  423.     end //1
  424.    else info_box("upozorn∞nφ","objednßvka neobsahuje ani 1 polo₧ku");  
  425. end;
  426.  
  427. procedure tisk_seznam();
  428. /*********************************************************************/
  429. var
  430.  irec:trecnum;
  431.  limit:integer;
  432.  podminka: string[120];
  433.  
  434. begin
  435.    limit:=0;
  436.    if tisk_obch<>-1 then   podminka:="id_obchodnika="+int2str(tisk_obch)
  437.    else podminka:="";
  438.    open_cursor(T_seznam_obj);
  439.    if tisk_obch<>-1 then  Restrict_cursor(T_seznam_obj, podminka); 
  440.    Rec_cnt(T_seznam_obj,limit);
  441.     if limit>0 then 
  442.      begin
  443.      if not Print_view("*T_seznam", T_seznam_obj, -1, -1) then Signalize;
  444.      end
  445.    else info_box("upozorn∞nφ","neobsahuje ani 1 polo₧ku");  
  446.    close_cursor(T_seznam_obj);
  447. end;
  448.  
  449.  
  450. procedure tisk_detail_obj(id_obj:integer);
  451. /*********************************************************************/
  452. var
  453.  irec:trecnum;
  454.  limit:integer;
  455.  podminka: string[120];
  456.  
  457. begin
  458.    limit:=0;
  459.    podminka:="id_dobj="+int2str(id_obj);
  460.    open_cursor(tobj1);
  461.    if not Restrict_cursor(TObj1, podminka) then Rec_cnt(TObj1,limit);
  462.     if limit>0 then 
  463.      begin
  464.      if not Print_view("*obj_tisk", tobj1, -1, -1) then Signalize;
  465.      end
  466.    else info_box("upozorn∞nφ","objednßvka neobsahuje ani 1 polo₧ku");  
  467.    close_cursor(tobj1);
  468. end;
  469.  
  470.  
  471.  procedure obj();
  472. /*********************************************************************/
  473.   var
  474.    Q, podmsub, podminka1, podminka2, podminka3: string[250];
  475.    podminka: string[2000];
  476.    curs, cseznam:cursor;
  477.    limit:integer;
  478.    co: string[255];
  479.  
  480.  begin
  481.   all:=false;
  482. //potvrzenß x nepotvrzenß x obojφ
  483.   case pn of
  484.   1:  begin cp:=true;cn:=false;end;
  485.   0:  begin cp:=false;cn:=true;end;
  486.   end;
  487.  
  488.   if cp then  podminka1:="(potvrzena=TRUE)";
  489.   if cn then  podminka1:="(potvrzena<>TRUE)"; //15
  490. //  if (cp AND cn) then podminka1:="";
  491.  
  492. //registrovan² u₧ivatel x neregistrovan² u₧ivatel
  493.   if cru then  podminka3:="(intr_user<>"+""""")";  //16
  494.   if cnu then  podminka3:="(intr_user="+""""")";
  495.   if (cru AND cnu) then podminka3:="";
  496.  
  497.  case   crec of                                      //65
  498.      1:      podminka2:="(zpracovana=NONEDATE) AND (storno<>TRUE)"; //nezpracovanΘ
  499.      3:      podminka2:="(zpracovana=NONEDATE) AND (storno)"; //nezpracovanΘ storno
  500.      2:      podminka2:="(datum>="+Date2str(dat_od,1)+") AND (datum<="+Date2str(dat_do,1)+")"; //Φasov∞ omezenΘ
  501.      else:   podminka2:="";
  502.  end;
  503.  
  504.  if podminka2="" then  strinsert(podminka1,podminka,1)
  505.  else 
  506.   begin
  507.     strinsert(podminka1,podminka,strlength(podminka)+1);
  508.     strinsert(" AND ",podminka,strlength(podminka)+1);
  509.     strinsert(podminka2,podminka,strlength(podminka)+1); 
  510.   end;
  511.  
  512.  if podminka3<>"" then  
  513.    begin
  514.      strinsert(" AND ",podminka,strlength(podminka)+1);
  515.      strinsert(podminka3,podminka,strlength(podminka)+1); 
  516.    end;  
  517.  strinsert(" AND  Obchodnici.id_obchodnika=Obj_header.obchodnik AND Obchodni_partneri.ID=Obj_header.ID_ORG ",podminka,strlength(podminka)+1); 
  518.  
  519.  
  520.  Q:="Obj_header, Obchodni_partneri, obchodnici";
  521.  if  Am_I_db_Admin then all:=YesNo_box("upozorn∞nφ",'Jako administrßtor databßze mßte mo₧nost:'#10'zobrazit vÜechny nezpracovanΘ objednßvky - zvolte ANO'#10'zobrazit pouze VaÜe - zvolte NE'); 
  522.   if NOT all then
  523.      begin
  524. //       podmsub:=" AND Obchodni_partneri.ID_obchodnika=Obchodnici.ID_obchodnika  AND (Obchodnici.logname=WHO_AM_I) ";  
  525.        podmsub:="  AND (Obchodnici.logname=WHO_AM_I) ";  
  526.        strinsert( podmsub,podminka,strlength(podminka)+1);
  527.        Q:="Obj_header, Obchodni_partneri, obchodnici";
  528.      end;
  529.   /*.jmeno+"+"""" """"+"+Obchodnici*/
  530.    co:="Obj_header.*,Obchodni_partneri.nazev1,Obchodni_partneri.intr_user,Obchodni_partneri.id_obchodnika,Obchodnici.jmeno+"+""""+" "+""""+"+Obchodnici.prijmeni AS jmenoobch";
  531.  if  Open_SQL_parts(cseznam, co ,Q, podminka, "Obj_header.obchodnik,Obchodni_partneri.nazev1,Obj_header.datum DESC,Obj_header.cis_eob DESC" ) then Signalize
  532.   else      Rec_cnt(cseznam,limit);
  533.    if limit>0 then 
  534.      begin
  535.        Open_view("*seznam_obj", cseznam,  AUTO_CURSOR, 0, 0, /*id_pohled*/nil);
  536. //       repeat Peek_message until id_POHLED = 0;
  537.      end
  538.    else info_box("upozorn∞nφ","neobsahuje ani 1 zßznam");  
  539. end;
  540.  
  541.  procedure vsechobjzak(id_org:integer);
  542. /*********************************************************************/
  543.   var
  544.    Q, Q2: string[1000];
  545.    podminka, podminka2: string[2000];
  546.    curs, cseznam, csum: cursor;
  547.    limit:integer;
  548.  
  549.  begin
  550.  
  551.  
  552.  
  553.   Q2:="SELECT Obj_header.id_dobj,Obchodni_partneri.nazev1,Obj_header.datum,Obj_header.cis_eob,Obj_header.sum_obj,Obj_header.id_org,Obj_header.k_uhrade,Obchodnici.id_obchodnika,Obj_header.potvrzena,Obj_header.storno_dat,Obj_header.zpracovana";
  554.   strinsert(Q2,Q,1);
  555.   Q2:=",Obj_header.datum_d FROM Obj_header, Obchodni_partneri, Obchodnici";
  556.   strinsert(Q2,Q,strlength(Q)+1);
  557.   Q2:=" WHERE Obchodnici.id_obchodnika=Obj_header.obchodnik  AND Obchodni_partneri.id=Obj_header.id_org  AND Obchodni_partneri.ID="+int2str(id_org);
  558.   strinsert(Q2,Q,strlength(Q)+1);
  559.   Q2:=" ORDER BY Obchodni_partneri.nazev1,Obj_header.datum DESC,Obj_header.cis_eob DESC";
  560.   strinsert(Q2,Q,strlength(Q)+1);
  561.  
  562.  if  Open_SQL_cursor(cseznam, Q ) then Signalize
  563.   else  Rec_cnt(cseznam,limit);
  564.  
  565.   if limit>0 then 
  566.      begin
  567.        Open_view("*Seznvsechobjzak", cseznam,  AUTO_CURSOR, 0, 0,nil);
  568.      end
  569.    else 
  570.      begin
  571.        info_box("upozorn∞nφ","Seznam neobsahuje ani 1 objednßvku");  
  572.        close_cursor(cseznam);
  573.      end;
  574. end;
  575.  
  576.  procedure objzak(id_org:integer);
  577. /*********************************************************************/
  578.   var
  579.    Q, Q2: string[1000];
  580.    podminka, podminka2: string[2000];
  581.    curs, cseznam, csum: cursor;
  582.    limit:integer;
  583.  
  584.  begin
  585.   Q2:="SELECT Obj_header.id_dobj,Obchodni_partneri.nazev1,Obj_header.datum,Obj_header.cis_eob,Sub_obj.count1,Obchodni_partneri.intr_user,Obj_header.sum_obj,Obj_header.id_org,";
  586.   strinsert(Q2,Q,1);
  587.   Q2:=" Obchodnici.jmeno+"+""""+" "+""""+ "+ Obchodnici.prijmeni AS JMENOOBCH,";
  588.   strinsert(Q2,Q,strlength(Q)+1);
  589.   Q2:=" Obchodnici.id_obchodnika,Obchodnici.jmeno,Obchodnici.prijmeni,Obchodnici.titl,Obj_header.k_uhrade,Sum_cena_firma.cena,Sum_cena_firma.sdph,Sum_cena_firma.pocet";
  590.   strinsert(Q2,Q,strlength(Q)+1);
  591.   Q2:=" FROM Obj_header, Obchodni_partneri, Sub_obj, Obchodnici, Sum_cena_firma";
  592.   strinsert(Q2,Q,strlength(Q)+1);
  593.   Q2:=" WHERE Sum_cena_firma.id_org=Obchodni_partneri.id AND Obchodnici.id_obchodnika=Obj_header.obchodnik AND Obchodnici.id_obchodnika=Obchodni_partneri.id_obchodnika AND Sub_obj.id_dobj=Obj_header.id_dobj ";
  594.   strinsert(Q2,Q,strlength(Q)+1);
  595.   Q2:=" AND Obchodni_partneri.id=Obj_header.id_org AND (Obj_header.potvrzena=true AND Obj_header.zpracovana<>NONEDATE AND Obj_header.storno<>true)  AND Obchodni_partneri.ID="+int2str(id_org);
  596.   strinsert(Q2,Q,strlength(Q)+1);
  597.   Q2:=" ORDER BY Obchodni_partneri.nazev1,Obj_header.datum DESC,Obj_header.cis_eob DESC";
  598.   strinsert(Q2,Q,strlength(Q)+1);
  599.  
  600.  
  601.  
  602. //  Q:="SELECT Obj_header.*,Obchodni_partneri.* FROM OBJ_HEADER, OBCHODNI_PARTNERI WHERE Obj_header.potvrzena=TRUE AND Obchodni_partneri.ID=Obj_header.ID_ORG AND Obchodni_partneri.ID="+int2str(id_org)+ " ORDER BY Obj_header.cis_eob DESC";
  603.  
  604.  
  605.  if  Open_SQL_cursor(cseznam, Q ) then Signalize
  606.   else  Rec_cnt(cseznam,limit);
  607.  
  608. /*  Q2:="SELECT SUM(sum_obj) AS ZAKSUM FROM OBJ_HEADER, OBCHODNI_PARTNERI WHERE Obj_header.potvrzena=TRUE AND Obchodni_partneri.ID=Obj_header.ID_ORG AND Obchodni_partneri.ID="+int2str(id_org);
  609.    if  Open_SQL_cursor(csum, Q2 ) then Signalize
  610.     else   zaksum:=csum[0].zaksum;
  611.    close_cursor(csum);
  612.   */
  613.    if limit>0 then 
  614.      begin
  615.        Open_view("*Seznamobjzak", cseznam,  AUTO_CURSOR, 0, 0,nil);
  616.      end
  617.    else 
  618.      begin
  619.        info_box("upozorn∞nφ","Seznam neobsahuje ani 1 objednßvku");  
  620.        close_cursor(cseznam);
  621.      end;
  622. end;
  623.  
  624.  
  625.  
  626.  procedure objzakstat(id_org:integer);
  627. /*********************************************************************/
  628.   var
  629.    Q: string[2000];
  630.    podminka: string[255];
  631.    curs, cseznam:cursor;
  632.    limit:integer;
  633.  
  634.  begin
  635.  
  636.   podminka:= "SELECT Obj_polozky.id_cnk,SUM(Obj_polozky.cena_summn) AS CENA,cenik.nazev_zbozi,COUNT(Obj_polozky.id_dobj) AS POCET_OBJ,SUM(Obj_polozky.mnozstvi) AS MNOZ,MAX(Obj_header.datum) AS POSLEDNI,cenik.kod_zbozi";
  637.   strinsert( podminka,Q,1);
  638.   podminka:= " FROM Obj_polozky, cenik, Obj_header, Obchodni_partneri";
  639.   strinsert( podminka,Q,strlength(Q)+1);
  640.   podminka:= " 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 Obj_header.zpracovana<>NONEDATE AND Obj_header.storno<>true) AND Obchodni_partneri.id=";
  641.   strinsert( podminka,Q,strlength(Q)+1);
  642.   podminka:= int2str(id_org); 
  643.   strinsert( podminka,Q,strlength(Q)+1);
  644.   podminka:= " GROUP BY Obj_polozky.id_cnk  ORDER BY MNOZ DESC";
  645.   strinsert( podminka,Q,strlength(Q)+1);
  646.  
  647.  
  648.  if  Open_SQL_cursor(cseznam, Q ) then Signalize
  649.   else  Rec_cnt(cseznam,limit);
  650.    if limit>0 then 
  651.      begin
  652.        Open_view("*Sum_zakcnk", cseznam,  AUTO_CURSOR, 0, 0,nil);
  653.      end
  654.    else 
  655.      begin
  656.        info_box("upozorn∞nφ","Seznam neobsahuje ani 1 objednßvku");  
  657.        close_cursor(cseznam);
  658.      end;
  659. end;
  660.  
  661. procedure smaz_nepotvrzene();
  662. /*********************************************************************/
  663. //sma₧e zßznamy z tabulek obj_polozky, obj_header kterΘ souvisφ s nepotvrzen²mi objednßvkami
  664. var
  665.  cislo_tab : tobjnum;
  666.  irec,jrec:trecnum;
  667.  pom_str,pomstr: string[120];
  668.  podminka1, podminka2, podminka3: string[250];
  669. // podminka2: string[1200];
  670.  curs, curs1: cursor;
  671.  u:untyped;
  672.  i,limit3,limit1,limit2, id, delkastr, idorg:integer;
  673.  ANO:Boolean;
  674.  
  675. begin    //1
  676.   podminka1:="(potvrzena<>TRUE) AND datum<"+date2str(today,1);
  677.   if not Open_sql_parts(curs1, "*", "obj_header", podminka1, "") then Rec_cnt(curs1,limit1);
  678.   pom_str:="Bude smazßno "+int2str(limit1)+" nepotvrzen²ch objednßvek";
  679.   if limit1 >0 then
  680.     if yesno_box("POZOR!", pom_str) then
  681.       begin   //2
  682.         podminka3:="((obj_header.potvrzena<>TRUE) AND (obj_header.id_dobj=obj_polozky.id_dobj))";
  683.         if not Open_sql_parts(curs, "*", "obj_header,obj_polozky", podminka3, "") then   Rec_cnt(curs,limit2);
  684.           if limit2>0 then
  685.             for i:=0 to limit2-1 do
  686.               begin  //4
  687.                 translate(curs,i,1,irec);
  688.                 delete(obj_polozky,irec);
  689.               end;  //4
  690.         Close_cursor(curs);
  691. //        if not Find_object("obj_polozky", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  692.  
  693.  /*      for i:=0 to limit1-1 do
  694.          begin   
  695.              idorg:=curs1[i].id_org;
  696.            if  idorg<>-1 then
  697.              begin 
  698.                 u:=idorg;
  699.                 jrec := Look_up(obchodni_partneri,"id",u);
  700.                 if jrec<>-1 then 
  701.                   begin
  702.                     if obchodni_partneri[jrec].intr_user="" then    Delete(obchodni_partneri,jrec);
  703.                   end;
  704.              end;    
  705.          end;
  706.  */
  707.       Delete_all_records(curs1);
  708.       info_box("upozorn∞nφ", "nepotvrzenΘ objednßvky byly smazßny");
  709.     end; //2
  710.   Close_cursor(curs1);
  711. //  if not Find_object("obj_header", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  712. end;  //1
  713.  
  714. procedure smaz_stare();
  715. /*********************************************************************/
  716. //sma₧e zßznamy z tabulek obj_polozky, obj_header kterΘ souvisφ s  objednßvkami starÜφmi ne₧ sys_par.del_obj dnφ 
  717. var
  718.  dat:date;
  719.  cislo_tab : tobjnum;
  720.  irec,jrec:trecnum;
  721.  pom_str,pomstr: string[120];
  722.  podminka1, podminka2, podminka3: string[250];
  723. // podminka2: string[1200];
  724.  curs, curs1: cursor;
  725.  u:untyped;
  726.  i,limit3,limit1,limit2, id, delkastr:integer;
  727.  ANO:Boolean;
  728.  
  729. begin    //1
  730.   dat:=today-sys_par[0].del_obj;
  731.   podminka1:="datum<"+date2str(dat,1);
  732.   if not Open_sql_parts(curs1, "*", "obj_header", podminka1, "") then Rec_cnt(curs1,limit1);
  733.   pom_str:="Bude smazßno "+int2str(limit1)+" star²ch objednßvek - "+podminka1;
  734.   if limit1 >0 then
  735.     if yesno_box("POZOR!", pom_str) then
  736.       begin   //2
  737.         podminka3:=podminka1+" AND (obj_header.id_dobj=obj_polozky.id_dobj)";
  738.         if not Open_sql_parts(curs, "*", "obj_header,obj_polozky", podminka3, "") then   Rec_cnt(curs,limit2);
  739.           if limit2>0 then
  740.             for i:=0 to limit2-1 do
  741.               begin  //4
  742.                 translate(curs,i,1,irec);
  743.                 delete(obj_polozky,irec);
  744.               end;  //4
  745.         Close_cursor(curs);
  746. //        if not Find_object("obj_polozky", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  747.       Delete_all_records(curs1);
  748.       info_box("upozorn∞nφ", "objednßvky byly smazßny");
  749.     end; //2
  750.   Close_cursor(curs1);
  751. // if not Find_object("obj_header", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  752. end;  //1
  753.  
  754. procedure smaz_obj(id_obj:integer);
  755. /*********************************************************************/
  756. var
  757.  cislo_tab : tobjnum;
  758.  irec,jrec:trecnum;
  759.  u:untyped;
  760.  limit, idorg:integer;
  761.  podminka, dotaz: string[120];
  762.  curs:cursor;
  763.  zrusit:Boolean;
  764.  
  765. begin
  766.    limit:=0;
  767.    podminka:="id_dobj="+int2str(id_obj);
  768.    u := id_obj;
  769.    irec := Look_up(obj_header,"id_dobj",u);
  770.    if irec<>-1 then 
  771.      begin //1
  772.        dotaz:="Chcete opravdu smazat objednßvku Φ. "+obj_header[irec].cis_eob+" ?";
  773.        zrusit:=yesno_box("UPOZORN╠N═",dotaz);
  774.        if zrusit then
  775.        begin //4
  776.        if not Open_sql_parts(curs, "*", "obj_polozky", podminka, "") then 
  777.          begin   //2
  778.            Delete_all_records(curs);
  779.            Close_cursor(curs);
  780. //           if not Find_object("obj_polozky", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  781.          end;    //2
  782.        idorg:=obj_header[irec].id_org;
  783.        if  idorg<>-1 then
  784.          begin  //2
  785.            u:=idorg;
  786.            jrec := Look_up(obchodni_partneri,"id",u);
  787.            if jrec<>-1 then 
  788.              begin //3
  789.                if obchodni_partneri[jrec].intr_user="" then
  790.                 begin
  791.                   dotaz:="Chcete opravdu smazat zßkaznφka "+obchodni_partneri[jrec].nazev1+" ?";
  792.                   zrusit:=yesno_box("UPOZORN╠N═",dotaz);
  793.                   if zrusit then  Delete(obchodni_partneri,jrec);
  794.                 end;
  795.              end;  //3
  796.          end;  //2  
  797.        Delete(obj_header,irec);
  798. //       if not Find_object("obj_header", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  799. //       if not Find_object("obchodni_partneri", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  800.      end;     //4
  801.      end;     //1
  802.      
  803. end;
  804.  
  805.  
  806.  procedure zpracovani(poprvep:Boolean);
  807. /*********************************************************************/
  808.    var
  809.    podminka_UZ, podmsub: string[120];
  810.    podminka, Q: string[2000];
  811.    curs, cseznam:cursor;
  812.    limit: integer;
  813.    ok:Boolean;
  814.    co:string[255];
  815.  
  816.  begin
  817. //potvrzenΘ a nezpracovanΘ
  818.   poprve:=poprvep;
  819.   podminka:="";
  820.   if ((storno) AND (cu=1)) then podmsub:="(potvrzena=TRUE) AND (zpracovana=NONEDATE) AND storno " //nezpracovanΘ storno
  821.   else  podmsub:="(potvrzena=TRUE) AND (zpracovana=NONEDATE) AND (storno<>TRUE) ";
  822.   tisk_obch:=-1;
  823.   if poprve then all:=FALSE;
  824.  //registrovan² u₧ivatel x neregistrovan² u₧ivatel
  825.   case cu of
  826.   1:  begin cru:=true;cnu:=false;end;
  827.   2:  begin cru:=false;cnu:=true;end;
  828.   end;
  829.   if cru then  podminka_UZ:=" AND (intr_user<>"+""""") ";  //16
  830.   if cnu then   podminka_UZ:=" AND (intr_user="+""""") ";
  831. //      Info_box("?",podminka_UZ); 
  832.   if ((NOT cru) AND (NOT cnu)) then Info_box("Upozorn∞nφ","nevybrali jste ₧ßdn² typ u₧ivatel∙")
  833.   else
  834.     begin   //nic
  835.       if podminka_UZ<>"" then 
  836.       begin
  837.         strinsert(podmsub,podminka, 1);
  838.         strinsert( podminka_UZ,podminka,strlength(podminka)+1);
  839.       end;
  840.       podmsub:=" AND  Obchodnici.id_obchodnika=Obj_header.obchodnik  AND Obchodni_partneri.ID=Obj_header.ID_ORG ";
  841.       strinsert( podmsub,podminka,strlength(podminka)+1);
  842.       Q:="Obj_header, Obchodni_partneri, obchodnici";
  843.       if poprve then if  Am_I_db_Admin then all:=YesNo_box("upozorn∞nφ",'Jako administrßtor databßze mßte mo₧nost:'#10'zobrazit vÜechny nezpracovanΘ objednßvky - zvolte ANO'#10'zobrazit pouze VaÜe - zvolte NE'); 
  844.        if NOT all then
  845.         begin
  846.  //        podmsub:=" AND  (waits_for_me(obj_header._W5_DOCFLOW)) ";  
  847. //         podmsub:=" AND Obchodni_partneri.ID_obchodnika=Obchodnici.ID_obchodnika  AND (Obchodnici.logname=WHO_AM_I)  ";  
  848.          podmsub:=" AND (Obchodnici.logname=WHO_AM_I)  ";  
  849.          strinsert( podmsub,podminka,strlength(podminka)+1);
  850.          Q:="Obj_header, Obchodni_partneri, obchodnici";
  851.         end;
  852.        co:="Obj_header.*,Obchodni_partneri.nazev1,Obchodni_partneri.intr_user,Obchodni_partneri.id_obchodnika,Obchodnici.jmeno+"+""""+" "+""""+"+Obchodnici.prijmeni AS jmenoobch";
  853.        if  Open_SQL_parts(cseznam, co,Q, podminka, "Obj_header.obchodnik,Obchodni_partneri.nazev1,Obj_header.datum DESC,Obj_header.cis_eob DESC" ) then Signalize
  854.        else   Rec_cnt(cseznam,limit);
  855.           if limit>0 then 
  856.             begin
  857.              /* if poprve then*/ Open_view("*moje_obj",cseznam,AUTO_CURSOR, 0, 0, nil);
  858. //              else Open_view("*moje_obj",cseznam, MODAL_VIEW+AUTO_CURSOR, 0, 0, id_pohled);
  859.             end
  860.           else 
  861.           begin
  862.            close_cursor(cseznam);
  863.            info_box("upozorn∞nφ","neobsahuje ani 1 zßznam");  
  864.            Open_view("*vyber_zprac_obj",NO_REDIR, 0, 0, 0, nil);
  865.           end; 
  866.     end; //nic
  867. end;
  868.  
  869.  
  870. procedure pridel_obch_login(id_obj:integer;id_org:integer;ID_POHLED1:window_id);
  871. /***************************************************************************************/
  872. var
  873.  irec, jrec, krec:trecnum;
  874.  u:untyped;
  875.  logname:string[80];
  876.  podminka:string[200];
  877.  curs:cursor;
  878.  numpol,idobchobj :integer;
  879.  
  880. begin
  881.   Close_view(ID_POHLED1);
  882.   Info_box("upozorn∞nφ","zkontrolujte ·daje o firm∞"#10"zadejte LOGIN"#10"p°id∞lte obchodnφka");
  883.  
  884.    u := id_org;
  885.    irec := Look_up(obchodni_partneri,"id",u);
  886.    if irec<>-1 then 
  887.    Open_view("*n_firma", NO_REDIR,NO_MOVE+MODAL_VIEW, -irec, 0,nil);
  888.  
  889.     u:=obchodni_partneri[irec].id_obchodnika;
  890.     jrec := Look_up(obchodnici,"id_obchodnika",u);
  891.     if jrec=-1 then  
  892.       begin
  893.          idobchobj:=default_hodnoty[0].obchodnik;
  894.          Info_box("upozorn∞nφ","chyba WinBase - nenalezen obchodnφk ");
  895.       end
  896.      else   idobchobj:=obchodni_partneri[irec].id_obchodnika;
  897.     //logname:=obchodnici[jrec].logname;
  898.  
  899.     u:=id_obj;
  900.     krec := Look_up(obj_header,"id_dobj",u);
  901.     if krec=-1 then  Info_box("upozorn∞nφ","chyba WinBase - nenalezena objednavka")
  902.      else 
  903.       begin
  904.         obj_header[krec].obchodnik:=idobchobj;
  905.         obj_header[krec].zpracovana:=today;
  906.       end;  
  907.  
  908. //              GetSet_next_user(obj_header, krec, 0, OPER_SET, VT_NAME,logname);
  909.  
  910.       zpracovani(false);
  911.       /*
  912.       podminka:="id_dobj="+int2str(id_obj);
  913.       if Open_cursor(Obj_head) then Signalize
  914.       else  if not Restrict_cursor(Obj_head, podminka) then Rec_cnt(curs,numpol);
  915.       if numpol>0 then    Open_view("*detail_obj", Obj_head,NO_MOVE+MODAL_VIEW,0, 0,nil)
  916.                   else    Info_box("upozorn∞nφ","chyba WinBase - nenalezena objednavka");
  917.       Restore_cursor(Obj_head);
  918.       close_cursor(Obj_head);
  919.      */
  920. end;
  921.  
  922.