用户登录
用户注册

分享至

opengl delphi

  • 作者: 毕竟是凡人
  • 来源: 51数据库
  • 2020-10-05
OpenGL(全写Open Graphics Library)是指定义了一个跨编程语言、跨平台的编程接口规格的专业的图形程序接口。它用于三维图像(二维的亦可),是一个功能强大,调用方便的底层图形库。
Delphi,是Windows平台下著名的快速应用程序开发工具。它的前身是DOS时代盛行一时的“Borland Turbo
Pascal”,最早的版本由美国Borland(宝兰)公司于1995年开发。主创者为Anders
Hejlsberg。经过数年的发展,此产品也转移至Embarcadero公司旗下。Delphi是一个集成开发环境(IDE),使用的核心是由传统Pascal语言发展而来的Object Pascal,以图形用户界面(Graphical User Interface,简称GUI)为开发环境,通过IDE、VCL工具与编译器,配合链接数据库的功能,构成一个以面向对象程序设计为中心的应用程序开发工具。Delphi所编译的可执行文件,虽然容量较大,但因为产生的是真正的原生机器码,性能上比较快速。除了使用数据库的程序之外,不需安装即可运行,在使用上相当方便。



  glpanel也能用,下面是源码,给大家共享:
unit glpanel;
interface
uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
extctrls,opengl,printers;

type
tglpanel = class(tcustompanel)
private
{ private declarations }
//dc: hdc;
rc: hglrc;
procedure initdc;
procedure initgl;
procedure preparepixelformat(var dc: hdc);

protected
{ protected declarations }
fonpaint:tnotifyevent;
foninit:tnotifyevent;
fonpreinit:tnotifyevent;
fonresize:tnotifyevent;

procedure paint;override;
procedure resize;override;
procedure wmdestroy(var msg: twmdestroy);message wm_destroy;
procedure wmcreate(var msg:twmcreate); message wm_create;

public
{ public declarations }
dc: hdc;
constructor create(owner:tcomponent);override;
procedure savetobmpfile(filename: string);
procedure printit;

published
{ published declarations }

property alignment;
property align;
property dragcursor;
property dragmode;
property enabled;
property parentfont;
property parentshowhint;
property popupmenu;
property showhint;
property taborder;
property tabstop;
property visible;

property onclick;
property ondblclick;
property ondragdrop;
property ondragover;
property onenddrag;
property onenter;
property onexit;
property onmousedown;
property onmousemove;
property onmouseup;
property onstartdrag;

property oninit:tnotifyevent read foninit write foninit;
property onpreinit:tnotifyevent read fonpreinit write fonpreinit;

property onresize:tnotifyevent read fonresize write fonresize;
property onpaint:tnotifyevent read fonpaint write fonpaint;

end;

procedure register;

implementation

procedure register;
begin
registercomponents('samples', [tglpanel]);
end;
//---------------------------------------------
constructor tglpanel.create;
begin
inherited;
end;
//---------------------------------------------
procedure tglpanel.wmdestroy(var msg: twmdestroy);
begin
wglmakecurrent(0, 0);
wgldeletecontext(rc);
releasedc(handle, dc);
end;
//---------------------------------------------------
procedure tglpanel.initdc;
begin
dc := getdc(handle);
preparepixelformat(dc);
end;
procedure tglpanel.initgl;
begin
glclear(gl_color_buffer_bit or gl_depth_buffer_bit);
glmatrixmode(gl_projection);
glloadidentity;
glenable(gl_lighting);
glenable(gl_light0);
gluperspective(45.0, self.clientwidth/self.clientheight, 1.0, 500.0);
//glortho(-1, 1, -1, 1, -1, 50);
glmatrixmode(gl_modelview);
glloadidentity;
glenable(gl_depth_test);
glenable(gl_color_material);
glshademodel(gl_smooth);
glulookat(0, 0, 6, 0, 0, 0, 0, 1, 0);
swapbuffers(dc);
end;
//---------------------------------------------
procedure tglpanel.preparepixelformat(var dc: hdc);
var
pfd : tpixelformatdescriptor;
chosenpixelformat : integer;
begin
fillchar(pfd, sizeof(tpixelformatdescriptor), 0);

with pfd do
begin
nsize := sizeof(tpixelformatdescriptor);
nversion := 1;
dwflags := pfd_draw_to_window or
pfd_support_opengl or
pfd_doublebuffer;
ipixeltype := pfd_type_rgba;
ccolorbits := 16; // 16位颜色
cdepthbits := 32; // 32位深度缓冲
ilayertype := pfd_main_plane;
{ should be 24, but we must allow for the clunky wku boxes }
end;

chosenpixelformat := choosepixelformat(dc, @pfd);
if chosenpixelformat = 0 then
raise exception.create('choosepixelformat failed!');
setpixelformat(dc, chosenpixelformat, @pfd);
end;

procedure tglpanel.wmcreate(var msg:twmcreate);
begin
//在这里做初始化工作
//修改dc的象素格式,使之支持opengl绘制
initdc;
rc := wglcreatecontext(dc);
if assigned(foninit) then
begin
if (wglmakecurrent(dc,rc)=false) then
showmessage('wglmakecurrent:' + inttostr (getlasterror));
foninit(self);
end;
wglmakecurrent(dc, rc);
//初始化gl绘制系统
initgl;
end;
//---------------------------------------------------------------------------
procedure tglpanel.paint;
begin
//tcustompanel::paint();
if assigned(fonpaint) then
begin
wglmakecurrent(dc,rc);
fonpaint(self);
swapbuffers(dc);
end;
end;
//---------------------------------------------------------------------------
procedure tglpanel.resize;
begin
inherited;
if assigned(fonresize) then
begin
wglmakecurrent(dc,rc);
glviewport(0,0,clientwidth,clientheight);
fonresize(self);
end;
end;
procedure tglpanel.savetobmpfile(filename: string);
var bitmap : tbitmap;
begin
bitmap:= tbitmap.create;
bitmap.height := height;
bitmap.width := width;
bringtofront;
paint;
bitmap.canvas.copyrect(clientrect ,canvas,clientrect);
bitmap.savetofile(filename);
//delete bitmap;
end;

procedure tglpanel.printit;
var
bitmap:tbitmap;
xpixelsperinch,ypixelsperinch:integer;
rect:trect;
printdlg:tprintdialog;
begin
printdlg:=tprintdialog.create(self);
if printdlg.execute then begin
bitmap := tbitmap.create;
bitmap.height:= height;
bitmap.width := width;
bringtofront;
paint;
bitmap.canvas.copyrect(clientrect,canvas,clientrect);
xpixelsperinch:=getdevicecaps(printer.handle,logpixelsx);
ypixelsperinch:=getdevicecaps(printer.handle,logpixelsy);
rect.left :=round(0.18*xpixelsperinch);
rect.top :=round(0.18*ypixelsperinch);
//根据需要调整right/bottom可以达到按比例打印或打满整纸等效果
//必要时可使用getdevicecaps(printer.handle,horzres/vertres)
//查询相关信息
rect.right :=bitmap.width+rect.left;
rect.bottom:=bitmap.height+rect.right;
printer.begindoc;
printer.canvas.copyrect(rect,bitmap.canvas,clientrect);
printer.enddoc;
end; //if(dlg.execute)
printdlg.destroy;
end;
end.
软件
前端设计
程序设计
Java相关