码农的笔记

Delphi虽好，但已不流行； 博客真好，可以做笔记
博客园 首页 新随笔 联系 订阅 管理
Delphi图像处理之图像二值化

-----------开发环境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     Button3: TButton;
 28     SavePictureDialog1: TSavePictureDialog;
 29     procedure Button1Click(Sender: TObject);
 30     procedure Button2Click(Sender: TObject);
 31     procedure Button4Click(Sender: TObject);
 32     procedure EditXChange(Sender: TObject);
 33     procedure Button3Click(Sender: TObject);
 34   private
 35     function GetThresholdValue(sBmp: TBitmap; sX,sY: Byte): ThresholdValueArray;
 36     function GetThresholdArrayGray(const sArray:ThresholdValueArray; sStartX, sEndX, sStartY, sEndY: word): Byte;
 37     procedure BinarizationA;
 38     { Private declarations }
 39   public
 40     { Public declarations }
 41   end;
 42 
 43 var
 44   Form1: TForm1;
 45 
 46 implementation
 47 
 48 {$R *.dfm}
 49 
 50 procedure TForm1.Button1Click(Sender: TObject);
 51 begin
 52   if OpenPictureDialog1.Execute then
 53   begin
 54     Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
 55     Label1.Caption:='图片宽x高:'+inttostr(Image1.Picture.Width)+'x'+inttostr(Image1.Picture.Height);
 56   end;
 57 end;
 58 
 59 procedure TForm1.Button2Click(Sender: TObject);
 60 const
 61   vThresholdValue:Byte=128;
 62 var
 63   vP:PByteArray;
 64   x,y:Integer;
 65   vBmp:TBitmap;
 66   vGray:Integer;
 67 begin
 68   if Image1.Picture.Graphic =nil then
 69   begin
 70     ShowMessage('没有图片！');
 71     Exit;
 72   end;
 73   vBmp:=TBitmap.Create;
 74   vBmp.Assign(Image1.Picture.Bitmap);
 75   vBmp.PixelFormat:=pf24bit;
 76   for y:=0 to vBmp.Height-1 do
 77   begin
 78     vP:=vBmp.ScanLine[y];
 79     for x:=0 to vBmp.Width-1 do
 80     begin
 81       vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
 82       if vGray>vThresholdValue then
 83       begin
 84         vP[3*x+2]:=255;
 85         vP[3*x+1]:=255;
 86         vP[3*x]:=255;
 87       end
 88       else
 89       begin
 90         vP[3*x+2]:=0;
 91         vP[3*x+1]:=0;
 92         vP[3*x]:=0;
 93       end;
 94     end;
 95   end;
 96   Image2.Picture.Assign(vBmp);
 97   vBmp.Free;
 98 end;
 99 
100 function TForm1.GetThresholdArrayGray(const sArray: ThresholdValueArray; sStartX,
101   sEndX, sStartY, sEndY: word): Byte;
102 var
103   vGraySum:DWORD;
104   i,j:Word;
105 begin
106   Result:=128;//默认返回128
107   if sArray=nil then
108     Exit;
109   vGraySum:=0;
110   for i:=sStartX-1 to sEndX-1 do
111   begin
112     for j:=sStartY-1 to sEndY-1 do
113     begin
114       vGraySum:=vGraySum+sArray[i,j];
115     end;
116   end;
117   Result:=Round(vGraySum/((sEndX-sStartX+1)*(sEndY-sStartY+1)));
118 end;
119 
120 function TForm1.GetThresholdValue(sBmp: TBitmap; sX,
121   sY: Byte): ThresholdValueArray;
122 
123 var
124   i,j,x,y,vGray:Word;
125   vLengthX,vLengthY,vModX,vModY:Word;
126   vP:PByteArray;
127   vBitmapGrayArray:ThresholdValueArray;
128   vResultGrayArray:ThresholdValueArray;
129 begin
130   Result:=nil;
131   if sBmp=nil then
132     Exit;
133   if sX=0 then
134     sX:=1;
135   if sY=0 then
136     sY:=1;
137   setlength(vBitmapGrayArray,sBmp.Width);
138   for i:=0 to sBmp.Width-1 do
139   begin
140     setlength(vBitmapGrayArray[i],sBmp.Height);
141   end;
142   SetLength(vResultGrayArray,sX);
143   for i:=0 to sX-1 do
144   begin
145     SetLength(vResultGrayArray[i],sY);
146   end;
147 
148   for y:=0 to sBmp.Height-1  do
149   begin
150     vP:=sBmp.ScanLine[y];
151     for x:=0 to sBmp.Width-1 do
152     begin
153       vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
154       vBitmapGrayArray[x,y]:=vGray;
155     end;
156   end;
157   vLengthX:=sBmp.width div sX;
158   vLengthY:=sBmp.Height div sY;
159   vModX:=sBmp.width mod sX;
160   vMody:=sBmp.Height mod sY;
161   for i:=0 to sX-1 do  //小块
162   begin
163     for j:=0 to sY-1 do//小块
164     begin
165       if i<>sX-1 then
166       begin
167         vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX,vLengthY*j+1,vLengthY*j+vLengthY);
168       end
169       else//最后一列
170       begin
171         vResultGrayArray[i,j]:=GetThresholdArrayGray(vBitmapGrayArray,vLengthX*i+1,vLengthX*i+vLengthX+vModX,vLengthY*j+1,vLengthY*j+vLengthY+vModY);
172       end;
173 
174     end;
175 
176   end;
177   Result:=vResultGrayArray;
178   //数组释放
179   for i:=0 to sBmp.Width-1 do
180   begin
181     setlength(vBitmapGrayArray[i],0);
182   end;
183   setlength(vBitmapGrayArray,0);
184 end;
185 
186 procedure TForm1.Button4Click(Sender: TObject);
187 begin
188   BinarizationA;
189 end;
190 procedure TForm1.EditXChange(Sender: TObject);
191 begin
192   Label6.Caption:='总块数：'+inttostr(StrToIntDef(EditX.Text ,0)*strtointDef(EditY.Text,0));
193 end;
194 
195 procedure TForm1.Button3Click(Sender: TObject);
196 begin
197   if Image2.Picture.Graphic =nil then
198   begin
199     ShowMessage('没有图片！');
200     Exit;
201   end;
202   if SavePictureDialog1.Execute then
203   begin
204     Image2.Picture.SaveToFile(SavePictureDialog1.FileName);
205     ShowMessage('保存成功！');
206   end;
207 end;
208 
209 procedure TForm1.BinarizationA;
210 var
211   vP:PByteArray;
212   x,y:Integer;
213   vBmp:TBitmap;
214   vGray:Integer;
215   vLengthX, vLengthY, vModX, vModY,vRowMod,vColMod: Word;
216   vX,vY:Byte;
217   vGrayArray:ThresholdValueArray;
218   vRow,vCol:byte;
219 begin
220   if Image1.Picture.Graphic =nil then
221   begin
222     ShowMessage('没有图片！');
223     Exit;
224   end;
225   vX:=StrToIntDef(editX.Text ,3);
226   vY:=StrToIntDef(editY.Text ,3);
227   //暂时最多分成255*255块
228   if (vX<1) or (vX>255) or (vY<1) or (vY>255) then
229   begin
230     MessageBox(Handle,PChar('X和Y的范围：1到255; 请输入在这个范围内的数字！'),PChar(Application.Title),MB_ICONEXCLAMATION);
231     Exit;
232   end;
233   Label6.Caption:='总块数:'+inttostr(vX*vY);
234   vBmp:=TBitmap.Create;
235   vBmp.Assign(Image1.Picture.Bitmap);
236   vBmp.PixelFormat:=pf24bit;
237   vGrayArray:=GetThresholdValue(vBmp,vX,vY);
238 
239   vLengthX:=vBmp.width div vX;
240   vLengthY:=vBmp.Height div vY;
241   for y:=0 to vBmp.Height-1 do
242   begin
243     vP:=vBmp.ScanLine[y];
244     vRow:=(y+1) div vLengthY;
245     vRowMod:=(y+1) mod vLengthY;
246     if vRow<vY then
247     begin
248       if vRowMod>0 then
249         vRow:=vRow+1;
250     end
251     else
252       vRow:=vY;
253     for x:=0 to vBmp.Width-1 do
254     begin
255       vCol:=(x+1) div vLengthx ;
256       vColMod:=(x+1) mod vLengthx ;
257       if vCol<vX then
258       begin
259         if vColMod>0 then
260           vCol:=vCol+1;
261       end
262       else
263         vCol:=vX;
264       vGray:=(77*vP[3*x+2] + 149*vP[3*x+1] + 29*vP[3*x]) shr 8;
265       
266       if (vGray>vGrayArray[vCol-1,vRow-1])or (vGray>128)  then 
267       begin
268         vP[3*x+2]:=255;
269         vP[3*x+1]:=255;
270         vP[3*x]:=255;
271       end
272       else
273       begin
274         vP[3*x+2]:=0;
275         vP[3*x+1]:=0;
276         vP[3*x]:=0;
277       end;
278     end;
279   end;
280   Image2.Picture.Assign(vBmp);
281   vBmp.Free;
282 end;
283 
284 end.

 

 

--------unit结束

--------Form开始 

  1 object Form1: TForm1
  2   Left = 513
  3   Top = 261
  4   Width = 910
  5   Height = 593
  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 = 
 91       '理应是块数分的越多，越准确！本人这个呈抛物线的感觉，'#13#10'有一个最优的块数，算了先不找原因了，抛砖引玉，哈哈哈,这个分块数的没啥意' +
 92       '思哈'
 93     WordWrap = True
 94   end
 95   object Button1: TButton
 96     Left = 16
 97     Top = 416
 98     Width = 161
 99     Height = 25
100     Caption = 'Button1_加载图片'
101     TabOrder = 0
102     OnClick = Button1Click
103   end
104   object Button2: TButton
105     Left = 232
106     Top = 416
107     Width = 177
108     Height = 25
109     Caption = 'Button2_二值化_默认阈值'
110     TabOrder = 1
111     OnClick = Button2Click
112   end
113   object Button4: TButton
114     Left = 560
115     Top = 407
116     Width = 297
117     Height = 25
118     Caption = 'Button4_分块求平均阈值，按块二值化'
119     TabOrder = 2
120     OnClick = Button4Click
121   end
122   object EditX: TEdit
123     Left = 567
124     Top = 378
125     Width = 49
126     Height = 21
127     ImeName = '中文(简体) - 搜狗拼音输入法'
128     TabOrder = 3
129     Text = 'EditX'
130     OnChange = EditXChange
131   end
132   object EditY: TEdit
133     Left = 649
134     Top = 379
135     Width = 47
136     Height = 21
137     ImeName = '中文(简体) - 搜狗拼音输入法'
138     TabOrder = 4
139     Text = 'EditY'
140     OnChange = EditXChange
141   end
142   object Button3: TButton
143     Left = 808
144     Top = 352
145     Width = 75
146     Height = 25
147     Caption = '导出图片'
148     TabOrder = 5
149     OnClick = Button3Click
150   end
151   object OpenPictureDialog1: TOpenPictureDialog
152     Filter = 'Bitmaps (*.bmp)|*.bmp'
153     Left = 72
154     Top = 368
155   end
156   object SavePictureDialog1: TSavePictureDialog
157     Left = 720
158     Top = 328
159   end
160 end

 

 

 

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

posted on 2021-08-14 12:01  码农的笔记  阅读(232)  评论(0)  编辑  收藏  举报