2020-01-14
120
| Номер полигона | Landsat, кв. ед. | Spot, кв. ед. | Расхождение |
| 1 | 17010 | 18511 | 8.9% |
| 2 | 10092 | 10799 | 7% |
| 3 | 8199 | 8854 | 8.1% |
| 4 | 18462 | 19735 | 6.9% |
| 5 | 14785 | 15864 | 7.3% |
| 6 | 20153 | 21886 | 8.6% |
| 7 | 5143 | 5636 | 9.6% |
| 8 | 7549 | 8266 | 9.5% |
| 9 | 11889 | 12733 | 7.1% |
| 10 | 15300 | 16340 | 6.8% |
Среднее расхождение составило 7,9%. Это связано с большим пространственным разрешением у системы Spot. Так же можно отметить, что при сравнении малых областей, процент расхождения более высок, чем при сравнении больших областей. В дальнейшем, при работе со снимками Spot можно делать поправку на найденное процентное расхождение для сравнения этих съемочных систем.
Выводы
В проделанной работе получены следующие результаты:
1) Определены информативные спектральные каналы для формирования изображения с нужной цветопередачей: 5,4 и 3 для съемочной системы Landsat ETM+.
2) Установлены цветовые формулы для обработки.
3) Разработан программный пакет Contour для обработки и визуализации объектов на космических изображениях со следующими возможностями:
· Загрузка графических изображений;
|
|
|
· Создание растровых слоев;
· Выделение границы объектов;
· Расчет площадей и периметров;
· Создание бинарных слоев с границами объектов;
· Географическая привязка;
· Векторизация;
· Экспортирование shape-файлов.
4) Проведено сравнение с профессиональным пакетом "Erdas Imagine 9". Установлено, что на простых объектов (вырубок) результаты идентичны. Время обработки существенно ниже при той же точности. При сравнении более сложных областей (гарей) процент расхождения достигает 15%, что связано в различии пороговых значений, используемых в программах. Вероятность достоверного результата выше по причине меньшего количества спектральных каналов.
5) Проведен сравнительных анализ двух съемочных систем на примере Landsat ETM+ и Spot5 с различными пространственными разрешениями. Среднее расхождение в 7.9% в дальнейшем можно учитывать как поправку при работе со снимками этих двух систем.
Список литературы
1. Кашкин В.Б., Сухинин А.И. Дистанционное зондирование Земли из космоса. Цифровая обработка изображений [текст]: учебник / В.Б. Кашкин, А.И. Сухинин. - М.: Логос, 2001. - 264 с.
2. Савельев, И.В. Курс общей физики / И.В. Савельев. - М.: Наука, 1968.
3. Ахманов, С.А. Введение в статистическую радиофизику и оптику / С.А. Ахманов, Ю.Е. Дьяков, А.С. Чиркин. - М.: Наука, 1981.
4. Тихомирова, В.А. Физика и биология / В.А. Тихомирова, А.И. Черноуцан. - М.: Бюро Квантум, 2001. - 128 с.
5. Чандра А.М., Гош С.К. Дистанционное зондирование и географические информационные системы [текст]: учебник / А.М. Чандра, С.К. Гош. - М.: Техносфера, 2008. - 312 с.
6. Берлянт, А.М. Картоведение / А.М. Берлянт. - М.: Аспект пресс, 2003. - 477 с.
|
|
|
7. Басараб М.А., Волосюк В.К., Горячкин О.В. Цифровая обработка сигналов и изображений в радиофизических приложениях [текст]: учебник / М.А. Басараб, В.К. Волосюк, О.В. Горячкин; Под ред. В.Ф. Кравченко. - М.: ФИЗМАТЛИТ, 2007. - 544 с.
8. Crosier S., Booth B. ArcGIS 9: Map projections [текст]: учебное пособие / S. Crosier, B. Booth. - New York: Environmental System Research Institute, 2004. - 116 p.
9. Crosier S., Booth B. ArcGIS 9: Getting started [текст]: учебное пособие / S. Crosier, B. Booth. - New York: Environmental System Research Institute, 2004. - 272 p.
10. Murai S. GIS Work Book: Fundamental Practical Course [текст]: учебное пособие / S. Murai. - Japan: Japan Association of Surveyors, 1999. - 74 p.
11. Grady, L., and Funka-Lea, G. 2004. Multi-label image segmentation for medical applications based on graph-theoretic electrical potentials. In ECCV Workshops CVAMIA and MMBIA, 230-245.
12. Richard Barbieri, Harry Montgomery и др. Algorithm Technical Background Document // MODIS ATBD: THEORETICAL BASIS 1, 1997. - P.27 - 29
13. Michael Matson, Jeff Dozier. Identification of Subresolution High Temperature Sources Using a Thermal IR Sensor // Photogrammetic Engineering and Remote Sensing №9, 1991 стр.1311-1318
14. Грузман И.С. и др. Цифровая обработка изображений в информационных системах. - Новосибирск: НГТУ, 2002. - 352 с.
15. Верещака Т.В., Зверев А.Т. Визуальные методы дешифрирования. - М.: Недра, 1990. - 341 с.
16. Трофимова, Н.В. Методика создания ГИС проекта / Н.В. Трофимова, 2006. - 50 с.
17. Рис, У. Физические основы дистанционного зондирования. Учебное пособие / У. Рис - М.: Техносфера, 2008. - 312с.
18. Грузман, И.С. Цифровая обработка изображений в информационных системах / И.С. Грузман. - Новосибирск: НГТУ, 2002. - 352 с.
19. Верещака, Т.В. Визуальные методы дешифрирования / Т.В. Верещака, А.Т. Зверев. - М.: Недра, 1990. - 341 с.
20. Гарбук, С.В. Космические системы дистанционного зондирования Земли / С.В. Гарбук, В.Е. Гершензон. - М.: Сканэкс, 1997. - 296 с
21. Прэтт, У. Цифровая обработка изображений / У. Прэтт. - М.: Мир, 1982.
22. Loboda, T. Regionally adaptable dNBR-based algorithm for burned area mapping from MODIS data / T. Loboda, K. J. O”Neal, I. Csiszar. - M: Science Direct, 2007.
23. Мураховский В.И. Компьютерная графика [текст]: учебник / В.И. Мураховский; Под. Ред. С.В. Симоновича. - М.: Аст-Пресс СКД, 2002. - 640 с.
Приложение
Компьютерный код программы "Contour" в среде "Delphi".
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, GR32_Layers, GR32_Polygons, StdCtrls, GR32_Image, GR32, ExtCtrls, Menus, ExtDlgs, Gauges,JPEG, Grids, ActnPopup, ComCtrls, Tabs, DockTabSet;
type
TFormMain = class (TForm)
ImgView321: TImgView32; ScaleBar: TScrollBar; OptionsImPanel: TPanel; ScaleLabel: TLabel; ScaleCombo: TComboBox; MainMenu: TMainMenu; FileN: TMenuItem; OpenN: TMenuItem; ExitN: TMenuItem; OpenPictureDialog1: TOpenPictureDialog; CloseN: TMenuItem; ScalePanel: TPanel; SystemPanel: TPanel; XYPanel: TPanel; RGBPanel: TPanel; Grid: TStringGrid; NewPolButton: TButton; EditN: TMenuItem; DelAllN: TMenuItem; DelLastN: TMenuItem; N7: TMenuItem; ProzrCont: TScrollBar; DelPolButton: TButton; Label1: TLabel; SavePictureDialog1: SavePictureDialog; SaveContN: TMenuItem; N2: TMenuItem; OpenContN: TMenuItem FillPanel: TPanel; AddDelPanel: TPanel; Label2: TLabel; TochekPanel: TPanel; RadioVidCon: TRadioGroup; ChangePanel: TPanel; N1: TMenuItem; AutoOptPanel: TPanel; Label8: TLabel; Label5: TLabel; EditR: TEdit; EditG: TEdit; EditB: TEdit; Label9: TLabel; Panel1: TPanel; Panel2: TPanel; ColorDialog1: TColorDialog; Button1: TButton; Label10: TLabel; Shape1: TShape; WxWyPanel: TPanel; Panel4: TPanel; Label6: TLabel; UpLeftX: TEdit; Panel5: TPanel; Label7: TLabel; UpLeftY: TEdit; Panel6: TPanel; Label3: TLabel; RazrEdit: TEdit; SaveTextFileDialog1: TSaveTextFileDialog; Memo1: TMemo; Button2: TButton;
procedure Button1Click (Sender: TObject);
procedure DelAllNClick (Sender: TObject); procedure OpenContNClick (Sender: TObject); procedure SaveContNClick (Sender: TObject); procedure DelLastNClick (Sender: TObject); procedure DelPolButtonClick (Sender: TObject); procedure GridMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure rozrContChange (Sender: TObject); procedure CloseNClick (Sender: TObject); procedure GridSelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure GridKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure NewPolButtonClick (Sender: TObject); procedure ImgView321MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); procedure FormCreate (Sender: TObject); procedure OpenNClick (Sender: TObject); procedure ScaleComboChange (Sender: TObject); procedure ScaleBarChange (Sender: TObject); procedure ImgView321MouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); procedure DelContour (nomer: integer); private Polygon: array [1.1000] of TPolygon32; Outline: TPolygon32; procedure Build; procedure Draw (sloi: integer; proz: integer); procedure Left; procedure Right; procedure Up; procedure Down; function ColorSrav (colFun: TColor32): boolean; function StopUp: boolean; function StopLeft: boolean; function StopDown: boolean; function StopRight: boolean; procedure OtrisovkaAuto;
var
FormMain: TFormMain; CurDir: string; p: TPoint; conty: array [1.1000] of TBitmapLayer; id: word; points: word; colg,rowg: integer; mm: boolean;
|
|
|
scrollfill: boolean; xt,yt: array [0.1000] of integer; dlina: array [1.1000] of real;
square: array [1.1000] of real; prozra: array [1.1000] of integer; // dot: array [1.10000,1.10000] of integer; dot: array of array of array of integer; x_g,y_g: integer; col,colP: TColor32; StopperSlayer: boolean;
procedure Area; var i: Integer; begin xt [0]: = xt [points]; yt [0]: = yt [points]; square [id]: = 0; i: = 0; repeat square [id]: = square [id] + (xt [i] +xt [i+1]) * (yt [i] - yt [i+1]); i: = i+1; until not (i<=points-1); square [id]: = 0.5*Abs (square [id]); end; procedure perimetr; vari: integer; begindlina [id]: =0; for i: = 1 to points-1 do dlina [id]: =dlina [id] + sqrt ((xt [i] - xt [i+1]) * (xt [i] - xt [i+1]) + (yt [i] - yt [i+1]) * (yt [i] - yt [i+1])); dlina [id]: =dlina [id] +sqrt ((xt [1] - xt [points]) * (xt [1] - xt [points]) + (yt [1] - yt [points]) * (yt [1] - yt [points])); end;
procedure Delay (ms: longint); var TheTime: LongInt; begin TheTime: = GetTickCount + ms; while GetTickCount < TheTime do Application. ProcessMessages; end;
procedure TFormMain. Build; var TmpPoly: TPolygon32; begin Outline. Free; Outline: = nil; TmpPoly: = Polygon [id]. Outline; Outline: = TmpPoly. Grow (Fixed (0), 0); Outline. FillMode: = pfWinding; TmpPoly. Free;
end; procedure TFormMain. DelAllNClick (Sender: TObject); vari: integer; begin for i: = 1 to id do begin Grid. Rows [i]. Clear (); Polygon [id]. Clear; Conty [i]. Free; end; id: =0; DelPolButton. Enabled: =False; end;
procedure TFormMain. DelLastNClick (Sender: TObject); begin if (id<>0) then DelContour (id); end; procedure TFormMain. DelPolButtonClick (Sender: TObject);
begin DelContour (rowg); end;
procedure TFormMain. Draw (sloi: integer; proz: integer); begin Conty [sloi]. Bitmap. BeginUpdate; Conty [sloi]. Bitmap. Clear ($00); Conty [sloi]. Bitmap. Draw (0, 0, Conty [sloi]. Bitmap); Polygon [sloi]. DrawFill (Conty [sloi]. Bitmap, SetAlpha (clBlue32, proz)); Polygon [sloi]. DrawEdge (Conty [sloi]. Bitmap, SetAlpha (clBlack32, 255)); Conty [sloi]. Bitmap. EndUpdate; Conty [sloi]. Bitmap. Changed; ImgView321. Refresh; end; procedure TFormMain. SaveContNClick (Sender: TObject); var: integer; bm: TBitmap32; fFileHandle: TextFile; begin bm: = TBitmap32. Create (); bm. SetSize (ImgView321. Bitmap. Width, ImgView321. Bitmap. Height); bm. FillRect (0,0,bm. Width,bm. Height,$0f000000); for i: = 1 to id do conty [i]. bitmap. DrawTo (bm); if SavePictureDialog1. Execute then bm. SaveToFile (SavePictureDialog1. FileName); memo1. lines. Add (razredit. text); memo1. lines. Add ('0.0'); memo1. lines. Add ('0.0'); memo1. lines. Add ('-razredit. text); memo1. lines. Add (UpLeftX. text); memo1. lines. Add (UpLeftY. text); memo1. Lines. SaveToFile ('c: \test. jgw'); memo1. Clear; end; procedure TFormMain. NewPolButtonClick (Sender: TObject); varswap: integer; beginscrollfill: =true; if ((points>=3) or (id=0)) and (radiovidcon. ItemIndex=0) then Begin inc (id); conty [id]: =TBitmapLayer. Create (ImgView321. Layers); conty [id]. Bitmap. SetSizeFrom (ImgView321. Bitmap); conty [id]. Bitmap. DrawMode: = dmBlend; conty [id]. Location: = FloatRect (0, 0, conty [id]. Bitmap. Width, conty [id]. Bitmap. Height); conty [id]. Scaled: =True; {conty [id]. Bitmap. MoveTo (0,0); conty [id]. Bitmap. pencolor: =Color32 (clBlack);
conty [id]. bitmap. LineToS (200, 200); }Polygon [id]: = TPolygon32. Create; Polygon [id]. NewLine; points: =0; Grid. Cells [0, id]: = (IntToStr (id)); Grid. Cells [1, id]: ='set ' + IntToStr (3-points) + ' dots'; Grid. Cells [2, id]: ='set ' + IntToStr (3-points) + ' dots'; prozra [id]: =ProzrCont. Position; end; end;
|
|
|
procedure TFormMain. FormCreate (Sender: TObject); beginStopperSlayer: =true;
GetDir (0,CurDir); id: =0; points: =0; mm: =true; DelPolButton. enabled: =false;
rowg: =0; colg: =0; scrollfill: =true; Grid. Cols [0]. Add ('Контур'); Grid. Cols [1]. Add ('Периметр'); Grid. Cols [2]. Add ('Площадь'); end; procedure TFormMain. GridKeyDown (Sender: TObject; var Key: Word;
Shift: TShiftState);
var i: integer; begin if (Key = VK_DELETE) then DelContour (rowg);
if (Key = VK_INSERT) and (Grid. Cells [colg,rowg] <>'') then begin draw (Rowg,1); Delay (50); draw (Rowg, 200); Delay (50); draw (Rowg,Prozra [rowg]); Delay (50); end; end;
procedure TFormMain. GridMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); beginmm: =true; end; procedure TFormMain. GridMouseUp (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
beginmm: =false; end; procedure TFormMain. GridSelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin scrollfill: =false; colg: =ACol; rowg: =ARow;
DelPolButton. Enabled: =True;
if Grid. Cells [Colg,Rowg] <>'' then begin while mm=True do begin draw (Rowg,1); Delay (50); draw (Rowg, 200); Delay (50); draw (Rowg,Prozra [rowg]); Delay (50); end; end; end;
procedure TFormMain. Left; var i,j: integer; beginrepeat for j: = 0 to mgview321. Bitmap. Height do begin for i: = 0 to imgview321. Bitmap. Width-1 do begin if (dot [id, i,j] =0) and (dot [id, i+1,j] =1) then begin if ColorSrav (ImgView321. Bitmap. PixelS [i,j]) =True then begin dot [id, i,j]: =1; if i=0 then dot [id, i,j]: =2; end else dot [id, i,j]: =2; end; end; end;
until StopLeft=False; end; procedure TFormMain. Right; var i,j: integer;
beginrepeat for j: = 1 to imgview321. Bitmap. Height do begin for i: = imgview321. Bitmap. Width downto 1 do begin if (dot [id, i,j] =0) and (dot [id, i-1,j] =1) then begin if lorSrav (ImgView321. Bitmap. PixelS [i,j]) =True then begin dot [id, i,j]: =1; if i=imgview321. Bitmap. Width then dot [id, i,j]: =2; end else dot [id, i,j]: =2; end; end; end; until StopRight=False; end; procedure TFormMain. Up; var i,j: integer; beginrepeat for i: = 0 to imgview321. Bitmap. Width do begin for j: = 0 to imgview321. Bitmap. Height do begin if (dot [id, i,j] =0) and (dot [id, i,j+1] =1) then begin if ColorSrav (ImgView321. Bitmap. PixelS [i,j]) =True then begin dot [id, i,j]: =1; if j=0 then dot [id, i,j]: =2; end else dot [id, i,j]: =2; end; end; end; until StopUp=False; end; procedure TFormMain. Down; var i,j: integer; beginrepeat for i: = 1 to imgview321. Bitmap. Width do begin for j: = imgview321. Bitmap. Height downto 1 do begin if (dot [id, i,j] =0) and (dot [id, i,j-1] =1) then begin if ColorSrav (ImgView321. Bitmap. PixelS [i,j]) =True then begin dot [id, i,j]: =1; if j=imgview321. Bitmap. Height then dot [id, i,j]: =2; end else dot [id, i,j]: =2; end; end; end; until StopDown=False; end; function TFormMain. ColorSrav (colFun: TColor32): boolean; beginif (abs (TColor32Entry (ColFun). R-TColor32Entry (Col). R) <=StrtoInt (EditR. Text)) and (abs (TColor32Entry (ColFun). G-TColor32Entry (Col). G) <=StrtoInt (EditG. Text)) and (abs (TColor32Entry (ColFun). B-TColor32Entry (Col). B) <=StrtoInt (EditB. Text)) then Result: = True else Result: = False; end; function TFormMain. StopDown: boolean; vari,j,k: integer; begin for i: = 1 to imgview321. Bitmap. Width do begin for j: = imgview321. Bitmap. Height downto 1 do begin if (dot [id, i,j] =0) and (dot [id, i,j-1] =1) then k: =1; end; end; if k=1 then Result: =True else Result: =False; end; function TFormMain. StopUp: boolean; vari,j,k: integer; begin for i: = 1 to imgview321. Bitmap. Width do begin for j: = 1 to imgview321. Bitmap. Height do begin if (dot [id, i,j] =0) and (dot [id, i,j+1] =1) then k: =1; end; end; if k=1 then Result: =True else Result: =False; end; function TFormMain. StopRight: boolean; vari,j,k: integer; begin for j: = 1 to imgview321. Bitmap. Height do begin for i: = imgview321. Bitmap. Width downto 1 do begin if (dot [id, i,j] =0) and (dot [id, i-1,j] =1) then k: =1; end; end; if k=1 then Result: =True else Result: =False; end; function TFormMain. StopLeft: boolean; vari,j,k: integer; begin for j: = 1 to imgview321. Bitmap. Height do begin for i: = 1 to imgview321. Bitmap. Width-1 do begin if (dot [id, i,j] =0) and (dot [id, i+1,j] =1) then k: =1; end; end; if k=1 then Result: =True else Result: =False; end; procedure TFormMain. OtrisovkaAuto; var i,j: integer; beginfor i: = 0 to conty [id]. Bitmap. Width do begin for j: = 0 to conty [id]. Bitmap. Height do begin if dot [id, i,j] =2 then conty [id]. Bitmap [i,j]: = Color32 (0,255,0); end; conty [id]. Changed; end; end; procedure TFormMain. ImgView321MouseDown (Sender: TObject; Button: MouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); var i,j,t: integer; l: real; beginif RadioVidCon. ItemIndex=1 thenbegin if Button = mbLeft then begin if (p. X>=1) and (p. X<imgview321. Bitmap. Width) and (p. Y>=1) and p. Y<imgview321. Bitmap. Height) then begin x_g: =p. X; y_g: =p. Y; col: = ImgView321. Bitmap. PixelS [x_g,y_g]; setlength (dot, id+1, imgview321. Bitmap. Width+1, imgview321. Bitmap. Height+1);
conty [id]: =TBitmapLayer. Create (ImgView321. Layers); conty [id]. Bitmap. SetSizeFrom (ImgView321. Bitmap); conty [id]. Bitmap. DrawMode: = dmBlend; conty [id]. Location: = FloatRect (0, 0, conty [id]. Bitmap. Width, onty [id]. Bitmap. Height); conty [id]. Scaled: =True; dot [id,x_g,y_g]: =1 repeat Up; Right; Down; Left; until (StopUp=False) and (StopLeft=False) and (StopRight=False) and StopDown=False); t: =0; for i: = 0 to imgview321. Bitmap. Width do begin for j: = 0 to imgview321. Bitmap. Height do begin if dot [id, i,j] =1 then inc (t); end; end; if t>3 then begin Grid. Cells [0, id]: = (IntToStr (id)); Grid. Cells [2, id]: = (IntToStr (t*strtoint (RazrEdit. Text))); l: =2*sqrt (Pi*t); Grid. Cells [1, id]: = (IntToStr (round (l))); end else begin showmessage ('В области менее трех точек. '); conty [id]. Free; dot [id]: =nil; id: =id-1; end; OtrisovkaAuto; end else showmessage ('Попали в (за) край снимка! '); end; if Button = mbRight then // условие на левый клик Begin conty [id]. Free; dot [id]: =nil; Grid. Rows [id]. Clear (); if id>=1 then id: =id-1 else if id=0 then id: =0; end; end; if RadioVidCon. ItemIndex=0 then Begin if (id>0) then Begin if (p. X<ImgView321. Bitmap. Width) and (p. Y < ImgView321. Bitmap. Height) and (p. X>0) and (p. Y>0) and ((xt [points] <>p. X) and (yt [points] <>p. Y)) then Begin if Button = mbLeft then Begin Polygon [id]. Add (FixedPoint (p. X, p. Y)); inc (points); TochekPanel. Caption: ='Вершин: '+ IntToStr (points); xt [points]: =p. X; yt [points]: =p. Y; if points >=3 then begin perimetr; area; Grid. Cells [1, id]: =FloatToStr (dlina [id] *StrToFloat (RazrEdit. Text));
rid. Cells [2, id]: =FloatToStr (square [id] *StrToFloat (RazrEdit. Text) *StrToFloat (RazrEdit. Text)); end else DelContour (id); End; Build; Draw (id,ProzrCont. Position); end; end; end; procedure TFormMain. ImgView321MouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); var col: TColor32; begin p. x: = X; p. y: = Y; p: =ImgView321. ControlToBitmap (p); col: = ImgView321. Bitmap. PixelS [p. X,p. Y]; if (p. X<=ImgView321. Bitmap. Width) and (p. Y <= ImgView321. Bitmap. Height)
and (p. X>=0) and (p. Y>=0) then begin XYPanel. Caption: =' [x,y] ='+' ['+IntToStr (p. X) +','+IntToStr (p. Y) +'] ';
WxWyPanel. Caption: = ' [Wx,Wy] ='+' ['+IntToStr (StrToInt (RazrEdit. Text) *p. X+StrToInt (UpLeftX. text)) +
','+IntToStr (StrToInt (RazrEdit. Text) *p. Y+StrToInt (UpLeftY. text)) +'] ';
RGBPanel. Caption: =' [R,G,B] ='+ ' ['+ IntToStr (TColor32Entry (Col). R) +','+
IntToStr (TColor32Entry (Col). G) +','+IntToStr (TColor32Entry (Col). B) + '] ';
if id >=1 then end else begin XYPanel. Caption: =' [x,y] = [?,?] '; WXWYPanel. Caption: =' [Wx,Wy] = [?,?] '; RGBPanel. Caption: =' [R,G,B] = [?,?,?] '; end; end; procedure TFormMain. OpenContNClick (Sender: TObject); beginwith OpenPictureDialog1 do if Execute then begin conty [100]: =TBitmapLayer. Create (ImgView321. Layers); conty [100]. Bitmap. LoadFromFile (FileName); if (conty [100]. Bitmap. Bitmap. Width) and (conty [100]. Bitmap. Height=imgview321. Bitmap. Height) then begin conty [100]. Bitmap. DrawMode: = dmBlend; conty [100]. Location: = FloatRect (0, 0, conty [100]. Bitmap. Width, onty [100]. Bitmap. Height); conty [100]. Scaled: =True; end else begin conty [100]. free; showmessage ('Размеры изображений контуров и снимка не совпадают. '); end; end; end; procedure TFormMain. OpenNClick (Sender: TObject); beginOpenPictureDialog1. InitialDir: =CurDir; with OpenPictureDialog1 do if Execute then begin ImgView321. Bitmap. LoadFromFile (FileName); end; NewPolButton. Enabled: =True; DelPolButton. Enabled: =True; end; procedure TFormMain. Button1Click (Sender: TObject); vargog: TColor32; beginColorDialog1. Execute; gog: =ColorDialog1. Color; Shape1. Brush. Color: = gog; end; procedure TFormMain. CloseNClick (Sender: TObject); vari: integer; begin for i: = 1 to id do begin Grid. Rows [i]. Clear (); Conty [i]. Free; // нет слоя Polygon [i]. Clear; // нет полигона end; ImgView321. Bitmap. Clear (clSilver); id: =0; points: =0; NewPolButton. Enabled: =False; DelPolButton. Enabled: =False; end; procedure TFormMain. ScaleBarChange (Sender: TObject); varNewScale: real; begin NewScale: = ScaleBar. Position/100; ScaleBar. Repaint; ImgView321. Scale: = NewScale; ScaleCombo. Text: = IntToStr (Round (NewScale*100)) +'%'; end; procedure TFormMain. ScaleComboChange (Sender: TObject); var S: string; I: Integer; begin S: = ScaleCombo. Text; S: = StringReplace (S, '%', '', [rfReplaceAll]); S: = StringReplace (S, ' ', '', [rfReplaceAll]); if S = '' then Exit; I: = StrToIntDef (S, - 1); if (I < 1) or (I > 1000) then I: = Round (ImgView321. Scale * 100) else ImgView321. Scale: = I / 100; ScaleCombo. Text: = IntToStr (I) + '%'; ScaleCombo. SelStart: = Length (ScaleCombo. Text) - 1; ScaleBar. Position: = I; end; procedure TFormMain. ProzrContChange (Sender: TObject); begin if (scrollfill=true) and (id<>0) then begin Draw (id,ProzrCont. Position); prozra [id]: =ProzrCont. Position; end; if scrollfill=false and (Grid. Cells [Colg,Rowg] <>'') then begin Draw (rowg,ProzrCont. Position); prozra [rowg]: =ProzrCont. Position; end; end; procedure TFormMain. DelContour (nomer: integer); var i: integer; begin if (Grid. Cells [0,nomer] <>'') and (nomer<>id) then begin for i: =nomer to id-1 do begin Grid. Rows [i]: =Grid. Rows [i+1]; Polygon [i]: =Polygon [i+1]; prozra [i]: =prozra [i+1]; end; conty [id]. Free; Grid. Rows [id]. Clear (); for i: =nomer to id-1 do begin draw (i,ProzrCont. Position); Grid. Cells [0, i]: =IntToStr (i); end; id: =id-1; end else begin if nomer=id then Polygon [id]. Clear; draw (id,ProzrCont. Position); points: =0; Grid. Cells [1, id]: ='set ' + IntToStr (3-points) + ' dots'; Grid. Cells [2, id]: ='set ' + IntToStr (3-points) + ' dots'; end; end; end.
