OpenGL inicializálása |
Top Previous Next |
Ez egy példa arra, hogy egy teljes formot hogyan alkalmazhatunk OpenGL felületként; A Draw rutinba írhatod meg a saját grafikus utasításaidat.
unit gl_1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, JPeg, ExtCtrls;
type
PPixelArray = ^TPixelArray; TPixelArray = array [0..0] of Byte;
TPoint2d = record x,y: double; end;
TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyPress(Sender: TObject; var Key: Char); private FZoom: double; FRotAngle: double; FCentrum: TPoint2d; procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND; function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; Procedure CMChildkey( Var msg: TCMChildKey ); message CM_CHILDKEY; procedure SetZoom(const Value: double); procedure SetRotAngle(const Value: double); procedure SetCentrum(const Value: TPoint2d); private DC: HDC; hrc: HGLRC; Tex: cardinal; oLeft,oRight,oBottom,oTop : double; x,y: double; procedure SetDCPixelFormat; procedure Draw; function CreateTexture(Texture: String): cardinal; public property Centrum: TPoint2d read FCentrum write SetCentrum; property Zoom: double read FZoom write SetZoom; property RotAngle: double read FRotAngle write SetRotAngle; end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); begin Initopengl; DC := GetDC(Handle);
SetDCPixelFormat; hrc := wglCreateContext(DC); wglMakeCurrent(DC, hrc);
glShadeModel(GL_SMOOTH); glEnable(GL_TEXTURE_2D); glEnable(GL_ALPHA_TEST); glEnable(GL_BLEND); glBlendFunc(GL_ONE,GL_ONE);
glMatrixMode(GL_PROJECTION); glViewport(0, 0, ClientWidth, ClientHeight);
FCentrum.x := 0; FCentrum.y := 0; oLeft:=-10; oRight:=10; oBottom:=-10; oTop := 10; FZoom := 0.5; FRotAngle := 0; x:=0; y:=0; end;
procedure TForm1.FormActivate(Sender: TObject); begin // Tex := CreateTexture('Texture.jpg'); end;
procedure TForm1.FormDestroy(Sender: TObject); begin wglMakeCurrent(0, 0); wglDeleteContext(hrc); ReleaseDC(Handle, DC); closeopengl; end;
procedure TForm1.SetDCPixelFormat; var nPixelFormat: Integer; pfd: TPixelFormatDescriptor; begin FillChar(pfd, SizeOf(pfd), 0);
with pfd do begin nSize := sizeof(pfd); nVersion := 1; dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; iPixelType:= PFD_TYPE_RGBA; cColorBits:= 16; cDepthBits:= 16; iLayerType:= PFD_MAIN_PLANE; end;
nPixelFormat := ChoosePixelFormat(DC, @pfd); SetPixelFormat(DC, nPixelFormat, @pfd);
end;
procedure TForm1.Draw; var ps : TPaintStruct; begin BeginPaint(Handle, ps); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glLoadIdentity();
// Draw a Rectangle glColor3d(1,0,0); glTranslatef(x,y,1); glRotatef(FRotAngle,0,0,1); glRectf(1.1,1.1,-1.1,-1.1);
glBegin(GL_LINE_STRIP);
glEnd;
glPopMatrix; SwapBuffers(DC); EndPaint(Handle, ps); end;
procedure TForm1.WMPaint(var Msg: TWMPaint); begin FormResize(nil); end;
procedure TForm1.FormResize(Sender: TObject); begin if (Height=0) then Height:=1; glViewport(0, 0, Width, Height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); gluOrtho2d(oLeft,oRight,oBottom,oTop); glMatrixMode(GL_MODELVIEW); Draw; end;
function TForm1.CreateTexture(Texture : String): cardinal; var bitmap: TBitmap; BMInfo : TBitmapInfo; I, ImageSize : Integer; Temp : Byte; MemDC : HDC; Picture: TJpegImage; Tex: PPixelArray; begin glenable(GL_TEXTURE_2D); glGenTextures(1, @Result); glBindTexture(GL_TEXTURE_2D, Result);
Bitmap:=TBitMap.Create; Picture:=TJpegImage.Create;
Picture.LoadFromFile(Texture); Bitmap.Assign(Picture); with BMinfo.bmiHeader do begin FillChar (BMInfo, SizeOf(BMInfo), 0); biSize := sizeof (TBitmapInfoHeader); biBitCount := 24; biWidth := Picture.Width; biHeight := Picture.Height; ImageSize := biWidth * biHeight; biPlanes := 1; biCompression := BI_RGB;
MemDC := CreateCompatibleDC (0); GetMem (Tex, ImageSize *3); try GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Tex, BMInfo, DIB_RGB_COLORS); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER,GL_LINEAR); glTexImage2d(GL_TEXTURE_2D, 0, 3, biwidth, biheight, 0, GL_BGR_EXT, GL_UNSIGNED_BYTE, tex); For I := 0 to ImageSize - 1 do begin Temp := tex [I * 3]; tex [I * 3] := tex [I * 3 + 2]; tex [I * 3 + 2] := Temp; end; finally DeleteDC (MemDC); Bitmap.Free; Picture.Free; freemem(tex); end; end; end;
procedure TForm1.SetZoom(const Value: double); var dx,dy: double; begin dx := oRight - FCentrum.x; dy := oTop - FCentrum.y; oLeft := FCentrum.x-dx*FZoom/Value; oRight:= FCentrum.x+dx*FZoom/Value; oBottom := FCentrum.y-dy*FZoom/Value; oTop := FCentrum.y+dy*FZoom/Value; FZoom := Value; FormResize(nil); end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin Case Key of VK_ESCAPE : Close; VK_ADD : Zoom := Zoom*1.1; VK_SUBTRACT : Zoom := Zoom*0.9; end; end;
procedure TForm1.WMEraseBkGnd(var Message: TWMEraseBkGnd); begin Message.Result := 1 end;
procedure TForm1.SetRotAngle(const Value: double); begin FRotAngle := Value; invalidate; end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin Case Key of 'l' : RotAngle := FRotAngle+1; 'r' : RotAngle := FRotAngle-1; end; end;
procedure TForm1.CMChildkey(var msg: TCMChildKey); var dx,dy : double; k :double; begin k:=0.05; dx := 0; dy:=0; msg.result := 1; // declares key as handled Case msg.charcode of VK_LEFT : dx:=-k; VK_RIGHT : dx:=k; VK_UP : dy:=-k; VK_DOWN : dy:=k; else msg.result := 0; end; if (dx<>0) or (dy<>0) then begin x:=x+dx;y:=y+dy end; invalidate; end;
procedure TForm1.SetCentrum(const Value: TPoint2d); var dx,dy: double; begin dx := Value.x - FCentrum.x; dy := Value.y - FCentrum.y; oLeft := oLeft+dx; oRight:= oRight+dx; oBottom := oBottom+dy; oTop := oTop+dy; FCentrum := Value; invalidate; end;
function TForm1.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; begin if WheelDelta>0 then Zoom:=FZoom*1.1; if WheelDelta<0 then Zoom:=FZoom*0.9; end;
end.
|