Преобразование изображения таким образом, чтобы строки располагались в порядке возрастания по средней яркости, страница 2

    if head<>TiffHead then begin

                              writeln('This is not a TIFF file');

                              readln;

                              halt

                           end;

    Blockread(f,BegIFD,4);

    Seek(f,BegIFD);

    Blockread(f,NumberofTag,2);

    IFDInd:=BegIFD+2;

    for i:=1 to NumberofTag do

       begin

          Blockread(f,TagType,2);

          case TagType of

             256: begin

                    Inc(IFDInd,8);

                    Seek(f,IFDInd);

                    Blockread(f,Wx,4);

                  end;

             257: begin

                    IFDInd:=IFDInd+8;

                    Seek(f,IFDInd);

                    Blockread(f,Wy,4);

                  end;

             273: begin

                    IFDInd:=IFDInd+2;

                    Seek(f,IFDInd);

                    Blockread(f,PoinTyp,2);

                    IFDInd:=IFDInd+2;

                    Seek(f,IFDInd);

                    Blockread(f,comp,4);

                    IFDInd:=IFDInd+4;

                    Seek(f,IFDInd);

                    if comp=1 then Blockread(f,seektiff,4)

                              else begin

                                      Blockread(f,PoinAdr,4);

                                      Seek(f,PoinAdr);

                                      Blockread(f,seektiff,PoinTyp);

                                     end;

                    end;

             else begin IFDInd:=IFDInd+8;

                     end;

          end; {case}

          Inc(IFDInd,4);

          Seek(f,IFDInd);

       end;

End; {HeadRead}

PROCEDURE oformlenie;

Var   

          Xmax,Ymax                   :string;

          Xpal,Ypal                       :word;

begin

      OutTextXY(Getmaxx -200 ,getmaxy-20,'Press any key  ');

      str(getmaxx+1,Xmax);

      str(getmaxy+1,Ymax);

      SetColor(15);

      OutTextXY(10,0,'   File  '+ImageFile1);

      OutTextXY(getmaxx-220,0,'  Resolution   - '+Xmax+'x'+Ymax);

      str(Wx,Xmax);

      str(Wy,Ymax);

      OutTextXY(getmaxx-220,15,'Picture size - '+Xmax+'x'+Ymax);

      Xpal:=0;

      Ypal:=getmaxy-30;

      SetColor(15);

      OutTextXY(Xpal,Ypal,'  Palette:');

      for col:=0 to 15 do

       for y:=0 to 10 do

        for x:=0 to 10 do

     putpixel(Xpal+col*12+x,Ypal+16+y,col);

end;

PROCEDURE puzirek;

var

          i,j                           :longint;

begin

           for y:=1 to Wy do

         begin

             for i:=1 to wy-y do

             if (br[i,1]>br[i+1,1]) then

             begin

             j:=br[i,1];

             br[i,1]:=br[i+1,1];

             br[i+1,1]:=j;

             j:=br[i,2];

             br[i,2]:=br[i+1,2];

             br[i+1,2]:=j;

             end

         end;

end;

Begin

  clrscr;

  if paramcount <> 0 then imagefile1:=paramstr(1)

  else Begin

  write('Enter a name of TIFF - file...');

  Readln(ImageFile1);

       end;

  if ImageFile1=''then ImageFile1:='mouseb.tif';

  Assign(f,ImageFile1);

  Size:=1;

  Reset(f,Size);

  if (imagefile1='eagle.dat') then begin

                                   wx:=180;wy:=240;seektiff:=0;

                                   end

  else headread;

  seek(f,seektiff);

{выделение для каждой строки динамической области памяти}

  for y:=1 to Wy do

          begin

            new(po[y]);

            blockread(f,po[y]^,Wx);

          end;

 close(f);

{вывод исходного изображения и заполнение массива яркости}

        Driv:=9;                                               

        Mode:=2;

        InitGraph(Driv,Mode,'c:fpc\img');

        for y:=0 to 15 do

         begin

          SetRGBpalette(y,y*4,y*4,y*4);

          SetPalette(y,y);

         end;

        for y:=1 to Wy do

        begin z:=0;

           for x:=1 to Wx do

             begin

             col:=po[y]^[x] ;

             col:=col shr 4;

             putpixel(x+50,y+50,col);

             z:=z+po[y]^[x];

             end;

            br[y,1]:=z;

            br[y,2]:=y;

        end;

       oformlenie;

       puzirek;

       readkey;

{вывод обработанного изображения}

    for y:=1 to wy do

     for x:=1 to wx do

      begin

       z:=br[y,2];

       col:=po[z]^[x] ;

       col:=col shr 4;

       putpixel(x+50,y+50,col);

      end;

 OutTextXY(getmaxx-220,30,'Obrabotannoe izobragenie');

 readln;

end.