home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 July / PCWorld_2001-07_cd.bin / Software / Komercni / software602 / cnv_ifp.exe / I_GLPROC.PGM < prev    next >
Encoding:
Text File  |  2001-02-14  |  4.2 KB  |  169 lines
  1. {$$3249892600 .                              }include
  2.  
  3.  
  4.  
  5. type
  6.   SSTRING=string[254];
  7.   LSTRING=string[10000];
  8.  
  9. var
  10.   g_progress      : integer;
  11.   g_progress_step : integer;
  12.  
  13.   glproc_int1     : integer;
  14.  
  15. function ShellExecute(handle : integer; var action, what, xx, yy : string; param : integer) : integer;
  16. external 'SHELL32' name 'ShellExecuteA';
  17.  
  18.  
  19. function SetCurs(var query : string; var curs : cursor; handle : window_id) : boolean;
  20. var
  21.   curs_old : cursor;
  22.   flags    : short;
  23.  
  24. begin
  25.   if handle<>0 then
  26.     begin    
  27.       if not Get_fcursor(handle, curs_old, flags) then SetCurs := false
  28.       else
  29.         begin
  30.           close_cursor(curs_old);
  31.           if Open_sql_cursor(curs, query) then SetCurs := false
  32.           else
  33.             begin                                  
  34.               if not Set_fcursor(handle, curs, -1) then SetCurs := false
  35.               else
  36.                 begin
  37.                   Reset_view(handle, -1, RESET_CACHE);                 
  38.                   SetCurs := true;
  39.                 end;          
  40.             end;
  41.         end;
  42.     end;
  43. end;
  44.  
  45. function SetCursEx(var curs : cursor; handle : window_id) : boolean;
  46. var
  47.   curs_old : cursor;
  48.   flags    : short;
  49.  
  50. begin
  51.   if handle<>0 then
  52.     begin    
  53.       if not Get_fcursor(handle, curs_old, flags) then SetCursEx := false
  54.       else
  55.         begin
  56.           if not Set_fcursor(handle, curs, -1) then SetCursEx := false
  57.           else
  58.             begin
  59.               Reset_view(handle, -1, RESET_CACHE);                 
  60.               close_cursor(curs_old);
  61.               SetCursEx := true;
  62.             end;                                                  
  63.         end;
  64.     end;
  65. end;
  66.  
  67. procedure StrAppend(var source, s : string);
  68. begin
  69.   StrInsert(source, s, StrLength(s)+1);
  70. end;
  71.  
  72. function GetSekvNext(sekv : string[31]) : integer;
  73. var
  74.   sql : SSTRING;
  75. begin
  76.   sql := "SET :>glproc_int1="+sekv+".NEXTVAL";
  77.   if SQL_execute(sql) then GetSekvNext := -1
  78.   else GetSekvNext := glproc_int1;
  79. end;
  80.  
  81. function GetSekvLast(sekv : string[31]) : integer;
  82. var
  83.   sql : SSTRING;
  84. begin
  85.   sql := "SET :>glproc_int1="+sekv+".CURRVAL";
  86.   if SQL_execute(sql) then GetSekvLast := -1
  87.   else GetSekvLast := glproc_int1;
  88. end;
  89.  
  90. function Get_name(f_tit : string[10]; first_name : string[15]; last_name : string[20]; l_tit : string[10]) : string[60];
  91. var
  92.   parsed : string[60];
  93.  
  94. begin  
  95.   parsed:=f_tit;
  96.  
  97.   if (parsed<>"") and (first_name<>"") then parsed:=parsed+" ";  
  98.  
  99.   parsed:=parsed+first_name;
  100.   if (parsed<>"") and (last_name<>"") then parsed:=parsed+" "; 
  101.   
  102.   parsed:=parsed+last_name;
  103.   if (parsed<>"") and (l_tit<>"") then parsed:=parsed+" ";  
  104.  
  105.   parsed:=parsed+l_tit;
  106.   
  107.   Get_name:=parsed;
  108. end;
  109.  
  110. function GetLicNum : integer;
  111. begin
  112.   #sql SET :>glproc_int1=Ri_getlicnum
  113.   GetLicNum := glproc_int1;
  114. end;
  115.  
  116.  
  117. function GetSetFocusNum(h_view : window_id; id : integer; field : string[31]; set : boolean) : integer;
  118. var
  119.   curnum : trecnum;
  120.   curs   : cursor;
  121.   unt    : untyped;  
  122.  
  123. begin
  124.   if not Get_fcursor(h_view, curs, nil) then GetSetFocusNum := -1
  125.   else
  126.     begin      
  127.       unt := id;
  128.       curnum := Look_up(curs, field, unt);
  129.       if curnum>0 then
  130.         begin
  131.           if set then
  132.             Set_ext_pos(h_view, curnum, -1);
  133.           GetSetFocusNum := curnum;
  134.         end;
  135.     end;
  136. end;
  137.  
  138. procedure GoToWebUrl(url : SSTRING);
  139. begin
  140.   if ShellExecute(GetActWind, "open",url,"",".\0",1) <= 32 then
  141.     MessageBox(nil, "Nepoda°ilo se otev°φt URL adresu!", "Chyba", mb_ok+mb_stop);
  142. end;
  143.  
  144. procedure ProgressInit(stepnum : integer; caption : string[255]; text : string[255]);
  145. begin
  146.   if (not Vi_088.IS_OPEN) and (stepnum<=1000) then
  147.     begin
  148.       g_progress := 0;
  149.       g_progress_step := 1000 div stepnum;
  150.       Vi_088.OPEN(nil);
  151.       Vi_088.CAPTION := caption;
  152.       Vi_088.STRING4.TEXT := text; 
  153.     end;
  154. end;
  155.  
  156. procedure ProgressStep(caption : string[255]; text : string[255]);
  157. begin
  158.   g_progress := g_progress+g_progress_step;
  159.   Vi_088.CAPTION := caption;
  160.   Vi_088.STRING4.TEXT := text;
  161.   Vi_088.RESET_VIEW(-1,RESET_CONTROLS);
  162.   Peek_message;
  163. end;
  164.  
  165. procedure ProgressDone;
  166. begin
  167.   Vi_088.CLOSE;
  168. end;
  169.