⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 生成等高线
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, CONTOUROCXLib_TLB, ExtCtrls;

type
  TForm1 = class(TForm)
    picture1: TImage;
    ContourOCX1: TContourOCX;
    GroupBox1: TGroupBox;
    RowEdit: TEdit;
    ColEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    CustomedLineValue: TRadioGroup;
    Button2: TButton;
    GroupBox2: TGroupBox;
    XSlopeEdit: TEdit;
    XInterceptEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    YSlopeEdit: TEdit;
    YInterceptEdit: TEdit;
    Polygon: TGroupBox;
    ListBox1: TListBox;
    FlashFillColorEdit: TEdit;
    Label8: TLabel;
    lab3: TLabel;
    FlashBorderColorEdit: TEdit;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Picture2: TPanel;
    InterposeCheck: TCheckBox;
    RestrictCheck: TCheckBox;
    Label3: TLabel;
    StepEdit: TEdit;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    GroupBox4: TGroupBox;
    CountEdit: TEdit;
    SmoothEdit: TEdit;
    MethodRadio: TRadioGroup;
    DrawValueCheck: TCheckBox;
    Label9: TLabel;
    Label10: TLabel;
    Button6: TButton;
    Button7: TButton;
    SaveDialog1: TSaveDialog;
    SourceRadio: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure InterposeCheckClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
  procedure DrawContour();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.DrawContour();
var
   linecount, PointCount: integer;
   i,j:integer;
     PreX, PreY , CurX , CurY, z: Double;

begin
//'''''''''''''''''''''''''''''

ContourOCX1.GetLineCount(linecount);
For i:= 0 To linecount - 1 do
begin
 ContourOCX1.GetCtrlPointCount( i, PointCount);
 For j:= 0 To PointCount - 1 do
 begin
 ContourOCX1.GetCtrlPoint( i, j, CurX, CurY, z);
 If j > 0 Then Picture1.Canvas.LineTo(round(CurX), round(CurY))
 else
  Picture1.Canvas.MoveTo(round(CurX),round(CurY));
end;//for j
end;//for i
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  i,j, row , col : integer;
  Linestep:single;//'等值线间隔
  INVALIDDATA:integer;//  '默认无效值
  X , Y , value:Double ;//  '实际坐标
    Interpose,Restrict:integer;//

begin
Picture1.Canvas.Rectangle(Picture1.ClientRect);//.Refresh();//.Repaint();
ContourOCX1.FreeData();

INVALIDDATA:= 99999;

row:= StrToInt(RowEdit.Text);
col:= StrToInt(ColEdit.Text);
Linestep:= StrToFloat(StepEdit.Text);
//'initialize
if(Interposecheck.Checked) then Interpose:=1 else Interpose:=0;
if(Restrictcheck.Checked) then Restrict:=1 else Restrict:=0;
ContourOCX1.Initial(row, col, Linestep,Interpose,Restrict );//'行数,列数,等值线间隔


//'input data points
For i:= 0 To row - 1 do
For j:= 0 To col - 1 do
begin
 X:= j * 50;// '由列号得出横坐标
 Y:= i * 50;// '由行号得出纵坐标
 value:= random(10)+random(10)/10.0;
 ContourOCX1.AddPoint(i, j, X, Y, value);// '行号,列号,坐标(X,Y),值(高程)
end;



//' if there are some invalid data
ContourOCX1.AddPoint( 3, 2, 100, 150, INVALIDDATA);/// '假如(3,2)处为无效点
ContourOCX1.AddPoint( 3, 3, 150, 150, INVALIDDATA);// '假如(3,3)处为无效点

//Is it customed  line step value?
if(CustomedLineValue.ItemIndex=1)    then
begin
 ContourOCX1.AddCustomedStep(3);
 ContourOCX1.AddCustomedStep(4.5);
 ContourOCX1.AddCustomedStep(6);
end;


//'there are 3 methods to create contour

Case RadioGroup1.ItemIndex of

 0: ContourOCX1.Calculate(1, INVALIDDATA);
 1: ContourOCX1.calculate2( 1,INVALIDDATA, 1);//  '是否要对无效值进行重新插补, 无效值
 2: ContourOCX1.Calculate3( 1, INVALIDDATA, 10 );// '是否要对无效值进行重新插补, 无效值
End;


DrawContour();
// '如果要释放空间
// ContourOCX1.FreeData ();
end;

procedure TForm1.Button2Click(Sender: TObject);
var lineCount,pointCount:integer;
   x,y,value:double;
   i:integer;

begin
ContourOCX1.GetLineCount(lineCount);

 For i:= 0 To lineCount - 1      do
 begin

  ContourOCX1.GetCtrlPoint( i, 0, x, y, value);
  Picture1.Canvas.TextOut(round(x),round(y),Format('%.1f',[value]));

 end;
end;

function ValidateData(const value:single):integer;
begin
  if(value<0)then result:=0
  else
  if(value>254) then result:=254;
  result:=round(value);
end;
procedure TForm1.Button4Click(Sender: TObject);
var i,suc,color:integer;
    polygonCount,pointCount:integer;
    minValue,maxValue , minArea, maxArea:single;
    dc:HDC;
begin
ListBox1.Clear();
ContourOCX1.ConvertToPolygon(suc);
if(suc=0)then //fail
begin
 showMessage('can not create contour surface!');
 exit;
end
else
begin
 ContourOCX1.ResetPolyPostion(StrToFloat(XSlopeEdit.Text),StrToFloat(XInterceptEdit.Text),
                            StrToFloat(YSlopeEdit.Text),StrToFloat(YInterceptEdit.Text));



 ContourOCX1.GetPolygonCount(polygonCount);
 for i:= 0 To polygonCount - 1   do
 begin
  ContourOCX1.GetPolygonPointCountValueArea(i, PointCount, minValue, maxValue, maxArea, minArea);
  color:= ValidateData(minValue * 20) ;
  ContourOCX1.ResetOnePolygonColor(i, color, 255 - color);
  ListBox1.AddItem(IntToStr( i),nil);
 end;//for
 dc:=GetDC(Picture2.Handle);
 ContourOCX1.DrawAllPolygons(dc );
 ReleaseDC(Picture2.Handle,dc);

end; //if
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 ContourOCX1.ResetPolyPostion(StrToFloat(XSlopeEdit.Text),StrToFloat(XInterceptEdit.Text),
                            StrToFloat(YSlopeEdit.Text),StrToFloat(YInterceptEdit.Text));

end;

procedure TForm1.ListBox1Click(Sender: TObject);
var dc:HDC;
   polygonCount,PointCount:integer;
   minValue, maxValue , largeArea , smallArea: Single;
begin
  //properties
 ContourOCX1.GetPolygonPointCountValueArea( ListBox1.ItemIndex, pointCount, minValue, maxValue, largeArea, smallArea);
 Memo1.Clear();
 Memo1.Lines.Add(Format('value range: %.5f - %.5f',[minValue, maxValue ]));
 Memo1.Lines.Add(Format('Area       : %.5f',[ smallArea]));
  //flash
 dc:=GetDC(Picture2.Handle);
 ContourOCx1.FlashPolygon(dc,listBox1.ItemIndex,StrToInt(FlashFillColorEdit.Text ),StrToInt(FlashBorderColorEdit.Text));
 ReleaseDC(Picture2.Handle,dc);

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin

  InterposeCheck.Enabled:=RadioGroup1.ItemIndex<2;
  RestrictCheck.Enabled :=InterposeCheck.Enabled;
  InterposeCheckClick(InterposeCheck);

end;

procedure TForm1.InterposeCheckClick(Sender: TObject);
begin

 RestrictCheck.Enabled := (Sender as TCheckBox).Checked and (Sender as TCheckBox).Enabled ;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 InterposeCheckClick(InterposeCheck);
end;

procedure TForm1.Button6Click(Sender: TObject);
var linestep:single;
    smooth:integer;
    i:integer;
    x,y,Value:single;
    DataPath:Widestring;
    PointCountFromFile:integer;

begin

Picture1.Canvas.Rectangle(Picture1.ClientRect);//.Refresh();//.Repaint();
contourOCX1.FreeData();
Linestep:= StrToFloat(StepEdit.Text);
smooth:=StrToInt(SmoothEdit.text);
Case MethodRadio.ItemIndex of
 0: ContourOCX1.InitialRandomIIDW(-1, -1, linestep, Smooth);
 1: ContourOCX1.InitialRandomCFWAI( -1, linestep, Smooth);
 2:ContourOCX1.InitialRandomKrigingOK(-1,30,1,-1,-1);//   Ordinary Kriging
End;
//Uneven line values
If (CustomedLineValue.Itemindex> 0) Then
begin

ContourOCX1.AddCustomedStep(5)  ;//    '生成值为5的等值线
ContourOCX1.AddCustomedStep(4.5);//  '生成值为5的等值线
ContourOCX1.AddCustomedStep( 1 );//  '生成值为1的等值线
End   ;
//Data source
Case SourceRadio.ItemIndex of
0:  //random points
 For i:= 0 To StrToInt(CountEdit.Text)-1 do
 begin
  X:= random(300);// 横坐标
  Y:= random(300);//纵坐标
  value:= random(10)+random(10)/100.0;
  ContourOCX1.AddPointRandom(X, Y, value);
  Picture1.Canvas.Pen.Color:=clRed;
  Picture1.Canvas.Ellipse(round( X-2),round(Y-2),round(X+2),round(Y+2));
  Picture1.Canvas.Pen.Color:=0;
  //draw point value
  If (DrawValueCheck.Checked ) then Picture1.Canvas.TextOut(round(x),round(y),Format('%.1f',[value]));
 end;//for
1:begin//From data file
   DataPath:=ExtractFileDir(Application.ExeName)+'\1.txt';
    PointCountFromFile:=ContourOCX1.AddRandomPointsFromFile(DataPath);
end;
 end;//case
ContourOCX1.CalculateRandom();
DrawContour();
end;

procedure TForm1.Button5Click(Sender: TObject);
var dc:HDC;
begin
dc:=GetDC(Picture2.Handle);
ContourOCx1.DrawAllPolygons (dc);
ReleaseDC(Picture2.Handle,dc);
//self.DrawContour();
end;

procedure TForm1.Button7Click(Sender: TObject);
var path,_type:WideString;
    LineCount,PolygonCount:integer;
begin
if SaveDialog1.Execute() then
begin
  ContourOCX1.GetLineCount(LineCount);
  ContourOCX1.GetPolygonCount(PolygonCount);
  if(LIneCount>0) then
  begin
    path:=SaveDialog1.FileName+'_line';
    _type:='line';
    ContourOCX1.InitializeSHPFile(path,_type);
    ContourOCX1.CreateShapeFile();
  end;    //if
  if(PolygonCount>0) then
  begin
     path:=SaveDialog1.FileName+'_Poly';
    _type:='polygon';
    ContourOCX1.InitializeSHPFile(path,_type);
    ContourOCX1.CreateShapeFile();

  end;//if
end;  //if
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -