home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / ctkit11.zip / SCSTUFF.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-05  |  7KB  |  269 lines
  1. Function BitSizeOf (x, y: integer): word;
  2.  
  3. var
  4.    t: integer;
  5.  
  6. begin
  7. if gd = 1 then
  8.    t := (x div 8 + 1)
  9.    else
  10.    t := (x div 8 + 1) * 2;
  11. BitSizeOf := t * (y+1) + 3;
  12. end;
  13.  
  14. Procedure SteToBit(var Size: word);
  15.  
  16. var
  17.    Bytes: array [1..2] of byte;
  18.    CurBytes: array[1..320] of byte;
  19.    x, y, n, b, count, at, g, across, plus, plus2, plus3, CinP, ecnt, ecnt1,
  20.       ecnt2, ecnt3, r, width, pig, togo: integer;
  21.    ybyte, temp0, temp1, temp2, temp3, tb0, tb1, tb2, tb3: byte;
  22.    c, d: cdtype;
  23.    tw, tw2: word;
  24.  
  25. begin
  26. New (TPic);
  27. Move (Pic^, TPic^, Size*2);
  28. if tpic^[1] < 9000 then
  29.    begin
  30.    Dispose(TPic);
  31.    exit;
  32.    end;
  33. FillChar (Pic^, SizeOf(Pic^), 0);
  34. Pic^[1] := TPic^[3];
  35. Pic^[2] := TPic^[4];
  36. width := Pic^[1];
  37. plus := width div 8 + 1;
  38. plus2 := plus*2;
  39. plus3 := plus*3;
  40. n := 3;
  41. if (gd = 1) and (gm = 4) then
  42.    begin
  43.    across := 0;
  44.    g := 7;
  45.    tw2 := 0;
  46.    For CinP := 5 to Size do
  47.       begin
  48.       tw := TPic^[Cinp];
  49.       if tw = 0 then
  50.          begin
  51.          inc(CinP);
  52.          Togo := TPic^[CinP];
  53.          Inc(CinP);
  54.          Move(TPic^[Cinp],Bytes,2);
  55.          end else begin
  56.          togo := 1;
  57.          Move(tw,Bytes,2);
  58.          end;
  59.       for tb0 := 1 to togo do
  60.       begin
  61.       for count := 1 to bytes[1] do
  62.          begin
  63.          tw2 := tw2 or (1 shl g);
  64.          dec(g);
  65.          if g = -1 then
  66.             g := 15;
  67.          inc(Across);
  68.          if Across > Width then
  69.             begin
  70.             Across := 0;
  71.             if ((g < 7) or (g=15)) and ((cinp <> size) or (count < bytes[1])) then
  72.                g := 15
  73.                else
  74.                g := 7;
  75.             end;
  76.          if g = 7 then
  77.             begin
  78.             Pic^[n] := tw2;
  79.             inc(n);
  80.             tw2 := 0;
  81.             end;
  82.          end;
  83.       for count := 1 to bytes[2] do
  84.          begin
  85. {        tw2 := tw2 or 0; }
  86.          dec(g);
  87.          if g = -1 then
  88.             g := 15;
  89.          inc(Across);
  90.          if Across > Width then
  91.             begin
  92.             Across := 0;
  93.             if ((g < 7) or (g=15)) and ((cinp <> size) or (count < bytes[2])) then
  94.                g := 15
  95.                else
  96.                g := 7;
  97.             end;
  98.          if g = 7 then
  99.             begin
  100.             Pic^[n] := tw2;
  101.             inc(n);
  102.             tw2 := 0;
  103.             end;
  104.          end;
  105.       end;
  106.       end;
  107.    Size := (width div 16 + 1)*(Pic^[2]+1)+3;
  108.    Dispose (TPic);
  109.    exit;
  110.    end;
  111. if gd = 1 then
  112.    begin
  113.    across := 0;
  114.    g := 6;
  115.    tw := 0;
  116.    togo := 0;
  117.    for CinP := 5 to Size do
  118.       begin
  119.       if togo > 0 then
  120.          begin
  121.          dec(togo);
  122.          dec(CinP);
  123.          end else begin
  124.          move (TPic^[CinP], Bytes, 2);
  125.          c[1] := bytes[2] shr 6;
  126.          c[2] := bytes[1] shr 6;
  127.          d[1] := bytes[2] mod 64;
  128.          d[2] := bytes[1] mod 64;
  129.          end;
  130.       if d[2] = 0 then
  131.          begin
  132.          togo := Bytes[2];
  133.          inc(CinP);
  134.          move (TPic^[CinP], Bytes, 2);
  135.          c[1] := bytes[2] shr 6;
  136.          c[2] := bytes[1] shr 6;
  137.          d[1] := bytes[2] mod 64;
  138.          d[2] := bytes[1] mod 64;
  139.          end;
  140.       for count := 1 to 2 do
  141.          for at := 1 to d[count] do
  142.             begin
  143.             if Across > width then
  144.                begin
  145.                Across := 0;
  146.                if g > 6 then
  147.                   begin
  148.                   Pic^[n] := tw;
  149.                   inc(n);
  150.                   tw := 0;
  151.                   g := 6;
  152.                   end else
  153.                   if g < 6 then
  154.                      g := 14;
  155.                end;
  156.             if g = -2 then
  157.                g := 14;
  158.             if c[count] > 0 then
  159.                tw := tw or (c[count] shl g);
  160.             Inc(Across);
  161.             dec(g);
  162.             dec(g);
  163.             if (g = 6) then
  164.                begin
  165.                Pic^[n] := tw;
  166.                inc(n);
  167.                tw := 0;
  168.                end;
  169.             end;
  170.       end;
  171.    end else begin
  172.    Across := plus2;
  173.    ybyte := 128;
  174.    b := 0;
  175.    ecnt := 1;
  176.    ecnt1 := plus+1;
  177.    ecnt2 := plus2+1;
  178.    ecnt3 := plus3+1;
  179.    tb0 := 0;
  180.    tb1 := 0;
  181.    tb2 := 0;
  182.    tb3 := 0;
  183.    for CinP := 5 to Size do
  184.       begin
  185.       togo := 1;
  186.       move (TPic^[CinP], Bytes, 2);
  187.       d[2] := Bytes[1] mod 16;
  188.       if d[2] = 0 then
  189.          begin
  190.          togo := Bytes[2] + 1;
  191.          Inc(CinP);
  192.          move (TPic^[CinP], Bytes, 2);
  193.          d[2] := Bytes[1] mod 16;
  194.          end;
  195.       c[1] := Bytes[2] shr 4;
  196.       d[1] := Bytes[2] mod 16;
  197.       c[2] := Bytes[1] shr 4;
  198.       repeat
  199.          dec(togo);
  200.          for count := 1 to 2 do
  201.             begin
  202. {           temp0 := Colors[c[count],0];
  203.             temp1 := Colors[c[count],1];
  204.             temp2 := Colors[c[count],2];
  205.             temp3 := Colors[c[count],3];  }
  206.             temp0 := c[count] and 8;
  207.             temp1 := c[count] and 4;
  208.             temp2 := c[count] and 2;
  209.             temp3 := c[count] and 1;
  210.             for AT := 1 to d[count] do
  211.                begin
  212.                if ybyte = 0 then
  213.                   begin
  214.                   ybyte := 128;
  215.                   CurBytes[ecnt] := tb0;
  216.                   CurBytes[ecnt+plus] := tb1;
  217.                   CurBytes[ecnt+plus2] := tb2;
  218.                   CurBytes[ecnt+plus3] := tb3;
  219.                   inc(ecnt);
  220. {                 inc(ecnt1);
  221.                   inc(ecnt2);
  222.                   inc(ecnt3);   }
  223.                   tb0 := 0;
  224.                   tb1 := 0;
  225.                   tb2 := 0;
  226.                   tb3 := 0;
  227.                   end;
  228.                if temp0=8 then
  229.                   tb0 := tb0 or ybyte;
  230.                if temp1=4 then
  231.                   tb1 := tb1 or ybyte;
  232.                if temp2=2 then
  233.                   tb2 := tb2 or ybyte;
  234.                if temp3=1 then
  235.                   tb3 := tb3 or ybyte;
  236.                ybyte := ybyte shr 1;
  237.                inc(b);
  238.                if b > width then
  239.                   begin
  240. {                 CurBytes[ecnt] := tb0;
  241.                   CurBytes[ecnt1] := tb1;
  242.                   CurBytes[ecnt2] := tb2;
  243.                   CurBytes[ecnt3] := tb3;  }
  244.                   CurBytes[ecnt] := tb0;
  245.                   CurBytes[ecnt+plus] := tb1;
  246.                   CurBytes[ecnt+plus2] := tb2;
  247.                   CurBytes[ecnt+plus3] := tb3;
  248.                   move (CurBytes, Pic^[n], Across*2);
  249.                   b := 0;
  250.                   ybyte := 128;
  251.                   tb0 := 0;
  252.                   tb1 := 0;
  253.                   tb2 := 0;
  254.                   tb3 := 0;
  255.                   ecnt := 1;
  256. {                 ecnt1 := plus+1;
  257.                   ecnt2 := plus2+1;
  258.                   ecnt3 := plus3+1;   }
  259.                   n := n + across;
  260.                   end;
  261.                end;
  262.             end;
  263.          until (togo = 0);
  264.       end;
  265.    end;
  266. Size := BitSizeOf (width, Pic^[2]);
  267. Dispose (TPic);
  268. end;
  269.