www.pudn.com > 172020781.rar > frmMain.pas

 
 
unit frmMain; 
 
interface 
 
uses 
  Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Menus, 
  Controls, Dialogs, SysUtils, OpenGL, Mesh, TextureGL; 
 
type 
  TfrmGL = class(TForm) 
    MainMenu1: TMainMenu; 
    N1: TMenuItem; 
    OpenDialog: TOpenDialog; 
    NSmooth: TMenuItem; 
    pe: TMenuItem; 
    Wireframe1: TMenuItem; 
    N21: TMenuItem; 
    Dshebnmntrcnehs1: TMenuItem; 
    N2: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    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 N1Click(Sender: TObject); 
    procedure NSmoothClick(Sender: TObject); 
    procedure peClick(Sender: TObject); 
    procedure N3Click(Sender: TObject); 
    procedure Wireframe1Click(Sender: TObject); 
    procedure Dshebnmntrcnehs1Click(Sender: TObject); 
    procedure N21Click(Sender: TObject); 
    procedure N2Click(Sender: TObject); 
  private 
    DC: HDC; 
    hrc: HGLRC; 
    lastx, down : Integer; 
 
    procedure Init; 
    procedure SetDCPixelFormat; 
  protected 
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; 
  end; 
 
 
var 
  frmGL: TfrmGL; 
  Anglex,Angley,angle : GLfloat; 
  wrkX, wrkY,xm,ym : Integer; 
  MyMesh : TGLMesh1; 
 
  lf,nf:integer; 
  s:string; 
 
  lfps,prm,fps,zad:real; 
  sfps,s2:string[100]; 
 
  t1,t2:TTextureGl; 
  en:boolean; 
 
implementation 
 
{$R *.DFM} 
 
procedure TfrmGL.Init; 
begin 
 glEnable(GL_DEPTH_TEST); 
 glEnable(GL_LIGHTING); 
 glEnable(GL_LIGHT0); 
 gldisable (GL_COLOR_MATERIAL); 
 gldisable (GL_NORMALIZE); 
 
 glEnable(GL_CULL_FACE); 
 glcullface(gl_back); 
 
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 (-90, 1.0,0.0 , 0.0); 
 
      glRotatef (-90, 0.0,0.0 , 1.0); 
 
      glRotatef (Angley, 0.0,1.0 , 0.0); 
      glRotatef (Anglex, 0.0,0.0 , 1.0); 
      MyMesh.Draw; // Рисуем объект 
 
      glRotatef (angle*100, 1.0,0.0 , 0.0); 
      glTranslatef(0.0, 2.0, 0); 
 
    glPopMatrix; 
 
    SwapBuffers (DC); 
  EndPaint (Handle, ps); 
 
  prm:=gettickcount;          //Смотрю на часы 
  if prm-zad>100 then 
  begin 
    fps:=1000/(prm-lfps); 
    str(fps:7:4,s); 
    sfps:='Fps: '+s; 
    str(mymesh.cFcs,s2); 
    frmGL.Caption:='3D Prog by BoogeMan (BoogeSoft@yandex.ru)  Triangles: '+s2+'  '+sfps; 
    zad:=prm; 
  end; 
  lfps:=prm; 
 
 
  InvalidateRect(Handle, nil, False); 
end; 
 
{======================================================================= 
Создание окна} 
procedure TfrmGL.FormCreate(Sender: TObject); 
begin 
  DC := GetDC(Handle); 
  SetDCPixelFormat; 
  hrc := wglCreateContext(DC); 
  wglMakeCurrent(DC, hrc); 
  glClearColor (0.0, 0.0, 0.0, 1.0); 
  down := 0; 
  Init; 
  MyMesh := TGLMesh1.Create; 
  MyMesh.LoadFromFile_lst( 'man' ); 
  MyMesh.mCfg.mde:=gl_triangles; 
 
  t2:=TTextureGl.Create; 
  t2.LoadFrom_bmp_File1('textyr1.bmp'); 
 
  t1:=TTextureGl.Create; 
  t1.LoadFrom_bmp_File1('textyr2.bmp'); 
end; 
 
{======================================================================= 
Изменение размеров окна} 
procedure TfrmGL.FormResize(Sender: TObject); 
begin 
 glViewPort (0, 0, ClientWidth, ClientHeight); 
 glMatrixMode(GL_PROJECTION); 
 glLoadIdentity; 
 gluPerspective(40.0, ClientWidth / ClientHeight, 3.0, 30.0); 
 glMatrixMode(GL_MODELVIEW); 
 glLoadIdentity; 
 glTranslatef(0.0, 0.0, -15.0); 
 InvalidateRect(Handle, nil, False); 
end; 
 
procedure TfrmGL.FormDestroy(Sender: TObject); 
begin 
 mymesh.clear; 
 wglMakeCurrent(0, 0); 
 wglDeleteContext(hrc); 
 ReleaseDC(Handle, DC); 
 DeleteDC (DC); 
end; 
 
procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  If Key = VK_ESCAPE then Close; 
end; 
 
procedure TfrmGL.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
begin 
  If down <> 0 then begin 
    anglex:=anglex+(x-xm); 
    angley:=angley+(y-ym); 
  end; 
  xm:=x;ym:=y; 
end; 
 
procedure TfrmGL.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  down := 0; 
end; 
 
procedure TfrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
 If button = mbLeft then begin 
    lastx := X; 
    wrkX := X; 
    wrkY := Y; 
    down := 1; 
 end; 
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.N1Click(Sender: TObject); 
begin 
  if OpenDialog.Execute then 
    begin 
      Mymesh.clear; 
      //Mymesh := TGLMesh1.Create; 
      MyMesh.LoadFromFile_lst(OpenDialog.FileName); 
      //myMesh.Save_To_file_lst(OpenDialog.FileName+'lst'); 
    end; 
end; 
 
procedure TfrmGL.NSmoothClick(Sender: TObject); 
begin 
  mymesh.MCfg.smt:=not mymesh.MCfg.smt; 
end; 
 
procedure TfrmGL.peClick(Sender: TObject); 
begin 
  glTexGenf(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); 
  glTexGenf(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); 
  glEnable(GL_TEXTURE_GEN_S); 
  glEnable(GL_TEXTURE_GEN_T); 
  t1.Enable; 
end; 
 
procedure TfrmGL.N3Click(Sender: TObject); 
begin 
  mymesh.MCfg.mde:=gl_line_loop 
end; 
 
procedure TfrmGL.Wireframe1Click(Sender: TObject); 
begin 
  if mymesh.MCfg.mde=gl_line_loop then  mymesh.MCfg.mde:=gl_triangles else 
  if mymesh.MCfg.mde=gl_triangles then  mymesh.MCfg.mde:=gl_line_loop; 
end; 
 
procedure TfrmGL.Dshebnmntrcnehs1Click(Sender: TObject); 
begin 
  gldisable(GL_TEXTURE_GEN_S); 
  gldisable(GL_TEXTURE_GEN_T); 
  t1.disable; 
  t2.disable; 
end; 
 
procedure TfrmGL.N21Click(Sender: TObject); 
begin 
  glTexGenf(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); 
  glTexGenf(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); 
  glEnable(GL_TEXTURE_GEN_S); 
  glEnable(GL_TEXTURE_GEN_T); 
  t2.Enable; 
end; 
 
procedure TfrmGL.N2Click(Sender: TObject); 
begin 
  close; 
end; 
 
end.