三维演示系统吕雪松.docx

三维演示系统吕雪松.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