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

📄 screenhistostretchgrays.pas

📁 给出了基于神经网络的手写体数字的识别程序
💻 PAS
📖 第 1 页 / 共 5 页
字号:
//Designer :Jiang Xiangang 2005
unit ScreenHistoStretchGrays;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,
  ExtDlgs,
  ComCtrls, Mask,  HistogramLibrary,
  Spin, Menus, OleCtrls, Chartfx3,TeEngine, Series, TeeProcs, Chart,TeeFunci;

  type d2num=array of array of integer;
  type d1num=array of integer ;
  type
  TFormHistoStretchGrays = class(TForm)
    OpenPictureDialog: TOpenPictureDialog;
    CheckBoxStretch: TCheckBox;
    ImageOriginal: TImage;
    Label2: TLabel;
    ImageHistoStretched: TImage;
    Label3: TLabel;
    SavePictureDialog: TSavePictureDialog;
    OroginalColorImage: TImage;
    TwoValueTrackBar: TTrackBar;
    plateimg: TImage;
    Label1: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    VSobel: TMenuItem;
    HSobel: TMenuItem;
    VMarge: TMenuItem;
    FrameClose: TMenuItem;
    Hough: TMenuItem;
    Stretch: TMenuItem;
    GrayImageFilet: TMenuItem;
    TwoValue: TMenuItem;
    Hmarge1: TMenuItem;
    Expand: TMenuItem;
    OrientMenu: TMenuItem;
    OpenPicture: TMenuItem;
    CopyImage: TMenuItem;
    SaveImage: TMenuItem;
    TwoValueAdjustLabel: TLabel;
    Gray: TMenuItem;
    Label4: TLabel;
    TwoValueFlagLabel: TLabel;
    N5: TMenuItem;
    PlateProjection: TMenuItem;
    PalteProjectionChart: TChart;
    PlateTwoValue: TMenuItem;
    PlateGray: TMenuItem;
    GetPlateColorImage: TMenuItem;
    xLabel: TLabel;
    yLabel: TLabel;
    PlateImageFilet: TMenuItem;
    CharNumLabel: TLabel;
    PlatePositionFurtherCertification: TMenuItem;
    OptialTwoValue: TMenuItem;
    MeanGrayValue: TLabel;
    PlateGrayDistribution: TMenuItem;
    Series2: TBarSeries;
    bestGrayLabel: TLabel;
    PlateTwoValueTrackBar: TTrackBar;
    PlateTwoValueLabel: TLabel;
    N4: TMenuItem;
    GrayValueLabel: TLabel;
    OtsuAlgorithm: TMenuItem;
    Otisu1: TMenuItem;
    DFDS1: TMenuItem;
    CarGrayStreench: TMenuItem;
    PlateGrayStrentch: TMenuItem;
    showgraystatics: TMenuItem;
    GetBlueColorPlate: TMenuItem;
    FilettoCarColrImage: TMenuItem;
    SmoothCarImage: TMenuItem;
    GetCarProfile: TMenuItem;
    VerticalMiddleValueFilet: TMenuItem;
    N6: TMenuItem;
    Image1: TImage;
    N7: TMenuItem;
    N8: TMenuItem;
    Image2: TImage;
    Label5: TLabel;
    N2561: TMenuItem;
    YellowPlate: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    ColorFieltGetDifferentGray: TMenuItem;
    GrayOpening: TMenuItem;
    AreaProfile: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    Series1: TLineSeries;
    GrayOpen2: TMenuItem;
    Label6: TLabel;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    P1: TMenuItem;
    B1: TMenuItem;
    Return: TMenuItem;
    GrayImageTwoValue: TMenuItem;

    procedure OpenimageClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBoxStretchClick(Sender: TObject);
    procedure SpinButtonTailUpClick(Sender: TObject);
    procedure SpinButtonTailDownClick(Sender: TObject);
    procedure SpinButtonFactorUpClick(Sender: TObject);
    procedure SpinButtonFactorDownClick(Sender: TObject);
    procedure MaskEditTailChange(Sender: TObject);
    procedure MaskEditFactorChange(Sender: TObject);
    procedure ButtonWriteImageClick(Sender: TObject);
    procedure ButtonCopyToClipboardClick(Sender: TObject);
    procedure CopyMe(Tobmp: TBitmap; Frombmp: TBitmap);
    procedure twovalue2Click(Sender: TObject);
    procedure PictureTwoValue(Bitmap: TBitmap;TwoValue:integer);
    procedure Button1Click(Sender: TObject);
    function BitmapErose(Bitmap: TBitmap; Horic: Boolean): Boolean;
    function BitmapDilate(Bitmap: TBitmap; Hori: Boolean): Boolean;
    procedure orientClick(Sender: TObject);
    procedure SelectionSort(var a: array of integer);
    procedure connect(tbmp:tbitmap; x,y:integer; var xmin,xmax,ymin,ymax:integer);
    procedure HmargeClick(Sender: TObject);
    procedure ImageFilet(Bitmap: TBitmap);
    procedure VSobelClick(Sender: TObject);
    procedure HSobelClick(Sender: TObject);
    procedure VMargeClick(Sender: TObject);
    procedure FrameCloseClick(Sender: TObject);
    procedure HoughClick(Sender: TObject);
    procedure Convolve(ray: array of integer; z: word; aBmp: TBitmap);
    procedure StretchClick(Sender: TObject);
    procedure OpenPictureClick(Sender: TObject);
    procedure ExpandClick(Sender: TObject);
    procedure ImageGray(Bitmap: TBitmap);
    procedure TwoValueTrackBarChange(Sender: TObject);
    procedure PlateProjectionClick(Sender: TObject);
    procedure PlateTwoValueClick(Sender: TObject);
    procedure GrayClick(Sender: TObject);
    procedure PlateGrayClick(Sender: TObject);
    procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Integer);
    procedure HSLtoRGB(H, S, L: Integer; var R, G, B: Integer);
    procedure GetPlateColorImageClick(Sender: TObject);
    procedure plateimgMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PlateImageFiletClick(Sender: TObject);
    procedure GrayImageFiletClick(Sender: TObject);
    procedure PlatePositionFurtherCertificationClick(Sender: TObject);
    procedure OptiumTwoValueClick(BitMap:TBitmap);
    procedure OptialTwoValueClick(Sender: TObject);
    procedure PlateGrayDistributionClick(Sender: TObject);
    procedure plateimgClick(Sender: TObject);
    procedure PlateTwoValueTrackBarChange(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure OtsuAlgorithmClick(Sender: TObject;BitMap:TBitmap);
    procedure Otsu(Sender: TObject);
    procedure Otisu1Click(Sender: TObject);
    procedure GrayStretch(bitmap:TBITMAP);
    procedure DFDS1Click(Sender: TObject);
    procedure CarGrayStreenchClick(Sender: TObject);
    procedure PlateGrayStrentchClick(Sender: TObject);
    procedure GetGrayParam(bitmap:TBITMAP);
    procedure showgraystaticsClick(Sender: TObject);
    PROCEDURE  ShowHistogram(CONST Histogram:  THistogram;
                          CONST Image:  TImage;
                          CONST LabelStats:  TLabel);
    procedure GetBlueColorPlateClick(Sender: TObject);
    procedure FilettoCarColrImageClick(Sender: TObject);
    procedure smothcarcolorimage(bitmap:TBITMAP);
    procedure GetProfile(bitmap:TBITMAP);
    procedure SmoothCarImageClick(Sender: TObject);
    procedure GetCarProfileClick(Sender: TObject);
    procedure VerticalMiddleValueFiletClick(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure PictureTwoValue2(Bitmap: TBitmap;TwoValue:integer);
    procedure N7Click(Sender: TObject);
    procedure accum(bmp:tbitmap;sign:d2num;x,y:integer;var accumvalue:integer);
    procedure N8Click(Sender: TObject);
    procedure N2561Click(Sender: TObject);
    procedure YellowPlateClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure ColorFieltGetDifferentGrayClick(Sender: TObject);
    procedure GrayOpeningClick(Sender: TObject);
    procedure GrayErode(bitmap: Tbitmap);
    procedure erode2(bitmap: Tbitmap);
    procedure GrayDilate(bitmap: Tbitmap);
    procedure dilate2(bitmap: Tbitmap);
    procedure AreaProfileClick(Sender: TObject);
    procedure GrayOpen2Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure ImgResize(RefBitmap, DescBitmap: TBitmap);
    procedure N23Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure ReturnClick(Sender: TObject);
    procedure GrayImageTwoValueClick(Sender: TObject);
    procedure N19Click(Sender: TObject);
  private
    OriginalRangeLeft:  INTEGER;
    ScaleFactor      :  DOUBLE;
    StretchFactor    :  DOUBLE;
    TailPercentLeft  :  DOUBLE;
    TailPercentRight :  DOUBLE;
    ShowDesignHeight :  INTEGER;
    ShowDesignWidth  :  INTEGER;
     PaletteHandle:  hPalette;
    Platexmin,Platexmax,Plateymin,Plateymax: integer;
    CharNumber,optialT:Integer;
    GrayRangeLeft,GrayRangeRight: integer;
     getMedian           :  BYTE;
     getStandardDeviation:  DOUBLE;
    PROCEDURE UpdateDisplay;
    PROCEDURE UpdateTailPercentage(CONST sign:  INTEGER);
    PROCEDURE UpdateFactor(CONST sign:  INTEGER);

    FUNCTION CreateHistoStretchBitmap:  TBitmap;
  public
    OriginalBitmap,bitmap1:  TBitmap;
  end;
  type
   TRGBArray = array[0..32767] of TRGBTriple;
   PRGBArray = ^TRGBArray;
var
  FormHistoStretchGrays: TFormHistoStretchGrays;
  RvalueArray, GvalueArray, BvalueArray: array[0..8] of integer;
  valuearray:array[0..25] of integer;
   accumvalue,accummax:integer;
implementation
{$R *.DFM}

  USES
   PaletteLibrary,
{$IFDEF GIF}
    GIFImage,         // TGIFImage (by Anders Melander)
{$ENDIF}
    ClipBrd,          // Clipboard
    JPEG,             // JPEG support at runtime
     Math, BpTrainUnit;             // MinIntValue, MaxIntValue

  CONST
    MaxPixelCount = 65536;

  TYPE
    // For pf24bit Scanlines
    pRGBTripleArray = ^TRGBTripleArray;
    TRGBTripleArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
   FUNCTION Plural(CONST n:  LongInt; CONST singularform,pluralform:  STRING):  STRING;
  BEGIN  // function similar to one on p. 314, Byte, December 1988
    IF   n = 1
    THEN RESULT := singularform
    ELSE
      IF   pluralform = ''
      THEN RESULT := singularform + 's'
      ELSE RESULT := pluralform
  END {Plural};

  FUNCTION  RGBTripleToY (CONST RGB:  TRGBTriple):  INTEGER;
  BEGIN
    WITH RGB DO
      RESULT := INTEGER(77*rgbtRed + 150*rgbtGreen + 29*rgbtBlue) SHR 8
  END {RGBtoY};
   FUNCTION CountColors(CONST Bitmap:  TBitmap):  INTEGER;
    VAR
      Flags:  ARRAY[BYTE, BYTE] OF TBits;
      i    :  INTEGER;
      j    :  INTEGER;
      k    :  INTEGER;
      rowIn:  pRGBTripleArray;
  BEGIN
    // Be sure bitmap is 24-bits/pixel
    ASSERT (Bitmap.PixelFormat = pf24Bit);

    // Clear 2D array of TBits objects
    FOR j := 0 TO 255 DO
      FOR i := 0 TO 255 DO
        Flags[i,j] := NIL;

    // Step through each scanline of image
    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      rowIn  := Bitmap.Scanline[j];
      FOR i := 0 TO Bitmap.Width-1 DO
      BEGIN
        WITH rowIn[i] DO
        BEGIN

          IF   NOT Assigned(Flags[rgbtRed, rgbtGreen])
          THEN BEGIN
            // Create 3D column when needed
            Flags[rgbtRed, rgbtGreen] := TBits.Create;
            Flags[rgbtRed, rgbtGreen].Size := 256;
          END;

          // Mark this R-G-B triple
          Flags[rgbtRed,rgbtGreen].Bits[rgbtBlue] := TRUE
        END
      END
    END;

    RESULT := 0;
    // Count and Free TBits objects
    FOR j := 0 TO 255 DO
    BEGIN
      FOR i := 0 TO 255 DO
      BEGIN

        IF   Assigned(Flags[i,j])
        THEN BEGIN
          FOR k := 0 TO 255 DO
            IF   Flags[i,j].Bits[k]
            THEN INC(RESULT);
          Flags[i,j].Free
        END

      END
    END

  END {CountColors};

// ========================================================================

procedure TFormHistoStretchGrays.OpenimageClick(Sender: TObject);
  VAR
    ColorCount:  INTEGER;
    Converted :  BOOLEAN;
    GrayCount :  INTEGER;
    i         :  INTEGER;
    Intensity :  INTEGER;
    j         :  INTEGER;
    Picture   :  TPicture;
    row       :  pRGBTripleARray;
begin
  IF   OpenPictureDialog.Execute
  THEN BEGIN
    Screen.Cursor := crHourGlass;
    TRY
      IF   Assigned(OriginalBitmap)
      THEN OriginalBitmap.Free;

      OriginalBitmap := TBitmap.Create;
      Picture := TPicture.Create;
      TRY
        Picture.LoadFromFile(OpenPictureDialog.Filename);
        OroginalColorImage.Picture.LoadFromFile(OpenPictureDialog.Filename);
        // Try converting into bitmap
        TRY
          OriginalBitmap.Assign(Picture.Graphic);
        EXCEPT
          OriginalBitmap.Width  := Picture.Graphic.Width;
          OriginalBitmap.Height := Picture.Graphic.Height;
          OriginalBitmap.PixelFormat := pf24bit;
          OriginalBitmap.Canvas.Draw(0,0, Picture.Graphic)
        END;

      FINALLY
        Picture.Free
      END;
      OriginalBitmap.PixelFormat := pf24bit;
      FormHistoStretchGrays.Caption := '车牌识别系统:  ' +
                                        OpenPictureDialog.Filename;
      ColorCount := CountColors(OriginalBitmap);

      // Convert any/all "color" pixels to intensity values-- but if original
      // image already in shades of gray, no conversion will occur.
      Converted := FALSE;
      FOR j := 0 TO OriginalBitmap.Height-1 DO
      BEGIN
        row := OriginalBitmap.Scanline[j];
        FOR i := 0 TO OriginalBitmap.Width-1 DO
        BEGIN
          WITH row[i] DO
          BEGIN  // Force R = G = B
            IF   (rgbtRed <> rgbtGreen) OR (rgbtRed <> rgbtBlue)
            THEN BEGIN
              Converted := TRUE;

              // Use the "Y" from "YIQ" coordinates -- this is the black/white
              // image like seen on old black/white TV sets.
              Intensity := RGBTripleToY(row[i]);

              rgbtRed   := Intensity;
              rgbtGreen := Intensity;
              rgbtBlue  := Intensity
            END
          END
        END
      END;

      GrayCount := CountColors(OriginalBitmap);

      // OK to show image now
      ImageOriginal.Picture.Graphic := OriginalBitmap;

//      CheckBoxStretch.Checked := (OriginalBitmap.Width  > ShowDesignWidth) OR
  //                               (OriginalBitmap.Height > ShowDesignHeight);

      UpdateDisplay
    FINALLY
      Screen.Cursor := crDefault
    END;

⌨️ 快捷键说明

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