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. Width=imgview321. 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.