㊣请问TGLPanel在何处下载?(50分)

  • 主题发起人 wantsinewy
  • 开始时间
W

wantsinewy

Unregistered / Unconfirmed
GUEST, unregistred user!
如题!谢谢!
 
opengl的吗?
有的话给我发一份
 
wantsinewy你的email?
 
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 }
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);
glOrtho(-1, 1, -1, 1, -1, 50);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glEnable(GL_DEPTH_TEST);
glEnable(GL_COLOR_MATERIAL);
glShadeModel(GL_SMOOTH);
gluLookAt(2, 4, 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.
 
接受答案了.
 
顶部