Easy opengl: de l'opengl dans la vcl

Soyez le premier à donner votre avis sur cette source.

Vue 8 356 fois - Téléchargée 1 165 fois

Description

Ce package permet de créer des composants visuels Delphi descendant de TWinControl avec un Canvas de type TGlCanvas et un contexte OpenGl associé créé automatiquement. Donc, fini les appels laborieux à wglCreateContext dès que la fenêtre est recréée par exemple, le composant le fait automatiquement.

En résumé, il est possible de créer une nouvelle famille de contrôles VCL descendant de TGLWinControl, qui utilisent OpenGl pour se dessiner.

Un exemple est fourni avec le package, qui montre entre autre comment utiliser la GlFont du GlCanvas (voir capture). Lors du lancement du programme, les fenêtres mettent quelques 10èmes de seconde à s'afficher, car la police OpenGl est générée en qualité maximale (pour l'instant, c'est l'option par défaut).

Le package contient 3 composants:
-TGlWinControl (l'équivalent d'une TPaintBox, mais en OpenGl). Il publie un événement OnPaint dans lequel le Canvas est automatiquement "locké", il suffit d'appeler les primitives OpenGl voulues pour dessiner à l'intérieur. De plus, ce contrôle peut tout à fait contenir des contrôles VCL standards non OpenGl (comme un TEdit par exemple)!
-TGlIntKnob : un bouton rond qui permet de définir un Integer entre 2 valeurs Min et Max. Il réagit aux flèches du clavier et à la molette de la souris, si on appuie sur Ctrl en même temps la variation est plus rapide.
-TGlFloatKnob: idem avec une valeur de type Double.

Les messages WM_PAINT sont traités automatiquement, et OpenGl est synchronisé avec GDI de façon à ce que l'application reste graphiquement homogène et pour éviter les clignotements. Pour dessiner sur un GlCanvas, il suffit d'appeler sa procédure Lock, appeler les primitives OpenGl correspondantes (glBegin, glVertex etc...) et au final ne pas oublier d'appeler la procédure UnLock du canvas, sinon l'application risque de se bloquer. Le tout est thread-safe (par l'intermédiaire d'un "thread local storage" qui garde en mémoire le canvas courant), c'est à dire qu'il est tout à fait possible de dessiner sur un Canvas depuis un autre thread, et même d'imbriquer les méthodes Lock et UnLock de plusieurs canvas différents.

La seule contrainte est que tout appel à la méthode Lock d'un canvas doit être suivi d'un appel à sa méthode UnLock dans le même thread, et l'imbrication des appels ne peut pas se "chevaucher". Par exemple:

Canvas1.Lock;
Canvas2.Lock
...
Canvas2.UnLock;
Canvas1.UnLock

est valide, mais

Canvas1.Lock;
Canvas2.Lock
...
Canvas1.UnLock;
Canvas2.UnLock

ne l'est pas.

Il y a de plus une détection automatique des erreurs OpenGl (GL_INVALID_ENUM et autres), et le dernier appel à la fonction UnLock d'un canvas appelle automatiquement SwapBuffers si le canvas est en DoubleBuffered. Ces exceptions OpenGl sont rejetées de façon à apparaitre uniquement lorsque Delphi est lancé lors de l'appel au PaintHandler de façon à éviter qu'elles apparaissent à l'exécution en dehors de Delphi.

De plus, tous les GlCanvas créés partagent automatiquement le même espace de listes, c'est à dire que les textures et listes créées avec un canvas peuvent s'utiliser avec tous les autres. Les canvas ont aussi une propriété Font (TGlFont) qui permet de dessiner du texte quasiment comme le TFont standard.

Lors des messages WM_PAINT, le Canvas est automatiquement "clippé" sur la zone à afficher du contrôle, en utilisant l'extension GL_WIN_swap_hint si disponible, sinon en utilisant GL_SCISSOR_TEST. Le viewport et la projection sont définis comme pour un contrôle VCL traditionnel (c'est à dire (0,0)=TopLeft, (ClientWidth,CLientHeight)=BottomRight).

Voilà, je crois que j'ai tout dit, c'est un peu technique mais je pense que si quelqu'un veut commencer à faire de l'OpenGl, ça peut être un bon FrameWork pour commencer facilement.

Source / Exemple :


TGlCanvas=class
    function LoadExtension(Name:string;ProcNames:array of string;ProcAddresses:array of PPointer):Boolean;  //Use to load non-standard gl extensions

    procedure CreateContext(Handle:HWND;Format:TGlPixelFormat);virtual;    //DO NOT CALL DIRECTLY (used internally)
    procedure DestroyContext(Handle:HWND);virtual;                         //DO NOT CALL DIRECTLY (used internally)

    property ColorBits:Byte read GetColorBits;               //Actual color bits
    property AlphaBits:Byte read GetAlphaBits;               //Actual alpha bits
    property DepthBits:Byte read GetDepthBits;               //Actual depth bits
    property StencilBits:Byte read GetStencilBits;           //Actual stencil bits
    property DoubleBuffered:Boolean read GetDoubleBuffered;  //If actually double buffered
    property SwapMethod:TGlSwapMethod read GetSwapMethod;    //Actual swap method
    property Font:TGlFont read FFont write SetFont;          //GL font

    procedure MakeViewPort(Rect:TRect;ClientHeight:Integer;ClipRect:PRect=nil;BorderWidth:Integer=0);  //DO NOT CALL DIRECTLY (used internally)

    procedure Lock;       //Use before painting on the canvas
    procedure Unlock;     //MUST be called after each call to Lock
  end;

  TGlPixelFormat=class(TPersistent)
  published
    property DesiredAlphaBits:Byte read FDesiredAlphaBits write SetDesiredAlphaBits;               //Desired alpha bits
    property DesiredDepthBits:Byte read FDesiredDepthBits write SetDesiredDepthBits;               //Desired depth bits
    property DesiredStencilBits:Byte read FDesiredStencilBits write SetDesiredStencilBits;         //Desired double buffer
    property DoubleBuffered:Boolean read FDoubleBuffered write SetDoubleBuffered;                  //Desired stencil bits
    property DesiredSwapMethod:TGlSwapMethod read FDesiredSwapMethod write SetDesiredSwapMethod;   //Desired swap method (not all methods are supported by drivers)
  end;

  TGlFont=class
  public
    function GetName:PChar;
    procedure SetName(Value:PChar);
    property Name:PChar read GetName write SetName;              //Like the usual TFont

    function GetSize:Single;
    procedure SetSize(Value:Single);
    property Size:Single read GetSize write SetSize;             //Like the usual TFont

    function GetStyle:TFontStyles;
    procedure SetStyle(Value:TFontStyles);
    property Style:TFontStyles read GetStyle write SetStyle;     //Like the usual TFont

    function TextSize(Text:PChar):TSize;                         //Size of text (given the size of the font)
    procedure TextOut(X,Y:Single;Text:PChar);                    //Draw text on current canvas
end;

  TGlWinControl=class(TWinCOntrol)
  public
    constructor Create(AOwner:TComponent);override;

    property Canvas:TGlCanvas read FCanvas write FCanvas;

    destructor Destroy;override;
  published
    property OnPaint:TNotifyEvent read FOnPaint write SetOnPaint;                                            //OnPaint event

    property OnAfterCreateContext:TNotifyEvent read FOnAfterCreateContext write SetOnAfterCreateContext;     //Called after Gl context has been created
    property OnBeforeDeleteContext:TNotifyEvent read FOnBeforeDeleteContext write SetOnBeforeDeleteContext;  //Called when Gl context is about to be destroyed

    property PixelFormat:TGlPixelFormat read FPixelFormat write SetPixelFormat;                              //Desired pixel format (not all systems will provide requested values)
  end;

Conclusion :


Merci de me dire si vous trouvez des bugs.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
66
Date d'inscription
lundi 13 mars 2006
Statut
Membre
Dernière intervention
4 août 2008

merci forman
dsl pour le retard à l'allumage...
j'ai mis ça dans mes sources préférés et je verrai ça plus tard.
j'ai désinstallé GLScene pour l'instant, car ce n'est pas ma priorité actuellement.
mais c'est toujours un plaisir d'apprendre en te lisant.
pour l'instant j'essaie de me familiariser avec UML... quand j'ai 5 minutes entre deux interventions sur le réseau du service. si j'avais que du XP, ça irai plus vite lol
en plus de ça mon programme déboussole sensiblement mon débogueur et je dois à chaque fois le relancer!
si si... je confirme! je suis le meilleur planteur de débogueur! mdr
à plus, camarade! ;-)
Messages postés
1
Date d'inscription
lundi 12 janvier 2004
Statut
Membre
Dernière intervention
19 juillet 2007

Bonjour,

Cette source est forte intérréssante, mais y a t-il la possibilité d'élargir le texte sans augmenter sa hauteur ???
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
Ah oui: si l'erreur persiste, supprimes les lignes: {$R GLControls.dcr} et {$R GLKnobs.dcr} qui sont dans GlControls.pas et GlKnobs.pas respectivement.
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
C'est bizarre, les 2 fichiers .DCR sont dans le zip...
As-tu vérifié que tu les avais extraits dans le répertoire du package?
Messages postés
66
Date d'inscription
lundi 13 mars 2006
Statut
Membre
Dernière intervention
4 août 2008

salut,
j'arrive bien à installer ton package, mais qd je lance ton exemple, D2005 me dit qu'il manque deux fichier .DCR (GLControls.dcr et GLKnobs.dcr).
et je ne les trouve mm pas dans ton package...
sinon, soit dit en passant, j'ai tenté d'installer GLScene mais ou bien je n'ai pas une version compatible ou bien il y a des erreurs qq part car je me fais jeter à la compil sur un {$include glscene.inc} pour cause de fichier introuvable alors que qu'il est ds le source. j'ai essayé en mettant la ligne en commentaire et il manque encore des dcu pour certaines unités...
bon, si tu peux me dire pour tes .DCR...
pour le reste, tu n'es pas obligé...
à bientôt
Afficher les 11 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.