// cc:Array of Array of Array[1..3] of GLfloat;//массив цветов
mess:string;
bmp:TBitmap;
procedure InitOpenGL;
procedure SetDCPixelFormat(DC:HDC);
end;
var
yess: Boolean;
Mat: TMat;
MouseButton : Integer;
Xcoord, Ycoord, Zcoord : Integer;
YRot, XRot : integer;
Depth : integer;
LastCCX,LastCCY : Integer;
//-----------------------------------------------------------------------------
implementation
//-----------------------------------------------------------------------------
uses UAbout;
{$R *.dfm}
procedure TMat.InitOpenGL;
begin
MyPanels.DC:=GetDC(Panel4.Handle);
SetDCPixelFormat(MyPanels.DC);
MyPanels.HRC:=wglCreateContext(MyPanels.DC);
wglMakeCurrent(MyPanels.DC,MyPanels.HRC);
glEnable(GL_DEPTH_TEST);
glClearColor(0,0,0,1);
end;
procedure TMat.SetDCPixelFormat(DC:HDC);
var
pfd:TPixelFormatDescriptor;
nPixelFormat:Integer;
begin
FillChar(pfd,SizeOf(pfd),0);
pfd.dwFlags:=PFD_DOUBLEBUFFER or
PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL;
nPixelFormat:=ChoosePixelFormat(DC,@pfd);
SetPixelFormat(DC,nPixelFormat,@pfd);
end;
procedure TMat.FormCreate(Sender: TObject);
begin
MouseButton :=0;
bmp:=TBitmap.Create;
InitOpenGL;
Left:=0;
Top:=0;
LastCCX:=0;
LastCCY:=0;
self.MCurrent := @self.myMatrix01;
self.ComboBoxMatrix.ItemIndex := 0;
// Width:=Screen.Width;
// Height:=Screen.Height;
// WindowState:=wsMaximized;
// Timer1.Enabled:=True;
end;
procedure TMat.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(0,0);
bmp.Destroy;
Finalize(myMatrix01.vx);
Finalize(myMatrix01.cx);
Finalize(myMatrix01.cc);
Finalize(myMatrix01.nx);
Finalize(myMatrix02.vx);
Finalize(myMatrix02.cx);
Finalize(myMatrix02.cc);
Finalize(myMatrix02.nx);
Finalize(myMatrix03.vx);
Finalize(myMatrix03.cx);
Finalize(myMatrix03.cc);
Finalize(myMatrix03.nx);
wglDeleteContext(MyPanels.HRC);
ReleaseDC(MyPanels.DC,Panel4.Handle);
DeleteDC(MyPanels.DC);
end;
procedure TMat.GL(var Matrix:TMatrix);
var
j,k,dw,dv : Integer;
ps : TPaintStruct;
av : Integer;
stroka:string;
begin
av:=0;
dw:=0;
dv:=0;
if (Yess=true) then
begin
GroupBox1.Enabled:=True;
dw:=Matrix.w div 2;
dv:=25 div 2;
BeginPaint(Panel4.Handle,ps);
wglMakeCurrent(MyPanels.DC,MyPanels.HRC);
glViewport(0,0,Panel4.Width,Panel4.Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(30,Panel4.Width/Panel4.Height,1,10000);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;
glTranslatef(0,0,-Zcoord);
glRotatef(Xrot,1,0,0);
glRotatef(Yrot,0,1,0);
try
if (Matrix.w>5) then
If cb_Surface.Checked then av:=2 else av:=1;
case av of
1 : begin
glDisable(GL_LIGHTING);
glDisable(GL_LIGHT0);
glColor3f(1,1,1);
glBegin(GL_LINES);
for j:=0 to Matrix.w-2 do
for k:=0 to Matrix.w-2 do
begin
glColor3f(Matrix.cx[j,k,1],Matrix.cx[j,k,2],Matrix.cx[j,k,3]);
glVertex3f(j-dw,Matrix.vx[j,k]-dv,k-dw);
glColor3f(Matrix.cx[j,k+1,1],Matrix.cx[j,k+1,2],Matrix.cx[j,k+1,3]);
glVertex3f(j-dw,Matrix.vx[j,k+1]-dv,k+1-dw);
end;
for j:=0 to Matrix.w-2 do
for k:=0 to Matrix.w-2 do
begin
glColor3f(Matrix.cx[j,k,1],Matrix.cx[j,k,2],Matrix.cx[j,k,3]);
glVertex3f(j-dw,Matrix.vx[j,k]-dv,k-dw);
glColor3f(Matrix.cx[j+1,k,1],Matrix.cx[j+1,k,2],Matrix.cx[j+1,k,3]);
glVertex3f(j+1-dw,Matrix.vx[j+1,k]-dv,k-dw);
end;
glEnd;
end;
2 : begin
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
glEnable(GL_COLOR_MATERIAL);
glColor3f(1,1,1);
glBegin(GL_TRIANGLES);
for j:=0 to Matrix.w-2 do
for k:=0 to Matrix.w-2 do
begin
glColor3f(Matrix.cx[j,k,1],Matrix.cx[j,k,2],Matrix.cx[j,k,3]);
glNormal3f(Matrix.nx[j,k,1],Matrix.nx[j,k,2],Matrix.nx[j,k,3]);
glVertex3f(j-dw,Matrix.vx[j,k]-dv,k-dw);
glColor3f(Matrix.cx[j+1,k,1],Matrix.cx[j+1,k,2],Matrix.cx[j+1,k,3]);
glNormal3f(Matrix.nx[j+1,k,1],Matrix.nx[j+1,k,2],Matrix.nx[j+1,k,3]);
glVertex3f(j-dw+1,Matrix.vx[j+1,k]-dv,k-dw);
glColor3f(Matrix.cx[j+1,k+1,1],Matrix.cx[j+1,k+1,2],Matrix.cx[j+1,k+1,3]);
glNormal3f(Matrix.nx[j+1,k+1,1],Matrix.nx[j+1,k+1,2],Matrix.nx[j+1,k+1,3]);
glVertex3f(j-dw+1,Matrix.vx[j+1,k+1]-dv,k-dw+1);
end;
for j:=0 to Matrix.w-2 do
for k:=0 to Matrix.w-2 do
begin
glColor3f(Matrix.cx[j,k,1],Matrix.cx[j,k,2],Matrix.cx[j,k,3]);
glNormal3f(Matrix.nx[j,k,1],Matrix.nx[j,k,2],Matrix.nx[j,k,3]);
glVertex3f(j-dw,Matrix.vx[j,k]-dv,k-dw);
glColor3f(Matrix.cx[j,k+1,1],Matrix.cx[j,k+1,2],Matrix.cx[j,k+1,3]);
glNormal3f(Matrix.nx[j,k+1,1],Matrix.nx[j,k+1,2],Matrix.nx[j,k+1,3]);
glVertex3f(j-dw,Matrix.vx[j,k+1]-dv,k-dw+1);
glColor3f(Matrix.cx[j+1,k+1,1],Matrix.cx[j+1,k+1,2],Matrix.cx[j+1,k+1,3]);
glNormal3f(Matrix.nx[j+1,k+1,1],Matrix.nx[j+1,k+1,2],Matrix.nx[j+1,k+1,3]);
glVertex3f(j-dw+1,Matrix.vx[j+1,k+1]-dv,k-dw+1);
end;
glEnd;
glDisable(GL_COLOR_MATERIAL);
end;
end;
except
Matrix.w:=0;
MessageBox(Handle,'Ошибка при прорисовке изображения',
'Ошибка',MB_OK or MB_ICONERROR);
end;
EndPaint(Panel4.Handle,ps);
glRotatef(120,1.0,0.0,0.0); // Rotate on x
glRotatef(120,0.0,1.0,0.0); // Rotate on y
glRotatef(120,0.0,0.0,1.0); // Rotate on z
SwapBuffers(MyPanels.DC);
//временная защита кода
// stroka := 'Это демонстрационная версия!!!';
// TextOut(myPanels.DC,300,200,PChar(stroka),Length(stroka));
// stroka := 'Программа сделана на заказ!!!';
// TextOut(myPanels.DC,300,220,PChar(stroka),Length(stroka));
// stroka := 'лоалофв аофоа длфыв а лдо';
// TextOut(myPanels.DC,300,240,PChar(stroka),Length(stroka));
end;
end;
procedure TMat.SelPos(var Matrix:TMatrix; xx:Integer;yy:Integer);
var
fx:Integer;
s:string;
begin
if (Matrix.w>0) then
begin
for fx := 0 to Matrix.w-1 do
begin
Matrix.cx[LastCCx,fx,1]:=Matrix.cc[LastCCx,fx,1];
Matrix.cx[LastCCx,fx,2]:=Matrix.cc[LastCCx,fx,2];
Matrix.cx[LastCCx,fx,3]:=Matrix.cc[LastCCx,fx,3];
Matrix.cx[fx,LastCCy,1]:=Matrix.cc[fx,LastCCy,1];
Matrix.cx[fx,LastCCy,2]:=Matrix.cc[fx,LastCCy,2];
Matrix.cx[fx,LastCCy,3]:=Matrix.cc[fx,LastCCy,3];
Matrix.cx[xx,fx,1]:=1;
Matrix.cx[xx,fx,2]:=1;
Matrix.cx[xx,fx,3]:=1;
Matrix.cx[fx,yy,1]:=1;
Matrix.cx[fx,yy,2]:=1;
Matrix.cx[fx,yy,3]:=1;
end;
LastCCx:=xx;
LastCCy:=yy;
s:=FormatFloat('0.00', Matrix.vx[LastCCx,LastCCy]);
// if Matrix.vx[LastCCx,LastCCy] < 0 then s:= '-'+s;
// Edit3.Text:=FloatToStr(Round(Matrix.vx[LastCCx,LastCCy]*100)/100);
Edit3.Text := s;
end; трехмерный изображение матричный графический
end;
//-----------------------------------------------------------------------------
function TMat.LoadMatrixFromBitmap(filename:string; var Matrix:TMatrix):boolean;
var
i,j :Integer;
ss : string;
begin
Result := false;
if not FileExists(filename) then exit;
with Matrix do
begin
bmp.Width:=0;
bmp.Height:=0;
bmp.LoadFromFile(OpenPictureDialog1.FileName);
w:=bmp.Width;
UpDown1.Max:=w;
UpDown2.Max:=w;
LastCCX:=w div 2;
LastCCY:=w div 2;
SetLength(vx,w);
SetLength(nx,w);
SetLength(cx,w);
SetLength(cc,w);
for i:=0 to w-1 do
begin
SetLength(vx[i],w);
SetLength(nx[i],w);
SetLength(cx[i],w);
SetLength(cc[i],w);
end;
ss:='';
ListBox1.Items.Clear;
for i:=0 to w-1 do
begin
for j:=0 to w-1 do
begin
vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
GetGValue(bmp.Canvas.Pixels[i,j])+
GetBValue(bmp.Canvas.Pixels[i,j]))/50;
if vx[i,j]>10 then vx[i,j]:=9+(random(99)+1)/100;
ss:=ss+FormatFloat('0.00', vx[i,j])+' ';
cx[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
cx[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
cx[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
end;
ListBox1.Items.Add(ss);
ss:='';
end;
Zcoord :=w*2;
SelPos(Matrix, LastCCX, LastCCY);
UpDown1.Position:=LastCCX;
UpDown2.Position:=LastCCY;
end;
Result := true;
end;
function TMat.LoadMatrixFromDtFile(filename:string; var Matrix:TMatrix):boolean;
var
i,x,y,j,k,posp,posbar:Integer;
spr,sfl,ss,formfl:String;
Fres : TFloatRec;
Conv : Extended ;
coint :integer;
ValStr :Extended;
begin
Result := false;
if not FileExists(filename) then exit;
with Matrix do
begin
LBData.Items.Clear;
bar.Position:=0;
progress.Visible:=True;
progress.Update;
LBData.Items.LoadFromFile(FileName);
if LBData.Items.Count>5 then
begin
bar.Position:=5;
bar.Update;
w:=LBData.Items.Count;
UpDown1.Max:=w;
UpDown2.Max:=w;
LastCCX:=w div 2;
LastCCY:=w div 2;
SetLength(vx,w);
SetLength(nx,w);
SetLength(cx,w);
SetLength(cc,w);
for i:=0 to w-1 do
begin
SetLength(vx[i],w);
SetLength(nx[i],w);
SetLength(cx[i],w);
SetLength(cc[i],w);
for y :=0 to w-1 do
begin
vx[i,y]:=0;
nx[i,y,1]:=0;
nx[i,y,2]:=0;
nx[i,y,3]:=0;
cx[i,y,1]:=0;
cx[i,y,2]:=0;
cx[i,y,3]:=0;
cc[i,y,1]:=0;
cc[i,y,2]:=0;
cc[i,y,3]:=0;
end;
end;
yess:=True;
mess:='';
for y :=0 to w-1 do
begin
spr:=LBData.Items[y];
x:=0;
while (((pos(' ',spr)>0) or (Length(spr)>0)) and (Yess=True) and (x<w)) do
begin
posp:=pos(' ',spr);
If (posp>0) then
begin
sfl:=trim (copy(spr,0,posp));
delete(spr,1,posp);
ValStr:=strtofloatdef(sfl,-100);
If (ValStr=-100) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Неверное значение'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+sfl+']';
break;
end;
If ((ValStr<-10) or (ValStr>10)) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Значение >10, либо <-10'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+sfl+']';
break;
end else vx[x,y]:=ValStr;
end else
begin
spr:=Trim(spr);
ValStr:=strtofloatdef(spr,-100);
If (ValStr=-100) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Неверное значение'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+spr+']';
break;
end;
If ((ValStr<-10) or (ValStr>10)) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Значение >10, либо <-10'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+spr+']';
break;
end else vx[x,y]:=ValStr;
spr:='';
end;
inc(x);
end;
formfl := FormatFloat('0',70*(((y+1)*(x))/(w*w)));
coint:=StrToInt(formfl);
bar.Position:=5+coint;
bar.Update;
// mat.Caption :=mat.Caption+inttostr(x)+' ';
if (x<w) then
begin
Yess:=false;
if (Length(mess)=0) then mess:='строка '+ IntToStr(y+1)+#13#10+'короткая, либо излишек строк в файле';
break;
end;
if (spr<>'') then
begin
Yess:=false;
if (Length(mess)=0) then mess:='строка '+ IntToStr(y+1)+#13#10+'длинная, либо недостаточно строк в файле';
break;
end;
end;
end else
begin
Yess:=false;
mess:='Форма должна иметь'+#13#10+'размер более чем 5х5';
end;
if Yess=true then
begin
bar.Position:=90;
bar.Update;
for i:=0 to w-1 do
begin
for j:=0 to w-1 do
begin
cx[i,j,1]:=(vx[i,j]+1)/9;
cx[i,j,2]:=1-vx[i,j+1]/9;
cx[i,j,3]:=0;
cc[i,j,1]:=(vx[i,j]+1)/9;
cc[i,j,2]:=1-vx[i,j+1]/9;
cc[i,j,3]:=0;
end;
end;
for i:=0 to w-1 do
for j:=0 to w-1 do
for k:=1 to 3 do
nx[i,j,k]:=1;
for i:=0 to w-2 do
for j:=0 to w-2 do
begin
CalcNormals(i,vx[i,j],j,
i+1,vx[i+1,j],j,
i+1,vx[i+1,j+1],j+1,
nx[i,j,1],nx[i,j,2],nx[i,j,3]);
end;
bar.Position:=100;
bar.Update;
Zcoord :=w*2;
XRot:=90;
YRot:=0;
UpDown1.Position:=LastCCX;
UpDown2.Position:=LastCCY;
SelPos(Matrix,LastCCX, LastCCY);
progress.Hide;
Panel4.Show;
end;
end;
Result := Yess;
end;
//-----------------------------------------------------------------------------
procedure TMat.bmp1Click(Sender: TObject);
begin
try
if OpenPictureDialog1.Execute then
if FileExists(OpenPictureDialog1.FileName) then
begin
self.LoadMatrixFromBitmap(OpenPictureDialog1.FileName,self.MCurrent^);
self.GL(self.MCurrent^);
end else
MessageBox(Handle,
PAnsiChar('Файл '+OpenPictureDialog1.FileName+' не найден'),
'Ошибка',MB_OK or MB_ICONERROR);
except
MessageBox(Handle,
PAnsiChar('Ошибка во время загрузки файла '+
OpenPictureDialog1.FileName),
'Ошибка',MB_OK or MB_ICONERROR);
end;
end;
procedure TMat.Panel4MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
MouseButton :=1;
Xcoord := X;
Ycoord := Y;
end;
if Button = mbRight then
begin
MouseButton :=2;
Zcoord := Y;
end;
end;
procedure TMat.Panel4MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if MouseButton = 1 then
begin
xRot := xRot + (Y - Ycoord) div 2; // moving up and down = rot around X-axis
yRot := yRot + (X - Xcoord)div 2;
Xcoord := X;
Ycoord := Y;
GL(self.MCurrent^);
end;
if MouseButton = 2 then
begin
Depth :=Depth - (Y-ZCoord) div 3;
Zcoord := Y;
GL(self.MCurrent^);
end;
// caption:=inttostr(xRot)+':'+inttostr(yRot);
end;
procedure TMat.Panel4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseButton :=0;
end;
procedure TMat.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key)<>8 then if ((key<'0') or (key>'9')) then Key:=#0;
end;
procedure TMat.Edit1Change(Sender: TObject);
var
x:Integer;
begin
If TryStrToInt(Edit1.Text,x)
then begin
if x>self.MCurrent^.w then Edit1.Text:=IntToStr(self.MCurrent^.w);
If x<2 then Edit1.Text:='1';
end
else begin
Edit1.Text:='1';
end;
SelPos(self.MCurrent^,UpDown1.Position-1,LastCCY);
GL(self.MCurrent^);
end;
procedure TMat.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key)<>8 then if ((key<'0') or (key>'9')) then Key:=#0;
end;
procedure TMat.Edit2Change(Sender: TObject);
var
x:Integer;
begin
If TryStrToInt(Edit2.Text,x)
then begin
if x>self.MCurrent^.w then Edit2.Text:=IntToStr(self.MCurrent^.w);
If x<2 then Edit2.Text:='1';
end
else begin
Edit2.Text:='1';
end;
SelPos(self.MCurrent^,LastCCX,UpDown2.Position-1);
GL(self.MCurrent^);
end;
procedure TMat.CalcNormals(x1,y1,z1,x2,y2,z2,x3,y3,z3:Extended; var nx,ny,nz:Extended);