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

📄 unit1.pas

📁 等值线插值Pascal程序
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Delaunay, StdCtrls,GridImport, Menus, Contour_Grid, ComCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    begin1: TMenuItem;
    grid1: TMenuItem;
    OpenDialog1: TOpenDialog;
    testC1: TMenuItem;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure begin1Click(Sender: TObject);
    procedure grid1Click(Sender: TObject);
    procedure testC1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  TheMesh: TDelaunay;
  TheGrid: TContourGridData;
  Contour1: TContour;
  end;

var
  Form1: TForm1;

implementation

//uses ContourForGrid;



{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
TheMesh:= TDelaunay.Create;
TheMesh.TargetForm:=Form1;
Form1.Caption:='Click on the form!';
TheGrid:= TContourGridData.Create;
end;


procedure TForm1.begin1Click(Sender: TObject);
var
   I,j,h: Integer;
   v: array of single;
 begin
   Randomize;
   TheMesh.zLow:= 0;
   TheMesh.zHigh:= 0;
   setlength(v,1);
   v[0]:= 60;
   for I := 1 to 10000 do
   begin
     if h>100 then
       h:= 10;
     h:= h+20;
     TheMesh.AddPoint(Random(Width),Random(Height),h);
   end;
   TheMesh.Mesh;
   //TheMesh.Draw;
   themesh.ScatterContour(1,v);
   form1.Canvas.Pen.Color:= clred;
   for j:= 0 to length(TheMesh.FLevers)-1 do
   begin
    form1.Canvas.Pen.Color:= RGB(255,100,j*10);
    for i:= 0 to TheMesh.FLevers[j].Points.count-1 do
    begin
      form1.Canvas.MoveTo(round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.x1),
                      round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.y1));
      form1.Canvas.LineTo(round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.x2),
                      round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.y2));
    end;
  end;
   Form1.Caption:='Points: '+IntToStr(TheMesh.PointCount-1)+
               '  Triangles: '+IntToStr(TheMesh.TriangleCount);
 end;

procedure TForm1.grid1Click(Sender: TObject);
var
   I,j: Integer;
   v: array of single;
begin
  TheGrid.LoadARCINFOASCII('kapiti.grd');
  for i:= 0 to TheGrid.NY-1 do
    for j:= 0 to TheGrid.NX-1 do
      if TheGrid.Points[i,j]<> thegrid.BlankValue then
        TheMesh.AddPoint(TheGrid.xLo+j*TheGrid.xStep,TheGrid.yLo+i*TheGrid.yStep,TheGrid.Points[i,j]);
  TheMesh.Mesh;
  TheMesh.Draw;

  setlength(v,5);
  v[0]:= 50;
  v[1]:= 60;
  v[2]:= 70;
  v[3]:= 80;
  v[4]:= 90;
  themesh.ScatterContour(5,v);
   form1.Canvas.Pen.Color:= clred;
   for j:= 0 to length(TheMesh.FLevers)-1 do
   begin
    for i:= 0 to TheMesh.FLevers[j].Points.count-1 do
    begin
      form1.Canvas.MoveTo(round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.x1),
                      round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.y1));
      form1.Canvas.LineTo(round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.x2),
                      round(PPointPair(TheMesh.FLevers[j].Points.Items[i])^.y2));
    sleep(30);
    end;

  end;
end;

procedure TForm1.testC1Click(Sender: TObject);
var
i,j: integer;
 v: tvector;
begin
  Contour1:= TContour.Create;
  Contour1.LoadARCINFOASCII('kapiti.grd');
  setlength(v,5);
   v[0]:= 50;
  v[1]:= 60;
  v[2]:= 70;
  v[3]:= 80;
  v[4]:= 90;
  Contour1.GridContour(0,49,0,38,5,v);
  self.ProgressBar1.Min:=0;
  for j:= 0 to length(Contour1.FLevers)-1 do
  begin
    self.ProgressBar1.Max:=Contour1.FLevers[j].Points.count-1;
    for i:= 0 to Contour1.FLevers[j].Points.count-1 do
    begin
      form1.Canvas.MoveTo(round(PPointPair(Contour1.FLevers[j].Points.Items[i])^.x1),
                      round(PPointPair(Contour1.FLevers[j].Points.Items[i])^.y1));
      form1.Canvas.LineTo(round(PPointPair(Contour1.FLevers[j].Points.Items[i])^.x2),
                      round(PPointPair(Contour1.FLevers[j].Points.Items[i])^.y2));
    Application.ProcessMessages;
    self.ProgressBar1.Position:=i;
    end;
    
  end;
end;

end.

⌨️ 快捷键说明

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