Диссертация (1151678), страница 42
Текст из файла (страница 42)
Pachepsky, W.J. Rawls // Developments in Soil Science. Vol. 30, 2004. –512 p.264. Pertovici, T. A mathematical generalized approach to estimate soil moistureretention characteristics from texture classes / T. Pertovici, A.M. Marinov //Univ. Politehn. Bucharest. Sci. Bull. D. Univ. Politehn. Bucharest, 2010. V.72. № 1. -pp.
59–66.265. Perumprul, J. A Numerical Method for predicting the stress distributions asoils deformation under a tractor wheel / J. Perumprul, J. Liljedahl, W. Perloff// Journal of Terramechanics, 1971, vol. 8, № 1, -pp. 9–22.266. Petkov, P.V. Statics and dynamics of capillary bridges / P.V. Petkov, B.P.Radoev // Col. and Surf. A Physicochemical and Engineering Aspects, 2014.№ 460(20). – pp. 18-27.267. Phoon, Kok-Kwang Probabilistis analysis of soil-water characteristic curver /Kok-Kwang Phoon, A. Santoso, Ser-Tong Quek // J. Geotechn. AndGeoenviron. Eng. 2010.
V. 136. № 3. - pp. 445–455.268. Ravichandran, N. A Statistical Model for the Relative Hydraulic Conductivityof Water Phase in Unsaturated Soils / N. Ravichandran, S. Krishnapillai //International Journal of Geosciences, 2011. № 2, - pp. 484-492.269. Schmugge, T.J. Survey of methods for soil moisture determination / T.J.Schmugge, T.J. Jackson, H.L. McKim // Water Resources Res., 1980. V.16.
pp. 961–979.270. Seki, K. SWRC fit – a nonlinear fitting program with a water retention curvefor soils having unimodal and bimodal pore structure / K. Seki // Hydrol.Earth Syst. Sci. Discuss. 2007. V. 4(1). -pp. 407–437.304271. Taylor, H.M. Effect of soil compaction on root development / H.M. Taylor //Soil compaction as a factor determine plant productivity. Lublin. Poland,1989. - 155 p.272. Touma, J. Comparison of the soil hydraulic conductivity predicted from itswater retention expressed by the equation of van Genuchten and differentcapillary models / J. Touma // European Journal of Soil Science, 2009. № 60.– pp. 671-680.273.
Van Genuchten, M.Th. A closed form equation for predicting the hydraulicconductivity of unsaturated soils / M.Th. Van Genuchten // Soil Sci. Soc. Am.J., 1980. № 44. –pp. 892-989.274. Vogel, T. Effect of the shape of the soil hydraulic functions near saturation onvariably-saturated flow predictions / T. Vogel, M. Th. van Genuchten, M.Cislerova // Adv.Water Res. 2000.
V. 24(2). -pp. 133–144.275. Xu, Y.F. Calculation of unsaturated hydraulic conductivity using a fractalmodel for the pore-size distribution / Y.F. Xu // Computer and Geotechnics,2004, № 31(7). –pp. 549-557.305ПРИЛОЖЕНИЯПриложение А. Документы, подтверждающие новизну методов испособов расчета гидрофизических величин306307308309Приложение Б. Листинги программЛистинг программы по расчету интенсивности впитывания, профилейувлажнения при дождевании и капельном поливеunit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, sSkinProvider, sSkinManager, StdCtrls, sEdit, sSpinEdit,TeEngine, Series, ExtCtrls, TeeProcs, Chart, sButton, sLabel, sComboBox,ComCtrls, sPageControl,Math, sPanel;typeTForm1 = class(TForm)sPageControl1: TsPageControl;sTabSheet1: TsTabSheet;sTabSheet2: TsTabSheet;sTabSheet3: TsTabSheet;sSkinManager1: TsSkinManager;Chart1: TChart;Series1: TFastLineSeries;Series2: TFastLineSeries;Series3: TFastLineSeries;Series4: TFastLineSeries;Series5: TFastLineSeries;Series6: TFastLineSeries;Series7: TFastLineSeries;Series8: TFastLineSeries;Series9: TFastLineSeries;Series10: TFastLineSeries;sButton1: TsButton;sLabel1: TsLabel;Chart2: TChart;FastLineSeries1: TFastLineSeries;sButton2: TsButton;sLabel2: TsLabel;sDecimalSpinEdit1: TsDecimalSpinEdit;sLabel4: TsLabel;sDecimalSpinEdit3: TsDecimalSpinEdit;sLabel5: TsLabel;sDecimalSpinEdit4: TsDecimalSpinEdit;310sLabel6: TsLabel;sDecimalSpinEdit5: TsDecimalSpinEdit;sComboBox1: TsComboBox;sPanel1: TsPanel;Image1: TImage;sButton3: TsButton;sDecimalSpinEdit2: TsDecimalSpinEdit;sLabelFX1: TsLabelFX;procedure sButton1Click(Sender: TObject);procedure sButton2Click(Sender: TObject);procedure sButton3Click(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;p1,p2,p3,p4,p5,p6,p7,al1,al2,Ip:real;mass:array [1..100] of real;mass3d:array [1..50,1..100] of real;implementation{$R *.dfm}function getPER():boolean;begintryp1:=0.000000000000000002;p2:=0.0073;p3:=StrToFloat(form1.sDecimalSpinEdit3.Text);p4:=StrToFloat(form1.sDecimalSpinEdit4.Text);p5:=StrToFloat(form1.sDecimalSpinEdit5.Text);p6:=0.00101;p7:=0.000025;Ip:=StrToFloat(form1.sDecimalSpinEdit1.Text);case form1.sComboBox1.ItemIndex of0:beginal1:=0.00735; al2:=2.92;end;1:begin311al1:=0.01429; al2:=2.5;end;2:beginal1:=0.0034; al2:=3.14;end;end;getPER:=true;exceptgetPER:=false;MessageDlg ('Ошибка ввода кoэффицентов!!!', mtError, [mbOK],0);end;end;function Pr(w:real):real;beginPr:=p3*(p1*(1/(w*w*w)-1/(p4*p4*p4))+p2*((1-p4)/(1-p4+w))*Power((1w/p4),al1));end;function Kr(w:real):real;beginKr:=1/(p3*p6)*Power(3.1415926,2)/Power(p4,2)*al2*Power(p4,al1)/(1p4)*(2*w/p4-Power(w,2)/Power(p4,2));end;function DW(k,r1,r2,t:real):real;beginDW:=k*(r2-r1+1000*9.8*0.005)*p7*t;end;procedure TForm1.sButton1Click(Sender: TObject);var x1,x2,k,d:real;i,ls,kol:integer;begingetPER;for i:=1 to 100 do mass[i]:=0; // Очистим массив// Очистим графики312series1.Clear;series2.Clear;series3.Clear;series4.Clear;series5.Clear;series6.Clear;series7.Clear;series8.Clear;series9.Clear;series10.Clear;sPanel1.Visible:=false;application.ProcessMessages;// Началоmass[1]:=p5+Ip/300;mass[2]:=p5;kol:=60;for ls:=1 to 72*10 do //720begin// Расчет wifor i:=1 to 99 dobeginx1:=Pr(mass[i]);x2:=Pr(mass[i+1]);k:=Kr(mass[i]);d:=DW(k,x1,x2,10);if (mass[i]-mass[i+1]<>0) and (d>(mass[i]-mass[i+1])/2) then/// Уменьшим dd:=(mass[i]-mass[i+1])/2;mass[i]:=mass[i]-d;if i=1 then mass[i]:=mass[i]+Ip/300; // Добавим к 1-муmass[i+1]:=mass[i+1]+d;if mass[i]>p4 thenbeginif sPanel1.Visible thenbeginmass[i]:=p4;endelsebeginsPanel1.Visible:=true;sPanel1.Caption:='Идёт сток ['+FloatToStr(mass[i]-p4)+']!!!';313mass[i]:=p4;application.ProcessMessages;endend;if i<>99 thenif mass[i+2]=0 then mass[i+2]:=p5;end;/////////////////////////////if ls=72 then // 12 минfor i:=1 to kol doseries1.addxy(i,mass[i],IntToStr(i),clRed);if ls=72*2 then // Прошло 24 минfor i:=1 to kol doseries2.addxy(i,mass[i],IntToStr(i),clBlue);if ls=72*3 then // Прошло 36 минfor i:=1 to kol doseries3.addxy(i,mass[i],IntToStr(i),clGreen);if ls=72*4 then // Прошло 48 минfor i:=1 to kol doseries4.addxy(i,mass[i],IntToStr(i),clPurple);if ls=72*5 then // Прошло 60 минfor i:=1 to kol doseries5.addxy(i,mass[i],IntToStr(i),clPurple);if ls=72*6 then // Прошло 72 минfor i:=1 to kol doseries6.addxy(i,mass[i],IntToStr(i),clPurple);if ls=72*7 then // Прошло 84 минfor i:=1 to kol doseries7.addxy(i,mass[i],IntToStr(i),clPurple);if ls=72*8 then // Прошло 96 минfor i:=1 to kol doseries8.addxy(i,mass[i],IntToStr(i),clPurple);if ls=72*9 then // Прошло 108 минfor i:=1 to kol doseries9.addxy(i,mass[i],IntToStr(i),clPurple);314if ls=72*10 then // Прошло 120 минfor i:=1 to kol doseries10.addxy(i,mass[i],IntToStr(i),clPurple);end;end;procedure TForm1.sButton2Click(Sender: TObject);var x1,x2,k,d,sums:real;i,ls,kol:integer;begingetPER;for i:=1 to 100 do mass[i]:=0; // Очистим массив// Очистим графикиFastLineSeries1.Clear;// Началоmass[1]:=p4;mass[2]:=p5;kol:=1;sums:=0;for ls:=1 to 720 dobegin// Расчет wifor i:=1 to 99 dobeginx1:=Pr(mass[i]);x2:=Pr(mass[i+1]);k:=Kr(mass[i]);d:=DW(k,x1,x2,1);if (mass[i]-mass[i+1]<>0) and (d>(mass[i]-mass[i+1])/2) then/// Уменьшим dd:=(mass[i]-mass[i+1])/2;mass[i]:=mass[i]-d;mass[1]:=p4; //mass[i+1]:=mass[i+1]+d;if mass[i+1]>p4 thenbeginMessageDlg ('Идёт сток!!!('+IntToStr(ls)+')', mtError, [mbOK],0);break;end;if i<>99 thenif mass[i+2]=0 then mass[i+2]:=p5;315end;if mass[i+1]>p4 then break;/////////////////////////////if ls mod 60 =0 then // Вывод суммы 6 разностейbegin// for i:=1 to kol doFastLineSeries1.addxy(kol,sums,IntToStr(kol),clRed);inc(kol);sums:=0;endelsesums:=sums+mass[1]-mass[2];end;end;//////////////////////////////// III частьfunction DWL(k,Pmn1,Pmn,Rn1,Rn,t:real):real;beginDWL:=k/0.005*(Pmn1-Pmn)/(Rn1*Rn1-Rn*Rn)*2*t;end;function DWD(k,Pmn1,Pmn,t:real):real;beginDWD:=k/sqr(0.005)*(Pmn1-Pmn+1000*9.8*0.005)*t;end;function Rn(n:integer):real;beginRn:=2.5+5*(n-1);end;procedure TForm1.sButton3Click(Sender: TObject);var iv,jv,i,j,kolsek:integer;x1,x2,k,d:real;begin// ИнициализацияgetPER;for iv:=1 to 50 dofor jv:=1 to 100 domass3d[iv,jv]:=0.32;mass3d[1,1]:= mass3d[1,1]+Ip/300;/////////////////////////////////////////////316// Обработкаfor iv:=1 to 50 dofor jv:=1 to 100 dobegin// Строка ->for i:=iv to 50 dobeginx1:=Pr(mass3d[i,jv]);x2:=Pr(mass3d[i,jv+1]);k:=Kr(mass3d[i,jv]);d:=DWL(k,x2,x1,Rn(i+1),Rn(i),1);mass3d[i,jv]:=mass3d[i,jv]-d;mass3d[i,jv+1]:=mass3d[i,jv+1]+d;end;// Столбец |//\|/for j:=jv to 100 dobeginx1:=Pr(mass3d[iv,j]);x2:=Pr(mass3d[iv,j+1]);k:=Kr(mass3d[iv,j]);d:=DWD(k,x2,x1,1);mass3d[iv,j]:=mass3d[iv,j]-d;mass3d[iv,j+1]:=mass3d[iv,j+1]+d;end;end;end;end.Листинг программы по автоматизации оценки остатков дернины ижнивьяunit Refuse;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, OleCtrls, ExtCtrls, FannNetwork, sSkinManager, sButton,RxRichEd, sPanel,317sLabel, sSkinProvider, Jpeg, IniFiles,IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdPOP3,IdBaseComponent, IdMessage, Sockets, Buttons, sSpeedButton, sColorSelect,ComCtrls, sTrackBar, sUpDown, sEdit, sMemo, ExtDlgs;constLineBreak = #13#10;typeTHackStringList = class(TStringList);TForm1 = class(TForm)sSkinManager1: TsSkinManager;sButton3: TsButton;sButton1: TsButton;ColorDialog1: TColorDialog;sPanel1: TsPanel;sButton2: TsButton;Image1: TImage;sUpDown1: TsUpDown;OpenDialog1: TOpenPictureDialog;sEdit1: TsEdit;sButton4: TsButton;Edit1: TEdit;sLabel1: TsLabel;Image2: TImage;procedure FormActivate(Sender: TObject);procedure sButton3Click(Sender: TObject);procedure sButton1Click(Sender: TObject);procedure sButton2Click(Sender: TObject);procedure sEdit1KeyPress(Sender: TObject; var Key: Char);procedure sButton4Click(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;implementation{$R *.dfm}318PROCEDURE DisplayBitmap(CONST Bitmap: TBitmap;CONST Image : TImage);VARHalf : INTEGER;Height : INTEGER;NewBitmap : TBitmap;TargetArea: TRect;Width : INTEGER;BEGINNewBitmap := TBitmap.Create;TRYNewBitmap.Width := Image.Width;NewBitmap.Height := Image.Height;NewBitmap.PixelFormat := pf24bit;// NewBitmap.Canvas.Brush := ShapeFill.Brush;NewBitmap.Canvas.FillRect(NewBitmap.Canvas.ClipRect);// "equality" (=) case can go either way in this comparisonIF Bitmap.Width / Bitmap.Height < Image.Width / Image.HeightTHEN BEGIN// Stretch Height to match.TargetArea.Top := 0;TargetArea.Bottom := NewBitmap.Height;// Adjust and center Width.Width := MulDiv(NewBitmap.Height, Bitmap.Width, Bitmap.Height);Half := (NewBitmap.Width - Width) DIV 2;TargetArea.Left := Half;TargetArea.Right := TargetArea.Left + Width;ENDELSE BEGIN// Stretch Width to match.TargetArea.Left := 0;TargetArea.Right := NewBitmap.Width;// Adjust and center Height.Height := MulDiv(NewBitmap.Width, Bitmap.Height, Bitmap.Width);Half := (NewBitmap.Height - Height) DIV 2;TargetArea.Top := Half;TargetArea.Bottom := TargetArea.Top + Height319END;NewBitmap.Canvas.StretchDraw(TargetArea, Bitmap);Image.Picture.Graphic := NewBitmapFINALLYNewBitmap.FreeENDEND {DisplayBitmap};procedure TForm1.FormActivate(Sender: TObject);beginImage1.Canvas.Brush.Color := clGreen;Image1.Canvas.Pen.Color := clGreen;Image1.Canvas.Rectangle(Image1.ClientRect);Image1.Repaint;end;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////procedure TForm1.sButton3Click(Sender: TObject);beginhalt;end;Function OSRPlacatLeft(filep:string):string;////////////////////////////////////////////////////////function Regnos(Bmp:TBitmap;miz:word):string;typeTRGB=recordB,G,R:Byte;end;pRGB=^TRGB;varx,y:Word;Dest,Dest2:pRGB;kols:integer;TmpBmp2:TBitmap;Color: TColor;r, g, b: byte;beginkols:=0;Bmp.PixelFormat:=pf24Bit;TmpBmp2:=TBitmap.Create;// TmpBmp2.PixelFormat:=pf24Bit;320TmpBmp2.Assign(form1.image1.picture.bitmap);Dest2:=TmpBmp2.ScanLine[1];for y:=0 to Bmp.Height-1 dobeginDest:=Bmp.ScanLine[y];for x:=0 to Bmp.Width-1 dobeginColor:= Bmp.Canvas.Pixels[x,y];b:= GetRValue(Color);g:= GetGValue(Color);r:= GetBValue(Color);if (g>=abs(Dest2.g-miz)) and (g<=(Dest2.g+miz)) and (r<=g) and (b<=g) theninc(kols);Inc(Dest);end;end;if Bmp.Width*Bmp.Height<>0 thenRegnos:=FloatToStr(kols/(Bmp.Width*Bmp.Height))elseRegnos:='';TmpBmp2.Free;end;////////////////////////////////////////////////////////var MyJpeg: TJpegImage;TmpBmp:TBitmap;stroka:string;begin// Проверка на нормальный формат jpgtryMyJpeg:=TJpegImage.Create;MyJpeg.LoadFromFile(filep);// MyJpeg.Grayscale:=true;TmpBmp:=TBitmap.Create;// TmpBmp.PixelFormat:=pf24Bit;MyJpeg.DIBNeeded; {Key method...}TmpBmp.Assign(MyJpeg);321DisplayBitmap(TmpBmp,form1.Image2);form1.Edit1.Clear;application.ProcessMessages;stroka:=Regnos(TmpBmp,StrToInt(form1.sEdit1.text)); //Распознаваниезаданного числа цифрexceptstroka:='Ошибка обработки!';end;form1.Edit1.text:=stroka;TmpBmp.Free;end;////////////////////////////////////////////////////////procedure TForm1.sButton1Click(Sender: TObject);beginsButton1.Enabled:=false;if OpenDialog1.Execute thenbeginOSRPlacatLeft(OpenDialog1.FileName);form1.sButton4.enabled:=true;end;sButton1.Enabled:=true;end;procedure TForm1.sButton2Click(Sender: TObject);beginif ColorDialog1.executethenbeginImage1.Canvas.Brush.Color := ColorDialog1.Color;Image1.Canvas.Pen.Color := ColorDialog1.Color;Image1.Canvas.Rectangle(Image1.ClientRect);Image1.Repaint;end;end;procedure TForm1.sEdit1KeyPress(Sender: TObject; var Key: Char);beginif not(Key in ['0'..'9']) and (ord(key)<>8) then Key:=#0;end;322procedure TForm1.sButton4Click(Sender: TObject);beginsButton4.Enabled:=false;OSRPlacatLeft(OpenDialog1.FileName);sButton4.Enabled:=true;end;end.323Листинг программы по автоматизации оценки крошения почвыunit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, sSkinManager, ExtDlgs, StdCtrls, sEdit, sLabel, sGroupBox,TeEngine, Series, TeeProcs, Chart, ExtCtrls, sPanel, sButton,sSkinProvider,Jpeg, Buttons, sSpeedButton, Clipbrd;typeTForm1 = class(TForm)Image2: TImage;Image3: TImage;sButton3: TsButton;sButton1: TsButton;sPanel1: TsPanel;sButton4: TsButton;Chart1: TChart;Series1: TPieSeries;OpenDialog1: TOpenPictureDialog;sSkinManager1: TsSkinManager;sLabel1: TsLabel;sLabel2: TsLabel;sLabel3: TsLabel;sLabel4: TsLabel;sLabel5: TsLabel;sLabel6: TsLabel;sLabel7: TsLabel;sLabel8: TsLabel;sLabel9: TsLabel;sLabel10: TsLabel;sEdit1: TsEdit;sEdit2: TsEdit;sEdit3: TsEdit;sEdit4: TsEdit;sEdit5: TsEdit;sEdit6: TsEdit;sEdit7: TsEdit;sEdit8: TsEdit;sEdit9: TsEdit;sEdit10: TsEdit;sLabelFX1: TsLabelFX;324sSpeedButton1: TsSpeedButton;sSpeedButton2: TsSpeedButton;procedure sButton3Click(Sender: TObject);procedure sButton1Click(Sender: TObject);procedure sButton4Click(Sender: TObject);procedure sSpeedButton1Click(Sender: TObject);procedure sSpeedButton2Click(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;mas: array [1..10] of integer;koef:real;istok: array [1..10] of String = (' - 1 мм',' - 2 мм',' - 3 мм',' - 4 мм',' - 5 мм',' - 6мм',' - 7 мм',' - 8 мм',' - 9 мм',' - 10 мм');implementation{$R *.dfm}procedure Mono(Bmp:TBitmap; intv:word);typeTRGB=recordB,G,R:Byte;end;pRGB=^TRGB;varx,y:Word;Dest:pRGB;MAX_RGB:integer;beginBmp.PixelFormat:=pf24Bit;MAX_RGB:=255;//Определим максимальную интенсивность цветаfor y:=0 to Bmp.Height-1 dobeginDest:=Bmp.ScanLine[y];for x:=0 to Bmp.Width-1 dobeginwith Dest^ doif (r+g+b) div 3< MAX_RGB then MAX_RGB:= (r+g+b) div 3;325Inc(Dest);end;end;for y:=0 to Bmp.Height-1 dobeginDest:=Bmp.ScanLine[y];for x:=0 to Bmp.Width-1 dobeginwith Dest^ dobegin// form1.Memo1.Lines.Add(intTostr((r+g+b) div 3));if (r+g+b) div 3>(MAX_RGB+intv) thenbeginr:=255;g:=255;b:=255;end elsebeginr:=0;g:=0;b:=0;end;end;Inc(Dest);end;end;end;PROCEDURE DisplayBitmap(CONST Bitmap: TBitmap;CONST Image : TImage);VARHalf : INTEGER;Height : INTEGER;NewBitmap : TBitmap;TargetArea: TRect;Width : INTEGER;BEGINNewBitmap := TBitmap.Create;TRYNewBitmap.Width := Image.Width;NewBitmap.Height := Image.Height;NewBitmap.PixelFormat := pf24bit;326// NewBitmap.Canvas.Brush := ShapeFill.Brush;NewBitmap.Canvas.FillRect(NewBitmap.Canvas.ClipRect);// "equality" (=) case can go either way in this comparisonIF Bitmap.Width / Bitmap.Height < Image.Width / Image.HeightTHEN BEGIN// Stretch Height to match.TargetArea.Top := 0;TargetArea.Bottom := NewBitmap.Height;// Adjust and center Width.Width := MulDiv(NewBitmap.Height, Bitmap.Width, Bitmap.Height);Half := (NewBitmap.Width - Width) DIV 2;TargetArea.Left := Half;TargetArea.Right := TargetArea.Left + Width;ENDELSE BEGIN// Stretch Width to match.TargetArea.Left := 0;TargetArea.Right := NewBitmap.Width;// Adjust and center Height.Height := MulDiv(NewBitmap.Width, Bitmap.Height, Bitmap.Width);Half := (NewBitmap.Height - Height) DIV 2;TargetArea.Top := Half;TargetArea.Bottom := TargetArea.Top + HeightEND;NewBitmap.Canvas.StretchDraw(TargetArea, Bitmap);Image.Picture.Graphic := NewBitmapFINALLYNewBitmap.FreeENDEND {DisplayBitmap};function ReschoR(TmpBmp:TBitmap):integer;var x,y,z:Integer;beginy:=2; x:=1; z:=0;while (TmpBmp.Canvas.Pixels[x,y]<>clWhite) do327begininc(y);inc(x);end;while (x<(TmpBmp.Width div 4)) and (TmpBmp.Canvas.Pixels[x,y]=clWhite)dobegininc(x);inc(z);end;ReschoR:=z;end;///////////////////////////////////////////////////////procedure Regnos(Bmp:TBitmap);varx,y:integer;kols,qw:integer;z:real;beginfor y:=2 to Bmp.Height-2 dobeginx:=1;while x<Bmp.Width-2 dobeginwhile (x<Bmp.Width-3) and (Bmp.Canvas.Pixels[x,y]=clWhite) doinc(x); //Выход на начало агрегата слеваkols:=0; // Ширина агрегатаwhile (x<Bmp.Width-3) and (Bmp.Canvas.Pixels[x,y]<>clWhite) doinc(x); //Выход на середину агрегата справаwhile (x<Bmp.Width-3) and (Bmp.Canvas.Pixels[x,y]=clWhite) dobegininc(x);inc(kols);end;z:=kols*4/3.1415926*koef; //Размер агрегата;qw:=Round(z); if qw>10 then qw:=10;if qw>0 thenmas[qw]:=mas[qw]+1;// Анализ и классификация агрегата328inc(x);end; //whileend; //forend;////////////////////////////////////////////////////////Function OSRPlacatLeft(filep:string):string;var MyJpeg: TJpegImage;TmpBmp:TBitmap;stroka:string;beginfillchar(mas,sizeof(mas),0); // Обнулим счетчики// Проверка на нормальный формат jpgtryMyJpeg:=TJpegImage.Create;MyJpeg.LoadFromFile(filep);// MyJpeg.Grayscale:=true;TmpBmp:=TBitmap.Create;// TmpBmp.PixelFormat:=pf24Bit;MyJpeg.DIBNeeded; {Key method...}TmpBmp.Assign(MyJpeg);DisplayBitmap(TmpBmp,form1.Image3);Mono(TmpBmp,110);DisplayBitmap(TmpBmp,form1.Image2);koef:=100/ReschoR(TmpBmp); //Коеф.пересчетаapplication.ProcessMessages;Regnos(TmpBmp); //Распознаваниеexceptstroka:='Ошибка обработки!';end;TmpBmp.Free;end;329////////////////////////////////////////////////////////procedure TForm1.sButton3Click(Sender: TObject);beginhalt;end;procedure TForm1.sButton1Click(Sender: TObject);var MyJpeg: TJpegImage;TmpBmp:TBitmap;stroka:string;beginsButton1.Enabled:=false;if OpenDialog1.Execute thenbegintryMyJpeg:=TJpegImage.Create;MyJpeg.LoadFromFile(OpenDialog1.FileName);TmpBmp:=TBitmap.Create;MyJpeg.DIBNeeded; {Key method...}TmpBmp.Assign(MyJpeg);DisplayBitmap(TmpBmp,form1.Image3);TmpBmp.Free;exceptstroka:='Ошибка обрабртки!';end;sButton4Click(self);sSpeedButton1.visible:=true;sSpeedButton2.visible:=true;form1.sButton4.enabled:=true;end;sButton1.Enabled:=trueend;procedure TForm1.sButton4Click(Sender: TObject);var i:integer;d:real;begin//sButton4.Enabled:=false;330OSRPlacatLeft(OpenDialog1.FileName);d:=0;for i:=1 to 10 dod:=d+mas[i];if d>0 thenbeginsEdit1.Text:=floattostr(mas[1]/d);sEdit2.Text:=floattostr(mas[2]/d);sEdit3.Text:=floattostr(mas[3]/d);sEdit4.Text:=floattostr(mas[4]/d);sEdit5.Text:=floattostr(mas[5]/d);sEdit6.Text:=floattostr(mas[6]/d);sEdit7.Text:=floattostr(mas[7]/d);sEdit8.Text:=floattostr(mas[8]/d);sEdit9.Text:=floattostr(mas[9]/d);sEdit10.Text:=floattostr(mas[10]/d);application.processmessages;// Диаграммаform1.series1.Clear;for i:=1 to 10 doform1.series1.addxy(i,mas[i]*100/d,istok[i]);endelseMessageDlg ('Ошибка обработки файла!!!', mtError, [mbOK],0);sButton4.Enabled:=true;end;procedure TForm1.sSpeedButton1Click(Sender: TObject);beginClipboard.Assign(Image3.Picture);end;331procedure TForm1.sSpeedButton2Click(Sender: TObject);beginClipboard.Assign(Image2.Picture);end;end.332Приложение В.