04-08-2023, 11:33 AM
Thank you all for your efforts, I am attaching the still broken source code, there must be some little thing missing somewhere that I still miss. I've been trying to get it running for 5 days...
This is QB64 source (based on C source)
and this is original C source:
If someone managed to get it up and running, I'd like to learn what's missing and why it doesn't work.
This is QB64 source (based on C source)
Code: (Select All)
Declare Dynamic Library "gdi32"
Function CreateFont& Alias CreateFontA (ByVal cHeight As Long, Byval cWidth As Long, Byval cEscapement As Long, Byval cOrientation As Long, Byval cWeight As Long, Byval bItalic As _Unsigned Long, Byval bUnderline As _Unsigned Long, Byval bStrikeOut As _Unsigned Long, Byval iCharSet As _Unsigned Long, Byval iOutPrecision As _Unsigned Long, Byval iClipPrecision As _Unsigned Long, Byval iQuality As _Unsigned Long, Byval iPitchAndFamily As _Unsigned Long, pszFaceName As String)
Function SelectObject& (ByVal HDC&&, Byval HGDI&&) 'select object nefunguje
End Declare
Declare Dynamic Library "User32"
Function GetDC& (ByVal Hwnd As _Integer64)
End Declare
Declare Dynamic Library "Opengl32"
Function wglUseFontBitmapsW& (ByVal HDC As _Unsigned Long, unnp1 As _Unsigned Long, unnp2 As _Unsigned Long, unnp3 As _Unsigned Long)
End Declare
Dim Shared GL_InitInfo As _Byte ' is need for OpenGL init
Dim Shared ExitSignal As _Byte ' is need for correct OpenGL exit when program end
Dim Shared Baze As Long
'constants for CreateFont
Const FW_DONTCARE = 0
Const FW_THIN = 100
Const FW_EXTRALIGHT = 200
Const FW_ULTRALIGHT = 200
Const FW_LIGHT = 300
Const FW_NORMAL = 400
Const FW_REGULAR = 400
Const FW_MEDIUM = 500
Const FW_SEMIBOLD = 600
Const FW_DEMIBOLD = 600
Const FW_BOLD = 700
Const FW_EXTRABOLD = 800
Const FW_ULTRABOLD = 800
Const FW_HEAVY = 900
Const FW_BLACK = 90
Const TRUE = 1 'tu -1 a v glprintu nebylo baze - 32 ale jen 32
Const FALSE = Not TRUE
Const FW_DONTCARE = 0
Const FW_THIN = 100
Const FW_EXTRALIGHT = 200
Const FW_ULTRALIGHT = 200
Const FW_LIGHT = 300
Const FW_NORMAL = 400
Const FW_REGULAR = 400
Const FW_MEDIUM = 500
Const FW_SEMIBOLD = 600
Const FW_DEMIBOLD = 600
Const FW_BOLD = 700
Const FW_EXTRABOLD = 800
Const FW_ULTRABOLD = 800
Const FW_HEAVY = 900
Const ANSI_CHARSET = 0
Const ARABIC_CHARSET = 178
Const BALTIC_CHARSET = 186
Const CHINESEBIG5_CHARSET = 136
Const DEFAULT_CHARSET = 1
Const EASTEUROPE_CHARSET = 238
Const GB2312_CHARSET = 134
Const GREEK_CHARSET = 161
Const HANGEUL_CHARSET = 129
Const HEBREW_CHARSET = 177 'http://www.jasinskionline.com/windowsapi/ref/c/createfont.html
Const JOHAB_CHARSET = 130
Const MAC_CHARSET = 77
Const OEM_CHARSET = 255
Const RUSSIAN_CHARSET = 204
Const SHIFTJIS_CHARSET = 128
Const SYMBOL_CHARSET = 2
Const THAI_CHARSET = 222
Const TURKISH_CHARSET = 162
Const OUT_DEFAULT_PRECIS = 0
Const OUT_DEVICE_PRECIS = 5
Const OUT_OUTLINE_PRECIS = 8
Const OUT_RASTER_PRECIS = 6
Const OUT_STRING_PRECIS = 1
Const OUT_STROKE_PRECIS = 3
Const OUT_TT_ONLY_PRECIS = 7
Const OUT_TT_PRECIS = 4
Const CLIP_DEFAULT_PRECIS = 0
Const CLIP_EMBEDDED = 128
Const CLIP_LH_ANGLES = 16
Const CLIP_STROKE_PRECIS = 2
Const ANTIALIASED_QUALITY = 4
Const DEFAULT_QUALITY = 0
Const DRAFT_QUALITY = 1
Const NONANTIALIASED_QUALITY = 3
Const PROOF_QUALITY = 2
Const DEFAULT_PITCH = 0
Const FIXED_PITCH = 1
Const VARIABLE_PITCH = 2
Const FF_DECORATIVE = 80
Const FF_DONTCARE = 0
Const FF_ROMAN = 16
Const FF_SCRIPT = 64
Const FF_SWISS = 32
Dim Shared hDC As _Integer64
'source: https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createfonta
Screen _NewImage(1024, 768, 32) 'this all before = 5 rows in C
Do
If ExitSignal Then System
_Limit 20
Loop
Sub _GL
If GL_InitInfo = 0 Then
_glShadeModel _GL_SMOOTH
_glClearColor 0.0F, 0.0F, 0.0F, 0.5F
_glClearDepth 1.0F
_glEnable _GL_DEPTH_TEST
_glDepthFunc _GL_LEQUAL
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST
BuildFont
GL_InitInfo = 1
Exit Sub
End If
_glShadeModel _GL_SMOOTH
_glClearColor 0.0F, 0.0F, 0.0F, 0.5F
_glClearDepth 1.0F
_glEnable _GL_DEPTH_TEST
_glDepthFunc _GL_LEQUAL
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT
_glLoadIdentity
_glTranslatef 0.0F, 0.0F, -1.0F
_glColor3f 1.0 * Cos(cnt1), 1.0 * Sin(cnt2), 1.0 - 0.5 * Cos(cnt1 + cnt2)
_glRasterPos2f -0.45 + 0.05 * Cos(cnt1), 0.32F * Sin(cnt2)
_glCallList 1
' glPrint "Test text"
cnt1 = cnt1 + 0.051
cnt2 = cnt2 + 0.005
_glEnd
If _Exit Then
KillFont
ExitSignal = 1
Exit Sub
End If
End Sub
Sub BuildFont
'HFONT = font 'in C - how write this in QB64?
Baze = _glGenLists(96)
Font& = CreateFont(-24, 0, 0, 0, FW_BOLD, FALSE, FALSE, FALSE, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, FF_DONTCARE And DEFAULT_PITCH, "Courier New")
hDC& = GetDC(_WindowHandle)
SO& = SelectObject(hDC&, Font&)
status = wglUseFontBitmapsW(hDC&, 32, 96, Baze) 'bool
Print "Display list BAZE handle:"; Baze
Print "Font handle: "; Font&
Print "hDC handle: "; hDC&
Print "Select Object handle: "; SO&
Print "wglUseFontBitmapsW handle: "; status
End Sub
Sub KillFont
_glDeleteLists 96, Baze
End Sub
Sub glPrint (text As String)
If text = "" Then Exit Sub
_glPushAttrib _GL_LIST_BIT
_glListBase (Baze - 32)
_glCallLists Len(text$), _GL_UNSIGNED_BYTE, _Offset(text$)
_glPopAttrib
End Suband this is original C source:
Code: (Select All)
#include <windows.h>
#include <math.h>
#include <stdio.h>
#include <stdarg.h>
#include <gl\gl.h>
#include <gl\glu.h>
#include <gl\glaux.h>
HDC hDC = NULL;
HGLRC hRC = NULL;
HWND hWnd = NULL;
HINSTANCE hInstance
bool keys[256];
bool active = TRUE;
bool fullscreen = TRUE;
GLuint base; //because BASE is statement in QB64, i use BAZE word in QB64 version
GLfloat cnt1;
GLfloat cnt2;
GLvoid BuildFont(GLvoid)
{
HFONT font; // must this be defined in QB64? How?
base = glGenLists (96)
font = CreateFont (-24, 0, 0, 0, FW_BOLD, FALSE, FALSE, FALSE, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, FF_DONTCARE | DEFAULT_PITCH, "Courier New")
SelectObject (hDC, font)
wglUseFontBitmaps(hDC, 32, 96, base)
}
GLvoid KillFont(GLvoid)
{
glDeleteLists(base, 96);
}
GLvoid glPrint (const char *fmt, ...)
{
char text[256]
va_list ap;
if (fmt == NULL)
return;
va_start(ap, fmt);
vsprintf(text, fmt, ap);
va_end(ap);
glPushAttrib (GL_LIST_BIT);
glListBase(base - 32);
glCallLists(strlen(text), GL_UNSIGNED_BYTE, text);
glPopAttrib();
}
int InitGL(GLvoid)
{
glShadeModel(GL_SMOOTH);
glClearColor(0.0f, 0.0f, 0.0f, 0.5f);
glClearDepth(1.0f);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LEQUAL);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
BuildFont();
return TRUE;
}
int DrawGLScene(GLvoid)
{
glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glTranslatef(0.0f,0.0f,-1.0f);
glColor3f(1.0f*float(cos(cnt1)),1.0f*float(sin(cnt2)),1.0f-0.5f*float(cos(cnt1+cnt2)));
glRasterPos2f(-0.45f+0.05f*float(cos(cnt1)), 0.32f*float(sin(cnt2)));
glPrint("Test text", cnt1);
cnt1+=0.051f;
cnt2+=0.005f;
return TRUE;
}
if(!UnregisterClass("OpenGL",hInstance))
{
MessageBox(NULL,"Could Not Unregister Class.","SHUTDOWN ERROR",MB_OK | MB_ICONINFORMATION);
hInstance=NULL;
}
KillFont();
}If someone managed to get it up and running, I'd like to learn what's missing and why it doesn't work.