home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / TESTYINP.PGM < prev    next >
Text File  |  2000-03-16  |  7KB  |  225 lines
  1. {$$3220792584 .                              }INCLUDE
  2. cursor Dskbezdopr; 
  3.  
  4. procedure test_obchinp(id_obchodnika:integer);
  5. /*********************************************************************/
  6.  var
  7.    u:untyped;
  8.    irec:trecnum;
  9.    pommail, pomtyp, pomlog:string[80];
  10.    okobch:Boolean;
  11.  
  12. begin  //0
  13.       okobch:=False;
  14.       u:=id_obchodnika;
  15.       irec:=Look_up(OBCHODNICI,"id_obchodnika",u);
  16.       if irec<>-1 then 
  17.        begin  //1
  18.         pommail:=OBCHODNICI[irec].MAIL_ADRES;
  19.         if strlength(pommail)>5 then 
  20.           begin  //2
  21.             pomtyp:=OBCHODNICI[irec].mailtyp;
  22.               if ((pomtyp="Intenet") OR (pomtyp="MAIL602")) then
  23.                 begin  //3
  24.                   pomlog:=OBCHODNICI[irec].logname;
  25.                   if strlength(pomlog)>0 then okobch:=true;
  26.                 end;   //3
  27.  
  28.           end;   //2
  29.        end;   //1
  30. end;   //0
  31.  
  32. procedure test_cenik(id_form:window_id; kod_zbozi:string[15];dph, vyrobce:integer);
  33. /********************************************************************************************/
  34.  var
  35.    irec:trecnum;
  36.  
  37. begin  //0
  38.    if ((kod_zbozi<>"") AND (dph<>NONEINTEGER) ) then
  39.       begin  //1
  40.         if sys_par[0].vyrobci then  
  41.           begin  //2
  42.             if  (vyrobce<>NONEINTEGER) then
  43.               begin  //3
  44.                if Commit_view(ID_FORM,false,true) then Close_view(ID_FORM);
  45.                sys_par[0].id_last_c:=sys_par[0].id_last_c+1
  46.               end   //3
  47.             else Info_box("UPOZORN╠N═", "nezadali jste v²robce"); 
  48.           end  //2
  49.          else
  50.            begin  //2
  51.              if Commit_view(ID_FORM,false,true) then Close_view(ID_FORM);
  52.              sys_par[0].id_last_c:=sys_par[0].id_last_c+1
  53.            end;   //2
  54.  
  55.       end  //1
  56.     else 
  57.      begin  //1
  58.        Info_box("UPOZORN╠N═", "nezadali jste vÜechny ·daje pot°ebnΘ k zalo₧enφ novΘ polo₧ky cenφku"); 
  59. //       Roll_back_view(ID_FORM);
  60.      end;  //1
  61. end;   //0
  62.  
  63. procedure test_default(id_form:window_id);
  64. /*********************************************************************/
  65.  var 
  66.  pom:integer;
  67.  pomstr, info:string[255];
  68.  
  69. begin  //0
  70.  info:="V default hodnotßch musφ b²t zadßny vÜechny hodnoty. Chybφ zadat:";
  71.  pomstr:="";
  72.  if default_hodnoty[0].DPH=NONEINTEGER then pomstr:=pomstr+" DPH "; 
  73.  if default_hodnoty[0].DEAL_SK=NONEINTEGER then pomstr:=pomstr+", dealerskß skupina "; 
  74.  if default_hodnoty[0].ZP_DOPRAV =NONEINTEGER then pomstr:=pomstr+", zp∙sob dopravy a platby "; 
  75.  if default_hodnoty[0].TYP_UZIV=NONEINTEGER then pomstr:=pomstr+", typ u₧ivatele "; 
  76. // if default_hodnoty[0].RABATOVA_METODA =NONEINTEGER then pomstr:=pomstr+", rabatovß metoda"; 
  77.  if default_hodnoty[0].OBCHODNIK =NONEINTEGER then pomstr:=pomstr+", obchodnφk"; 
  78.  if default_hodnoty[0].JEDNOTKA=NONEINTEGER then pomstr:=pomstr+", jednotka"; 
  79.  if default_hodnoty[0].ROUND_ID =NONEINTEGER then pomstr:=pomstr+", zp∙sob zaokrouhlenφ"; 
  80. // if default_hodnoty[0].PLATBA =NONEINTEGER then pomstr:=pomstr+", formulß°"; 
  81.  
  82. if  strlength(pomstr)>0 then  Info_box(info,pomstr)
  83. else Close_view(ID_FORM);
  84. end;   //0
  85.  
  86. procedure test_dopr(id_form:window_id);
  87. /*********************************************************************/
  88.  var 
  89.  pom, pocet, i:integer;
  90.  pomstr, info, pomstr2 :string[255];
  91.  
  92. begin  //0
  93.  info:="Ka₧dΘ dealerskΘ skupin∞ je t°eba vybrat alespo≥ 1 zp∙sob dopravy a platby. Chybφ zadat:";
  94.  pomstr:="";
  95.  if Open_cursor(Dskbezdopr) then Signalize
  96.   else begin Rec_cnt(Dskbezdopr, pocet);
  97.    if pocet>0 then
  98.     begin
  99.       for i:=0 to pocet-1 do
  100.        begin
  101.           pomstr2:=Dskbezdopr[i].deal_skupina;
  102.           pomstr:=pomstr+", "+ pomstr2;
  103.        end;
  104.     end;
  105.     close_cursor(Dskbezdopr);
  106.    end;
  107.  
  108. if  strlength(pomstr)>0 then  Info_box(info,pomstr)
  109. else Close_view(ID_FORM);
  110. end;   //0
  111.  
  112. procedure test_licence(liccis:string[25]);
  113. /*********************************************************************/
  114.  var 
  115.  pom, pocet, i:integer;
  116.  pomstr, info, pomstr2 :string[255];
  117.  ok:boolean;
  118.  
  119. begin  //0
  120.   STRTRIM(liccis);
  121.   Upcase(liccis);
  122.   pom:=-1;
  123.   if ((strlength(liccis)=21) AND (Pref("WDE",liccis))) then pom:=ValidSerNumC(liccis); 
  124.   if pom=0 then ok:=true else  ok:=false;
  125.   if NOT ok then
  126.    begin
  127.     info:="Chybn∞ zadanΘ licenΦnφ Φφslo, program bude nadßle pracovat s omezenφmi pro LITE verzi";
  128.     pomstr:=liccis;
  129.     if strlength(liccis)>0 then Info_box(info,pomstr);
  130.     pomtr:=0;
  131.     sys_par[0].mailovat:=false;
  132.   end 
  133.   else 
  134.    pomtr:=5;
  135. end;   //0
  136.  
  137. procedure testlic();
  138. /*********************************************************************/
  139.  var 
  140.    pom, pocet, i:integer;
  141.    pomstr, info, pomstr2 :string[255];
  142.    ok:boolean;
  143.    licnum:string[25];
  144.  begin  //0
  145.    pom:=-1;
  146.    licnum:=SYS_PAR[0].liccis;
  147.    STRTRIM(licnum);
  148.    Upcase(licnum);
  149.    if ((strlength(licnum)=21) AND  (Pref("WDE",licnum))) then pom:=ValidSerNumC(licnum); 
  150.    if pom=0 then 
  151.    begin pomtr:=5; ok:=true end 
  152.    else begin  pomtr:=0; ok:=false; end;
  153.    if NOT ((Current_application.=."_demo") OR (Current_application.=."_DEMO")) then
  154.    begin if NOT ok then    Open_view("*licenceok",NO_REDIR,MODAL_VIEW,0,0,nil); end;
  155.  
  156.  end;   //0
  157.  
  158.  
  159. procedure  browser1(); 
  160. /*********************************************************************/
  161.  var
  162.   chybaB, chybaF :integer;
  163.   browser: string[254];
  164.   f:file;
  165.  
  166.  begin
  167.   if rewrite(f,"c:\findbrow.htm") then   
  168.   begin
  169.     Close(f);
  170.     chybaF:=FindExecutable("findbrow.htm","C:\", browser);
  171.     delete_file("c:\findbrow.htm");
  172.    end;
  173.    if (chybaF>32) then
  174.     begin
  175.       chybaB:=Exec(browser, "HTTP:\\www.SOFTWARE602.CZ\eshop\");
  176.     end;
  177.     if chybaB<32  then Info_box('Chyba p°i spouÜt∞nφ browseru',int2str(chybaB));
  178.  end; 
  179.  
  180.  
  181.  
  182. procedure  browser2(); 
  183. /*********************************************************************/
  184.  var
  185.   chybaB, chybaF :integer;
  186.   browser: string[254];
  187.   f:file;
  188.  
  189.  begin
  190.   if rewrite(f,"c:\findbrow.htm") then   
  191.   begin
  192.     Close(f);
  193.     chybaF:=FindExecutable("findbrow.htm","C:\", browser);
  194.     delete_file("c:\findbrow.htm");
  195.    end;
  196.    if (chybaF>32) then
  197.     begin
  198.       chybaB:=Exec(browser, "http://www.software602.cz/produkty/eshop/eshop.htm");
  199.     end;
  200.     if chybaB<32  then Info_box('Chyba p°i spouÜt∞nφ browseru',int2str(chybaB));
  201.  end; 
  202.  
  203.  
  204. procedure  browser3(); 
  205. /*********************************************************************/
  206.  var
  207.   chybaB, chybaF :integer;
  208.   browser: string[254];
  209.   f:file;
  210.  
  211.  begin
  212.   if rewrite(f,"c:\findbrow.htm") then   
  213.   begin
  214.     Close(f);
  215.     chybaF:=FindExecutable("findbrow.htm","C:\", browser);
  216.     delete_file("c:\findbrow.htm");
  217.    end;
  218.    if (chybaF>32) then
  219.     begin
  220.       chybaB:=Exec(browser, "http://www.software602.cz/registrace/");
  221.     end;
  222.     if chybaB<32  then Info_box('Domovskß strßnka - Chyba p°i spouÜt∞nφ browseru',int2str(chybaB));
  223.  end; 
  224.  
  225.