How get private Device context GDI in QB64?

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