📄 unit1.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 + -