AL_GL

Top  Previous  Next

(*  AL_OpenGl  Delphi 5 komponens

 

   TCustomControl descendant OpenGL component for fast graphic

 

   Windowed control, with OpenGl properties;

   Some predefinied function:

        Keyboard:   + and -  : magnify;

                    R ang L  : Rotate Right and left;

        Mouse:      Dragging with pressed left mose button;

                    Magnifying with pressed right mose button;

                    Wheel for magnify;

 

   By: Agócs László StellaSOFT

*)

 

unit AL_GL;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls,

Forms, Dialogs, OpenGL, NewGeom, ClipBrd, Math, JPeg;

 

const

GLF_START_LIST = 100000;

 

type

PPixelArray = ^TPixelArray;

TPixelArray = array [0..0] of Byte;

 

TSzin = record

   R,G,B : double;

   width : integer;

end;

 

TShadeModel = (smFlat,smSmooth);

TEditMode   = (emView,emEdit);

 

TPaintEvent      = procedure(Sender: TObject) of object;

TChangeWindow    = procedure(Sender: TObject; Cent: TPoint2D;  Zoom: Double) of object;

 

TAL_OpenGL = class(TCustomControl)

private

   FCentralCross: boolean;

   FRotAngle: double;

   FZoom: extended;

   FChangeWindow: TChangeWindow;

   FClearColor: TColor;

   FOnPaint: TPaintEvent;

   FCentrum: TPoint2d;

   FShadeModel: TShadeModel;

   FOnInitGL: TNotifyEvent;

   FOnAfterPaint: TPaintEvent;

   FOnMouseLeave: TNotifyEvent;

   FOnMouseEnter: TNotifyEvent;

   FNotPaint: boolean;

   FCursorCross: boolean;

   FDblClickEnabled: boolean;

   procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;

   procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

   procedure WMSize(var Msg: TWMSize); message WM_SIZE;

   Procedure CMChildkey( Var msg: TCMChildKey ); message CM_CHILDKEY;

   procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;

   procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;

   procedure SetCentralCross(const Value: boolean);

   procedure SetCentrum(const Value: TPoint2d);

   procedure SetClearColor(const Value: TColor);

   procedure SetRotAngle(const Value: double);

   procedure SetShadeModel(const Value: TShadeModel);

   procedure SetZoom(const Value: extended);

   procedure SetDCPixelFormat;

   procedure Demo;

   function GetCanvas: TCanvas;

protected

   OpenGL_OK: boolean;           // OpenGL initialized

   origin,movept,oldmovept: TPoint;

   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

     X, Y: Integer); override;

   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

       procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

     X, Y: Integer); override;

   function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;

     MousePos: TPoint): Boolean; override;

   function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;

   function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;

   procedure KeyDown(var Key: Word;Shift: TShiftState); override;

   procedure KeyPress(var Key: Char); override;

   procedure DblClick;  override;

public

   DC: HDC;

   hrc : HGLRC;

   BackBMP: TBitmap;                  // For drawing in back

   OrtoLeft,OrtoRight,OrtoBottom,OrtoTop: double;

   SelRect : TRect;

   rSIN,rCOS : double;               // sin and cos of RotAngle;

   CursorPos : TPoint;

   MouseIn   : boolean;

 

   MapPoint      : TPoint2d;         // Actual map point coordinates

 

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

 

   procedure InitGL;

   procedure Paint; override;

   procedure ReDraw;

   procedure DrawCentralCross;

   procedure DrawCursorCross(p: TPoint); overload;

   procedure DrawCursorCross(x,y: integer); overload;

   procedure CopyToClipboard;

 

   // Coordinate functions

   function XToW(x: integer): double;

   function YToW(y: integer): double;

   function XToS(x: double): integer;

   function YToS(y: double): integer;

   function WToS(p: TPoint2d): TPoint;

   function SToW(p: TPoint): TPoint2d;

 

   function GetWorkArea:TRect2d;

 

   procedure MoveWindow(x, y: double);

   procedure ShiftWindow(x, y: double);

 

   procedure SBI;         // Save the current bitmap to BackBMP

   procedure LBI;         // Load the current bitmap from BackBMP

 

   // Drawing primitives

   procedure glColor(col: TColor);

   procedure glRectangle(p1,p2,p3,p4: TPoint2d);  overload;

   procedure glRectangle(p: TPoint2d; a,b: double); overload;

   procedure glCircle(u,v,r: double); overload;

   procedure glCircle(Cent: TPoint2d; r: double); overload;

   procedure glCircle(Cent,KerPoint: TPoint2d); overload;

   procedure glEllipse(p1,p2: TPoint2d);

   procedure glPrint(x,y,Height,Angle: double; text : string);

 

   // Texture

   function CreateTexture(Texture: String): cardinal;

   function CreateTextureFromBMP(Bitmap: TBitmap): cardinal;

 

   { FONT RUTINS }

   procedure InitFont(dc: HDC; Fontname: PChar);

   procedure Draw3DText(Text: String; X, Y, Z, AX, AY, AZ, Height: GLFloat);

 

   property Canvas        : TCanvas  read GetCanvas;

   property Centrum       : TPoint2d read FCentrum write SetCentrum;

   property NotPaint      : boolean  read FNotPaint write FNotPaint;

   property DblClickEnabled: boolean read FDblClickEnabled write FDblClickEnabled default True;

published

   property CentralCross  : boolean   read FCentralCross write SetCentralCross;

   property CursorCross   : boolean   read FCursorCross write FCursorCross;

   Property ClearColor    : TColor    read FClearColor write SetClearColor;

   property RotAngle      : double    read FRotAngle write SetRotAngle;

   property ShadeModel    : TShadeModel read FShadeModel write SetShadeModel;

   property Zoom          : extended  read FZoom write SetZoom;

   property OnChangeWindow: TChangeWindow read FChangeWindow write FChangeWindow;

   property OnInitGL      : TNotifyEvent read FOnInitGL write FOnInitGL;

   property OnMouseEnter  : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;

   property OnMouseLeave  : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

   property OnPaint       : TPaintEvent read FOnPaint write FOnPaint;

   property OnAfterPaint  : TPaintEvent read FOnAfterPaint write FOnAfterPaint;

   property Align;

   property Enabled;

   property Font;

   property TabStop;

   property OnClick;

   property OnDblClick;

   property OnDockDrop;

   property OnDockOver;

   property OnEnter;

   property OnExit;

   property OnGetSiteInfo;

   property OnKeyDown;

   property OnKeyPress;

   property OnKeyUp;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

   property OnMouseWheel;

   property OnMouseWheelDown;

   property OnMouseWheelUp;

   property OnResize;

   property OnUnDock;

end;

 

function ColorToSzin(c:TColor):TSzin;

 

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL', [TAL_OpenGL]);

end;

 

function ColorToSzin(c:TColor):TSzin;

begin

With Result do begin

R:=GetRValue(c)/255;

G:=GetGValue(c)/255;

B:=GetBValue(c)/255;

end;

end;

 

{ TALOpenGL }

 

constructor TAL_OpenGL.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

OpenGL_OK      := False;

BackBMP        := TBitmap.Create;

Canvas.Font.Name := 'Times New Roman';

width          := 200;

height         := 200;

OrtoLeft       := -10;

OrtoRight      := 10;

OrtoBottom     := -10;

OrtoTop        := 10;

fClearColor    := clWhite;

FCentralCross  := True;

FCentrum       := Point2d(0,0);

FZoom          := 2;

FShadeModel    := smSmooth;

FRotAngle      := 0;

DoubleBuffered := True;

FDblClickEnabled := True;

TabStop        := True;

NotPaint       := False;

MouseIn        := False;

end;

 

destructor TAL_OpenGL.Destroy;

begin

Try

BackBMP.Free;

wglMakeCurrent(0, 0);

wglDeleteContext(hrc);

inherited Destroy;

except

end;

end;

 

procedure TAL_OpenGL.InitGL;

begin

if not OpenGL_OK then

Try

Try

DC := GetDC(Handle);

 

SetDCPixelFormat;

hrc := wglCreateContext(DC);

wglMakeCurrent(DC, hrc);

 

glShadeModel(GL_SMOOTH);

glEnable(GL_TEXTURE_2D);

 

glEnable(GL_ALPHA_TEST);

glAlphaFunc(GL_GEQUAL,0.8);

 

glEnable(GL_BLEND);

glBlendFunc(GL_SRC_COLOR,GL_SRC_COLOR);

//  glBlendFunc(GL_ONE_MINUS_SRC_COLOR,GL_ONE_MINUS_SRC_COLOR);

 

glMatrixMode(GL_PROJECTION);

glViewport(0, 0, ClientWidth, ClientHeight);

 

except

OpenGL_OK  := False;

Application.MessageBox('OpenGL cannot initialised!','OpenGl Error',IDOK);

end;

finally

OpenGL_OK  := True;

InitFont(dc,PChar('Arial'));

ClearColor := FClearColor;

Zoom := FZoom;

if Assigned(FOnInitGL) then FOnInitGL(Self);

end;

end;

 

procedure TAL_OpenGL.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:= 24;

   cDepthBits:= 32;

   iLayerType:= PFD_MAIN_PLANE;

end;

 

nPixelFormat := ChoosePixelFormat(DC, @pfd);

SetPixelFormat(DC, nPixelFormat, @pfd);

end;

 

procedure TAL_OpenGL.CMChildkey(var msg: TCMChildKey);

var dx,dy: integer;

   k:integer;

begin

k:=16;

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;

   inherited;

End;

if (dx<>0) or (dy<>0) then

    ShiftWindow(dx,dy);

end;

 

procedure TAL_OpenGL.CMMouseEnter(var msg: TMessage);

begin

inherited;

if TabStop then Setfocus;

MouseIn := True;

if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);

invalidate;

end;

 

procedure TAL_OpenGL.CMMouseLeave(var msg: TMessage);

begin

inherited;

MouseIn := False;

if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);

invalidate;

end;

 

procedure TAL_OpenGL.Paint;

var

ps : TPaintStruct;

begin

if NotPaint=False then begin

If componentstate=[csDesigning] then begin

BeginPaint(Handle, ps);

glClear(GL_COLOR_BUFFER_BIT);

    Demo;

end else

If Assigned(FOnPaint) then begin

BeginPaint(Handle, ps);

glClear(GL_COLOR_BUFFER_BIT);

    glPushMatrix;

    If Assigned(FOnPaint) then FOnPaint(Self);

    glPopMatrix;

end else begin

    BeginPaint(Handle, ps);

    glClear(GL_COLOR_BUFFER_BIT);

    If Assigned(FOnAfterPaint) then FOnAfterPaint(Self);

    if FCentralCross then DrawCentralCross;

    if FCursorCross then DrawCursorCross(CursorPos);

    SwapBuffers(DC);

    EndPaint(Handle, ps);

    exit;

end;

if FCentralCross then DrawCentralCross;

if FCursorCross then DrawCursorCross(CursorPos);

SwapBuffers(DC);

EndPaint(Handle, ps);

SBI;

If Assigned(FOnAfterPaint) then FOnAfterPaint(Self);

end;

end;

 

procedure TAL_OpenGL.DrawCentralCross;

begin

       glLineWidth(1);

       glBegin(GL_LINES);

         glColor3d(1.0,0.0,0.0);

         glVertex2d(FCentrum.x,OrtoTop);

         glVertex2d(FCentrum.x,OrtoBottom);

         glVertex2d(OrtoLeft,FCentrum.y);

         glVertex2d(OrtoRight,FCentrum.y);

       glEnd;

end;

 

procedure TAL_OpenGL.DrawCursorCross(p: TPoint);

begin

DrawCursorCross(p.x,p.y);

end;

 

procedure TAL_OpenGL.DrawCursorCross(x,y: integer);

var p: TPoint2d;

begin

if MouseIn then begin

    p := SToW(Point(x,y));

       glLineWidth(1);

       glBegin(GL_LINES);

         glColor3d(0.0,0.0,1.0);

         glVertex2d(p.x,OrtoTop);

         glVertex2d(p.x,OrtoBottom);

         glVertex2d(OrtoLeft,p.y);

         glVertex2d(OrtoRight,p.y);

       glEnd;

end;

end;

 

procedure TAL_OpenGL.SetCentralCross(const Value: boolean);

begin

FCentralCross := Value;

invalidate;

end;

 

procedure TAL_OpenGL.Demo;

begin

     glBegin(GL_POLYGON);

       glColor3d(1.0,0.0,0.0);

       glVertex2d(-30.0,-30.0);

 

       glColor3d(0.0,1.0,0.0);

       glVertex2d(30.0,-30.0);

 

       glColor3d(0.0,0.0,1.0);

       glVertex2d(30.0,30.0);

 

       glColor3d(1.0,1.0,1.0);

       glVertex2d(-30.0,30.0);

    glEnd;

    glBegin(GL_POLYGON);

       glColor4d(1.0,0.0,0.0,1.0);

       glVertex2d(0.0,-30.0);

 

       glColor4d(0.0,0.0,1.0,1.0);

       glVertex2d(30.0,0.0);

 

       glColor4d(1.0,1.0,0.0,1.0);

       glVertex2d(10.0,10.0);

 

       glColor4d(1.0,0.0,1.0,1.0);

       glVertex2d(0.0,30.0);

 

       glColor4d(0.0,0.5,1.0,1.0);

       glVertex2d(-10.0,10.0);

 

       glColor4d(5.0,0.5,0.0,1.0);

       glVertex2d(-30.0,0.0);

    glEnd;

       //INNEN LESZ A KIRAJZOLAS

    glFlush;

end;

 

procedure TAL_OpenGL.SBI;

begin

StretchBlt(BackBMP.Canvas.Handle,0,0,width,Height,

            Canvas.handle,0,0,width,Height,SRCCOPY)

end;

 

procedure TAL_OpenGL.LBI;

begin

StretchBlt(Canvas.Handle,0,0,width,Height,

            BackBMP.Canvas.handle,0,0,width,Height,SRCCOPY)

end;

 

procedure TAL_OpenGL.SetCentrum(const Value: TPoint2d);

var wx,hx: GLDouble;

begin

FCentrum := Value;

wx := (Width/2)/FZoom;

hx := (Height/2)/FZoom;

OrtoLeft   := Value.x - wx;

OrtoRight  := Value.x + wx;

OrtoBottom := Value.y - hx;

OrtoTop    := Value.y + hx;

invalidate;

If Assigned(FChangeWindow) then FChangeWindow(Self,FCentrum,FZoom);

end;

 

procedure TAL_OpenGL.SetClearColor(const Value: TColor);

var sz: TSzin;

begin

FClearColor := Value;

sz := ColorToSzin(Value);

glClearcolor(sz.R,sz.G,sz.B,1);

invalidate;

end;

 

procedure TAL_OpenGL.SetRotAngle(const Value: double);

begin

FRotAngle := Value;

rSIN := SIN(DegToRad(FRotAngle)); rCOS := COS(DegToRad(FRotAngle));

invalidate;

end;

 

procedure TAL_OpenGL.SetShadeModel(const Value: TShadeModel);

begin

if OpenGL_OK then

Try

FShadeModel := Value;

Case Value of

smFlat   : glShadeModel(GL_FLAT);

smSmooth : glShadeModel(GL_SMOOTH);

end;

invalidate;

except

end;

end;

 

procedure TAL_OpenGL.SetZoom(const Value: extended);

var wx,hx: GLDouble;

begin

FZoom := Value;

if OpenGL_OK then

Try

wx := (Width/2)/FZoom;

hx := (Height/2)/FZoom;

OrtoLeft   := FCentrum.x - wx;

OrtoRight  := FCentrum.x + wx;

OrtoBottom := FCentrum.y - hx;

OrtoTop    := FCentrum.y + hx;

If Assigned(FChangeWindow) then FChangeWindow(Self,FCentrum,FZoom);

invalidate;

EXCEPT

end;

end;

 

procedure TAL_OpenGL.WMEraseBkGnd(var Message: TWMEraseBkGnd);

begin

Message.Result := 1

end;

 

procedure TAL_OpenGL.WMPaint(var Msg: TWMPaint);

begin

ReDraw;

Msg.Result := 1;

end;

 

procedure TAL_OpenGL.WMSize(var Msg: TWMSize);

var w,h: GLDouble;

   wx,hx: GLDouble;

begin

Try

w  := Msg.Width;

h  := Msg.Height;

wx := (w/2)/FZoom;

hx := (h/2)/FZoom;

OrtoLeft   := FCentrum.x - wx;

OrtoRight  := FCentrum.x + wx;

OrtoBottom := FCentrum.y - hx;

OrtoTop    := FCentrum.y + hx;

BackBMP.Width  := Msg.Width;

BackBMP.height := Msg.Height;

ReDraw;

except

end;

end;

 

procedure TAL_OpenGL.ReDraw;

begin

if not OpenGL_OK then InitGL;

    glViewport(0,0,width ,height);

    glMatrixMode(GL_PROJECTION);

    glLoadIdentity;

    gluOrtho2D(OrtoLeft, OrtoRight, OrtoBottom, OrtoTop);

//  gluPerspective(45.0,Width/Height,0.1,800.0);

    glMatrixMode(GL_MODELVIEW);

    glDrawBuffer(GL_BACK);

glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);

Paint;

end;

 

procedure TAL_OpenGL.DblClick;

begin

if FDblClickEnabled then

Centrum := SToW(Point(Origin.x,Height-Origin.y));

inherited;

end;

 

procedure TAL_OpenGL.KeyDown(var Key: Word; Shift: TShiftState);

var zFactor: double;

begin

if Shift=[ssCtrl] then zFactor:=1.1

else zFactor:=2;

Case Key of

VK_ADD     : begin Zoom:=zFactor*Zoom;end;

VK_SUBTRACT: begin Zoom:=1/zFactor*Zoom;end;

VK_SPACE   : RotAngle := 0;

end;

inherited KeyDown(Key,Shift);

end;

 

procedure TAL_OpenGL.KeyPress(var Key: Char);

begin

Case Key of

'K','k' : CentralCross:=not CentralCross;

^C      : CopyToClipboard;

'L','l' : RotAngle := FRotAngle+1;

'R','r' : RotAngle := FRotAngle-1;

'F','f' : RotAngle := FRotAngle+1;

end;

inherited KeyPress(Key);

end;

 

procedure TAL_OpenGL.MouseDown(Button: TMouseButton; Shift: TShiftState; X,

Y: Integer);

begin

CursorPos := Point(x,Height-y);

MapPoint := SToW(Point(x,Height-y));

origin:=Point(x,y);

oldmovept:=origin;

inherited MouseDown(Button, Shift, X, Height-Y);

end;

 

procedure TAL_OpenGL.MouseMove(Shift: TShiftState; X, Y: Integer);

var

dx,dy: GLDouble;

begin

CursorPos := Point(x,Height-y);

MapPoint := SToW(Point(x,Height-y));

MovePt:=Point(x,y);

 

inherited MouseMove(Shift,x,y);

 

{ Moving graphic with pressed left mouse button }

IF Shift=[ssLeft] then

begin

   // Pontosítani kell a képleteken !!!!!!!!

   if RotAngle=0 then begin

      dx := (oldMovePt.x-MovePt.x)/FZoom;

      dy := (oldMovePt.y-MovePt.y)/FZoom;

      Centrum := Point2d(FCentrum.x+dx,FCentrum.y-dy);

   end else begin

      dx := (Width/2)+(oldMovePt.x-MovePt.x);

      dy := (Height/2)-(oldMovePt.y-MovePt.y);

      Centrum := SToW(Point(Round(dx),Round(dy)));

   end;

end;

 

{ Magnifying graphic with pressed right mouse button }

IF Shift=[ssRight] then

begin

   if oldMovePt.y<>MovePt.y then

      if oldMovePt.y>MovePt.y then

         Zoom := Zoom*1.1

      else

         Zoom := Zoom*0.9;

end;

 

oldMovePt := MovePt;

invalidate;

 

end;

 

procedure TAL_OpenGL.MouseUp(Button: TMouseButton; Shift: TShiftState; X,

Y: Integer);

begin

inherited;

 

end;

 

procedure TAL_OpenGL.CopyToClipboard;

begin

SBI;

Clipboard.Assign(BackBMP);

end;

 

function TAL_OpenGL.CreateTexture(Texture: String): cardinal;

var

bitmap: TBitmap;

Pict:TJpegImage;

BMInfo : TBitmapInfo;

I,ImageSize : Integer;

Temp : Byte;

MemDC : HDC;

Tex: PPixelArray;

ext: string;

begin

glGenTextures(1, @Result);

glBindTexture(GL_TEXTURE_2D, Result);

Bitmap:=TBitMap.Create;

 

ext := UpperCase(ExtractFileExt(Texture));

 

if ext='.JPG' THEN begin

    Pict:=TJpegImage.Create;

    Pict.LoadFromFile(Texture);

    BitMap.Assign(Pict);

    Pict.Free;

end;

if ext='.BMP' THEN begin

    BitMap.LoadFromFile(Texture);

end;

 

with BMinfo.bmiHeader do begin

   FillChar (BMInfo, SizeOf(BMInfo), 0);

   biSize := sizeof (TBitmapInfoHeader);

   biBitCount := 24;

   biWidth := Bitmap.Width;

   biHeight := Bitmap.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;

     freemem(tex);

  end;

end;

end;

 

function TAL_OpenGL.CreateTextureFromBMP(Bitmap: TBitmap): cardinal;

var

BMInfo : TBitmapInfo;

I,ImageSize : Integer;

Temp : Byte;

MemDC : HDC;

Tex: PPixelArray;

begin

glGenTextures(1, @Result);

glBindTexture(GL_TEXTURE_2D, Result);

 

with BMinfo.bmiHeader do begin

   FillChar (BMInfo, SizeOf(BMInfo), 0);

   biSize := sizeof (TBitmapInfoHeader);

   biBitCount := 24;

   biWidth := Bitmap.Width;

   biHeight := Bitmap.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);

     freemem(tex);

  end;

end;

end;

 

function TAL_OpenGL.GetWorkArea: TRect2d;

begin

Result := Rect2d(OrtoLeft,OrtoTop,OrtoRight,OrtoBottom);

end;

 

procedure TAL_OpenGL.MoveWindow(x, y: double);

begin

Centrum := Point2d(Centrum.x-x,Centrum.y-y);

end;

 

procedure TAL_OpenGL.ShiftWindow(x, y: double);

var dx,dy : double;

begin

//  Centrum := Point2d(FCentrum.x+(x/FZoom),FCentrum.y+(y/FZoom));

   dx := (Width/2)+x;

   dy := (Height/2)-y;

   Centrum := SToW(Point(Round(dx),Round(dy)));

end;

 

function TAL_OpenGL.SToW(p: TPoint): TPoint2d;

begin

Result := Point2d(XToW(p.x),YToW(p.y));

if FRotAngle<>0 then

RelRotate2D(Result,FCentrum,DegToRad(-FRotAngle));

end;

 

function TAL_OpenGL.WToS(p: TPoint2d): TPoint;

begin

if FRotAngle<>0 then

RelRotate2D(p,FCentrum,DegToRad(FRotAngle));

Result := Point(XToS(p.x),YToS(p.y));

end;

 

function TAL_OpenGL.XToS(x: double): integer;

var asp: double;

begin

asp := Width/Height;

Result := Trunc(asp*Width/2+(x-FCentrum.x)*FZoom);

end;

 

function TAL_OpenGL.YToS(y: double): integer;

begin

Result := Trunc((Height/2+(y-FCentrum.y)*FZoom));

end;

 

function TAL_OpenGL.XToW(x: integer): double;

begin

Result := FCentrum.x+(x-Width/2)/FZoom;

end;

 

function TAL_OpenGL.YToW(y: integer): double;

begin

Result := FCentrum.y+(y-Height/2)/FZoom;

end;

 

procedure TAL_OpenGL.glCircle(u, v, r: double);

var i: integer;

begin

glBegin(GL_LINE_STRIP);

   For i:=0 to 360 do

       glVertex2d(u+r*cos(DegToRad(i)),v+r*sin(DegToRad(i)));

glEnd;

end;

 

procedure TAL_OpenGL.glCircle(Cent: TPoint2d; r: double);

begin

glCircle(Cent.X,Cent.Y,r);

end;

 

procedure TAL_OpenGL.glCircle(Cent, KerPoint: TPoint2d);

begin

glCircle(Cent.X,Cent.Y,RelDist2d(Cent,KerPoint));

end;

 

// Ellipszis 2 átellenes pontja

procedure TAL_OpenGL.glEllipse(p1,p2: TPoint2d);

var i: integer;

   u,v,r1,r2: double;

begin

u:=(p2.x+p1.x)/2; v:=(p2.y+p1.y)/2;

r1:=Abs(p2.x-p1.x)/2; r2:=Abs(p2.y-p1.y)/2;

glBegin(GL_LINE_STRIP);

   For i:=0 to 360 do

       glVertex2d(u+r1*cos(DegToRad(i)),v+r2*sin(DegToRad(i)));

glEnd;

end;

 

procedure TAL_OpenGL.glPrint(x,y,Height,Angle: double; text: string);

var szoveg: PChar;

begin

if Height*Zoom>7 then

      Draw3DText(Text,y,x,0,0,0,Angle,Height);

end;

 

procedure TAL_OpenGL.glRectangle(p1, p2, p3, p4: TPoint2d);

begin

glBegin(GL_LINES);

   glVertex2d(p1.x,p1.y);

   glVertex2d(p2.x,p2.y);

   glVertex2d(p3.x,p3.y);

   glVertex2d(p4.x,p4.y);

glEnd;

end;

 

procedure TAL_OpenGL.glRectangle(p: TPoint2d; a, b: double);

begin

glBegin(GL_LINE_STRIP);

   glVertex2d(p.x-a/2,p.y+b/2);

   glVertex2d(p.x+a/2,p.y+b/2);

   glVertex2d(p.x+a/2,p.y-b/2);

   glVertex2d(p.x-a/2,p.y-b/2);

   glVertex2d(p.x-a/2,p.y+b/2);

glEnd;

end;

 

function TAL_OpenGL.GetCanvas: TCanvas;

begin

Result := inherited Canvas;

end;

 

function TAL_OpenGL.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;

MousePos: TPoint): Boolean;

begin

Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

if Focused then

if WheelDelta<0 then Zoom:=0.9*Zoom  else Zoom:=1.1*Zoom;

end;

 

function TAL_OpenGL.DoMouseWheelDown(Shift: TShiftState;

MousePos: TPoint): Boolean;

begin

Result := inherited DoMouseWheelDown(Shift, MousePos);

end;

 

function TAL_OpenGL.DoMouseWheelUp(Shift: TShiftState;

MousePos: TPoint): Boolean;

begin

Result := inherited DoMouseWheelUp(Shift, MousePos);

end;

 

{ FONT RUTINS }

{ ===================================================================== }

procedure TAL_OpenGL.InitFont(dc: HDC; Fontname: PChar);

var

lf : TLOGFONT;

hFontNew, hOldFont : HFONT;

agmf : Array [0..255] of TGLYPHMETRICSFLOAT ;

begin

FillChar(lf, SizeOf(lf), 0);

lf.lfHeight               :=   -38 ;

lf.lfWeight               :=   FW_NORMAL ;

lf.lfCharSet              :=   ANSI_CHARSET ;

lf.lfOutPrecision         :=   OUT_DEFAULT_PRECIS ;

lf.lfClipPrecision        :=   CLIP_DEFAULT_PRECIS ;

lf.lfQuality              :=   DEFAULT_QUALITY ;

lf.lfPitchAndFamily       :=   FF_DONTCARE OR DEFAULT_PITCH;

lstrcpy (lf.lfFaceName, Fontname) ;

 

//  hFontNew := CreateFont(lf);

hFontNew := CreateFontIndirect(lf);

hOldFont := SelectObject(DC, hFontNew);

 

wglUseFontOutlines(DC, 0, 255, GLF_START_LIST, 0.0, 0.15,

                    WGL_FONT_POLYGONS, @agmf);

 

DeleteObject(SelectObject(DC,hOldFont));

DeleteObject(SelectObject(DC,hFontNew));

end;

 

procedure TAL_OpenGL.Draw3DText(Text: String; X, Y, Z, AX, AY, AZ, Height: GLFloat);

begin

glPushMatrix;

glTranslatef(Y, X, Z);

glPushMatrix;

glRotatef(AX, 1, 0, 0);

glRotatef(AY, 0, 1, 0);

glRotatef(AZ, 0, 0, 1);

glScaled(Height,Height,0);

glPushMatrix;

//  glTranslatef(-0.46, -0.31, 0);

glListBase(GLF_START_LIST);

glCallLists(Length(Text), GL_UNSIGNED_BYTE, pChar(Text));

glPopMatrix;

glPopMatrix;

glPopMatrix;

end;

 

procedure TAL_OpenGL.glColor(col: TColor);

var sz: TSzin;

begin

sz := ColorToSzin(col);

glColor3f(sz.R,sz.G,sz.B);

end;

 

initialization

Initopengl;

end.