Листинг данной программы

unit Unit1;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, Grids, StdCtrls, Buttons, Menus;

type.

TForm1 = class (TForm).

StringGrid1: TStringGrid;

Button_ApGrig: TButton;

Button_Load: TButton;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

Button_Save: TButton;

Button_Clear: TButton;

SpeedButton1: TSpeedButton;

Button_start: TButton;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

StringGrid2: TStringGrid;

Button1: TButton;

procedure StringGrid1Enter (Sender: TObject);

procedure StringGrid1KeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure Button_ApGrigClick (Sender: TObject);

procedure Button_LoadClick (Sender: TObject);

procedure Button_SaveClick (Sender: TObject);

procedure Button_ClearClick (Sender: TObject);

procedure StringGrid1KeyPress (Sender: TObject; var Key: Char);

procedure SpeedButton1Click (Sender: TObject);

procedure Button_frozenClick (Sender: TObject);

procedure Button_startClick (Sender: TObject);

procedure Button1Click (Sender: TObject);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

coordinates=record.

x:real;

y:real;

z:real;

ex:boolean;

end;

original=array [1.10 000] of coordinates;

var.

Form1: TForm1;

m, m1, step, numofint: integer;

editcontrol:boolean;

resultnet:array [1.10 000, 1.3] of double;

scale, scale_z:real;

line: array [1.10 000,1.6] of real;

o:integer;

implementation.

uses Unit2, Unit3, Unit4;

{$R *.dfm}.

procedure TForm1. StringGrid1Enter (Sender: TObject);

var n: Integer;

s: string;

begin.

StringGrid1.Cells[1,0]: ='X';

StringGrid1.Cells[2,0]: ='Y';

StringGrid1.Cells[3,0]: ='Z';

StringGrid1.Cells[0,0]: ='№';

StringGrid1.Cells[0,1]: ='1';

end;

procedure TForm1. StringGrid1KeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

var n: integer; s: string;

begin.

n:= StringGrid1. RowCount;

if Key = VK_RETURN then begin //adds one more row.

if StringGrid1. Cells[3,n-1] '' then.

begin.

//showmessage ('');

n:=n+1 ;

StringGrid1.RowCount:=n;

s:=inttostr (n-1);

StringGrid1.Cells[0,n-1] :=s;

StringGrid1.Row:=n-1;

StringGrid1.Col:=1;

end;

end;

if Key = VK_RETURN then begin.

if StringGrid1. Cells[1,n-1] '' then.

begin.

StringGrid1.Row:=n-1;

StringGrid1.Col:=2;

end;

end;

if Key = VK_RETURN then begin.

if StringGrid1. Cells[2,n-1] '' then.

begin.

StringGrid1.Row:=n-1;

StringGrid1.Col:=3;

end;

end;

end;

procedure TForm1. Button_ApGrigClick (Sender: TObject);

begin.

Stringgrid1.Visible:=true;

Button_Save.Visible:=true;

Button_Clear.Visible:=true;

Form1.ClientHeight:=Button_start.Top+40;

if editcontrol=false then.

begin.

editcontrol:=true; Stringgrid1. Options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goTabs, goAlwaysShowEditor];

Button_ApGrig.Caption:='Готово';

end.

else.

begin.

editcontrol:=false; Stringgrid1. Options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goTabs, goAlwaysShowEditor];

Button_ApGrig.Caption:='Редактировать';

end;

end;

procedure TForm1. Button_LoadClick (Sender: TObject);

type.

coord = record.

x:string;

y:string;

z:string;

end;

var f: textfile; s, str: string; n, i, p:integer; xyz: coord;

begin.

openDialog1.Filter :=.

'Текстовый файл с разделителем|*.txt';

If OpenDialog1. Execute then.

begin.

s:=Opendialog1.FileName;

AssignFile (f, s);

Reset (f);

n:=0;

while not eof (f) do.

begin.

Readln (f, str);

n:=n+1;

StringGrid1.RowCount:=n+1;

trimleft (str);

trimright (str);

p:=pos (' ', str);

xyz.x:=copy (str, 1, p) ;

delete (str, 1, p);

trimleft (str);

p:=pos (' ', str);

xyz.y:=copy (str, 1, p) ;

delete (str, 1, p);

trimleft (str);

xyz.z:=str;

//showmessage (xyz.y);

Stringgrid1.Cells[1,n]: =trimright (xyz.x);

Stringgrid1.Cells[2,n]: =trimright (xyz.y);

Stringgrid1.Cells[3,n]: =xyz.z;

end;

StringGrid1.Visible:=true;

Button_Save.Visible:=true;

Button_Clear.Visible:=true;

StringGrid1.Cells[1,0]: ='X';

StringGrid1.Cells[2,0]: ='Y';

StringGrid1.Cells[3,0]: ='Z';

StringGrid1.Cells[0,0]: ='№';

for i:=1 to n do.

begin.

s:=inttostr (i);

StringGrid1.Cells[0,i]: =s;

end;

closefile (f);

Form1.ClientHeight:=423;

Button_ApGrig.Caption:='Редактировать';

editcontrol:=false; Stringgrid1. Options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goTabs, goAlwaysShowEditor];

end;

end;

procedure TForm1. Button_SaveClick (Sender: TObject);

var s, str: string; f: textfile; n, i: integer;

begin.

saveDialog1.Filter := 'Текстовый файл с разделителем|*.txt' ;

saveDialog1.DefaultExt := 'txt';

if savedialog1. Execute then.

begin.

s:=Savedialog1.FileName;

AssignFile (f, s);

Rewrite (f);

n:=StringGrid1.Rowcount;

for i:=1 to n-1 do.

begin.

str:=StringGrid1.Cells[1,i]+'StringGrid1.Cells[2,i]+' '+StringGrid1.Cells[3,i]+#13;

Writeln (f, str);

end;

CloseFile (f);

Showmessage ('Файл успешно сохранен!').

end;

end;

procedure TForm1. Button_ClearClick (Sender: TObject);

begin.

Form2.Showmodal;

end;

procedure TForm1. StringGrid1KeyPress (Sender: TObject; var Key: Char);

const Digit: set of Char=['1'.'9', '0', #8];

Separator: set of Char=['/', '.', ',', 'б', 'Б', 'ю', 'Ю'];

var i, j: integer;

begin.

f (Key in Separator).

then Key:=DecimalSeparator.

else.

if (not (Key in Digit)).

then Key:=#0;

i:=Stringgrid1.Row;

j:=Stringgrid1.Col;

if ((Key=DecimalSeparator)and (pos (DecimalSeparator, Stringgrid1. Cells[i, j])0)).

then Key:=#0;

end;

procedure TForm1. SpeedButton1Click (Sender: TObject);

begin.

Form3.Showmodal;

end;

procedure TForm1. Button_frozenClick (Sender: TObject);

var row, n, i:integer;

begin.

//if editcontrol=1 then begin.

// row:=stringgrid1.Row;

// n:=stringgrid1.RowCount;

// for i:=row to n do.

// begin.

// end;

//end;

end;

procedure TForm1. Button_startClick (Sender: TObject);

var massive: original;

i, n, j, width_n, height_n, t, l, k, min:integer;

maxx, maxy, minx, miny, width, height, buf, bufz, maxz, sump, sumz: real;

aux, aux1: array [1.10 000, 1.2] of real;

alert:string[50];

begin.

n:=stringgrid1.rowcount-1;

//setlength (massive, n);

//setlength (aux, n);

for i:=1 to n do.

begin.

try.

massive[i]. x:=strtofloat (stringgrid1.Cells[1,i]);

massive[i]. y:=strtofloat (stringgrid1.Cells[2,i]);

massive[i]. z:=strtofloat (stringgrid1.Cells[3,i]);

massive[i]. ex:=true;

except.

alert:='Точка '+inttostr (i)+' содержит ошибку и будет заморожена.';

showmessage (alert);

massive[i]. ex:=false;

stringgrid1.Cells[0,i]: =stringgrid1.Cells[0,i]+'*';

end;

end;

minx:=massive[1]. x;

miny:=massive[1]. y;

maxx:=massive[1]. x;

maxy:=massive[1]. y;

for i:=1 to n-1 do.

begin.

if massive[i]. x < minx then minx:=massive[i]. x;

if massive[i]. y < miny then miny:=massive[i]. y;

if massive[i]. x > maxx then maxx:=massive[i]. x;

if massive[i]. y > maxy then maxy:=massive[i]. y;

end;

step:=strtoint (Form3.Edit_step.Text);

width:=0;

width_n:=1;

height:=0;

height_n:=1;

while width < (maxy-miny) do.

begin.

width:=width+step;

width_n:=width_n+1;

end;

while height < (maxx-minx) do.

begin.

height:=height+step;

height_n:=height_n+1;

end;

numofint:=strtoint (Form3.Edit_NearNeib.Text);

if n < numofint then numofint:=n;

//setlength (aux1,numofint);

t:=1;

//showmessage (inttostr (width_n));

for j:=1 to height_n do begin.

i:=t;

Repeat.

resultnet[i, 1]: =minx+(j-1)*step;

resultnet[i, 2]: =miny+(i-t)*step;

i:=i+1;

Until i>j*width_n;

t:=t+width_n;

end;{for j:=1 to height_n}.

for i:=1 to t do //.

begin.

for j:=1 to n do.

begin.

aux[j, 1]: =sqrt ((massive[j].x-resultnet[i, 1])*(massive[j].x-resultnet[i, 1])+(massive[j].y-resultnet[i, 2])*(massive[j].y-resultnet[i, 2]));

aux[j, 2]: =massive[j].z;

end;//auxillary massive formed, contains minimal distances and Z’s.

for j:=1 to n do begin.

k:=j;

while aux[k, 1]>aux[k-1,1] do begin.

buf:=aux[k, 1];

aux[k, 1]: =aux[k-1,1];

aux[k-1,1]: =buf;

bufz:=aux[k, 2];

aux[k, 2]: =aux[k-1,2];

aux[k-1,2]: =bufz;

end;

end;

if aux[1,1]=0 then resultnet[i, 3]: =aux[1,2].

else.

begin.

for j:=1 to numofint do.

begin.

sump:=sump+(aux[j, 1]*aux[j, 2]);

sumz:=sumz+aux[j, 1];

end;

resultnet[i, 3]: =(sump/sumz);

end;

sump:=0;

sumz:=0;

end;

Stringgrid2.Rowcount:=t;

for i:=1 to t-1 do.

begin.

Stringgrid2.Cells[1,i]: =floattostr (resultnet[i, 1]);

Stringgrid2.Cells[2,i]: =floattostr (resultnet[i, 2]);

Stringgrid2.Cells[3,i]: =floattostr (resultnet[i, 3]);

end;

end;

procedure TForm1. Button1Click (Sender: TObject);

var.

setka: array [1.10 000,1.3] of real;

min_x, max_x, min_y, max_y, min_z, max_z, mid_x, mid_y, mid_z:real;

razmer:integer;

i, p, j:integer;

begin.

for i:=1 to (StringGrid2.RowCount-1) do //читаю значения из таблицы.

begin.

setka[i, 1]: =strtofloat (StringGrid2.Cells[1,i]);

setka[i, 2]: =strtofloat (StringGrid2.Cells[2,i]);

setka[i, 3]: =strtofloat (StringGrid2.Cells[3,i]);

razmer:=i;

end;

min_x:=setka[1,1]; //поиск среднего значения координат, необходимо бут при прорисовке.

max_x:=setka[1,1];

min_y:=setka[1,2];

max_y:=setka[1,2];

min_z:=setka[1,3];

max_z:=setka[1,3];

for i:=2 to razmer do.

begin.

if setka[i, 1].

if setka[i, 1]>max_x then max_x:=setka[i, 1];

if setka[i, 2].

if setka[i, 2]>max_y then max_y:=setka[i, 2];

if setka[i, 3].

if setka[i, 3]>max_z then max_z:=setka[i, 3];

end;

mid_x:=(max_x+min_x)/2;

mid_y:=(max_y+min_y)/2;

mid_z:=(max_z+min_z)/2;

if (abs (max_x-mid_x))>(abs (max_y-mid_y)) //определение масштаба при прорисовке.

then scale:=abs (max_x-mid_x).

else scale:=abs (max_y-mid_y);

scale_z:=abs (max_z-mid_z)*5;

p:=1;

for i:=1 to razmer do.

for j:=1 to razmer do.

begin.

if ((sqrt (sqr (setka[i, 1]-setka[j, 1])+sqr (setka[i, 2]-setka[j, 2])))<=(step+0.001)) then.

begin.

line[p, 1]: =setka[i, 1]-mid_x;

line[p, 2]: =setka[i, 2]-mid_y;

line[p, 3]: =setka[i, 3]-mid_z;

line[p, 4]: =setka[j, 1]-mid_x;

line[p, 5]: =setka[j, 2]-mid_y;

line[p, 6]: =setka[j, 3]-mid_z;

p:=p+1;

o:=p-1;

end;

end;

Application.CreateForm (TForm4, Form4);

Form4.Show;

end;

end.

unit Unit2;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, StdCtrls;

type.

TForm2 = class (TForm).

Label1: TLabel;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

procedure Button2Click (Sender: TObject);

procedure Button1Click (Sender: TObject);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

var.

Form2: TForm2;

implementation.

uses Unit1;

{$R *.dfm}.

procedure TForm2. Button2Click (Sender: TObject);

begin.

Close;

end;

procedure TForm2. Button1Click (Sender: TObject);

var i: integer;

begin.

for i:=1 to form1. stringgrid1.rowcount-1 do.

begin.

Form1.Stringgrid1.Cells[1,i]: ='';

Form1.Stringgrid1.Cells[2,i]: ='';

Form1.Stringgrid1.Cells[3,i]: ='';

end;

Form1.Stringgrid1.Rowcount:=2;

Close;

end;

end.

unit Unit3;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, StdCtrls;

type.

TForm3 = class (TForm).

Label1: TLabel;

CheckBox1: TCheckBox;

Edit_NearNeib: TEdit;

Label2: TLabel;

Edit_step: TEdit;

Button_SaveSettng: TButton;

Button_Cancel: TButton;

procedure Button_CancelClick (Sender: TObject);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

var.

Form3: TForm3;

implementation.

{$R *.dfm}.

procedure TForm3. Button_CancelClick (Sender: TObject);

begin.

Close;

end;

end.

unit Unit4;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, ExtCtrls, OpenGL, StdCtrls, Spin, ComCtrls, Buttons;

type.

TForm4 = class (TForm).

Panel1: TPanel;

procedure FormCreate (Sender: TObject);

procedure FormDestroy (Sender: TObject);

procedure FormPaint (Sender: TObject);

procedure FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

private.

dc: HDC;

hrc: HGLRC;

{ Private declarations }.

public.

{ Public declarations }.

end;

var.

Form4: TForm4;

u, ox, oy, oz: integer;

procedure setdcpixelformat (hdc:hdc);

implementation.

uses Unit2, Unit1, Unit3;

{$R *.dfm}.

procedure TForm4. FormCreate (Sender: TObject);

begin.

dc := GetDC (Form4.Panel1.Handle);

SetDCPixelFormat (dc);

hrc := wglCreateContext (dc);

u:=0;

ox:=0;

oy:=0;

oz:=0;

end;

procedure SetDCPixelFormat (hdc: HDC);

var.

pfd: TPIXELFORMATDESCRIPTOR;

nPixelFormat: Integer;

begin.

FillChar (pfd, SizeOf (pfd), 0);

nPixelFormat := ChoosePixelFormat (hdc, @pfd);

SetPixelFormat (hdc, nPixelFormat, @pfd);

end;

procedure TForm4. FormDestroy (Sender: TObject);

begin.

wglDeleteContext (hrc);

end;

procedure TForm4. FormPaint (Sender: TObject);

var.

ps: TPaintStruct;

i:integer;

begin.

BeginPaint (form4.panel1.Handle, ps);

wglMakeCurrent (dc, hrc);

glViewPort (0, 0, form4. panel1.ClientWidth, form4. panel1.ClientHeight);

glClearColor (0.9, 0.9, 0.9, 1.0);

glClear (GL_COLOR_BUFFER_BIT);

glRotatef (u, ox, oy, oz);

glBegin (GL_LINES);

glColor3f (0.0, 1.0, 0.0);

glVertex3f (0,0,0);

glVertex3f (1,0,0);

glColor3f (1.0, 0.0, 0.0);

glVertex3f (0,0,0);

glVertex3f (0,1,0);

glColor3f (0.0, 0.0, 1.0);

glVertex3f (0,0,0);

glVertex3f (0,0,1);

glEnd;

glColor3f (0.0, 0.0, 0.0);

glScalef (1/(sqrt (2)*scale), 1/(sqrt (2)*scale), 1/(sqrt (2)*scale_z));

for i:=1 to o do.

begin.

glBegin (GL_LINES);

glVertex3f (line[i, 2], line[i, 1], line[i, 3]);

glVertex3f (line[i, 5], line[i, 4], line[i, 6]);

glEnd;

end;

glScalef (sqrt (2)*scale, sqrt (2)*scale, sqrt (2)*scale_z);

SwapBuffers (form4.panel1.Handle);

wglMakeCurrent (0, 0);

EndPaint (form4.panel1.Handle, ps);

end;

procedure TForm4. FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

begin.

if (Key=38) then.

begin.

u:=-1;

ox:=1;

oy:=0;

oz:=0;

Form4.FormPaint (Form4);

end;

if (Key=40) then.

begin.

u:=1;

ox:=1;

oy:=0;

oz:=0;

Form4.FormPaint (Form4);

end;

if (Key=37) and (HiWord (GetKeyState (VK_Shift))0) then.

begin.

u:=1;

ox:=0;

oy:=1;

oz:=0;

Form4.FormPaint (Form4);

end;

if (Key=39) and (HiWord (GetKeyState (VK_Shift))0) then.

begin.

u:=-1;

ox:=0;

oy:=1;

oz:=0;

Form4.FormPaint (Form4);

end;

if (Key=37) and (HiWord (GetKeyState (VK_Shift))=0) then.

begin.

u:=1;

ox:=0;

oy:=0;

oz:=1;

Form4.FormPaint (Form4);

end;

if (Key=39) and (HiWord (GetKeyState (VK_Shift))=0) then.

begin.

u:=-1;

ox:=0;

oy:=0;

oz:=1;

Form4.FormPaint (Form4);

end;

end;

end.