-----------开发环境D7
---效果图
-------只提供参考------
----------unit开始
1 unit Unit1; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, ExtCtrls, StdCtrls, ExtDlgs; 8 9 type 10 ThresholdValueArray=array of array of Byte ; 11 TForm1 = class(TForm) 12 Button1: TButton; 13 Button2: TButton; 14 Image1: TImage; 15 Image2: TImage; 16 OpenPictureDialog1: TOpenPictureDialog; 17 Label1: TLabel; 18 Button4: TButton; 19 Label2: TLabel; 20 EditX: TEdit; 21 EditY: TEdit; 22 Label3: TLabel; 23 Label4: TLabel; 24 Label5: TLabel; 25 Label6: TLabel; 26 Label7: TLabel; 27 procedure Button1Click(Sender: TObject); 28 procedure Button2Click(Sender: TObject); 29 procedure Button4Click(Sender: TObject); 30 procedure EditXChange(Sender: TObject); 31 private 32 function GetThresholdValue(sBmp: TBitmap; sX,sY: Byte): ThresholdValueArray; 33 function GetThresholdArrayGray(const sArray:ThresholdValueArray; sStartX, sEndX, sStartY, sEndY: word): Byte; 34 { Private declarations } 35 public 36 { Public declarations } 37 end; 38 39 var 40 Form1: TForm1; 41 42 implementation 43 44 {$R *.dfm} 45 46 procedure TForm1.Button1Click(Sender: TObject); 47 begin 48 if OpenPictureDialog1.Execute then 49 begin 50 Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); 51 Label1.Caption:='图片宽x高:'+inttostr(Image1.Picture.Width)+'x'+inttostr(Image1.Picture.Height); 52 end; 53 end; 54 55 procedure TForm1.Button2Click(Sender: TObject); 56 const 57 vThresholdValue:Byte=128; 58 var 59 vP:PByteArray; 60 x,y:Integer; 61 vBmp:TBitmap; 62 vGray:Integer; 63 begin 64 if Image1.Picture.Graphic =nil then 65 begin 66 ShowMessage('没有图片！'); 67 Exit; 68 end; 69 vBmp:=TBitmap.Create; 70 vBmp.Assign(Image1.Picture.Bitmap); 71 vBmp.PixelFormat:=pf24bit; 72 for y:=0 to vBmp.Height-1 do 73 begin 74 vP:=vBmp.ScanLine[y]; 75 for x:=0 to vBmp.Width-1 do 76 begin 77 vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8; 78 if vGray>vThresholdValue then 79 begin 80 vP[3*x+2]:=255; 81 vP[3*x+1]:=255; 82 vP[3*x]:=255; 83 end 84 else 85 begin 86 vP[3*x+2]:=0; 87 vP[3*x+1]:=0; 88 vP[3*x]:=0; 89 end; 90 end; 91 end; 92 Image2.Picture.Assign(vBmp); 93 vBmp.Free; 94 end; 95 96 function TForm1.GetThresholdArrayGray(const sArray: ThresholdValueArray; sStartX, 97 sEndX, sStartY, sEndY: word): Byte; 98 var 99 vGraySum:DWORD; 100 i,j:Word; 101 begin 102 Result:=128;//默认返回128 103 if sArray=nil then 104 Exit; 105 vGraySum:=0; 106 for i:=sStartX-1 to sEndX-1 do 107 begin 108 for j:=sStartY-1 to sEndY-1 do 109 begin 110 vGraySum:=vGraySum+sArray[i,j]; 111 end; 112 end; 113 Result:=Round(vGraySum/((sEndX-sStartX+1)*(sEndY-sStartY+1))); 114 end; 115 116 function TForm1.GetThresholdValue(sBmp: TBitmap; sX, 117 sY: Byte): ThresholdValueArray; 118 119 var 120 i,j,x,y,vGray:Word; 121 vLengthX,vLengthY,vModX,vModY:Word; 122 vP:PByteArray; 123 vBitmapGrayArray:ThresholdValueArray; 124 vResultGrayArray:ThresholdValueArray; 125 begin 126 Result:=nil; 127 if sBmp=nil then 128 Exit; 129 if sX=0 then 130 sX:=1; 131 if sY=0 then 132 sY:=1; 133 setlength(vBitmapGrayArray,sBmp.Width); 134 for i:=0 to sBmp.Width-1 do 135 begin 136 setlength(vBitmapGrayArray[i],sBmp.Height); 137 end; 138 SetLength(vResultGrayArray,sX); 139 for i:=0 to sX-1 do 140 begin 141 SetLength(vResultGrayArray[i],sY); 142 end; 143 144 for y:=0 to sBmp.Height-1 do 145 begin 146 vP:=sBmp.ScanLine[y]; 147 for x:=0 to sBmp.Width-1 do 148 begin 149 vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8; 150 vBitmapGrayArray[x,y]:=vGray; 151 end; 152 end; 153 vLengthX:=sBmp.width div sX; 154 vLengthY:=sBmp.Height div sY; 155 vModX:=sBmp.width mod sX; 156 vMody:=sBmp.Height mod sY; 157 for i:=0 to sX-1 do //小块 158 begin 159 for j:=0 to sY-1 do//小块 160 begin 161 if i<>sX-1 then 162 begin 163 vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX,vLengthY*j+1,vLengthY*j+vLengthY); 164 end 165 else//最后一列 166 begin 167 vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX+vModX,vLengthY*j+1,vLengthY*j+vLengthY+vModY); 168 end; 169 170 end; 171 172 end; 173 Result:=vResultGrayArray; 174 //数组释放 175 for i:=0 to sBmp.Width-1 do 176 begin 177 setlength(vBitmapGrayArray[i],0); 178 end; 179 setlength(vBitmapGrayArray,0); 180 end; 181 182 procedure TForm1.Button4Click(Sender: TObject); 183 var 184 vP:PByteArray; 185 x,y:Integer; 186 vBmp:TBitmap; 187 vGray:Integer; 188 vLengthX, vLengthY, vModX, vModY,vRowMod,vColMod: Word; 189 vX,vY:Byte; 190 vGrayArray:ThresholdValueArray; 191 vRow,vCol:byte; 192 begin 193 if Image1.Picture.Graphic =nil then 194 begin 195 ShowMessage('没有图片！'); 196 Exit; 197 end; 198 vX:=StrToIntDef(editX.Text ,3); 199 vY:=StrToIntDef(editY.Text ,3); 200 201 //暂时最多分成255*255块 202 if (vX<1) or (vX>255) or (vY<1) or (vY>255) then 203 begin 204 MessageBox(Handle,PChar('X和Y的范围：1到255; 请输入在这个范围内的数字！'),PChar(Application.Title),MB_ICONEXCLAMATION); 205 Exit; 206 end; 207 Label6.Caption:='总块数:'+inttostr(vX*vY); 208 vBmp:=TBitmap.Create; 209 vBmp.Assign(Image1.Picture.Bitmap); 210 vBmp.PixelFormat:=pf24bit; 211 212 vGrayArray:=GetThresholdValue(vBmp,vX,vY); 213 for y:=0 to vBmp.Height-1 do 214 begin 215 vP:=vBmp.ScanLine[y]; 216 vRow:=y div vLengthY; 217 vRowMod:=y div vLengthY; 218 if vRow<vY then 219 begin 220 if vRowMod>0 then 221 vRow:=vRow+1; 222 end; 223 for x:=0 to vBmp.Width-1 do 224 begin 225 vCol:=x div vLengthx; 226 vColMod:=x div vLengthx; 227 if vCol<vX then 228 begin 229 if vColMod>0 then 230 vCol:=vCol+1; 231 end; 232 vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8; 233 if vGray>vGrayArray[vCol,vRow] then 234 begin 235 vP[3*x+2]:=255; 236 vP[3*x+1]:=255; 237 vP[3*x]:=255; 238 end 239 else 240 begin 241 vP[3*x+2]:=0; 242 vP[3*x+1]:=0; 243 vP[3*x]:=0; 244 end; 245 end; 246 end; 247 Image2.Picture.Assign(vBmp); 248 vBmp.Free; 249 end; 250 251 procedure TForm1.EditXChange(Sender: TObject); 252 begin 253 Label6.Caption:='总块数：'+inttostr(StrToIntDef(EditX.Text ,0)*strtointDef(EditY.Text,0)); 254 end; 255 256 end.
--------unit结束
--------Form开始
1 object Form1: TForm1 2 Left = 513 3 Top = 326 4 Width = 910 5 Height = 528 6 Caption = 'Form1' 7 Color = clBtnFace 8 Font.Charset = DEFAULT_CHARSET 9 Font.Color = clWindowText 10 Font.Height = -11 11 Font.Name = 'MS Sans Serif' 12 Font.Style = [] 13 OldCreateOrder = False 14 PixelsPerInch = 96 15 TextHeight = 13 16 object Image1: TImage 17 Left = 8 18 Top = 16 19 Width = 425 20 Height = 337 21 Center = True 22 Proportional = True 23 Stretch = True 24 end 25 object Image2: TImage 26 Left = 448 27 Top = 16 28 Width = 425 29 Height = 337 30 Center = True 31 Proportional = True 32 Stretch = True 33 end 34 object Label1: TLabel 35 Left = 16 36 Top = 360 37 Width = 385 38 Height = 25 39 AutoSize = False 40 Caption = '图片宽x高:' 41 end 42 object Label2: TLabel 43 Left = 528 44 Top = 360 45 Width = 273 46 Height = 13 47 Alignment = taCenter 48 AutoSize = False 49 Caption = '按块求出阈值' 50 end 51 object Label3: TLabel 52 Left = 457 53 Top = 381 54 Width = 73 55 Height = 13 56 Caption = '输入X x Y块：' 57 end 58 object Label4: TLabel 59 Left = 533 60 Top = 381 61 Width = 24 62 Height = 13 63 Alignment = taRightJustify 64 AutoSize = False 65 Caption = 'X:' 66 end 67 object Label5: TLabel 68 Left = 620 69 Top = 380 70 Width = 21 71 Height = 17 72 Alignment = taRightJustify 73 AutoSize = False 74 Caption = 'Y:' 75 end 76 object Label6: TLabel 77 Left = 704 78 Top = 383 79 Width = 185 80 Height = 13 81 AutoSize = False 82 Caption = '总块数：' 83 end 84 object Label7: TLabel 85 Left = 512 86 Top = 440 87 Width = 377 88 Height = 45 89 AutoSize = False 90 Caption = '理应是块数分的越多，越准确！本人这个呈抛物线的感觉，'#13#10'有一个最优的块数，算了先不找原因了，抛砖引玉，哈哈哈' 91 WordWrap = True 92 end 93 object Button1: TButton 94 Left = 16 95 Top = 416 96 Width = 161 97 Height = 25 98 Caption = 'Button1_加载图片' 99 TabOrder = 0 100 OnClick = Button1Click 101 end 102 object Button2: TButton 103 Left = 232 104 Top = 416 105 Width = 177 106 Height = 25 107 Caption = 'Button2_二值化_默认阈值' 108 TabOrder = 1 109 OnClick = Button2Click 110 end 111 object Button4: TButton 112 Left = 560 113 Top = 407 114 Width = 297 115 Height = 25 116 Caption = 'Button4_分块求平均阈值，按块二值化' 117 TabOrder = 2 118 OnClick = Button4Click 119 end 120 object EditX: TEdit 121 Left = 567 122 Top = 378 123 Width = 49 124 Height = 21 125 ImeName = '中文(简体) - 搜狗拼音输入法' 126 TabOrder = 3 127 Text = 'EditX' 128 OnChange = EditXChange 129 end 130 object EditY: TEdit 131 Left = 649 132 Top = 379 133 Width = 47 134 Height = 21 135 ImeName = '中文(简体) - 搜狗拼音输入法' 136 TabOrder = 4 137 Text = 'EditY' 138 OnChange = EditXChange 139 end 140 object OpenPictureDialog1: TOpenPictureDialog 141 Filter = 'Bitmaps (*.bmp)|*.bmp' 142 Left = 72 143 Top = 368 144 end 145 end
------------Form结束