How get private Device context GDI in QB64?

[Petr]

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) 

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 Sub

and 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.