How get private Device context GDI in QB64?
#11
That's how I most likely figured out why the program this thread revolves around didn't (and doesn't) work. This line in C source code: HGLRC hRC is to provide a persistent rendering context. Any smart advice on how to get into a library that handles this? I tried to use my imagination, but somehow it didn't help.

How I figured it out. Run the following dump of the completely messed up previous program - now in QB64PE without OpenGL (the patient didn't work, so he went to the autopsy) - watch out, the text flashes heavily. It's even possible that on faster computers you won't see anything there, just one number.
I added Print there to slow down the refresh of the graphics background, because in this case it's controlled by the OS and it's beyond my power to change it - I think it's supposed to set the rendering context permanently - but that's just a guess.

Well, since it was displayed in one thousandth of a second, empty display lists were created, so there was nothing on the monitor. That seems like a logical explanation to me. But what more! If we could get this working (this blinking monster), we have the option of uncropped fonts, and beware - including Asian, including Western European and also Central European! In addition, with rotating options and other things, there are ten novels in the documentation for this function. Both he and today's question in Help regarding BYVAL marginally touched on this program as well.


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 TextOut Alias TextOutA (ByVal HDC As _Offset, Byval Xpos As Long, Byval Ypos As Long, Text As String, Byval LenghtString As Long)
    Function SelectObject~& (ByVal HDC%&, Byval HGDI%&)
    Sub SetTextColor (ByVal HDC As _Offset, Kolor As _Unsigned Long) 'BGR
End Declare


Declare Dynamic Library "User32"
    Function GetDC%& (ByVal Hwnd As _Integer64)
End Declare

'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 = 0
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



s$ = "Surprise"
font%& = CreateFont(60, 20, 40, 0, FW_BOLD, TRUE, TRUE, FALSE, ANSI_CHARSET, OUT_iT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, FF_DECORATIVE And DEFAULT_PITCH, "Courier" + Chr$(0))
hDC%& = GetDC%&(_WindowHandle)
c~& = SelectObject(hDC%&, font%&)


Screen _NewImage(1024, 768, 32)
Cls , _RGB32(127)

Color _RGB32(255, 0, 0)



Do
    Print c~&
    ce = TextOut(hDC%&, 100, 100, s$, Len(s$))
Loop


Reply




Users browsing this thread: 1 Guest(s)