三維演示系統(tǒng)[呂雪松].docx

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); 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: 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(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: 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);beginClose;end;procedure TMainForm.N26Click(Sender: TObject);begin/GLChild := TfrmGL.Create(Application, );end;procedure TMainForm.N30Click(Sender: TObject);beginTileMode := tbVertical;Tile;end;procedure TMainForm.N31Click(Sender: TObject);beginCascade;end;procedure TMainForm.N8Click(Sender: TObject);beginif MDIChildCount 0 then beginGLChild.MyMesh.MeshConfig.mode:= gl_triangles; InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N9Click(Sender: TObject);beginif MDIChildCount 0 then beginGLChild.MyMesh.MeshConfig.mode:= gl_Line_loop; InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N16Click(Sender: TObject);beginend;procedure TMainForm.N21Click(Sender: TObject);beginwith 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.Selected.SubItems1); end; Free; end;end;procedure TMainForm.N14Click(Sender: TObject);beginif MDIChildCount 0 then begin glEnable(GL_LIGHTING); InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N15Click(Sender: TObject);beginif MDIChildCount 0 then beginglDisable(GL_LIGHTING); InvalidateRect(GLChild.Handle, nil, False); end;end;procedure TMainForm.N1Click(Sender: TObject);beginif (MDIChildCount 0) and (not Assigned(GLChild.MyMesh.Root) then beginGLChild.MyMesh.BuildTree; end;end;procedure TMainForm.FormCreate(Sender: TObject);beginend;end.unit frmDEMCollection;interfaceuses 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 Create(AOwner : TComponent); procedure LoadDEMCollection(sPath : string); end;implementation$R *.dfm TDEMCollectionForm constructor TDEMCollectionForm.Create(AOwner: TComponent);begininherited; LoadDEMCollection(sSysPath);end;procedure TDEMCollectionForm.LoadDEMCollection(sPath : string);varF : TextFile; sBuf : string; Item : TListItem;beginAssignFile(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(F);end;procedure TDEMCollectionForm.Button1Click(Sender: TObject);beginClose;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;type 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(Sender: 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(Sender: 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: TShiftState; 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: TWMPaint); message WM_PAINT; publicMyMesh : 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, dLength : 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, 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);begin 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 bRBtnDown 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 begin mdown := false; end else if Button = mbRight then beginbRBtnDown := FALSE; end;end;procedure TfrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);beginif Button = mbLeft then begin mdown:=true; end else if Button = mbRight then beginbRBtnDown := TRUE; 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, nPixelFormat, 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_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;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);beginMyMesh.MeshConfig.smt:=true; InvalidateRect(Handle, nil, False);end;procedure TfrmGL.N12Click(Sender: TObject);beginMyMesh.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);beginClose;end;procedure TfrmGL.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);beginZoomIn;end;procedure TfrmGL.ZoomIn;begindLength := 0.1;gluLookAt(0,0,dLength,0,0,-100,0,1,0); InvalidateRect(Handle, nil, false);end;procedure TfrmGL.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);beginZoomOut;end;procedure TfrmGL.ZoomOut;egindLength := -0.1;gluLookAt(0,0,dLength,0,0,-100,0,1,0); InvalidateRect(Handle, nil, false);end;function TfrmGL.DoSelect(X, Y: integer): integer; var selectBuff : Array0.BUFSIZE of glUint;begin glGetIntegerv(GL_VIEWPORT, viewP); / Viewport = 0, 0, width, height glSelectBuffer(BUFSIZE, selectBuff); glRenderMode(GL_SELECT); glInitNames; glPushName(0); glMatrixMode(GL_PROJECTION); glPushMatrix(); glLoadIdentity(); gluPickMatrix(x, ClientHeight - y, 5, 5, viewP); / Set-up pick matrix gluPerspective(45, ClientWidth / ClientHeight, -100, -100); / Do the perspective calculations. Last value = max clipping depth glMatrixMode(GL_MODELVIEW); glMatrixMode(GL_PROJECTION); glPopMatrix(); glMatrixMode(GL_MODELVIEW); if glRenderMode(GL_RENDER)0 then result:= selectBuff3 else result:= -1; caption := floattostr(result) + objs selected!end;procedure TfrmGL.Button1Click(Sender: TObject);varn : GLINT;beginglGetIntegerV(GL_NAME_STACK_DEPTH, n); ShowMessage(IntToStr(n);end;constructor TfrmGL.Create(AOwner: TComponent; sDem, sIMG: string);begininherited Create(AOwner); DC := GetDC(Handle); SetDCPixelFormat; hrc := wglCreateContext(DC); wglMakeCurrent(DC, hrc); glClearColor (0.0, 0.0, 0.0, 1.0); Init; anglex:= 20;myMesh := TGeo3DMesh.Create(sDEM, sIMG); myMesh.MeshConfig.mode:=gl_triangles;myMesh.MeshConfig.clr:=true; myMesh.MeshConfig.txt:=true; mymesh.BuildTree;end;destructor TfrmGL.Destroy;begin Mymesh.Free; wglMakeCurrent(0, 0); wglDeleteContext(hrc); ReleaseDC(Handle, DC); DeleteDC (DC); inherited;end;procedure TfrmGL.FormClose(Sender: TObject; var Action: TCloseAction);beginAction := caFree;end;end.unit Global;interfaceusesSysUtils,dialogs;function GetStrItem(SourStr : string;Border : Char;Index : integer):string;var sSysPath : string;implementationfunction GetStrItem(SourStr : string;Border : Char;Index : integer):string;varTempStr : string; I : integer;beginTempStr := SourStr;if Pos(Border,SourStr)=0 then Result := else begin try for I := 1 to Index - 1 do begin if Pos(Border,TempStr) = 0 then begin Result := ; Exit;end; Delete(TempStr,1,Pos(Border,TempStr); TempStr := Trim(TempStr); end;except ShowMessage(Have not such Index!); result := ; Exit; end; if Pos(Border,TempStr)=0 then Result := TempStr elseResult := Copy(TempStr,1,Pos(Border,TempStr) - 1); end;end;end.unit Mesh;interfaceuses Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Menus, Math, Controls, Dialogs, SysUtils, OpenGL,TextureGL;Type TGeo3DMesh = class; TGeoRect = record dLeft, dTop, dRight, dBottom : double; end; PGeo3DPt = TGeo3DPt; TGeo3DPt = record dX, dY,dZ : glfloat; end; TGeo3DPtArray = array of TGeo3DPt; /四叉樹方式的點樹結(jié)構(gòu) TGeoMeshNode = class public Mesh : TGeo3DMesh; nLevel : integer;/第幾級 nXWidth, nYWidth : integer; Pts : TList; dOffset : single;/高程值的判斷閾值 SubNodes : TList; constructor Create(_Mesh : TGeo3DMesh); destructor Destroy;override; procedure Draw(MODE: glenum); procedure CalcSubRoot; end; TGLNrm=array0.2 of glfloat; TGLvrt=record crd:TGLNrm; nrm:TGLNrm; clr:TGLNrm; txt:array0.1 of glfloat; end; TGLfcs=record vrt:array0.2of word; nrm:TGLNrm; end;TMeshConfig = record smt:boolean; clr:boolean; txt:boolean; mode:glenum;/圖形類型，線、點，多邊形等 fa : Boolean;/是否顯示法向量nCellCount : integer; dBaseHeight : single; end;/三維模型核心 TGeo3DMesh = class public Base,TexBmp : TBitmap; /所有網(wǎng)格上的點 Pts : Array of TGeo3DPt; nXWidth, nYWidth : integer;/水平方向的網(wǎng)格數(shù)，缺省為125*125 Root : TGeoMeshNode; procedure GetDataFromVtrs; procedure ClearRootPts;public Texture : TTextureGl; MeshConfig : TMeshConfig; cVrt:longint; /暑? 怵. cFcs:longint; /暑? 沭. Vrts:array of TGLVrt; /銻耨椏 忮瘌檜 Fcss:array of TGLFcs; /銻耨椏 沭囗彘 MeshRect : TGeoRect; MinH, MaxH : glfloat; / 記錄當前范圍的最大值和最小值 ShowMinRange, ShowMaxRange : glfloat; / 記錄顯示范圍的0, 1 bShowRange : Boolean; / 是否只顯示設(shè)定范圍內(nèi)的信息 constructor Create(BB, TB : string); destructor Destroy;override; procedure CalcRect; procedure calc_normals_fr; procedure calc_normals_sm; procedure filter_rs(x,y,z:glfloat); procedure filter_sd(x,y,z:glfloat); procedure load_lst_obj(var f:textfile); procedure load_gms_obj(var f:textfile); procedure Save_Lst_obj(var f:textfile); procedure LoadTexture(BMP : TBitmap); procedure loadfromfile_lst(filename:string); procedure loadfromfile_gms(filename:string); procedure Save_To_file_lst(filename:string); /從位圖得到Mesh的高程和顏色值 procedure CreateMeshFromBitmap(nWidth,nheight,mash:glfloat;cpw,cph:byte;var b:tbitmap);overload; procedure CreateMeshFromBitmap(b:tbitmap);overload; function gt_ln(x1,y1,z1,x2,y2,z2:real;var code:boolean):tGlnrm; procedure draw; Procedure CalRange; /建立四叉樹 procedure BuildTree; end; function get_Normal_fl(var p1,p2,p3:TGLNrm):TGLNrm; function get_j(r,g,b:glfloat):glfloat; function PixelInOtr(x1,x2,x:glfloat):boolean; function get_dl_line(x1,y1,z1,x2,y2,z2:glfloat):glfloat; function g_ang(x,y:glfloat):real; function pt_in_tr(x1,y1,x2,y2,x3,y3,x,y:glfloat):boolean; function getpoint(p1,p2,pt1:TGLnrm;nrm:TGLnrm):TGLnrm; procedure rotate_point(angle:glfloat;var x,y:glfloat); Procedure GetCoords(x1,y1,x2,y2,x3,y3,x4,y4:real; Var x,y : glfloat; code:boolean);implementationfunction getNormal(x1,y1,z1,x2,y2,z2,x3,y3,z3 : glfloat):TGLArrayf3;var wrki, vx1, vy1, vz1, vx2, vy2, vz2 : GLfloat; nx, ny, nz : GLfloat; wrkVector : tpoint; f:textfile;begin vx1 := x1 - x2; vy1 := y1 - y2; vz1 := z1 - z2; vx2 := x2 - x3; vy2 := y2 - y3; vz2 := z2 - z3; nx := vy1 * vz2 - vz1 * vy2; ny := vz1 * vx2 - vx1 * vz2; nz := vx1 * vy2 - vy1 * vx2; wrki := sqrt (nx * nx + ny * ny + nz * nz); If wrki = 0 then wrki := 1;result0 := nx/ wrki;result1 := ny/ wrki;result2 := nz/ wrki;end;var a,b