三维演示系统吕雪松.docx
《三维演示系统吕雪松.docx》由会员分享，可在线阅读，更多相关《三维演示系统吕雪松.docx（71页珍藏版）》请在冰豆网上搜索。
三维演示系统吕雪松
programSurface;
uses
Forms,
SysUtils,
frmGLMDIin'frmGLMDI.pas'{frmGL},
Meshin'Mesh.pas',
TextureGLin'TextureGL.pas',
frmMainin'frmMain.pas'{MainForm},
frmDEMCollectionin'frmDEMCollection.pas'{DEMCollectionForm},
Globalin'Global.pas';
{$R*.RES}
begin
sSysPath:
=ExtractFilePath（Application.ExeName）;
Application.Initialize;
Application.CreateForm（TMainForm,MainForm）;
Application.Run;
end.
unitfrmMain;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,Menus,frmGLMDI,mesh,opengl,frmDEMCollection,
StdCtrls;
type
TMainForm=class（TForm）
MainMenu1:
TMainMenu;
N5:
TMenuItem;
Grayface1:
TMenuItem;
N8:
TMenuItem;
N9:
TMenuItem;
N13:
TMenuItem;
N14:
TMenuItem;
N15:
TMenuItem;
OpenDialog1:
TOpenDialog;
SaveDialog1:
TSaveDialog;
N20:
TMenuItem;
N21:
TMenuItem;
N23:
TMenuItem;
N24:
TMenuItem;
procedureN24Click（Sender:
TObject）;
procedureN26Click（Sender:
TObject）;
procedureN30Click（Sender:
TObject）;
procedureN31Click（Sender:
TObject）;
procedureN8Click（Sender:
TObject）;
procedureN9Click（Sender:
TObject）;
procedureN16Click（Sender:
TObject）;
procedureN21Click（Sender:
TObject）;
procedureN14Click（Sender:
TObject）;
procedureN15Click（Sender:
TObject）;
procedureN1Click（Sender:
TObject）;
procedureFormCreate（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
GLChild:
TfrmGL;
end;
var
MainForm:
TMainForm;
implementation
{$R*.dfm}
procedureTMainForm.N24Click（Sender:
TObject）;
begin
Close;
end;
procedureTMainForm.N26Click（Sender:
TObject）;
begin
//GLChild:
=TfrmGL.Create（Application,）;
end;
procedureTMainForm.N30Click（Sender:
TObject）;
begin
TileMode:
=tbVertical;
Tile;
end;
procedureTMainForm.N31Click（Sender:
TObject）;
begin
Cascade;
end;
procedureTMainForm.N8Click（Sender:
TObject）;
begin
ifMDIChildCount>0thenbegin
GLChild.MyMesh.MeshConfig.mode:
=gl_triangles;
InvalidateRect（GLChild.Handle,nil,False）;
end;
end;
procedureTMainForm.N9Click（Sender:
TObject）;
begin
ifMDIChildCount>0thenbegin
GLChild.MyMesh.MeshConfig.mode:
=gl_Line_loop;
InvalidateRect（GLChild.Handle,nil,False）;
end;
end;
procedureTMainForm.N16Click（Sender:
TObject）;
begin
end;
procedureTMainForm.N21Click（Sender:
TObject）;
begin
withTDEMCollectionForm.Create（nil）dobegin
ShowModal;
ifListView1.ItemIndex>=0thenbegin
ifGLChild<>nilthenGLChild.Free;
GLChild:
=TfrmGL.Create（Application,ListView1.Selected.SubItems[0],ListView1.Selected.SubItems[1]）;end;
Free;
end;
end;
procedureTMainForm.N14Click（Sender:
TObject）;
begin
ifMDIChildCount>0thenbegin
glEnable（GL_LIGHTING）;
InvalidateRect（GLChild.Handle,nil,False）;
end;
end;
procedureTMainForm.N15Click（Sender:
TObject）;
begin
ifMDIChildCount>0thenbegin
glDisable（GL_LIGHTING）;
InvalidateRect（GLChild.Handle,nil,False）;
end;
end;
procedureTMainForm.N1Click（Sender:
TObject）;
begin
if（MDIChildCount>0）and（notAssigned（GLChild.MyMesh.Root））thenbegin
GLChild.MyMesh.BuildTree;
end;
end;
procedureTMainForm.FormCreate（Sender:
TObject）;
begin
end;
end.
unitfrmDEMCollection;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,ComCtrls,global,StdCtrls;
type
TDEMCollectionForm=class（TForm）
ListView1:
TListView;
Button1:
TButton;
procedureButton1Click（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
constructorCreate（AOwner:
TComponent）;
procedureLoadDEMCollection（sPath:
string）;
end;
implementation
{$R*.dfm}
{TDEMCollectionForm}
constructorTDEMCollectionForm.Create（AOwner:
TComponent）;
begin
inherited;
LoadDEMCollection（sSysPath）;
end;
procedureTDEMCollectionForm.LoadDEMCollection（sPath:
string）;
var
F:
TextFile;
sBuf:
string;
Item:
TListItem;
begin
AssignFile（F,sPath+'\dem.ini'）;
Reset（F）;
Readln（F）;
whilenotEof（F）dobegin
ReadLn（F,sBuf）;
Item:
=ListView1.Items.Add;
Item.Caption:
=GetStrItem（sBuf,',',1）;
Item.SubItems.Add（GetStrItem（sBuf,',',2））;
Item.SubItems.Add（GetStrItem（sBuf,',',3））;
end;
CloseFile（F）;
end;
procedureTDEMCollectionForm.Button1Click（Sender:
TObject）;
begin
Close;
end;
end.
/////////////////////////////////////////////////////////////
BoogeManBoogeSoft@yandex.ru///
///////////////////////////////////////////////////////////////
unitfrmGLMDI;
interface
uses
Windows,Messages,Classes,Graphics,Forms,
Controls,SysUtils,OpenGL,Mesh,Menus,StdCtrls,Dialogs,ExtCtrls,
ComCtrls,Buttons;
constBUFSIZE=512;
type
TfrmGL=class（TForm）
procedureFormKeyDown（Sender:
TObject;varKey:
Word;
Shift:
TShiftState）;
procedureFormMouseMove（Sender:
TObject;Shift:
TShiftState;X,
Y:
Integer）;
procedureFormMouseUp（Sender:
TObject;Button:
TMouseButton;
Shift:
TShiftState;X,Y:
Integer）;
procedureFormMouseDown（Sender:
TObject;Button:
TMouseButton;
Shift:
TShiftState;X,Y:
Integer）;
procedureFormCanResize（Sender:
TObject;varNewWidth,
NewHeight:
Integer;varResize:
Boolean）;
procedureN14Click（Sender:
TObject）;
procedureN15Click（Sender:
TObject）;
procedureN11Click（Sender:
TObject）;
procedureN12Click（Sender:
TObject）;
procedureN7Click（Sender:
TObject）;
procedureGrayface2Click（Sender:
TObject）;
procedureN3Click（Sender:
TObject）;
procedureFormMouseWheelDown（Sender:
TObject;Shift:
TShiftState;
MousePos:
TPoint;varHandled:
Boolean）;
procedureFormMouseWheelUp（Sender:
TObject;Shift:
TShiftState;
MousePos:
TPoint;varHandled:
Boolean）;
procedureButton1Click（Sender:
TObject）;
procedureFormClose（Sender:
TObject;varAction:
TCloseAction）;
private
DC:
HDC;
hrc:
HGLRC;
mDown:
Boolean;
bRBtnDown:
Boolean;
procedureInit;
procedureSetDCPixelFormat;
protected
procedureWMPaint（varMsg:
TWMPaint）;messageWM_PAINT;
public
MyMesh:
TGeo3DMesh;
viewP:
array[0..3]ofGLint;
constructorCreate（AOwner:
TComponent;sDem,sIMG:
string）;
destructorDestroy;override;
procedureZoomIn;
procedureZoomOut;
functionDoSelect（X,Y:
integer）:
integer;
end;
var
frmGL:
TfrmGL;
Anglex,Angley,angle,dLength:
GLfloat;
xm,ym:
Integer;
implementation
usesfrmMain;
{$R*.DFM}
{=======================================================================
软桷栲腓玎鲨}
procedureTfrmGL.Init;
begin
glEnable（GL_DEPTH_TEST）;
glEnable（GL_LIGHT0）;
glenable（GL_COLOR_MATERIAL）;
gldisable（GL_NORMALIZE）;
end;
procedureTfrmGL.WMPaint（varMsg:
TWMPaint）;
var
ps:
TPaintStruct;
begin
BeginPaint（Handle,ps）;
glClear（GL_COLOR_BUFFER_BITorGL_DEPTH_BUFFER_BIT）;
glPushMatrix;
glRotatef（Anglex,1.0,0.0,0.0）;
glRotatef（Angley,0.0,1.0,0.0）;
MyMesh.Draw;//
glPopMatrix;
SwapBuffers（DC）;
EndPaint（Handle,ps）;
end;
procedureTfrmGL.FormKeyDown（Sender:
TObject;varKey:
Word;
Shift:
TShiftState）;
begin
IfKey=VK_ESCAPEthenClose
elseifKey=38thenZoomOut
elseifKey=40thenZoomIn;
end;
procedureTfrmGL.FormMouseMove（Sender:
TObject;Shift:
TShiftState;X,
Y:
Integer）;
begin
Ifmdownthenbegin
anglex:
=anglex+（y-ym）;
angley:
=angley+（x-xm）;
InvalidateRect（Handle,nil,False）;
end;
ifbRBtnDownthenbegin
gluLookAt（（xm-x）/500,（y-ym）/500,0,（xm-x）/500,（y-ym）/500,-100,0,1,0）;
InvalidateRect（Handle,nil,false）;
end;
//DoSelect（X,Y）;
xm:
=x;ym:
=y;
end;
procedureTfrmGL.FormMouseUp（Sender:
TObject;Button:
TMouseButton;
Shift:
TShiftState;X,Y:
Integer）;
begin
ifButton=mbLeftthenbegin
mdown:
=false;
end
else
ifButton=mbRightthenbegin
bRBtnDown:
=FALSE;
end;
end;
procedureTfrmGL.FormMouseDown（Sender:
TObject;Button:
TMouseButton;
Shift:
TShiftState;X,Y:
Integer）;
begin
ifButton=mbLeftthenbegin
mdown:
=true;
end
else
ifButton=mbRightthenbegin
bRBtnDown:
=TRUE;
end;
xm:
=x;
ym:
=y;
end;
procedureTfrmGL.SetDCPixelFormat;
var
nPixelFormat:
Integer;
pfd:
TPixelFormatDescriptor;
begin
FillChar（pfd,SizeOf（pfd）,0）;
pfd.dwFlags:
=PFD_DRAW_TO_WINDOWorPFD_SUPPORT_OPENGLor
PFD_DOUBLEBUFFER;
nPixelFormat:
=ChoosePixelFormat（DC,@pfd）;
SetPixelFormat（DC,nPixelFormat,@pfd）;
end;
procedureTfrmGL.FormCanResize（Sender:
TObject;varNewWidth,
NewHeight:
Integer;varResize:
Boolean）;
begin
glViewPort（0,0,ClientWidth,ClientHeight）;
glMatrixMode（GL_PROJECTION）;
glLoadIdentity;
gluPerspective（50.0,ClientWidth/ClientHeight,0.01,5000.0）;
glMatrixMode（GL_MODELVIEW）;
glLoadIdentity;
glTranslatef（0.0,0.3,-1.0）;
InvalidateRect（Handle,nil,False）;
glFogi（GL_FOG_MODE,GL_exp2）;
glFogfv（GL_FOG_COLOR,@color）;
//glFogf（GL_FOG_START,25）;
//glFogf（GL_FOG_END,55）;
glFogf（GL_FOG_DENSITY,0.020）;
glEnable（GL_FOG）;
glenable（GL_COLOR_MATERIAL）;
glEnable（GL_LIGHT0）;
glEnable（GL_CULL_FACE）;
end;
procedureTfrmGL.N14Click（Sender:
TObject）;
begin
glEnable（GL_LIGHTING）;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.N15Click（Sender:
TObject）;
begin
gldisable（GL_LIGHTING）;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.N11Click（Sender:
TObject）;
begin
MyMesh.MeshConfig.smt:
=true;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.N12Click（Sender:
TObject）;
begin
MyMesh.MeshConfig.smt:
=false;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.N7Click（Sender:
TObject）;
begin
glenable（GL_COLOR_MATERIAL）;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.Grayface2Click（Sender:
TObject）;
begin
glColor3f（0.5,0.5,0.5）;
gldisable（GL_COLOR_MATERIAL）;
InvalidateRect（Handle,nil,False）;
end;
procedureTfrmGL.N3Click（Sender:
TObject）;
begin
Close;
end;
procedureTfrm
升级会员 