lbjoseph
Oct 3, 2011
gx Graphics Library
This the code that makes the gx Graphics Library work. This page will always contain the most up-to-date version.Just paste this code into the bottom of
' ---------------------------------------------------------------------------------------------- '
'-------------------------------------------------------------------- gx GRAPHICS LIBRARYVARIABLES -------------------------------------------------------------------- '
' ---------------------------------------------------------------------------------------------- '
Struct gxInfo,_DC As ULong,_ ' Device ContextBmpCache As ULong,_ ' Another Device Context for temporarily storing bitmaps.Width As Long,_ ' Area WidthHeight As Long,_ ' Area HeightPenStyle As Long,_ ' _PS_SOLID _PS_DASH _PS_DOT _PS_DASHDOT_ ' _PS_DASHDOTDOT _PS_NULL _PS_INSIDEFRAMEPenWidth As Long,_ ' Line ThicknessPenColor As Long,_ ' Line ColorBrushStyle As Long,_ ' _HS_BDIAGONAL _HS_CROSS _HS_DIAGCROSS_ ' _HS_FDIAGONAL _HS_HORIZONTAL _HS_VERTICALFillColor As Long,_ ' Fill ColorStyleColor As Long,_ ' Brush Style ColorFont As Long,_ ' Handle to a font for text rendering.FontHeight As Long,_ ' Height of the current font in pixels. Provided for your convenience.DesktopDPI As Long,_ ' DPI-Y of the desktop window.BlitStyle As Long,_ ' The blit mode for drawing bitmapsBlitKey As Long,_ ' The transparent color for drawing bitmaps._ ' -1 indicates no transparency.BlitAngle As Long,_ ' The angle of rotation for drawing bitmaps in degrees.BlitOrigin$ As Ptr ,_ ' The origin point for blitting.TextColor As Long ' Text ColorStruct gxGDIBitmap,_bmType As Long,_bmWidth As Long,_bmHeight As Long,_bmWidthBytes As Long,_bmPlanes As Word,_bmBitsPixel As Word,_bmBits As LongStruct gxTA, eM11 As uLong, eM12 As uLong, eM21 As uLong,_eM22 As uLong, eDx As uLong, eDy As uLongStruct gxTB, eM11 As uLong, eM12 As uLong, eM21 As uLong,_eM22 As uLong, eDx As uLong, eDy As uLongStruct gxPoint, x As Long, y As LongStruct gxLocal, R4 As ULong' ---------------------------------------------------------------------------------------------- '' ---------------------------------------------------------------------------------------------- '' ---------------------------------------------------------------------------------------------- 'gxGL LibraryPut this code at the bottom of every program that uses gxGL:Sub gx.InitMemoryDrawing width, height
' Call this once before attempting to draw in memory using the gx functions.
' width and height are the maximum dimensions of the graphics you intend to draw in memory.
gxDC = gxInfo.DC.structIf gxDC Then' Clean oldStruct gxInfo,_
DCoutgxDC = 0End IfAs ULong,_ ' Device Context
BmpCache As ULong,_ ' Another Device Context for temporarily storing bitmaps.
Width As Long,_ ' Area Width
Height As Long,_ ' Area Height
PenStyle As Long,_ ' _PS_SOLID _PS_DASH _PS_DOT _PS_DASHDOT
_ ' _PS_DASHDOTDOT _PS_NULL _PS_INSIDEFRAME
PenWidth As Long,_ ' Line Thickness
PenColor As Long,_ ' Line Color
BrushStyle As Long,_ ' _HS_BDIAGONAL _HS_CROSS _HS_DIAGCROSS
_ ' _HS_FDIAGONAL _HS_HORIZONTAL _HS_VERTICAL
FillColor As Long,_ ' Fill Color
StyleColor As Long,_ ' Brush Style Color
Font As Long,_ ' Handle to a font for text rendering.
FontHeight As Long,_ ' Height of the current font in pixels. Provided for your convenience.
DesktopDPI As Long,_ ' DPI-Y of the desktop window.
BlitStyle As Long,_ ' The blit mode for drawing bitmaps
BlitKey As Long,_ ' The transparent color for drawing bitmaps.
_ ' -1 indicates no transparency.
BlitAngle As Long,_ ' The angle of rotation for drawing bitmaps in degrees.
BlitOrigin$ As Ptr ,_ ' The origin point for blitting.
TextColor As Long ' Text Color
Struct gxGDIBitmap,_
bmType As Long,_
bmWidth As Long,_
bmHeight As Long,_
bmWidthBytes As Long,_
bmPlanes As Word,_
bmBitsPixel As Word,_
bmBits As Long
Struct gxTA, eM11 As uLong, eM12 As uLong, eM21 As uLong,_
eM22 As uLong, eDx As uLong, eDy As uLong
Struct gxTB, eM11 As uLong, eM12 As uLong, eM21 As uLong,_
eM22 As uLong, eDx As uLong, eDy As uLong
Struct gxPoint, x As Long, y As Long
Struct gxLocal, R4 As ULong
' Needed for TransparentBlt:
Open "msimg32.dll" For DLL As #msimg32
Open "oleaut32" For DLL As #oleaut32
' Get the desktop window:
CallDLL #user32, "GetDesktopWindow", desktopWin As ULong
' Get the desktop window's device context:
CallDLL #user32, "GetDC", desktopWin As ULong, desktopDC As ULong
' Make a compatible DC:
CallDLL #gdi32,"CreateCompatibleDC", desktopDC As Ulong, gxDC As ULong
' Make another one:
CallDLL #gdi32,"CreateCompatibleDC", desktopDC As Ulong, BmpCache As ULong
' Make a compatible bitmap for drawing on:
CallDLL #gdi32, "CreateCompatibleBitmap",_
desktopDC As ULong, width As Long, height As Long, bitmap As ULong
' Select it into our DC:
CallDLL #gdi32, "SelectObject", gxDC As ULong, bitmap As ULong, oldBitmap As ULong
' Delete the old bitmap:
CallDLL #gdi32, "DeleteObject", oldBitmap As ULong, result As Long
' Release the desktop window's DC:
CallDLL #user32, "ReleaseDC", desktopWin As ULong, desktopDC As ULong, result As Long
' Set the text align to work as expected:
CallDLL #gdi32, "SetTextAlign", gxDC As ULong, 0 As uLong, result As Long
' DPI:
CallDLL #gdi32, "GetDeviceCaps", gxDC As ULong, _LOGPIXELSY As Long, dpi As Long
CallDLL #gdi32, "SetStretchBltMode", gxDC As ULong, _COLORONCOLOR As Long, result As Long
CallDLL #gdi32, "SetGraphicsMode", gxDC As ULong, _GM_ADVANCED As Long, result As Long
CallDLL #gdi32, "SetPolyFillMode", gxDC As ULong, _WINDING As Long, result As Long
gxInfo.DC.struct = gxDC
gxInfo.BmpCache.struct = BmpCache
gxInfo.Width.struct = width
gxInfo.Height.struct = height
gxInfo.PenStyle.struct = _PS_SOLID
gxInfo.PenWidth.struct = 1
gxInfo.PenColor.struct = gx.Color("black")
gxInfo.BrushStyle.struct = -1 ' Solid. -2 = null brush.
gxInfo.FillColor.struct = gx.Color("darkgray")
gxInfo.StyleColor.struct = gx.Color("lightgray")
gxInfo.Font.struct = 0
gxInfo.FontHeight.struct = 0
gxInfo.DesktopDPI.struct = dpi
gxInfo.BlitStyle.struct = gx.BlitStyle("normal")
gxInfo.BlitKey.struct = -1 ' No transparent color.
gxInfo.BlitAngle.struct = 0 ' No rotation in degrees.
gxInfo.BlitOrigin$.struct = "default"
gxInfo.TextColor.struct = gx.Color("black")
End Sub
Sub gx.RenderTo control, destX, destY, srcX, srcY, srcW, srcH
' control is the hwnd of the control you'd like to render the image in memory to.
' destX and destY specify where to place the image on the control.
' srX and srcY specify the start point to grab the source image.
' srcW and srcH specify the size of the grab area.
gxDC = gxInfo.DC.struct
If Not(gxDC) Then Exit Sub
' Get the control's DC:
CallDLL #user32, "GetDC", control As ULong, controlDC As ULong
' Render the specified area of the source to the specified location on the destination control.
CallDLL #gdi32, "SetStretchBltMode", controlDC As ULong, _COLORONCOLOR As Long, result As Long
CallDLL #gdi32, "StretchBlt",_
controlDC As Ulong,_ 'destination
destX As Long,_ 'destination x pos
destY As Long,_ 'destination y pos
srcW As Long,_ 'destination width desired
srcH As Long,_ 'destination height desired
gxDC As Ulong,_ 'source
srcX As Long,_ 'x location to start from source
srcY As Long,_ 'y location to start from source
srcW As Long,_ 'width desired from source
srcH As Long,_ 'height desired from source
_SRCCOPY As ULong,_ 'dwRasterOperation
result As Long
' Release the control's DC:
CallDLL #user32, "ReleaseDC", control As ULong, controlDC As ULong, result As Long
End Sub
Sub gx.Finish
' Call this once at the end of your program after using the gx library.
gxDC = gxInfo.DC.struct
BmpCache = gxInfo.BmpCache.struct
If Not(gxDC) Then Exit Sub
Close #msimg32
Close #oleaut32
' Delete the DC and it's resources.
CallDLL #gdi32, "DeleteDC", gxDC As ULong, result As Long
CallDLL #gdi32, "DeleteDC", BmpCache As ULong, result As Long
gxInfo.DC.struct = 0
End Sub
Sub gx.Draw query$
' Call this with your drawing commands in draw$
gxDC = gxInfo.DC.struct
BmpCache = gxInfo.BmpCache.struct
If Not(gxDC) Then Exit Sub
width = gxInfo.Width.struct
height = gxInfo.Height.struct
penStyle = gxInfo.PenStyle.struct
penWidth = gxInfo.PenWidth.struct
penColor = gxInfo.PenColor.struct
brushStyle = gxInfo.BrushStyle.struct
fillColor = gxInfo.FillColor.struct
styleColor = gxInfo.StyleColor.struct
font = gxInfo.Font.struct
dpi = gxInfo.DesktopDPI.struct
blitStyle = gxInfo.BlitStyle.struct
blitKey = gxInfo.BlitKey.struct
blitAngle = gxInfo.BlitAngle.struct
blitOrigin$ = WinString(gxInfo.BlitOrigin$.struct)
textColor = gxInfo.TextColor.struct
If Not(font) Then
fontHeightPx = 16 : fontWeight = 400
fontItalic = 0 : fontUnderline = 0 : fontStrikeout = 0 : fontFace$ = "Arial"
GoSub [CreateFont]
End If
GoSub [ResetPen]
GoSub [ResetBrush]
' Don't parse past the | character if it's in there. That denotes rendering text.
textMaybe = Instr(query$,"|")
If Not(textMaybe) Then textMaybe = Len(query$) Else textMaybe = textMaybe - 1
text$ = Mid$(query$, textMaybe+2)
query$ = Mid$(query$, 1, textMaybe)
i = 1 : While Word$(query$,i,";") <> "" : i = i + 1 : WEnd : queries = i - 1
For i = 1 To queries
q$ = Trim$(Word$(query$, i, ";"))
key$ = Lower$(Word$(q$, 1))
' These are used for a lot of things:
x = Val(Word$(q$,2)) : y = Val(Word$(q$,3))
x2 = x + Val(Word$(q$,4)) : y2 = y + Val(Word$(q$,5))
' ---------------------------------------------------------------- '
afterKey$ = Trim$(Mid$(q$, Len(key$)+1))
Select Case key$
Case "polygonmode"
If Lower$(Word$(q$,2)) = "winding" Then mode = _WINDING Else mode = _ALTERNATE
CallDLL #gdi32, "SetPolyFillMode", gxDC As ULong, mode As Long, result As Long
Case "blitstyle"
blitStyle = gx.BlitStyle(Word$(q$,2))
Case "blitkey"
If Lower$(Word$(q$,2)) = "none" Then
blitKey = -1
Else
blitKey = gx.Color(afterKey$)
End If
Case "blitangle"
blitAngle = Val(Word$(q$,2))
Case "blitorigin"
If Lower$(Word$(q$,2)) = "default" Then
blitOrigin$ = "default"
Else
blitOrigin$ = Str$(Val(Word$(q$,2)));" ";Str$(Val(Word$(q$,3)))
End If
Case "pencolor"
penColor = gx.Color(afterKey$) : GoSub [ResetPen]
Case "penwidth"
penWidth = Val(Word$(q$,2)) : GoSub [ResetPen]
Case "penstyle"
Select Case Lower$(Word$(q$,2))
Case "normal","solid" : penStyle = _PS_SOLID
Case "none" : penStyle = _PS_NULL
Case "insideframe" : penStyle = _PS_INSIDEFRAME
Case "dash" : penStyle = _PS_DASH
Case "dot" : penStyle = _PS_DOT
Case "dashdot" : penStyle = _PS_DASHDOT
Case "dashdotdot" : penStyle = _PS_DASHDOTDOT
End Select
GoSub [ResetPen]
Case "fillcolor"
fillColor = gx.Color(afterKey$) : GoSub [ResetBrush]
Case "brushstyle"
Select Case Lower$(Word$(q$,2))
Case "45up" : brushStyle = _HS_BDIAGONAL
Case "45down" : brushStyle = _HS_FDIAGONAL
Case "45" : brushStyle = _HS_DIAGCROSS
Case "cross" : brushStyle = _HS_CROSS
Case "horizontal" : brushStyle = _HS_HORIZONTAL
Case "vertical" : brushStyle = _HS_VERTICAL
Case "solid","normal" : brushStyle = -1
Case "none" : brushStyle = -2
End Select
GoSub [ResetBrush]
Case "stylecolor"
If Lower$(Word$(q$,2)) = "none" Then
' Set background mode to be transparent:
CallDLL #gdi32, "SetBkMode", gxDC As ULong, _TRANSPARENT As Long, result As Long
styleColor = -1
Else
' Set background color to be opaque:
CallDLL #gdi32, "SetBkMode", gxDC As ULong, _OPAQUE As Long, result As Long
styleColor = gx.Color(afterKey$)
' Set the background color:
CallDLL #gdi32, "SetBkColor", gxDC As ULong, styleColor As Long, result As Long
End If
Case "ellipse"
CallDLL #gdi32, "Ellipse", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
Case "box"
CallDLL #gdi32, "Rectangle", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
Case "roundbox"
nWidth = Val(Word$(q$,6)) : nHeight = Val(Word$(q$,7))
If Not(nWidth) And Not(nHeight) Then nWidth = 10 ' Default round radius.
If Not(nHeight) Then nHeight = nWidth ' Make it whatever the other is.
CallDLL #gdi32, "RoundRect", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, nWidth As Long, nHeight As Long,_
result As Long
Case "line"
x2 = Val(Word$(q$,4)) : y2 = Val(Word$(q$,5))
CallDLL #gdi32, "MoveToEx", gxDC As ULong, x As Long, y As Long, 0 As Long, result As Long
CallDLL #gdi32, "LineTo", gxDC As ULong, x2 As Long, y2 As Long, result As Long
Case "polygon"
polyArray$ = ""
p = 1
While Word$(afterKey$,p) <> "" : p = p + 1 : WEnd
p = Int((p-1)/2)
For q = 1 To p*2 Step 2
x = Val(Word$(afterKey$,q))
y = Val(Word$(afterKey$,q+1))
gxPoint.x.struct = x
gxPoint.y.struct = y
polyArray$ = polyArray$; gxPoint.struct
Next q
CallDLL #gdi32, "Polygon", gxDC As ULong, polyArray$ As Ptr, p As ULong, result As Long
Case "cls"
CallDLL #gdi32, "GetStockObject", _WHITE_BRUSH As Long, whiteBrush As uLong
CallDLL #gdi32, "SelectObject", gxDC As ULong, whiteBrush As Long, oldBrush As ULong
GoSub [NullPen]
x = -2 : y = -2 : x2 = width+4 : y2 = height+4
CallDLL #gdi32, "Rectangle", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
GoSub [NonNullPen]
CallDLL #gdi32, "SelectObject", gxDC As ULong, oldBrush As ULong, whiteBrush As ULong
Case "fill"
GoSub [NullPen]
x = -2 : y = -2 : x2 = width+4 : y2 = height+4
oldBrushStyle = brushStyle : oldFillColor = fillColor
brushStyle = -1 : fillColor = gx.Color(afterKey$)
GoSub [ResetBrush]
CallDLL #gdi32, "Rectangle", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
brushStyle = oldBrushStyle
fillColor = oldBrushColor
GoSub [ResetBrush]
GoSub [NonNullPen]
Case "fillat"
CallDLL #gdi32, "GetPixel", gxDC As ULong, x As Long, y As Long, fillAtColor As Long
CallDLL #gdi32, "ExtFloodFill", gxDC As ULong,_
x As Long, y As Long, fillAtColor As Long, _FLOODFILLSURFACE As Long, result As Long
Case "font"
fontFace$ = Word$(q$,2)
fb$ = ""
For f = 1 To Len(fontFace$)
char$ = Mid$(fontFace$,f,1)
If char$="_" Then char$=" "
fb$ = fb$;char$
Next f
fontFace$ = fb$
' Technically, calculating the height of the font should work without the 1.25.
' But to get it to be the same as all other programs on my system (JosephE), I had
' to add that constant in. For some reason, it works for me.
fontHeightPx = Int( ( (Val(Word$(q$,3)) * dpi*1.25) / 72 ) - .5)
a$ = Trim$(Lower$(Word$(q$,4);" ";Word$(q$,5);" ";Word$(q$,6);" ";Word$(q$,7)))
If Instr(a$,"bold") Then fontWeight = 700 Else fontWeight = 400
If Instr(a$,"underline") Then fontUnderline = 1 Else fontUnderline = 0
If Instr(a$,"strike") Then fontStrikeout = 1 Else fontStrikeout = 0
If Instr(a$,"italic") Then fontItalic = 1 Else fontItalic = 0
' Create new font, select it, and destroy any old ones:
GoSub [CreateFont]
Case "textat"
CallDLL #gdi32, "SetBkMode", gxDC As ULong, _TRANSPARENT As Long, oldBkMode As Long
textLen = Len(text$)
CallDLL #gdi32, "TextOutA", gxDC As ULong,_
x As Long, y As Long, text$ As Ptr, textLen As Long, result As Long
CallDLL #gdi32, "SetBkMode", gxDC As ULong, oldBkMode As Long, null As Long
Case "textcolor"
textColor = gx.Color(afterKey$)
CallDLL #gdi32, "SetTextColor", gxDC As ULong, textColor As ULong, result As Long
Case "blit"
bitmap$ = Word$(q$,2)
bitmap = HBmp(Word$(q$,2))
destX = Val(Word$(q$,3)) : destY = Val(Word$(q$,4))
size$ = gx.BitmapSize$(bitmap$)
destW = Val(Word$(size$,1)) : destH = Val(Word$(size$,2))
srcW = destW : srcH = destH : srcX = 0 : srcY = 0
' Blit the bitmap:
GoSub [Blit]
Case "blitfield"
' blitfield bitmap srcX srcY srcW srcH destX destY destW destH
bitmap = HBmp(Word$(q$,2))
srcX = Val(Word$(q$,3)) : srcY = Val(Word$(q$,4))
srcW = Val(Word$(q$,5)) : srcH = Val(Word$(q$,6))
destX = Val(Word$(q$,7)) : destY = Val(Word$(q$,8))
destW = Val(Word$(q$,9)) : destH = Val(Word$(q$,10))
' Show the bitmap to custom dimensions:
GoSub [Blit]
Case "getbmp"
' getbmp bmpName x y width height
bitmap$ = Word$(q$,2)
x = Val(Word$(q$,3)) : y = Val(Word$(q$,4))
w = Val(Word$(q$,5)) : h = Val(Word$(q$,6))
' Create a new bitmap. Place it in the bitmap buffer. Draw the portion of the memory bitmap
' into it. Unselect it, and give it to the user after LOADBMPing it.
CallDLL #user32, "GetDesktopWindow", desktopWin As ULong
CallDLL #user32, "GetDC", desktopWin As ULong, desktopDC As ULong
CallDLL #gdi32, "CreateCompatibleBitmap",_
desktopDC As ULong, w As Long, h As Long, bitmap As ULong
CallDLL #gdi32, "SelectObject", BmpCache As ULong, bitmap As ULong, oldBitmap As ULong
CallDLL #gdi32, "StretchBlt", BmpCache As ULong,_
0 As Long, 0 As Long, w As Long, h As Long,_
gxDC As ULong, x As Long, y As Long, w As Long, h As Long,_
_SRCCOPY As Long, result As Long
CallDLL #gdi32, "SelectObject", BmpCache As ULong, oldBitmap As ULong, bitmap As ULong
LoadBMP bitmap$, bitmap
End Select
Next i
GoTo [CleanUp]
[Blit]
' See if rotation is necessary:
If blitAngle <> 0 Then
' Apply world rotation.
radians = blitAngle / 180 * acs(-1)
cosine = cos(radians)
sine = sin(radians)
If blitOrigin$ = "default" Then
centerX = destX + Int(destW/2)
centerY = destY + Int(destH/2)
Else
centerX = destX + Val(Word$(blitOrigin$,1))
centerY = destY + Val(Word$(blitOrigin$,2))
End If
gxTB.eM11.struct = gx.InternalFloat(cosine)
gxTB.eM12.struct = gx.InternalFloat(sine)
gxTB.eM21.struct = gx.InternalFloat(-1*sine)
gxTB.eM22.struct = gx.InternalFloat(cosine)
gxTB.eDx.struct = gx.InternalFloat(centerX - cos(radians)*centerX + sin(radians)*centerY)
gxTB.eDy.struct = gx.InternalFloat(centerY - cos(radians)*centerY - sin(radians)*centerX)
' Get the original transform:
CallDLL #gdi32, "GetWorldTransform", gxDC As ULong, gxTA As struct, result As Long
' Set it to the new one:
CallDLL #gdi32, "SetWorldTransform", gxDC As ULong, gxTB As struct, result As Long
End If
CallDLL #gdi32, "SelectObject", BmpCache As ULong, bitmap As ULong, junkBitmap As ULong
' srcX srcY srcW srcH
If blitKey = -1 Then
' Stretch Blit:
CallDLL #gdi32, "StretchBlt", gxDC As ULong,_
destX As Long, destY As Long, destW As Long, destH As Long,_
BmpCache As ULong, srcX As Long, srcY As Long, srcW As Long, srcH As Long,_
blitStyle As Long, result As Long
Else
' Transparent Blit:
CallDLL #msimg32, "TransparentBlt", gxDC As ULong,_
destX As Long, destY As Long, destW As Long, destH As Long,_
BmpCache As ULong, srcX As Long, srcY As Long, srcW As Long, srcH As Long,_
blitKey As ULong, result As Long
End If
CallDLL #gdi32, "SelectObject", BmpCache As ULong, junkBitmap As ULong, bitmap As ULong
If blitAngle <> 0 Then
' Go back to the old transform setting:
CallDLL #gdi32, "SetWorldTransform", gxDC As ULong, gxTA As struct, result As Long
End If
Return
[CreateFont]
CallDLL #gdi32, "CreateFontA",_
fontHeightPx As Long,0 As Long,0 As Long,0 As Long, fontWeight As Long, fontItalic As Long,_
fontUnderline As Long, fontStrikeout As Long,0 As Long,0 As Long,0 As Long,0 As Long,0 As Long,_
fontFace$ As Ptr, font As Long
CallDLL #gdi32, "SelectObject", gxDC As ULong, font As Long, oldFont As Long
If oldFont Then CallDLL #gdi32, "DeleteObject", oldFont As Long, result As Long
Return
[NullPen]
' The transparent pen for non-outlined shapes.
CallDll #gdi32, "GetStockObject", _NULL_PEN As ULong, nullPen As ULong
CallDLL #gdi32, "SelectObject", gxDC As ULong, nullPen As ULong, oldPen As ULong
Return
[NonNullPen]
' The other pen that is for outlined shapes.
CallDLL #gdi32, "SelectObject", gxDC As ULong, oldPen As ULong, nullPen As ULong
Return
[ResetPen]
' Recreate the pen and select it.
CallDLL #gdi32, "CreatePen", penStyle As ULong, penWidth As Long, penColor As ULong, pen As ULong
' Select the new pen:
CallDLL #gdi32, "SelectObject", gxDC As ULong, pen As ULong, oldPen As ULong
CallDLL #gdi32, "DeleteObject", oldPen As ULong, result As Long
Return
[ResetBrush]
' Recreate the brush and select it.
Select brushStyle
Case -1
' Solid brush:
CallDLL #gdi32, "CreateSolidBrush", fillColor As Long, brush As ULong
Case -2
' No brush (invisible/hollow/null) brush:
CallDll #gdi32, "GetStockObject", _HOLLOW_BRUSH As ULong, hollowBrush As ULong
brush = hollowBrush
Case Else
' Hatch brush of some kind:
CallDLL #gdi32, "CreateHatchBrush",_
brushStyle As Long, fillColor As Long, brush As ULong
End Select
' Select the new brush:
CallDLL #gdi32, "SelectObject", gxDC As ULong, brush As ULong, oldBrush As ULong
CallDLL #gdi32, "DeleteObject", oldBrush As ULong, result As Long
Return
[CleanUp]
' Replace the pen with the stock one. Delete the custom pen.
CallDll #gdi32, "GetStockObject", _BLACK_PEN As Long, blackPen As ULong
CallDLL #gdi32, "SelectObject", gxDC As ULong, blackPen As ULong, oldPen As ULong
CallDLL #gdi32, "DeleteObject", oldPen As ULong, result As Long
' Do the same for the brushies:
' Save any changes into gx:
gxInfo.PenStyle.struct = penStyle
gxInfo.PenWidth.struct = penWidth
gxInfo.PenColor.struct = penColor
gxInfo.BrushStyle.struct = brushStyle
gxInfo.FillColor.struct = fillColor
gxInfo.StyleColor.struct = styleColor
gxInfo.Font.struct = font
gxInfo.FontHeight.struct = fontHeightPx
gxInfo.BlitStyle.struct = blitStyle
gxInfo.BlitKey.struct = blitKey
gxInfo.BlitAngle.struct = blitAngle
gxInfo.BlitOrigin$.struct = blitOrigin$
gxInfo.TextColor.struct = textColor
End Sub
Function gx.Color(color$)
' Returns the RGB color version of color$.
' color$ can be a "### ### ###" (rgb string) or a LB recognized color.
' You don't need to use this function. This is for internal use by gxGL.
If Word$(color$, 2) <> "" Then
' Color is a rgb string.
red = Val(Word$(color$,1))
green = Val(Word$(color$,2))
blue = Val(Word$(color$,3))
gx.Color = gx.RGB(red,green,blue)
Exit Function ' Return the value.
End If
' Color must be a Liberty BASIC color:
' Get the system "buttonface" color just in case:
CallDLL #user32, "GetSysColor", _COLOR_BTNFACE As Long, btnface as ULong
color$ = Trim$(Lower$(color$))
Select Case color$
Case "buttonface" : rgb = btnface
Case "yellow" : rgb = gx.RGB(255,255,0)
Case "brown" : rgb = gx.RGB(128,128,0)
Case "red" : rgb = gx.RGB(255,0,0)
Case "darkred" : rgb = gx.RGB(128,0,0)
Case "pink" : rgb = gx.RGB(255,0,255)
Case "darkpink" : rgb = gx.RGB(128,0,128)
Case "blue" : rgb = gx.RGB(0,0,255)
Case "darkblue" : rgb = gx.RGB(0,0,128)
Case "green" : rgb = gx.RGB(0,255,0)
Case "darkgreen" : rgb = gx.RGB(0,128,0)
Case "cyan" : rgb = gx.RGB(0,255,255)
Case "darkcyan" : rgb = gx.RGB(0,128,128)
Case "white" : rgb = gx.RGB(255,255,255)
Case "black" : rgb = 0
Case "lightgray", "lightgrey" : rgb = gx.RGB(192,192,192)
Case "darkgray", "darkgrey" : rgb = gx.RGB(128,128,128)
End Select
gx.Color = rgb
End Function
Function gx.RGB(r,g,b)
' Returns a single RGB color representation of the given color.
gx.RGB = (b*256*256)+(g*256)+r
End Function
Function gx.InternalFloat(R8)
' This is an internal function for use by gxGL.
' It converts a 64-bit double to a 32-bit number.
' This is necessary for certain GDI functions.
' You don't need to use this function.
CallDLL #oleaut32, "VarR4FromR8", R8 As Double, gxLocal As Struct, result As Long
gx.InternalFloat = gxLocal.R4.struct
End Function
Function gx.BlitStyle(style$)
' Returns the GDI raster code for the internal gx blit style style$.
' You don't need to use this function.
Select Case Lower$(Trim$(style$))
Case "copy", "normal" : style = _SRCCOPY
Case "and" : style = _SRCAND
Case "or" : style = _SRCPAINT
Case "xor" : style = _SRCINVERT
Case "invert" : style = _NOTSRCCOPY
Case "orinvert" : style = _NOTSRCERASE
Case "invertormerge" : style = _MERGEPAINT
Case "invertfinal" : style = _DSTINVERT
Case "invertfinaland" : style = _SRCERASE
End Select
gx.BlitStyle = style
End Function
Function gx.BitmapSize$(bitmap$)
' Returns the dimensions of the bitmap with the name bitmap$.
bitmap = HBmp(bitmap$)
nsize = Len(gxGDIBitmap.struct)
CallDLL #gdi32, "GetObjectA",_
bitmap As ULong, nsize As Long, gxGDIBitmap As struct, result As Long
width = gxGDIBitmap.bmWidth.struct : height = gxGDIBitmap.bmHeight.struct
gx.BitmapSize$ = "";width;" ";height
End Function