screenhistostretchgrays.pas

给出了基于神经网络的手写体数字的识别程序

    //ButtonWriteImage.Enabled      := TRUE;
   // ButtonCopyToClipboard.Enabled := TRUE;
  END
end;


procedure TFormHistoStretchGrays.FormCreate(Sender: TObject);
begin
  // Make sure ICO, WMF, GIF, JPG, GIF, etc. are in list
  OpenPictureDialog.Filter := GraphicFilter(TGraphic);

  ShowDesignWidth  := ImageOriginal.Width;
  ShowDesignHeight := ImageOriginal.Height;

  TailPercentLeft  :=  1.0;
  TailPercentRight := 99.0;
  StretchFactor    :=  1.0;
   Platexmin:=0;  Platexmax:=0;
   Plateymin:=0;  Plateymax:=0;
   CharNumber:=0;
  ImageOriginal.Picture.Graphic := NIL;
  FormHistoStretchGrays.DoubleBuffered := TRUE
end;
procedure TFormHistoStretchGrays.GetGrayParam(bitmap:TBITMAP);
var
  p: PByteArray;
    Grayclass: array[0..256] of integer;

  // PbyteArray类型
  x, y, i, j: Integer;
  Bmp: TBitmap;
  Gray: byte;
  scanlinebytes: integer;
  //扫描线间距
begin
  Bmp := TBitmap.Create;
  //创建实例
  Bmp.Assign(bitmap);
  Bmp.PixelFormat := pf24Bit;
  //24bit位图
  p := Bmp.scanline[0];
  //首行扫描线信息
  for i := 0 to 255 do
  begin
    Grayclass[i] := 0;
    //初始化数组为0
  end;
  scanlinebytes := integer(Bmp.scanline[1]) - integer(Bmp.scanline[0]);
  for y := 0 to Bmp.Height - 1 do
  begin
    //注意边界,不能越界
    for x := 0 to Bmp.Width - 1 do
    begin
      Gray := p[x* 3];
      //求取灰度值
      for i := 0 to 255 do
      begin
        if Gray = i then
        begin
          Grayclass[i] := Grayclass[i] + 1;
          //每级灰度象素点数
        end;
      end;
    end;
    inc(integer(p), scanlinebytes);
    //指针增加,增加得其实是一个负值
  end;
  bmp.Free;
  //释放资源
  for i := 0 to 255 do
  begin
    if grayclass[i] <> 0 then
    begin
     grayRangeLeft := i;
      break;
      //获取最大灰度级
    end;
  end;
  for j := 255 downto 0 do
  begin
    if grayclass[j] <> 0 then
    begin
     grayRangeRight := j;
      break;
      //获取最小灰度级
    end;
  end;
end;
 PROCEDURE TFormHistoStretchGrays.ShowHistogram(CONST Histogram:  THistogram;
                          CONST Image:  TImage;
                          CONST LabelStats:  TLabel);
    CONST
      clSkyBlue    = TColor($F0CAA6);   // RGB:  166 202 240
    VAR
      Kurtosis         :  DOUBLE;
      Maximum          :  BYTE;
      Mean             :  DOUBLE;
      Median           :  BYTE;
      Minimum          :  BYTE;
      Mode             :  BYTE;
      N                :  INTEGER;
      Skewness         :  DOUBLE;
      StandardDeviation:  DOUBLE;
  BEGIN
    Image.Canvas.Brush.Color := clSkyBlue;
    Image.Canvas.FillRect(Rect(0, 0, Image.Width, Image.Height));

    Histogram.Draw(Image.Canvas);
    Histogram.GetStatistics(N, Minimum, Maximum,
       Mode, Median,
       Mean, StandardDeviation,
       Skewness, Kurtosis);
     getMedian:=Median;
     getStandardDeviation:=StandardDeviation;

  END {UpdateHistogram};


PROCEDURE TFormHistoStretchGrays.UpdateDisplay;
  VAR
    OriginalHistogram :  THistogram;
    OriginalRangeRight:  INTEGER;
    OriginalRange     :  INTEGER;
    StretchedBitmap   :  TBitmap;
    StretchedHistogram:  THistogram;
    StretchedRange    :  INTEGER;


BEGIN
  Screen.Cursor := crHourGlass;
  TRY

    // Update Display of Histograms.  Some work will be redone below to create
    // optimal Histostretch parameters.

    OriginalHistogram := THistogram.Create;
    TRY
      // Ask for cpRed, but cpGreen or cpBlue will give identical results
      // since R = G = B for shades of gray
      GetHistogram(cpRed, OriginalBitmap, OriginalHistogram);
      // Show Original Histogram

      OriginalRangeLeft  := OriginalHistogram.GetPercentileLevel(TailPercentLeft);
      OriginalRangeRight := OriginalHistogram.GetPercentileLevel(TailPercentRight);
      OriginalRange      := OriginalRangeRight - OriginalRangeLeft;

      // Normally, StretchFactor is 1.00 and RangeStretched = 255 (full width)
      StretchedRange := OriginalRange + ROUND( StretchFactor*(255 - OriginalRange) );

      IF   OriginalRange = 0.0
      THEN ScaleFactor := 1.0
      ELSE ScaleFactor := StretchedRange / OriginalRange;

      StretchedBitmap := CreateHistoStretchBitmap;
      TRY
        ImageHistoStretched.Picture.Graphic := StretchedBitmap;
        StretchedHistogram := THistogram.Create;
        TRY


        FINALLY
          StretchedHistogram.Free
        END

      FINALLY
        StretchedBitmap.Free
      END
    FINALLY
      OriginalHistogram.Free
    END

  FINALLY
    Screen.Cursor := crDefault
  END
END {UpdateDisplay};


procedure TFormHistoStretchGrays.FormDestroy(Sender: TObject);
begin
  OriginalBitmap.Free
end;


procedure TFormHistoStretchGrays.CheckBoxStretchClick(Sender: TObject);
begin
  ImageOriginal.Stretch := CheckBoxStretch.Checked;
  ImageHistoStretched.Stretch := CheckBoxStretch.Checked;
  OroginalColorImage.Stretch := CheckBoxStretch.Checked;

end;


PROCEDURE TFormHistoStretchGrays.UpdateTailPercentage(CONST sign:  INTEGER);
  VAR
    TenthPercent:  INTEGER;
BEGIN
  TRY

  EXCEPT
    ON EConvertError DO TenthPercent := 0;  // 0.0 %
  END;

  TenthPercent := TenthPercent + sign;
  TenthPercent := MinIntValue( [MaxIntValue([0, TenthPercent]), 99 ]);

  TailPercentLeft  := TenthPercent/10.0;
  TailPercentRight := 100.0 - TenthPercent/10.0;

END {UpdateTailPercentage};


procedure TFormHistoStretchGrays.SpinButtonTailUpClick(Sender: TObject);
begin
  UpdateTailPercentage(+1)
end;


procedure TFormHistoStretchGrays.SpinButtonTailDownClick(Sender: TObject);
begin
  UpdateTailPercentage(-1)
end;


procedure TFormHistoStretchGrays.MaskEditTailChange(Sender: TObject);
begin
  UpdateTailPercentage(0)
end;


PROCEDURE TFormHistoStretchGrays.UpdateFactor(CONST sign:  INTEGER);
  VAR
    Hundredth:  INTEGER;
BEGIN
  TRY
  EXCEPT
    ON EConvertError DO Hundredth := 100;  // 1.00
  END;

  Hundredth := Hundredth + 5*sign;
  Hundredth := MinIntValue( [MaxIntValue([0, Hundredth]), 100 ]);
  StretchFactor := Hundredth/100.0;

  
END {UpdateFactor};

FUNCTION TFormHistoStretchGrays.CreateHistoStretchBitmap:  TBitmap;
  VAR
    i,j               :  INTEGER;
    Intensity         :  INTEGER;
    OriginalRow       :  pRGBTripleARray;
    StretchedRow      :  pRGBTripleArray;
begin
  // Create stretched bitmap
  RESULT := TBitmap.Create;

  RESULT.Width  := OriginalBitmap.Width;
  RESULT.Height := OriginalBitmap.Height;
  RESULT.PixelFormat := pf24bit;

  FOR j := 0 TO OriginalBitmap.Height-1 DO
  BEGIN
    OriginalRow  := OriginalBitmap.Scanline[j];
    StretchedRow := RESULT.Scanline[j];
    FOR i := 0 TO OriginalBitmap.Width-1 DO
    BEGIN
      // Use the R component, but R = G = B for shades of gray
      Intensity := OriginalRow[i].rgbtRed;
       // Calculate new intensity level
      Intensity := ROUND(ScaleFactor*(Intensity - OriginalRangeLeft) );
      IF   Intensity < 0
      THEN Intensity := 0
      ELSE
        IF   Intensity > 255
        THEN Intensity := 255;

      WITH StretchedRow[i] DO
      BEGIN
        rgbtRed   := Intensity;
        rgbtGreen := Intensity;
        rgbtBlue  := Intensity
      END

    END
  END
END {CreateHistoStretchBitamp};


procedure TFormHistoStretchGrays.SpinButtonFactorUpClick(Sender: TObject);
begin
  UpdateFactor (+1)
end;


procedure TFormHistoStretchGrays.SpinButtonFactorDownClick(Sender: TObject);
begin
  UpdateFactor (-1)
end;


procedure TFormHistoStretchGrays.MaskEditFactorChange(Sender: TObject);
begin
  UpdateFactor (0)
end;

procedure TFormHistoStretchGrays.ButtonWriteImageClick(Sender: TObject);
  VAR
    StretchedBitmap   :  TBitmap;
begin
  IF   SavePictureDialog.Execute
  THEN BEGIN
    StretchedBitmap := CreateHistoStretchBitmap;
    TRY
      StretchedBitmap := CreateHistoStretchBitmap;
      StretchedBitmap.SaveToFile(SavePictureDialog.Filename);
    FINALLY
      StretchedBitmap.Free
    END
  END
end;

procedure TFormHistoStretchGrays.ButtonCopyToClipboardClick(
  Sender: TObject);
  VAR
    StretchedBitmap   :  TBitmap;
begin
  StretchedBitmap := CreateHistoStretchBitmap;
  TRY
    Clipboard.Assign(StretchedBitmap);
  FINALLY
    StretchedBitmap.Free
  END
end;

procedure TFormHistoStretchGrays.twovalue2Click(Sender: TObject);
begin
   PictureTwoValue(ImageHistoStretched.Picture.Bitmap,TwoValueTrackBar.Position+128);
end;
 procedure TFormHistoStretchGrays.PictureTwoValue(Bitmap: TBitmap;TwoValue:integer);
var
   X, Y: integer;
   P: pByteArray;
   newbmp: TBitmap;
   gray: byte;
begin
   newbmp := TBitmap.Create;
   newbmp.PixelFormat := pf24bit;
   newbmp.Assign(bitmap);
   for Y := 0 to bitmap.Height - 1 do
   begin
      P := newbmp.ScanLine[Y];
      for X := 0 to bitmap.Width - 1 do
      begin
         //gray := Round(0.299 * P[3 * X + 2] + 0.587 * P[3 * X + 1] + 0.11
           // *
            //P[3 * X]);
         // 灰化的计算公式
         if (p[3*x]>TwoValue) then
            p[3*x] := 255
         else
            p[3*x] := 0;
         // 128为阙值
         P[3 * X + 2] := p[3*x];
         P[3 * X + 1] := p[3*x];
         //P[3 * X] := gray;
      end;
   end;
   bitmap.Assign(newbmp);
   newbmp.free;
end;
function TFormHistoStretchGrays.BitmapErose(Bitmap: TBitmap; Horic: Boolean):Boolean;
var
   X, Y: integer;
   newbmp: TBitmap;
   P, Q, R, O: pByteArray;
   { IWidth, IHeight: integer;
   BA: array of array of Boolean;
   procedure GetBAValue;
   var
      X, Y: integer;
      P: pByteArray;
   begin
      SetLength(BA, IWidth, IHeight);
      begin
         for Y := 0 to IHeight - 1 do
            begin
               P := bitmap.ScanLine[Y];
               for X := 0 to IWidth - 1 do
                  begin
                     BA[X][Y] := ((P[3 * X + 2]) < 128);
                  end;
            end;
      end;
   end; }
begin
   newbmp := TBitmap.Create;
   //动态创建位图
   newbmp.Assign(bitmap);
   // Horic标志是水平方向还是竖直方向腐蚀
   if (Horic) then
   begin
      for Y := 1 to newbmp.Height - 2 do
      begin
         O := bitmap.ScanLine[Y];
         P := newbmp.ScanLine[Y - 1];
         Q := newbmp.ScanLine[Y];
         R := newbmp.ScanLine[Y + 1];
         for X := 1 to newbmp.Width - 2 do
         begin
            if ((O[3 * X] = 0) and (O[3 * X + 1] = 0) and (O[3 * X + 2]
               = 0)) then
            begin
               // 判断黑点左右邻居是否有白色点,有则腐蚀,置该点为白色
               // 白色点则保持不变