三维演示系统吕雪松.docx

1、三维演示系统吕雪松program Surface;uses Forms, SysUtils, frmGLMDI in frmGLMDI.pas frmGL, Mesh in Mesh.pas, TextureGL in TextureGL.pas, frmMain in frmMain.pas MainForm, frmDEMCollection in frmDEMCollection.pas DEMCollectionForm, Global in Global.pas;$R *.RESbegin sSysPath := ExtractFilePath(Application.ExeName

2、); Application.Initialize; Application.CreateForm(TMainForm, MainForm); Application.Run;end.unit frmMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, frmGLMDI, mesh, opengl, frmDEMCollection, StdCtrls;type TMainForm = class(TForm) MainMenu1

3、: 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; procedure N24Click(Sender: TObject); procedure N26Click(

4、Sender: TObject); procedure N30Click(Sender: TObject); procedure N31Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N16Click(Sender: TObject); procedure N21Click(Sender: TObject); procedure N14Click(Sender: TObject); procedure N15Click(Sender

5、: TObject); procedure N1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private Private declarations public Public declarations GLChild : TfrmGL; end;var MainForm: TMainForm;implementation$R *.dfmprocedure TMainForm.N24Click(Sender: TObject);begin Close;end;procedure TMainForm.N26Clic

6、k(Sender: TObject);begin/ GLChild := TfrmGL.Create(Application, );end;procedure TMainForm.N30Click(Sender: TObject);begin TileMode := tbVertical; Tile;end;procedure TMainForm.N31Click(Sender: TObject);begin Cascade;end;procedure TMainForm.N8Click(Sender: TObject);begin if MDIChildCount 0 then begin

7、GLChild.MyMesh.MeshConfig.mode:= gl_triangles; InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N9Click(Sender: TObject);begin if MDIChildCount 0 then begin GLChild.MyMesh.MeshConfig.mode:= gl_Line_loop; InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N

8、16Click(Sender: TObject);begin end;procedure TMainForm.N21Click(Sender: TObject);begin with TDEMCollectionForm.Create(nil) do begin ShowModal; if ListView1.ItemIndex = 0 then begin if GLChild nil then GLChild.Free; GLChild := TfrmGL.Create(Application, ListView1.Selected.SubItems0, ListView1.Selecte

9、d.SubItems1); end; Free; end;end;procedure TMainForm.N14Click(Sender: TObject);begin if MDIChildCount 0 then begin glEnable(GL_LIGHTING); InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N15Click(Sender: TObject);begin if MDIChildCount 0 then begin glDisable(GL_LIGHTING); Inva

10、lidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N1Click(Sender: TObject);begin if (MDIChildCount 0) and (not Assigned(GLChild.MyMesh.Root) then begin GLChild.MyMesh.BuildTree; end;end;procedure TMainForm.FormCreate(Sender: TObject);beginend;end.unit frmDEMCollection;interfaceuses

11、 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, global, StdCtrls;type TDEMCollectionForm = class(TForm) ListView1: TListView; Button1: TButton; procedure Button1Click(Sender: TObject); private Private declarations public Public declarations constructor

12、Create(AOwner : TComponent); procedure LoadDEMCollection(sPath : string); end;implementation$R *.dfm TDEMCollectionForm constructor TDEMCollectionForm.Create(AOwner: TComponent);begin inherited; LoadDEMCollection(sSysPath);end;procedure TDEMCollectionForm.LoadDEMCollection(sPath : string);var F : Te

13、xtFile; sBuf : string; Item : TListItem;begin AssignFile(F, sPath + dem.ini); Reset(F); Readln(F); while not Eof(F) do begin 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(

14、F);end;procedure TDEMCollectionForm.Button1Click(Sender: TObject);begin Close;end;end./BoogeMan BoogeSoftyandex.ru /unit frmGLMDI;interfaceuses Windows, Messages, Classes, Graphics, Forms, Controls, SysUtils, OpenGL, Mesh, Menus, StdCtrls, Dialogs, ExtCtrls, ComCtrls, Buttons;const BUFSIZE = 512;typ

15、e TfrmGL = class(TForm) procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown(Sen

16、der: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure N14Click(Sender: TObject); procedure N15Click(Sender: TObject); procedure N11Click(Sender: TObject); procedure N12Click(S

17、ender: TObject); procedure N7Click(Sender: TObject); procedure Grayface2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftStat

18、e; MousePos: TPoint; var Handled: Boolean); procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private DC: HDC; hrc: HGLRC; mDown : Boolean; bRBtnDown : Boolean; procedure Init; procedure SetDCPixelFormat; protected procedure WMPaint(var Msg: TWM

19、Paint); message WM_PAINT; public MyMesh : TGeo3DMesh; viewP : array 0.3 of GLint; constructor Create(AOwner : TComponent; sDem, sIMG : string); destructor Destroy;override; procedure ZoomIn; procedure ZoomOut; function DoSelect(X,Y : integer) : integer; end;var frmGL: TfrmGL; Anglex,Angley,angle, dL

20、ength : GLfloat; xm,ym : Integer;implementationuses frmMain;$R *.DFM=软桷栲腓玎鲨procedure TfrmGL.Init;begin glEnable(GL_DEPTH_TEST); glEnable(GL_LIGHT0); glenable (GL_COLOR_MATERIAL); gldisable (GL_NORMALIZE);end;procedure TfrmGL.WMPaint(var Msg: TWMPaint);var ps : TPaintStruct;begin BeginPaint (Handle,

21、ps); glClear (GL_COLOR_BUFFER_BIT or GL_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;procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);begi

22、n If Key = VK_ESCAPE then Close else if Key = 38 then ZoomOut else if Key = 40 then ZoomIn;end;procedure TfrmGL.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin If mdown then begin anglex:=anglex+(y-ym); angley:=angley+(x-xm); InvalidateRect(Handle, nil, False); end; if bRBtnD

23、own then begin 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;procedure TfrmGL.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if Button = mbLeft then

24、begin mdown := false; end else if Button = mbRight then begin bRBtnDown := FALSE; end;end;procedure TfrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if Button = mbLeft then begin mdown:=true; end else if Button = mbRight then begin bRBtnDown := TRU

25、E; end; xm:=x; ym:=y;end;procedure TfrmGL.SetDCPixelFormat;var nPixelFormat: Integer; pfd: TPixelFormatDescriptor;begin FillChar(pfd, SizeOf(pfd), 0); pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; nPixelFormat := ChoosePixelFormat(DC, pfd); SetPixelFormat(DC, nPixelFor

26、mat, pfd);end;procedure TfrmGL.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);begin glViewPort (0, 0, ClientWidth, ClientHeight); glMatrixMode(GL_PROJECTION); glLoadIdentity; gluPerspective(50.0, ClientWidth / ClientHeight, 0.01, 5000.0); glMatrixMode(GL_MODELV

27、IEW); 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); g

28、lEnable(GL_CULL_FACE);end;procedure TfrmGL.N14Click(Sender: TObject);begin glEnable(GL_LIGHTING); InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N15Click(Sender: TObject);begin gldisable(GL_LIGHTING); InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N11Click(Sender: TObject);begin My

29、Mesh.MeshConfig.smt:=true; InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N12Click(Sender: TObject);begin MyMesh.MeshConfig.smt:=false; InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N7Click(Sender: TObject);begin glenable (GL_COLOR_MATERIAL); InvalidateRect(Handle, nil, False);end;procedure TfrmGL.Grayface2Click(Sender: TObject);begin glColor3f(0.5,0.5,0.5); gldisable (GL_COLOR_MATERIAL); InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N3Click(Sender: TObject);begin Close;end;procedure Tfrm