Delphi图像处理之图像二值化

-----------开发环境D7

---效果图

-------只提供参考------

----------unit开始

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  ThresholdValueArray=array of array of Byte ;
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    Label1: TLabel;
    Button4: TButton;
    Label2: TLabel;
    EditX: TEdit;
    EditY: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure EditXChange(Sender: TObject);
  private
    function GetThresholdValue(sBmp: TBitmap; sX,sY: Byte): ThresholdValueArray;
    function GetThresholdArrayGray(const sArray:ThresholdValueArray; sStartX, sEndX, sStartY, sEndY: word): Byte;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    Label1.Caption:='图片宽x高:'+inttostr(Image1.Picture.Width)+'x'+inttostr(Image1.Picture.Height);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
const
  vThresholdValue:Byte=128;
var
  vP:PByteArray;
  x,y:Integer;
  vBmp:TBitmap;
  vGray:Integer;
begin
  if Image1.Picture.Graphic =nil then
  begin
    ShowMessage('没有图片！');
    Exit;
  end;
  vBmp:=TBitmap.Create;
  vBmp.Assign(Image1.Picture.Bitmap);
  vBmp.PixelFormat:=pf24bit;
  for y:=0 to vBmp.Height-1 do
  begin
    vP:=vBmp.ScanLine[y];
    for x:=0 to vBmp.Width-1 do
    begin
      vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
      if vGray>vThresholdValue then
      begin
        vP[3*x+2]:=255;
        vP[3*x+1]:=255;
        vP[3*x]:=255;
      end
      else
      begin
        vP[3*x+2]:=0;
        vP[3*x+1]:=0;
        vP[3*x]:=0;
      end;
    end;
  end;
  Image2.Picture.Assign(vBmp);
  vBmp.Free;
end;

function TForm1.GetThresholdArrayGray(const sArray: ThresholdValueArray; sStartX,
  sEndX, sStartY, sEndY: word): Byte;
var
  vGraySum:DWORD;
  i,j:Word;
begin
  Result:=128;//默认返回128
  if sArray=nil then
    Exit;
  vGraySum:=0;
  for i:=sStartX-1 to sEndX-1 do
  begin
    for j:=sStartY-1 to sEndY-1 do
    begin
      vGraySum:=vGraySum+sArray[i,j];
    end;
  end;
  Result:=Round(vGraySum/((sEndX-sStartX+1)*(sEndY-sStartY+1)));
end;

function TForm1.GetThresholdValue(sBmp: TBitmap; sX,
  sY: Byte): ThresholdValueArray;

var
  i,j,x,y,vGray:Word;
  vLengthX,vLengthY,vModX,vModY:Word;
  vP:PByteArray;
  vBitmapGrayArray:ThresholdValueArray;
  vResultGrayArray:ThresholdValueArray;
begin
  Result:=nil;
  if sBmp=nil then
    Exit;
  if sX=0 then
    sX:=1;
  if sY=0 then
    sY:=1;
  setlength(vBitmapGrayArray,sBmp.Width);
  for i:=0 to sBmp.Width-1 do
  begin
    setlength(vBitmapGrayArray[i],sBmp.Height);
  end;
  SetLength(vResultGrayArray,sX);
  for i:=0 to sX-1 do
  begin
    SetLength(vResultGrayArray[i],sY);
  end;

  for y:=0 to sBmp.Height-1  do
  begin
    vP:=sBmp.ScanLine[y];
    for x:=0 to sBmp.Width-1 do
    begin
      vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
      vBitmapGrayArray[x,y]:=vGray;
    end;
  end;
  vLengthX:=sBmp.width div sX;
  vLengthY:=sBmp.Height div sY;
  vModX:=sBmp.width mod sX;
  vMody:=sBmp.Height mod sY;
  for i:=0 to sX-1 do  //小块
  begin
    for j:=0 to sY-1 do//小块
    begin
      if i<>sX-1 then
      begin
        vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX,vLengthY*j+1,vLengthY*j+vLengthY);
      end
      else//最后一列
      begin
        vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX+vModX,vLengthY*j+1,vLengthY*j+vLengthY+vModY);
      end;

    end;

  end;
  Result:=vResultGrayArray;
  //数组释放
  for i:=0 to sBmp.Width-1 do
  begin
    setlength(vBitmapGrayArray[i],0);
  end;
  setlength(vBitmapGrayArray,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  vP:PByteArray;
  x,y:Integer;
  vBmp:TBitmap;
  vGray:Integer;
  vLengthX, vLengthY, vModX, vModY,vRowMod,vColMod: Word;
  vX,vY:Byte;
  vGrayArray:ThresholdValueArray;
  vRow,vCol:byte;
begin
  if Image1.Picture.Graphic =nil then
  begin
    ShowMessage('没有图片！');
    Exit;
  end;
  vX:=StrToIntDef(editX.Text ,3);
  vY:=StrToIntDef(editY.Text ,3);

  //暂时最多分成255*255块
  if (vX<1) or (vX>255) or (vY<1) or (vY>255) then
  begin
    MessageBox(Handle,PChar('X和Y的范围：1到255; 请输入在这个范围内的数字！'),PChar(Application.Title),MB_ICONEXCLAMATION);
    Exit;
  end;
  Label6.Caption:='总块数:'+inttostr(vX*vY);
  vBmp:=TBitmap.Create;
  vBmp.Assign(Image1.Picture.Bitmap);
  vBmp.PixelFormat:=pf24bit;

  vGrayArray:=GetThresholdValue(vBmp,vX,vY);
  for y:=0 to vBmp.Height-1 do
  begin
    vP:=vBmp.ScanLine[y];
    vRow:=y div vLengthY;
    vRowMod:=y div vLengthY;
    if vRow<vY then
    begin
      if vRowMod>0 then
        vRow:=vRow+1;
    end;
    for x:=0 to vBmp.Width-1 do
    begin
      vCol:=x div vLengthx;
      vColMod:=x div vLengthx;
      if vCol<vX then
      begin
        if vColMod>0 then
          vCol:=vCol+1;
      end;
      vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
      if vGray>vGrayArray[vCol,vRow] then
      begin
        vP[3*x+2]:=255;
        vP[3*x+1]:=255;
        vP[3*x]:=255;
      end
      else
      begin
        vP[3*x+2]:=0;
        vP[3*x+1]:=0;
        vP[3*x]:=0;
      end;
    end;
  end;
  Image2.Picture.Assign(vBmp);
  vBmp.Free;
end;

procedure TForm1.EditXChange(Sender: TObject);
begin
  Label6.Caption:='总块数：'+inttostr(StrToIntDef(EditX.Text ,0)*strtointDef(EditY.Text,0));
end;

end.

--------unit结束

--------Form开始 

object Form1: TForm1
  Left = 513
  Top = 326
  Width = 910
  Height = 528
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 8
    Top = 16
    Width = 425
    Height = 337
    Center = True
    Proportional = True
    Stretch = True
  end
  object Image2: TImage
    Left = 448
    Top = 16
    Width = 425
    Height = 337
    Center = True
    Proportional = True
    Stretch = True
  end
  object Label1: TLabel
    Left = 16
    Top = 360
    Width = 385
    Height = 25
    AutoSize = False
    Caption = '图片宽x高:'
  end
  object Label2: TLabel
    Left = 528
    Top = 360
    Width = 273
    Height = 13
    Alignment = taCenter
    AutoSize = False
    Caption = '按块求出阈值'
  end
  object Label3: TLabel
    Left = 457
    Top = 381
    Width = 73
    Height = 13
    Caption = '输入X x Y块：'
  end
  object Label4: TLabel
    Left = 533
    Top = 381
    Width = 24
    Height = 13
    Alignment = taRightJustify
    AutoSize = False
    Caption = 'X:'
  end
  object Label5: TLabel
    Left = 620
    Top = 380
    Width = 21
    Height = 17
    Alignment = taRightJustify
    AutoSize = False
    Caption = 'Y:'
  end
  object Label6: TLabel
    Left = 704
    Top = 383
    Width = 185
    Height = 13
    AutoSize = False
    Caption = '总块数：'
  end
  object Label7: TLabel
    Left = 512
    Top = 440
    Width = 377
    Height = 45
    AutoSize = False
    Caption = '理应是块数分的越多，越准确！本人这个呈抛物线的感觉，'#13#10'有一个最优的块数，算了先不找原因了，抛砖引玉，哈哈哈'
    WordWrap = True
  end
  object Button1: TButton
    Left = 16
    Top = 416
    Width = 161
    Height = 25
    Caption = 'Button1_加载图片'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 232
    Top = 416
    Width = 177
    Height = 25
    Caption = 'Button2_二值化_默认阈值'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Button4: TButton
    Left = 560
    Top = 407
    Width = 297
    Height = 25
    Caption = 'Button4_分块求平均阈值，按块二值化'
    TabOrder = 2
    OnClick = Button4Click
  end
  object EditX: TEdit
    Left = 567
    Top = 378
    Width = 49
    Height = 21
    ImeName = '中文(简体) - 搜狗拼音输入法'
    TabOrder = 3
    Text = 'EditX'
    OnChange = EditXChange
  end
  object EditY: TEdit
    Left = 649
    Top = 379
    Width = 47
    Height = 21
    ImeName = '中文(简体) - 搜狗拼音输入法'
    TabOrder = 4
    Text = 'EditY'
    OnChange = EditXChange
  end
  object OpenPictureDialog1: TOpenPictureDialog
    Filter = 'Bitmaps (*.bmp)|*.bmp'
    Left = 72
    Top = 368
  end
end

------------Form结束