imageprocessmainunit.pas

数字图像预出处理系统

  begin
    Curfichier := ImageSelectForm.filelistbox1.filename;
    InitialImages(sender);
    ShowPrimitiveBmp;
    //showOriginalBmp;
  //  ShowChangedBmp;
    with ImageSelectForm.filelistbox1 do
    begin
     if itemindex > -1 then ImageProcessForm.caption := '数字图像预处理软件系统-'+items[itemindex];
    end;
  end
  else
  begin
    if  ImageSelectForm.filelistbox1.itemindex > 0 then
      ImageSelectForm.filelistbox1.itemindex :=  ImageSelectForm.filelistbox1.itemindex-1;
  end;
  CurrentDir := ImageSelectForm.directorylistbox1.directory;
  savetodir := CurrentDir;
end;

procedure TImageProcessForm.ExitClick(Sender: TObject);
begin
  Close;
end;

procedure TImageProcessForm.SaveAsClick(Sender: TObject);
var
  JP  : TJPEGImage;
  ctrfich : integer;
  i : integer;
  ext : string;
begin
  { save ProcessedBmp  format .JPEG ou .Bmp or .GIF}
  if savepicturedialog1.execute then
  begin
    ext :=uppercase(extractfileext(savepictureDialog1.FileName));
    if Not ((ext = '.BMP') or (ext = '.JPG')) then
    begin
     showmessage('错误的文件扩展名'+curfichier+' (.jpg .bmp)');
    // exit;
    end;

    for i := 1 to 32 do application.processmessages;
    if ext = '.BMP' then
    begin
      ChangedBmp.savetofile(savepictureDialog1.FileName);
    end
    else
    if ext = '.JPG' then
    begin
      JP := TJPEGImage.Create;             // TJPEGImage 临时文件
      try
        JP.CompressionQuality := 88;  // 压缩比
        JP.ProgressiveEncoding := false;
        JP.Assign(ChangedBmp);                    // 分配JPEG为 bitmap
        JP.SaveToFile(savepictureDialog1.FileName);  // 保存JPEG文件
      finally
        JP.Free;                            // 释放  JPEG
      end;
    end;
    sleep(400);
    curfichier :=  savepictureDialog1.filename;
    ctrfich :=  ImageSelectForm.filelistbox1.itemindex;
    ImageSelectForm.filelistbox1.update;
    ImageSelectForm.filelistbox1.itemindex := ctrfich;
  end;
end;

procedure TImageProcessForm.PaintBox2Paint(Sender: TObject);
begin
   ShowChangedBmp;
end;

procedure TImageProcessForm.BitBtn1Click(Sender: TObject);
begin
  WillbeChangedBmp.Assign(ChangedBmp);
  showOriginalbmp;
end;

procedure TImageProcessForm.TwoValueTrackBarChange(Sender: TObject);
begin
  TwoValueLabel.Caption:= '二值化值：'+inttoStr(TwoValueTrackBar.position);
  TwoValueClick(Sender);
end;

procedure TImageProcessForm.LoadPrimitiveImageClick(Sender: TObject);
begin
    WillbeChangedBmp.Assign(PromitiveBmp);
    ShowPrimitiveBmp;
end;

procedure TImageProcessForm.FilterClick(Sender: TObject);
var
  p1, p2, p3, p4: pbytearray;
  i, j: integer;
begin
  self.DoubleBuffered := true;
  ProcessedBmp.assign(WillbeChangedBmp);
  TestBMP.Assign(WillbeChangedBmp);
    for j := 1 to ProcessedBmp.Height - 2 do
  begin
    p1 := TestBMP.ScanLine[j];
    p2 := ProcessedBmp.ScanLine[j - 1];
    p3 := ProcessedBmp.ScanLine[j];
    p4 := ProcessedBmp.ScanLine[j + 1];
    for i := 1 to ProcessedBmp.Width - 2 do
    begin
      RvalueArray[0] := p2[3 * (i - 1) + 2];
      RvalueArray[1] := p2[3 * i + 2];
      RvalueArray[2] := p2[3 * (i + 1) + 2];
      RvalueArray[3] := p3[3 * (i - 1) + 2];
      RvalueArray[4] := p3[3 * i + 2];
      RvalueArray[5] := p3[3 * (i + 1) + 2];
      RvalueArray[6] := p4[3 * (i - 1) + 2];
      RvalueArray[7] := p4[3 * i + 2];
      RvalueArray[8] := p4[3 * (i + 1) + 2];
      SelectionSort(RvalueArray);
      p1[3 * i + 2] := RvalueArray[4];
      GvalueArray[0] := p2[3 * (i - 1) + 1];
      GvalueArray[1] := p2[3 * i + 1];
      GvalueArray[2] := p2[3 * (i + 1) + 1];
      GvalueArray[3] := p3[3 * (i - 1) + 1];
      GvalueArray[4] := p3[3 * i + 1];
      GvalueArray[5] := p3[3 * (i + 1) + 1];
      GvalueArray[6] := p4[3 * (i - 1) + 1];
      GvalueArray[7] := p4[3 * i + 1];
      GvalueArray[8] := p4[3 * (i + 1) + 1];
      SelectionSort(GvalueArray);
      p1[3 * i + 1] := GvalueArray[4];
      BvalueArray[0] := p2[3 * (i - 1)];
      BvalueArray[1] := p2[3 * i];
      BvalueArray[2] := p2[3 * (i + 1)];
      BvalueArray[3] := p3[3 * (i - 1)];
      BvalueArray[4] := p3[3 * i];
      BvalueArray[5] := p3[3 * (i + 1)];
      BvalueArray[6] := p4[3 * (i - 1)];
      BvalueArray[7] := p4[3 * i];
      BvalueArray[8] := p4[3 * (i + 1)];
      SelectionSort(BvalueArray);
      p1[3 * i] := BvalueArray[4];
    end;
  end;
  ChangedBmp.Assign(TestBMP);
  ShowChangedBmp;
end;

procedure TImageProcessForm.SelectionSort(var a: array of integer);
var
  i, j, t: integer;
begin
  for i := low(a) to high(a) - 1 do
    for j := high(a) downto i + 1 do
      if a[i] > a[j] then
      begin
        t := a[i];
        a[i] := a[j];
        a[j] := t;
      end;
end;

procedure TImageProcessForm.DilateClick(Sender: TObject);
var
   X, Y: Integer;
   p1,p2,p3,p4: pByteArray;
begin
    //动态创建位图
   TestBMP.Assign(WillbeChangedBmp);
   ProcessedBmp.Assign(WillbeChangedBmp);
  begin
      for Y := 1 to ProcessedBmp.Height - 2 do
      begin
         p1 := TestBMP.ScanLine[Y];
         P2 := ProcessedBmp.ScanLine[Y - 1];
         p3 := ProcessedBmp.ScanLine[Y];
         p4 := ProcessedBmp.ScanLine[Y + 1];
         for X := 1 to ProcessedBmp.Width - 2 do
         begin
            if ((p1[3 * X] = 255) and (p1[3 * X + 1] =255) and (p1[3 * X + 2]
               =255)) then
            begin
               // 判断黑点左右邻居是否有白色点,有则腐蚀,置该点为黑色
               // 白色点则保持不变
               if (((p3[3 * (X - 1)] = 0) and (p3[3 * (X - 1) + 1] =
                 0) and (p3[3 * (X - 1) + 2] = 0))
                 or ((p3[3 * (X+ 1)] = 0)and (p3[3 * (X + 1) + 1] =0) and
                  (p3[3 * (X + 1) + 2] = 0))
                  or ((P2[3 * X] = 0) and (P2[3 * X + 1] = 0) and (P2[3 * X + 2] = 0))
                  or ((p4[3 * X] = 0) and (p4[3 * X + 1] =0) and
                  (p4[3* X + 2] = 0))) then
                  begin
                  p1[3 * X] :=0;
                  p1[3 * X + 1] := 0;
                  p1[3 * X + 2] := 0;
                  //// 将满足条件的白色点置为黑色
                  end;
            end;
         end;
      end;
   end ;
  ChangedBmp.Assign(TestBMP);
  ShowChangedBmp;
end;
procedure TImageProcessForm.LaplaceFilter(Sender: TObject);
var
   i,j:integer;
   p1,p2,p3,p:pByteArray;
begin
   TestBMP.Assign(WillbeChangedBmp);
   ProcessedBmp.Assign(WillbeChangedBmp);
   for j:=1 to ProcessedBmp.Height-2 do
   begin
      p:=TestBMP.ScanLine[j];
      p1:=ProcessedBmp.ScanLine[j-1];
      p2:=ProcessedBmp.ScanLine[j];
      p3:=ProcessedBmp.ScanLine[j+1];
      for i:=1 to ProcessedBmp.Width-2 do
      begin
         p[i*3]:=min(255,max(0,(
                     -p1[(i-1)*3]-p1[i*3]-p1[(i+1)*3]
                     -p2[(i-1)*3]+8*p2[i*3]-p2[(i+1)*3]
                     -p3[(i-1)*3]-p3[i*3]-p3[(i+1)*3])
                     ));
         p[i*3+1]:=min(255,max(0,(
                     -p1[(i-1)*3+1]-p1[i*3+1]-p1[(i+1)*3+1]
                     -p2[(i-1)*3+1]+8*p2[i*3+1]-p2[(i+1)*3+1]
                     -p3[(i-1)*3+1]-p3[i*3+1]-p3[(i+1)*3+1])
                     ));
         p[i*3+2]:=min(255,max(0,(
                     -p1[(i-1)*3+2]-p1[i*3+2]-p1[(i+1)*3+2]
                     -p2[(i-1)*3+2]+8*p2[i*3+2]-p2[(i+1)*3+2]
                     -p3[(i-1)*3+2]-p3[i*3+2]-p3[(i+1)*3+2])
                     ));

      end;
   end;
    ChangedBmp.Assign(TestBMP);
    ShowChangedBmp;
end;


procedure TImageProcessForm.ErodeClick(Sender: TObject);
var
   X, Y: integer;
   p1,p2,p3,p4: pByteArray;
   begin
    TestBMP.Assign(WillbeChangedBmp);
    ProcessedBmp.Assign(WillbeChangedBmp);
      for Y := 1 to ProcessedBmp.Height - 2 do
      begin
         p1 := TestBMP.ScanLine[Y];
         P2 := ProcessedBmp.ScanLine[Y - 1];
         p3 := ProcessedBmp.ScanLine[Y];
         p4 := ProcessedBmp.ScanLine[Y + 1];
         for X := 1 to ProcessedBmp.Width - 2 do
         begin
            if ((p1[3 * X] = 0) and (p1[3 * X + 1] = 0) and (p1[3 * X + 2]
               = 0)) then
            begin
               // 判断黑点左右邻居是否有白色点,有则腐蚀,置该点为白色
               // 白色点则保持不变
               if (((p3[3 * (X - 1)] = 255) and (p3[3 * (X - 1) + 1] =
                  255) and (p3[3 * (X - 1) + 2] = 255)) or ((p3[3 * (X
                     +
                     1)] = 255) and (p3[3 * (X + 1) + 1] = 255) and
                  (p3[3 * (X + 1) + 2] = 255)) or ((P2[3 * X] = 0) and
                  (P2[3 * X + 1] = 255) and (P2[3 * X + 2] = 255))
                  or ((p4[3 * X] = 255) and (p4[3 * X + 1] = 255) and
                  (p4[3* X + 2] = 255))) then
               begin
                  p1[3 * X] := 255;
                  p1[3 * X + 1] := 255;
                  p1[3 * X + 2] := 255;
                  //// 将满足条件的黑色点置为白色
               end;
            end;
         end;
      end;
   begin
      for Y := 1 to ProcessedBmp.Height - 2 do
      begin
         p1 := TestBMP.ScanLine[Y];
             p3 := ProcessedBmp.ScanLine[Y];
           for X := 1 to ProcessedBmp.Width - 2 do
         begin
            //  判断一个黑点上下邻居是否有白点,有则腐蚀,置黑点为白色
            //  白色点就保持不变
            if ((p1[3 * X] = 0) and (p1[3 * X + 1] = 0) and (p1[3 * X + 2]
               = 0)) then
            begin
               if (((p3[3 * (X - 1)] = 255) and (p3[3 * (X - 1) + 1] =
                  255) and (p3[3 * (X - 1) + 2] = 255)) or ((p3[3 * (X
                     +
                     1)] = 255) and (p3[3 * (X + 1) + 1] = 255) and
                  (p3[3 * (X + 1) + 2] = 255))) then
               begin
                  p1[3 * X] := 255;
                  p1[3 * X + 1] := 255;
                  p1[3 * X + 2] := 255;
                  // 将满足条件的黑色点置为白色
               end;
            end;
         end;
      end;
   end;
  ChangedBmp.Assign(TestBMP);
  ShowChangedBmp;
end;

procedure TImageProcessForm.InvertImageClick(Sender: TObject);
var
   p: PByteArray;
   X, Y: Integer;
begin
   TestBMP.Assign(WillbeChangedBmp);
    for Y := 0 to TestBMP.Height - 1 do
      begin
         p := TestBMP.scanline[y];
         for X := 0 to TestBMP.Width - 1 do
            begin
               begin
                  p[x * 3] := not p[x * 3];
                  p[x * 3 + 1] := not p[x * 3 + 1];
                  p[x * 3 + 2] := not p[x * 3 + 2];
               end
            end;
        end;
  ChangedBmp.Assign(TestBMP);
  ShowChangedBmp;
end;

procedure TImageProcessForm.SobelClick(Sender: TObject);
var
   p1, p3, p2, p4: pByteArray;
   I,J: integer;
   R,G,B: Byte;
begin
  self.DoubleBuffered := true; //采用双缓冲模式
    TestBMP.Assign(WillbeChangedBmp);
    ProcessedBmp.Assign(WillbeChangedBmp);
 for J := 1 to TestBMP.Height - 2 do
   begin
      p1 := TestBMP.ScanLine[j];
      p2 := ProcessedBmp.ScanLine[j - 1];
      p3 := ProcessedBmp.ScanLine[j];
      p4 := ProcessedBmp.ScanLine[j + 1];
      for I := 1 to TestBMP.Width - 2 do
      begin
        R := min(255, max(0, ((-p2[3 * (i - 1) + 2] - 2 * p2[3 * i +
            2] - p2[3 * (i + 1) + 2] - 0 * p3[3 * (i - 1) + 2]
            + 0 * p3[3 * i + 2] - 0 *  p3[3 * (i + 1)
            + 2] + p4[3 * (i - 1) + 2] + 2 * p4[3 * i + 2] +
            p4[3 * (i + 1) + 2]))));
         G := min(255, max(0, ((-p2[3 * (i - 1) + 1] - 2 * p2[3 * i +