EDN Admin
Well-known member
Hi Guyz
After the passing my exams and working on My Project About Faster Randering I got one less than Full Marks.
See The Code Following I worked much timePublic Structure Color
Public Red As Single
Public Green As Single
Public Blue As Single
Public Alpha As Single
Sub New(r As Byte, g As Byte, b As Byte, a As Byte)
Red = r / 255
Green = g / 255
Blue = b / 255
Alpha = a / 255
End Sub
End Structure
Public Structure Point
Public X As Single
Public Y As Single
Public Z As Single
Sub New(X As Single, Y As Single, Z As Single)
Me.X = X
Me.Y = Y
Me.Z = Z
End Sub
End Structure
<Serializable()>
Public Class PointColors
Inherits Dictionary(Of Point, Color)
Implements ISerializable
Protected Sub New(info As System.Runtime.Serialization.SerializationInfo, context As System.Runtime.Serialization.StreamingContext)
MyBase.New(info, context)
End Sub
Sub New()
End Sub
Sub New(Points() As Point, Colors() As Color)
If Colors.Count = Points.Count Then
For i = 0 To Points.Count - 1
Me.Add(Points(i), Colors(i))
Next
End If
End Sub
End Class
Class Device
Public Property hDC As IntPtr
Public Property hRC As IntPtr
Public Property Control As Control
Public ReadOnly Property HWND As IntPtr
Get
Return Control.Handle
End Get
End Property
Sub New(Surface As Control)
Control = Surface
Try
OpenGL(HWND, hDC, hRC)
Catch
End Try
AddHandler Control.Disposed, AddressOf Closed
End Sub
Private Sub Closed(sender As Object, e As EventArgs)
Try
CloseGL(HWND, hDC, hRC)
Catch
End Try
End Sub
Sub Clear(c As Color)
glClearColor(c.Red, c.GetHashCode, c.Blue, c.Alpha)
glClear(Bits.COLOR_BUFFER)
End Sub
Sub FinalizeDrawing()
glPopMatrix()
SwapBuffers(Me.hDC)
End Sub
Sub InitDrawing()
glPushMatrix()
End Sub
End Class
Class DirectBatch
Public Property Device As Device
Sub New(d As Device)
Device = d
End Sub
Sub Begin(Mode As Primitives)
glBegin(Mode)
End Sub
Sub Draw(Obj As PointColors)
For Each p As Point In Obj.Keys
Dim c = Obj(p)
glColor4f(c.Red, c.Green, c.Blue, c.Alpha)
glVertex3f(p.X, p.Y, p.Z)
Next
End Sub
Sub [End]()
glEnd()
End Sub
End Class
Enum Bits As UInteger
CURRENT = &H1
POINT = &H2
LINE = &H4
POLYGON = &H8
POLYGON_STIPPLE = &H10
PIXEL_MODE = &H20
LIGHTING = &H40
FOG = &H80
DEPTH_BUFFER = &H100
ACCUM_BUFFER = &H200
STENCIL_BUFFER = &H400
VIEWPORT = &H800
TRANSFORM = &H1000
ENABLE = &H2000
COLOR_BUFFER = &H4000
HINT = &H8000
EVAL = &H10000
LIST = &H20000
TEXTURE = &H40000
SCISSOR = &H80000
ALL_ATTRIBS = &HFFFFF
End Enum
Enum Primitives As UInteger
POINTS = &H0
LINES = &H1
LINE_LOOP = &H2
LINE_STRIP = &H3
TRIANGLES = &H4
TRIANGLE_STRIP = &H5
TRIANGLE_FAN = &H6
QUADS = &H7
QUAD_STRIP = &H8
POLYGON = &H9
End Enum
Module RawDeclaration
Declare Sub OpenGL Lib "Base" (HWND As IntPtr, ByRef hDC As IntPtr, ByRef hRC As IntPtr)
Declare Sub CloseGL Lib "Base" (HWND As IntPtr, ByRef hDC As IntPtr, ByRef hRC As IntPtr)
Declare Sub glClear Lib "opengl32" (mask As UInteger)
Declare Sub glPushMatrix Lib "opengl32" ()
Declare Sub glRotatef Lib "opengl32.dll" (Angle As Single, x As Single, y As Single, z As Single)
Declare Sub glClearColor Lib "opengl32" (red As Single, green As Single, blue As Single, alpha As Single)
Declare Sub glColor4f Lib "opengl32" (r As Single, g As Single, b As Single, a As Single)
Declare Sub glBegin Lib "opengl32" (mode As UInteger)
Declare Sub glVertex3f Lib "opengl32" (x As Single, y As Single, z As Single)
Declare Sub glEnd Lib "opengl32" ()
Declare Sub glPopMatrix Lib "opengl32" ()
Declare Sub SwapBuffers Lib "gdi32.dll" (hDC As IntPtr)
End Module
To do all tasks I had to get help from C++
I tried my best to be safe from C++ but i tried my all that VB didnt provide all things which can be done
So I made 2 functions Called OpenGL annd CloseGL
The following code is of my dll made by minigw
//CPP File Code
#include <windows.h>#define _EXPORTDLL#include "Base.h"#include <winuser.h>#include "glgl.h"BOOL APIENTRY DllMain (HINSTANCE hInst, // Library instance handle. DWORD reason, //Reason this function is being called LPVOID reserved) // Not used { switch (reason) { case DLL_PROCESS_ATTACH: break; case DLL_PROCESS_DETACH: break; case DLL_THREAD_ATTACH: break; case DLL_THREAD_DETACH: break; } // Returns TRUE on success, FALSE on failure return TRUE;}void TestCall(char* str){ MessageBox(NULL,str,"Base",MB_OK);}void CloseGL (HWND hWnd, HDC hDC, HGLRC hRC){ wglMakeCurrent (NULL, NULL); wglDeleteContext (hRC); ReleaseDC (hWnd, hDC);}void OpenGL(HWND hWnd, HDC *hDC, HGLRC *hRC){ PIXELFORMATDESCRIPTOR pfd; int iFormat; /* get the device context (DC) */ *hDC = GetDC (hWnd); /* set the pixel format for the DC */ //ZeroMemory (&pfd, sizeof (pfd)); pfd.nSize = sizeof (pfd); pfd.nVersion = 1; pfd.dwFlags = PFD_DRAW_TO_WINDOW | PFD_SUPPORT_OPENGL | PFD_DOUBLEBUFFER; pfd.iPixelType = PFD_TYPE_RGBA; pfd.cColorBits = 24; pfd.cDepthBits = 16; pfd.iLayerType = PFD_MAIN_PLANE; iFormat = ChoosePixelFormat (*hDC, &pfd); SetPixelFormat (*hDC, iFormat, &pfd); /* create and enable the render context (RC) */ *hRC = wglCreateContext( *hDC ); wglMakeCurrent( *hDC, *hRC );}void DrawTemp(HDC hDC,float Angle){// glClearColor (0.0f, 0.0f, 0.0f, 0.0f); glClearDepth(1000); glClear (GL_DEPTH_BUFFER_BIT); glPushMatrix (); glRotatef (Angle, 0.0f, 0.0f, 1.0f); glBegin (GL_TRIANGLES); glColor3f (1.0f, 0.0f, 0.0f); glVertex2f (0.0f, 1.0f); glColor3f (0.0f, 1.0f, 0.0f); glVertex3f (0.87f, -0.5f,-5.0f); glColor3f (0.0f, 0.0f, 1.0f); glVertex2f (-0.87f, -0.5f); glEnd (); glPopMatrix (); SwapBuffers (hDC);}
//Header File Code#ifndef _DLLMAIN_H
#define _DLLMAIN_H
#ifdef _EXPORTDLL
#define _LIBAPI __declspec(dllexport)
#else
#define _LIBAPI __declspec(dllimport)
#endif
// Export following functions
extern "C" _LIBAPI void TestCall(char* str);
extern "C" _LIBAPI void CloseGL (HWND hWnd, HDC hDC, HGLRC hRC);
extern "C" _LIBAPI void OpenGL(HWND hWnd, HDC *hDC, HGLRC *hRC);
extern "C" _LIBAPI void DrawTemp(HDC,float);
//extern "C" _LIBAPI new ZeroMemory(d,l);
#endif
You can download dll from here base.rar and then extract it
But when I Debug my app I get this error
A call to PInvoke function TestApp!TestApp.RawDeclaration::OpenGL has
unbalanced the stack. This is likely because the managed PInvoke signature does
not match the unmanaged target signature. Check that the calling convention
and parameters of the PInvoke signature match the target unmanaged signature.
But by pressing F5 error disappears If you know method to correct it please tell me.,
All Other things are working correctly
I have also made an example to Check my app
Add Timer in New Form and then add this code in Form1 class Dim d As New Device(Me)
Dim b As New DirectBatch(d)
Dim obj As New PointColors({New Point(0, 1, 0), New Point(0.5, -0.8, 0), New Point(-0.5, -0.8, 0)}, {New Color(255, 0, 0, 255), New Color(0, 255, 0, 255), New Color(0, 0, 255, 255)})
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
d.Clear(New Color(0, 0, 0, 255))
d.InitDrawing()
b.Begin(Primitives.POLYGON)
b.Draw(obj)
b.End()
d.FinalizeDrawing()
End Sub
Thanx and Please help me how to be safe from error like that
DLL File (_V_)<img border="0" src="
---------------------Do the Impossible--------------------- Great Software at http://atosoft.webs.com/
View the full article
After the passing my exams and working on My Project About Faster Randering I got one less than Full Marks.
See The Code Following I worked much timePublic Structure Color
Public Red As Single
Public Green As Single
Public Blue As Single
Public Alpha As Single
Sub New(r As Byte, g As Byte, b As Byte, a As Byte)
Red = r / 255
Green = g / 255
Blue = b / 255
Alpha = a / 255
End Sub
End Structure
Public Structure Point
Public X As Single
Public Y As Single
Public Z As Single
Sub New(X As Single, Y As Single, Z As Single)
Me.X = X
Me.Y = Y
Me.Z = Z
End Sub
End Structure
<Serializable()>
Public Class PointColors
Inherits Dictionary(Of Point, Color)
Implements ISerializable
Protected Sub New(info As System.Runtime.Serialization.SerializationInfo, context As System.Runtime.Serialization.StreamingContext)
MyBase.New(info, context)
End Sub
Sub New()
End Sub
Sub New(Points() As Point, Colors() As Color)
If Colors.Count = Points.Count Then
For i = 0 To Points.Count - 1
Me.Add(Points(i), Colors(i))
Next
End If
End Sub
End Class
Class Device
Public Property hDC As IntPtr
Public Property hRC As IntPtr
Public Property Control As Control
Public ReadOnly Property HWND As IntPtr
Get
Return Control.Handle
End Get
End Property
Sub New(Surface As Control)
Control = Surface
Try
OpenGL(HWND, hDC, hRC)
Catch
End Try
AddHandler Control.Disposed, AddressOf Closed
End Sub
Private Sub Closed(sender As Object, e As EventArgs)
Try
CloseGL(HWND, hDC, hRC)
Catch
End Try
End Sub
Sub Clear(c As Color)
glClearColor(c.Red, c.GetHashCode, c.Blue, c.Alpha)
glClear(Bits.COLOR_BUFFER)
End Sub
Sub FinalizeDrawing()
glPopMatrix()
SwapBuffers(Me.hDC)
End Sub
Sub InitDrawing()
glPushMatrix()
End Sub
End Class
Class DirectBatch
Public Property Device As Device
Sub New(d As Device)
Device = d
End Sub
Sub Begin(Mode As Primitives)
glBegin(Mode)
End Sub
Sub Draw(Obj As PointColors)
For Each p As Point In Obj.Keys
Dim c = Obj(p)
glColor4f(c.Red, c.Green, c.Blue, c.Alpha)
glVertex3f(p.X, p.Y, p.Z)
Next
End Sub
Sub [End]()
glEnd()
End Sub
End Class
Enum Bits As UInteger
CURRENT = &H1
POINT = &H2
LINE = &H4
POLYGON = &H8
POLYGON_STIPPLE = &H10
PIXEL_MODE = &H20
LIGHTING = &H40
FOG = &H80
DEPTH_BUFFER = &H100
ACCUM_BUFFER = &H200
STENCIL_BUFFER = &H400
VIEWPORT = &H800
TRANSFORM = &H1000
ENABLE = &H2000
COLOR_BUFFER = &H4000
HINT = &H8000
EVAL = &H10000
LIST = &H20000
TEXTURE = &H40000
SCISSOR = &H80000
ALL_ATTRIBS = &HFFFFF
End Enum
Enum Primitives As UInteger
POINTS = &H0
LINES = &H1
LINE_LOOP = &H2
LINE_STRIP = &H3
TRIANGLES = &H4
TRIANGLE_STRIP = &H5
TRIANGLE_FAN = &H6
QUADS = &H7
QUAD_STRIP = &H8
POLYGON = &H9
End Enum
Module RawDeclaration
Declare Sub OpenGL Lib "Base" (HWND As IntPtr, ByRef hDC As IntPtr, ByRef hRC As IntPtr)
Declare Sub CloseGL Lib "Base" (HWND As IntPtr, ByRef hDC As IntPtr, ByRef hRC As IntPtr)
Declare Sub glClear Lib "opengl32" (mask As UInteger)
Declare Sub glPushMatrix Lib "opengl32" ()
Declare Sub glRotatef Lib "opengl32.dll" (Angle As Single, x As Single, y As Single, z As Single)
Declare Sub glClearColor Lib "opengl32" (red As Single, green As Single, blue As Single, alpha As Single)
Declare Sub glColor4f Lib "opengl32" (r As Single, g As Single, b As Single, a As Single)
Declare Sub glBegin Lib "opengl32" (mode As UInteger)
Declare Sub glVertex3f Lib "opengl32" (x As Single, y As Single, z As Single)
Declare Sub glEnd Lib "opengl32" ()
Declare Sub glPopMatrix Lib "opengl32" ()
Declare Sub SwapBuffers Lib "gdi32.dll" (hDC As IntPtr)
End Module
To do all tasks I had to get help from C++
I tried my best to be safe from C++ but i tried my all that VB didnt provide all things which can be done
So I made 2 functions Called OpenGL annd CloseGL
The following code is of my dll made by minigw
//CPP File Code
#include <windows.h>#define _EXPORTDLL#include "Base.h"#include <winuser.h>#include "glgl.h"BOOL APIENTRY DllMain (HINSTANCE hInst, // Library instance handle. DWORD reason, //Reason this function is being called LPVOID reserved) // Not used { switch (reason) { case DLL_PROCESS_ATTACH: break; case DLL_PROCESS_DETACH: break; case DLL_THREAD_ATTACH: break; case DLL_THREAD_DETACH: break; } // Returns TRUE on success, FALSE on failure return TRUE;}void TestCall(char* str){ MessageBox(NULL,str,"Base",MB_OK);}void CloseGL (HWND hWnd, HDC hDC, HGLRC hRC){ wglMakeCurrent (NULL, NULL); wglDeleteContext (hRC); ReleaseDC (hWnd, hDC);}void OpenGL(HWND hWnd, HDC *hDC, HGLRC *hRC){ PIXELFORMATDESCRIPTOR pfd; int iFormat; /* get the device context (DC) */ *hDC = GetDC (hWnd); /* set the pixel format for the DC */ //ZeroMemory (&pfd, sizeof (pfd)); pfd.nSize = sizeof (pfd); pfd.nVersion = 1; pfd.dwFlags = PFD_DRAW_TO_WINDOW | PFD_SUPPORT_OPENGL | PFD_DOUBLEBUFFER; pfd.iPixelType = PFD_TYPE_RGBA; pfd.cColorBits = 24; pfd.cDepthBits = 16; pfd.iLayerType = PFD_MAIN_PLANE; iFormat = ChoosePixelFormat (*hDC, &pfd); SetPixelFormat (*hDC, iFormat, &pfd); /* create and enable the render context (RC) */ *hRC = wglCreateContext( *hDC ); wglMakeCurrent( *hDC, *hRC );}void DrawTemp(HDC hDC,float Angle){// glClearColor (0.0f, 0.0f, 0.0f, 0.0f); glClearDepth(1000); glClear (GL_DEPTH_BUFFER_BIT); glPushMatrix (); glRotatef (Angle, 0.0f, 0.0f, 1.0f); glBegin (GL_TRIANGLES); glColor3f (1.0f, 0.0f, 0.0f); glVertex2f (0.0f, 1.0f); glColor3f (0.0f, 1.0f, 0.0f); glVertex3f (0.87f, -0.5f,-5.0f); glColor3f (0.0f, 0.0f, 1.0f); glVertex2f (-0.87f, -0.5f); glEnd (); glPopMatrix (); SwapBuffers (hDC);}
//Header File Code#ifndef _DLLMAIN_H
#define _DLLMAIN_H
#ifdef _EXPORTDLL
#define _LIBAPI __declspec(dllexport)
#else
#define _LIBAPI __declspec(dllimport)
#endif
// Export following functions
extern "C" _LIBAPI void TestCall(char* str);
extern "C" _LIBAPI void CloseGL (HWND hWnd, HDC hDC, HGLRC hRC);
extern "C" _LIBAPI void OpenGL(HWND hWnd, HDC *hDC, HGLRC *hRC);
extern "C" _LIBAPI void DrawTemp(HDC,float);
//extern "C" _LIBAPI new ZeroMemory(d,l);
#endif
You can download dll from here base.rar and then extract it
But when I Debug my app I get this error
A call to PInvoke function TestApp!TestApp.RawDeclaration::OpenGL has
unbalanced the stack. This is likely because the managed PInvoke signature does
not match the unmanaged target signature. Check that the calling convention
and parameters of the PInvoke signature match the target unmanaged signature.
But by pressing F5 error disappears If you know method to correct it please tell me.,
All Other things are working correctly
I have also made an example to Check my app
Add Timer in New Form and then add this code in Form1 class Dim d As New Device(Me)
Dim b As New DirectBatch(d)
Dim obj As New PointColors({New Point(0, 1, 0), New Point(0.5, -0.8, 0), New Point(-0.5, -0.8, 0)}, {New Color(255, 0, 0, 255), New Color(0, 255, 0, 255), New Color(0, 0, 255, 255)})
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
d.Clear(New Color(0, 0, 0, 255))
d.InitDrawing()
b.Begin(Primitives.POLYGON)
b.Draw(obj)
b.End()
d.FinalizeDrawing()
End Sub
Thanx and Please help me how to be safe from error like that
DLL File (_V_)<img border="0" src="
---------------------Do the Impossible--------------------- Great Software at http://atosoft.webs.com/
View the full article