home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk12 / data.12 / WINTEXT / MAKRA / SOURCES / TISK.TXT < prev    next >
Text File  |  1996-12-17  |  4KB  |  172 lines
  1. //***********************************************************************
  2. //*
  3. //*       Nßzev makra:   Tisk nesouvisl²ch oblastφ dokumentu
  4. //*             Autor:   Software602 a.s.
  5. //*   Datum vytvo°enφ:   17.12.1996
  6. //*
  7. //*     Nßzev souboru:   
  8. //*    Nßzev programu:   
  9. //*              Tisk:    
  10. //*
  11. //*             Popis:   Tisk libovolnΘho rozsahu stran dokumentu
  12. //*                      p°. pou₧itφ: 1-3,8,12-15,5,4
  13. //*
  14. //******************************************************************mt***
  15. Program Tisk;
  16.  
  17. const
  18.   MAXLEN       = 100;
  19.   MAXPAGES     = 50;
  20.  
  21.   CHAR_0       = 48;
  22.   CHAR_9       = 57;
  23.   CHAR_SPACE   = 32;
  24.  
  25.   ERR_BADCHAR  = -1;
  26.   ERR_NOTPAGE  = -2;
  27.  
  28.  
  29. type
  30.   formStr = string[MAXLEN];
  31.  
  32.   tPage = record
  33.     first,
  34.     last  :short;
  35.   end;
  36.  
  37.  
  38. var
  39.   formatS :formStr;
  40.   page :array[1..MAXPAGES] of tPage;
  41.   pgCount :integer;
  42.   infStr1, infStr2, infStr3 :string[100];
  43.   i :integer;
  44.   pgCn :integer;
  45.   chOddel, chPole :char;
  46.  
  47.  
  48. function GetFormat(var s:formStr):boolean;
  49. begin
  50.   s := "1";
  51.   if (GetTotPages > 1) then
  52.     s := s + "-" + int2str(GetTotPages);
  53.   GetFormat := Input_box_msg (
  54.      'Vlo₧te Φφsla/rozsah stran odd∞lenΘ Φßrkou:',
  55.      'P°iklad:  1,2,5-8,10', s, MAXLEN );
  56. end;
  57.  
  58.  
  59. function GetNumbers(s:formStr):short;
  60. var
  61.   result, i :short;
  62.   tmp :string[MAXLEN];
  63.   err :short;
  64.   num :short;
  65.   OnlyLast :boolean;
  66.  
  67. begin
  68.   result := 0;
  69.   i := 1;
  70.   tmp := '';
  71.   err := 0;
  72.   OnlyLast := false;
  73.   StrTrim(s);
  74.  
  75.   while (i <= StrLength(s)) and (err = 0) do begin
  76.     if((ord(s[i]) >= CHAR_0) and (ord(s[i]) <= CHAR_9)) then
  77.       (***  Φφslo :  ***)
  78.       tmp := tmp + StrCopy(s, i, 1);
  79.  
  80.     if(s[i] <> chOddel) and
  81.       ((ord(s[i]) < CHAR_0) or (ord(s[i]) > CHAR_9)) and
  82.       (ord(s[i]) <> CHAR_SPACE) and (s[i] <> chPole) then
  83.       (***  neznßm² znak :  ***)
  84.       err := ERR_BADCHAR
  85.  
  86.     else if(s[i] = chOddel) or (i = StrLength(s)) then begin
  87.       (***  ukonΦovacφ znak nebo konec °et∞zce, p°elo₧ na Φφslo :  ***)
  88.       num := Str2Int(tmp);
  89.       if (num > GetTotPages) or (num <= 0) then err := ERR_NOTPAGE
  90.       else begin
  91.         if not(OnlyLast) then begin
  92.           inc(result);
  93.           page[result].first := num;
  94.         end
  95.         else OnlyLast := false;
  96.         page[result].last := num;
  97.         tmp := '';
  98.       end;
  99.     end
  100.  
  101.     else if (s[i] = chPole) then begin
  102.       (***  pole stran :  ***)
  103.       num := Str2Int(tmp);
  104.       if (num > GetTotPages) or (num <= 0) then err := ERR_NOTPAGE
  105.       else begin
  106.         inc(result);
  107.         page[result].first := num;
  108.       end;
  109.       OnlyLast := true;
  110.       //inc(i);
  111.       tmp := '';
  112.     end;
  113.     inc(i);
  114.   end;
  115.  
  116.   if(err <> 0) then GetNumbers := err else GetNumbers := result;
  117. end;
  118.  
  119.  
  120. begin
  121.   chOddel := ',';
  122.   chPole := '-';
  123.   formatS := '';
  124.  
  125.   if (GetFormat(formatS)) then begin
  126.     pgCount := GetNumbers(formatS);
  127.  
  128.     case (pgCount) of
  129.       ERR_BADCHAR:
  130.         Info_box('Chyba!', 'Chyba p°i Φtenφ dat!');
  131.  
  132.       ERR_NOTPAGE:
  133.         Info_box('Chyba!', 'èpatnΘ Φφslo strany!');
  134.  
  135.       else: if (pgCount > 0) then begin
  136.         i := 1;
  137.         pgCn := 0;
  138.  
  139.         while (i <= pgCount) do begin
  140.           if(page[i].first = page[i].last)
  141.             then infStr2 := infStr2 + Int2Str(page[i].first)
  142.             else infStr2 := infStr2 + Int2Str(page[i].first) + '..'
  143.               + Int2Str(page[i].last);
  144.             { secteni stran : }
  145.             if (page[i].last >= page[i].first) then
  146.               inc(pgCn, (page[i].last - page[i].first) + 1)
  147.             else
  148.               inc(pgCn, (page[i].first - page[i].last) + 1);
  149.           if(i <> pgCount) then infStr2 := infStr2 + ', ';
  150.           i := i + 1;
  151.         end;
  152.  
  153.         infStr1 := 'PoΦet stran:   ' + Int2Str(pgCn);
  154.         infStr2 := 'JednotlivΘ strany:    ' + infStr2;
  155.         infStr3 := infStr1 + #13#10 + infStr2 + #13#10#13#10 + 
  156. 'Vytisknout?';
  157.  
  158.         if(YesNo_box('PrintDoc', infStr3)) then begin
  159.           { tisk : }
  160.           i := 1;
  161.           while (i <= pgCount) do begin
  162.             Print(false, 1, 0, page[i].first, page[i].last);
  163.             i := i + 1;
  164.           end;
  165.         end;
  166. //      Info_Box('PrintDoc', 'Konec makra PrintDoc.');
  167.       end;
  168.  
  169.     end;  { case }
  170.   end;
  171. end.
  172.