⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit12.~pas

📁 一个比较好的图象处理器。
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
   x,y,pos:integer;
    temp:array  of  byte;
   val:integer;

 begin
  backup();
  progressbar1.Position:=0;

 for y:=0  to   h-2    do
begin
  for  x:=0  to   w-2   do
   begin
     pos:=y*w*3+x*3;
     val:=trunc((pixels[pos]-pixels[pos+w*3+3]+pixels[pos+1]-pixels[pos+w*3+4]+pixels[pos+2]-pixels[pos+3*w+5])/3)+127;
     if val>255 then
     temp[pos]:=255
     else if val<0 then
      temp[pos]:=0;
     pixels[pos]:=val;
   pixels[pos+1]:=val;
     pixels[pos+2]:=val;

      end;
        for  x:=w*3-3  to  w*3-1   do
        pixels[y*w*3+x]:=127;
        progressbar1.Position:=trunc(100*y/(h-1));
        end;
        for  x:=0   to   w*3-1    do
         pixels[(h-1)*w*3+x]:=127;
                   progressbar1.Position:=0;
           updateimage();
    end;

procedure TForm1.N17Click(Sender: TObject);
begin
  form2.ShowModal;
end;

procedure TForm1.N19Click(Sender: TObject);
 var
   x,y,pos:integer;
   ave:double;


begin
   backup();
   progressbar1.Position:=0;
   ave:=0;
   for y:=0  to  h-1  do
     for  x:=0   to  w*3-1   do
       ave:=ave+pixels[y*w*3+x];
     ave:=ave/(w*h*3);
     for  Y:=0  to  h-1  do
      begin
        for   x:=0   to   w-1   do
          begin
           pos:=y*w*3+x*3;
            if  (pixels[pos]+pixels[pos]+pixels[pos]>=ave*3)  then
             begin
              pixels[pos]:=255;
              pixels[pos+1]:=255;
             pixels[pos+2]:=255;
                end
                 else begin
                 pixels[pos]:=0;
              pixels[pos+1]:=0;
             pixels[pos+2]:=0;
             end;
             end;
             progressbar1.Position:=trunc(100*y/(h-1));
             end;
             progressbar1.Position:=0;
       updateimage;

end;

procedure TForm1.N20Click(Sender: TObject);
  var
   x,y,pos:integer;
   temp:array  of  byte;
   k,mx,my:integer;

 begin
backup();
progressbar1.Position:=0;
 setlength(temp,length(pixels));
 randomize;
 k:=2;
 for  y:=k  to   h-1-k   do
   begin
    for  x:=k  to  w-1-k  do
     begin
      mx:=round(random(k*2))-k;
      my:=round(random(k*2))-k;
      pos:=y*w*3+x*3;
      temp[pos]:=pixels[pos+my*w*3+mx*3];
       temp[pos+1]:=pixels[pos+my*w*3+mx*3+1];
        temp[pos+2]:=pixels[pos+my*w*3+mx*3+2];
       end;
       progressbar1.Position:=trunc(100*y/(h-1));
       end;
       for  y:=k  to  h-k-1  do
        for  x:=k*3  to  (w-1-k)*3+2   do
         pixels[y*w*3+x]:=temp[y*w*3+x];
         progressbar1.Position:=0;
         updateimage();
         

end;



procedure TForm1.N23Click(Sender: TObject);
  var
    x,y,i:integer;
    bitmap:tbitmap;
    pixcolo:pbytearray;


begin
  bitmap:=tbitmap.Create;
    try
    bitmap.Assign(image1.Picture.Graphic);
    bitmap.PixelFormat:=pf24bit;
    for i:=0 to 255 do
      begin
         for y:=0 to bitmap.Height-1 do
          begin
           pixcolo:=bitmap.ScanLine[y];
             for x:=0 to  (bitmap.Width*3 div 2-1) do
               if pixcolo[x]>0 then pixcolo[x]:=(pixcolo[x]-1);
               end;
                image1.Canvas.Draw(0,0,bitmap);
               application.ProcessMessages;
               end;
               finally bitmap.Free;
             end;

end;

procedure TForm1.N24Click(Sender: TObject);
 var
    x,y,i:integer;
    bitmap1,bitmap2:tbitmap;
    pixcolo1,pixcolo2:pbytearray;
begin
   bitmap1:=tbitmap.Create;
     bitmap2:=tbitmap.Create;
     try
        bitmap1.Assign(image1.Picture.Graphic);
        bitmap2.Assign(image1.Picture.Graphic);
        bitmap1.PixelFormat:=pf24bit;
         bitmap2.PixelFormat:=pf24bit;
          for y:=0 to bitmap2.Height-1 do
          begin
           pixcolo2:=bitmap2.ScanLine[y];
             for x:=0 to (bitmap2.Width*3 div 2-1) do
               pixcolo2[x]:=0;
               end;
      for i:=0 to  255  do
        begin
            for y:=0 to bitmap2.Height-1 do
              begin
                 pixcolo2:=bitmap2.ScanLine[y];
                  pixcolo1:=bitmap1.ScanLine[y];
                    for x:=0 to (bitmap2.Width*3 div 2-1) do
                     if pixcolo2[x]<pixcolo1[x] then
                       pixcolo2[x]:=(pixcolo2[x]+1);
               end;
        image1.Canvas.Draw(0,0,bitmap2);
        application.ProcessMessages;
        end;
        finally bitmap1.Free;
      end;

end;

procedure TForm1.N26Click(Sender: TObject);
const
   step=100;
   x0=0;
   y0=0;
var
   bitmap:tbitmap;
   midx:integer;
   ratiox:real;
   i:integer;

   rect1,rect2:trect;
   begin

   bitmap:=tbitmap.Create;
   bitmap.loadfromfile(form1.OpenPictureDialog1.FileName);
   ratiox:=bitmap.Width/step;
   for i:=0 to step do
     begin
       midx:=round(ratiox*i);
         with rect1 do
           begin
            left:=bitmap.width-midx;
             top:=0;
             right:=bitmap.Width;
             bottom:=bitmap.Height;
             end;
         with rect2 do
          begin
            left:=x0;
            top:=y0;
            right:=x0+midx;
            bottom:=y0+bitmap.Height;
            end;
          image1.Canvas.CopyRect(rect2,bitmap.Canvas,rect1);
          image1.Refresh;
          end;
          bitmap.Free;


end;

procedure TForm1.N27Click(Sender: TObject);
 var
  bitmap:tbitmap;
  i,j:integer;
begin
  bitmap:=tbitmap.Create;
   bitmap.LoadFromFile(form1.OpenPictureDialog1.FileName);
   i:=0;
   while i<=bitmap.Width do
     begin
       j:=i;
        while j>0 do
        begin
        image1.Canvas.CopyRect(rect(j-1,0,j,bitmap.Height),bitmap.Canvas,rect(bitmap.Width-i+j-1,0,bitmap.Width-i+j,bitmap.Height));
         image1.Canvas.CopyRect(rect(bitmap.Width-j,0,bitmap.Width-j+1,bitmap.Height),bitmap.Canvas,rect(i-j,0,i-j+1,bitmap.Height));
       j:=J-2;
           end;
           image1.Refresh;
           i:=i+2;
           end;
           bitmap.Free;


end;

procedure TForm1.N28Click(Sender: TObject);
 var
  bitmap:tbitmap;
  i,j:integer;

begin
 bitmap:=tbitmap.Create;
   bitmap.LoadFromFile(form1.OpenPictureDialog1.FileName);
   i:=0;
   while i<=bitmap.Height do
     begin
       j:=i;
        while j>0 do
        begin
        image1.Canvas.CopyRect(rect(0,j-1,bitmap.Width,j),bitmap.Canvas,rect(0,bitmap.Height-i+j-1,bitmap.Width,bitmap.Height-i+j));
         image1.Canvas.CopyRect(rect(0,bitmap.Height-j,bitmap.Width,bitmap.Height-j+1),bitmap.Canvas,rect(0,i-j,bitmap.Width,i-j+1));
           j:=J-1;
           end;
           image1.Refresh;
           i:=i+1;
           end;
           bitmap.Free;

end;

procedure TForm1.N29Click(Sender: TObject);
 var
  bitmap:tbitmap;
  i,j:integer;
  xgroup,xcount:integer;


begin
   bitmap:=tbitmap.Create;
  bitmap.LoadFromFile(form1.OpenPictureDialog1.FileName);
  xgroup:=16;
  xcount:=bitmap.Height div xgroup;
  for i:=0 to xcount do
   for j:=0 to xgroup do
    begin
     image1.Canvas.CopyRect(rect(0,xcount*j+i-1,bitmap.Width,xcount*j+i),bitmap.Canvas,rect(0,xcount*j+i-1,bitmap.Width,xcount*j+i-j));
     image1.Refresh;
     end;
     bitmap.Free;
     

end;

procedure TForm1.N30Click(Sender: TObject);
var
bitmap:tbitmap;
i,j:integer;
begin
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile(form1.OpenPictureDialog1.FileName);
  i:=bitmap.Height;
  while i>0 do
   begin
     for j:=100 to i do
       begin
        image1.Canvas.CopyRect(rect(0,j-100,bitmap.Width,j),bitmap.Canvas,rect(0,i-100,bitmap.Width,i));
        image1.Refresh;
        end;
        i:=i-100;
        end;
        bitmap.Free;


end;

procedure TForm1.N31Click(Sender: TObject);
  var
   x,y:integer;

begin
   backup();
   for  y:=0  to  h-1   do
     for  x:=0  to  w*3-1   do
      pixels[y*w*3+x]:=255;
      updateimage();
end;

procedure TForm1.N32Click(Sender: TObject);

   var
   x,y:integer;
 begin
 backup();
 for y:=0  to  h-1   do
    for  x:=0  to  w*3-1    do
      pixels[y*w*3+x]:=255-pixels[y*w*3+x];
      updateimage();

end;

procedure TForm1.N33Click(Sender: TObject);
 var
   x,y:integer;
   r,g,b,gr:byte;

begin
  backup();
  progressbar1.Position:=0;
  for  y:=0   to  h-1  do
    begin
    for  x:=0  to  w-1  do
    begin
      b:=pixels[y*w*3+x*3];
        g:=pixels[y*w*3+x*3+1];
     r:=pixels[y*w*3+x*3+2];
     gr:=trunc(b*0.11+g*0.95+r*0.3);
     pixels[y*w*3+x*3]:=gr;
      pixels[y*w*3+x*3+1]:=gr;
      pixels[y*w*3+x*3+2]:=gr;
      end;
      progressbar1.Position:=trunc(100*y/(h-1));
      end;
      progressbar1.Position:=0;
      updateimage();

end;

procedure TForm1.N34Click(Sender: TObject);
var x,y:integer;
   bright,clr:integer;
   avr,contr:double;

begin
   if  (form3.ShowModal=idok)then
     begin
      backup();
      progressbar1.Position:=0;
      bright:=form3.brightness;
      contr:=form3.contrast;
      avr:=0;
       for  y:=0  to  h-1  do
         begin
           for  x:=0  to  w*3-1  do
            begin
             clr:=trunc((pixels[y*w*3+x]-avr)*contr+avr)+bright;
             if (clr<0)then
              clr:=0;
              if (clr>255)then
               clr:=255;
               pixels[y*w*3+x]:=clr;
               end;
               progressbar1.Position:=trunc(100*y/(h-1));
               updateimage();
               end;
end;

end;
end.




⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -