unit1.pas

3D火焰效果好程序好的很

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, model, OpenGL, Textures;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    rc : HGLRC;    // Rendering Context
    dc  : HDC;     // Device Context

    ElapsedTime, DemoStart, LastTime : DWord;
    YRot, XRot     : glFloat;    // Y Rotation
    Depth  : glFloat;
    Xcoord, Ycoord, Zcoord : Integer;
    MouseButton : Integer;
    WireFrame  : Boolean;
    procedure glDraw;
    procedure Idle(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Player : Q3Player;
  Weapon : TMD3Model;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;


{------------------------------------------------------------------}
{  Function used to load a railgin and join it to the player       }
{------------------------------------------------------------------}
procedure LoadRailgun;

  procedure LoadMeshTexture(const imagename, meshname : String);
  var I : Integer;
  begin
    // Find the right mesh item to assign the skin to
    for I :=0 to Weapon.header.numMeshes-1 do
    begin
      // check it the two names are the same
      if UpperCase(CharArrToStr(Weapon.meshes[i].MeshHeader.Name)) = Uppercase(meshname) then
      begin
        LoadTexture(ImageName, Weapon.meshes[i].Texture, FALSE);
        Weapon.meshes[i].SetTexture :=TRUE;
      end;
    end;
  end;

begin
  Weapon.LoadModel('model\railgun\railgun.md3');

  LoadMeshTexture('model\railgun\railgun1.jpg',      'w_railgun1');
  LoadMeshTexture('model\railgun\railgun2.glow.jpg', 'w_railgun2');
  LoadMeshTexture('model\railgun\railgun4.jpg',      'w_railgun4');
  LoadMeshTexture('model\railgun\railgun3.glow.jpg', 'w_railgun3');
  LoadMeshTexture('model\railgun\railgun1.jpg',      'w_railgun05');

  Player.Upper.LinkModel('tag_weapon', Weapon);
end;


{------------------------------------------------------------------}
{  Function to draw the actual scene                               }
{------------------------------------------------------------------}
procedure TForm1.glDraw();
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    // Clear The Screen And The Depth Buffer
  glLoadIdentity();                                       // Reset The View

  glTranslatef(0.0, -10.0, Depth);

  glRotatef(xRot, 1, 0, 0);
  glRotatef(yRot, 0, 0, 1);

  Player.Draw(ElapsedTime/1000);
end;


{------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
var pfd : TPIXELFORMATDESCRIPTOR;
    pf  : Integer;
begin
  // OpenGL initialisieren
  dc:=GetDC(Panel2.Handle);

  // PixelFormat
  pfd.nSize:=sizeof(pfd);
  pfd.nVersion:=1;
  pfd.dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER or 0;
  pfd.iPixelType:=PFD_TYPE_RGBA;      // PFD_TYPE_RGBA or PFD_TYPEINDEX
  pfd.cColorBits:=32;

  pf :=ChoosePixelFormat(dc, @pfd);   // Returns format that most closely matches above pixel format
  SetPixelFormat(dc, pf, @pfd);

  rc :=wglCreateContext(dc);    // Rendering Context = window-glCreateContext
  wglMakeCurrent(dc,rc);        // Make the DC (Form1) the rendering Context


  glClearColor(0.0, 0.0, 0.0, 0.0); 	   // Black Background
  glShadeModel(GL_SMOOTH);                 // Enables Smooth Color Shading
  glClearDepth(1.0);                       // Depth Buffer Setup
  glEnable(GL_DEPTH_TEST);                 // Enable Depth Buffer
  glDepthFunc(GL_LESS);		           // The Type Of Depth Test To Do

  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);   //Realy Nice perspective calculations

  glEnable(GL_TEXTURE_2D);                     // Enable Texture Mapping

  xRot :=-90;
  yRot :=-85;
  Depth :=-110;
  DemoStart :=GetTickCount();

  Player.LoadPlayer('model\sarge\', 'default');
  LoadRailgun;

  ComboBox1.ItemIndex :=11;
  ComboBox2.ItemIndex :=7;

  Application.OnIdle := Idle;
end;


{------------------------------------------------------------------}
{------------------------------------------------------------------}
procedure TForm1.Idle(Sender: TObject; var Done: Boolean);
begin
  Done := FALSE;

  LastTime :=ElapsedTime;
  ElapsedTime :=GetTickCount() - DemoStart;     // Calculate Elapsed Time
  ElapsedTime :=(LastTime + ElapsedTime) DIV 2; // Average it out for smoother movement

  glDraw();                         // Draw the scene
  SwapBuffers(DC);                  // Display the scene
end;


{------------------------------------------------------------------}
{------------------------------------------------------------------}
procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, Panel2.Width, Panel2.Height);    // Set the viewport for the OpenGL window
  glMatrixMode(GL_PROJECTION);        // Change Matrix Mode to Projection
  glLoadIdentity();                   // Reset View
  gluPerspective(45.0, Panel2.Width/Panel2.Height, 1.0, 500.0);  // Do the perspective calculations. Last value = max clipping depth

  glMatrixMode(GL_MODELVIEW);         // Return to the modelview matrix
end;


{------------------------------------------------------------------}
{------------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(0,0);
  wglDeleteContext(rc);
end;


{------------------------------------------------------------------}
{---  Change torso animation                                    ---}
{------------------------------------------------------------------}
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  if ComboBox1.ItemIndex < 6 then   // both have to have death at same time
    ComboBox2.ItemIndex :=ComboBox1.ItemIndex
  else
  begin
    if ComboBox2.ItemIndex < 6 then
    begin
      ComboBox2.ItemIndex := 15;
      Player.SetAnim(ComboBox2.ItemIndex+7);
    end;
  end;

  Player.SetAnim(ComboBox1.ItemIndex);
end;


{------------------------------------------------------------------}
{---  Change leg animation                                      ---}
{------------------------------------------------------------------}
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  if ComboBox2.ItemIndex > 5 then
  begin
    if ComboBox1.ItemIndex < 6 then    // cant have legs walking and head dying
    begin
      ComboBox1.ItemIndex :=TORSO_STAND;
      Player.SetAnim(ComboBox1.ItemIndex);
    end;
    Player.SetAnim(ComboBox2.ItemIndex+7);
  end
  else
  begin
    ComboBox1.ItemIndex :=ComboBox2.ItemIndex;
    Player.SetAnim(ComboBox2.ItemIndex);
  end
end;


{------------------------------------------------------------------}
{---  Got to from texture to texture wireframe to wireframe     ---}
{------------------------------------------------------------------}
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.State = cbGrayed then
    glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
  else
  if CheckBox1.State = cbChecked then
    GlDisable(GL_TEXTURE_2D)
  else
  begin
    GLEnable(GL_TEXTURE_2D);
    glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
  end;
end;


{------------------------------------------------------------------}
{------------------------------------------------------------------}
procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if MouseButton = 1 then
  begin
    xRot := xRot + (Y - Ycoord)/2;  // moving up and down = rot around X-axis
    yRot := yRot + (X - Xcoord)/2;
    Xcoord := X;
    Ycoord := Y;
  end;
  if MouseButton = 2 then
  begin
    Depth :=Depth - (Y-ZCoord)/3;
    Zcoord := Y;
  end;
end;


{------------------------------------------------------------------}
{------------------------------------------------------------------}
procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft  then
  begin
    MouseButton :=1;
    Xcoord := X;
    Ycoord := Y;
  end;
  if Button = mbRight then
  begin
    MouseButton :=2;
    Zcoord := Y;
  end;
end;

procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseButton :=0;
end;

end.