lbjoseph
Jul 11, 2011
gx Graphics Library
These are the functions that make the gx Graphics Library work. This page will always contain the most up-to-date version.Be sure to paste this into the bottom of every program that uses gxGL. Also, this won't work if the gxGL headers aren't at the top of the program.
' gx High-Level Graphics Wrapper based on WinGDI32' by Joseph Essin' To Do:' Pies need to be implimented.' Antialiasing:' http://www.codeproject.com/KB/GDI/AntiAliasing.aspx' Syntax:' BOX[FILLED] x y width height' ROUNDBOX[FILLED] x y width height [xRoundRadius] [yRoundRadius]' ELLIPSE[FILLED] x y width height' LINE x y x2 y2' CLS' FILL color' FILLAT x y' FONT facename sizept [bold] [italic] [strike]' TEXTAT x y color | <- text comes after that' PENCOLOR color' FILLCOLOR color' STYLECOLOR color' PENWIDTH width' PENSTYLE style' BRUSHSTYLE style' Possible commands:' ---------------------------------------------------------------------------------------------- '' -------------------------------- gx GRAPHICS LIBRARY VARIABLES ------------------------------- '' ---------------------------------------------------------------------------------------------- '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.Struct gxGDIBitmap,_bmType As Long,_bmWidth As Long,_bmHeight As Long,_bmWidthBytes As Long,_bmPlanes As Word,_bmBitsPixel As Word,_bmBits As Long' ---------------------------------------------------------------------------------------------- '' ---------------------------------------------------------------------------------------------- '' ---------------------------------------------------------------------------------------------- '[Demo]NoMainWinWindowWidth = 640WindowHeight = 480UpperLeftX = Int((DisplayWidth-WindowWidth)/2)UpperLeftY = Int((DisplayHeight-WindowHeight)/2)Open "gx Graphics Demo" For Graphics_NF_NSB As #win#win "TrapClose [Quit]"#win "CLS; Down; Fill White; Flush;"' Must be called first. You can set the dimensions to be as big as you like. I'm just using the size of the window.Call gx.InitMemoryDrawing 640, 480' Draw a blue circle, but fill it lightgray and darkgray cross-hatch later by dipping it at 40 40.Call gx.Draw "cls; fill pink"Call gx.Draw "penstyle insideframe; pencolor red; penwidth 4; fillcolor blue"Call gx.Draw "ellipsefilled 10 10 100 100"Call gx.Draw "brushstyle solid; fillcolor 255 255 0; stylecolor lightgray; fillat 40 40"Call gx.Draw "pencolor red; fillcolor 64 64 64; penstyle insideframe; brushstyle solid; penwidth 4; ellipsefilled 2 2 40 24;"Call gx.Draw "penwidth 2; pencolor 90 90 90; boxfilled 45 2 100 68"Call gx.Draw "penwidth 1; fillcolor 25 45 50; pencolor 45 90 100; roundboxfilled 2 30 40 40 21"Call gx.Draw "penwidth 3; pencolor blue; line 2 78 144 78"Call gx.Draw "penwidth 1; pencolor 90 90 90; fillcolor 80 80 80; stylecolor none; brushstyle cross"Call gx.Draw "roundboxfilled 2 84 146 94 40"Call gx.Draw "font Arial 20 bold; textat 40 40 white ; | HELLO WORLD!"' Load your bitmaps here and draw them. :)'LoadBMP "rocket", "rocket.bmp"'LoadBMP "spark", "Spark 5.bmp"'Call gx.Draw "drawbmp rocket 100 100; drawbmp rocket 50 50; drawbmp spark 2 50"' (destination loc.) (source area start) (source area dimensions)Call gx.RenderTo hWnd(#win), 0,0, 0,0, 640,480Wait[Quit]Call gx.FinishClose #winEndSub 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.struct
If gxDC Then
' Clean old DC out
gxDC = 0
End If
' Needed for TransparentBlt:
Open "msimg32.dll" For DLL As #msimg32
' 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 Long, oldBitmap As ULong
' Delete the old bitmap:
CallDLL #gdi32, "DeleteObject", oldBitmap As Long, 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
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 = 0
gxInfo.BrushStyle.struct = -1 ' Solid
gxInfo.FillColor.struct = gx.Color("red")
gxInfo.StyleColor.struct = gx.Color("darkgray")
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.
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
' 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
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);Chr$(0)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 key$
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 "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" : 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", "bdiagonal" : brushStyle = _HS_BDIAGONAL
Case "45down", "fdiagonal" : brushStyle = _HS_FDIAGONAL
Case "cross" : brushStyle = _HS_CROSS
Case "diagcross" : brushStyle = _HS_DIAGCROSS
Case "horizontal" : brushStyle = _HS_HORIZONTAL
Case "vertical" : brushStyle = _HS_VERTICAL
Case "solid" : brushStyle = -1
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", "ellipsefilled" ' x y width height
If key$="ellipse" Then GoSub [NullBrush]
CallDLL #gdi32, "Ellipse", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
If key$="ellipse" Then GoSub [NonNullBrush]
Case "box", "boxfilled"
If key$="box" Then GoSub [NullBrush]
CallDLL #gdi32, "Rectangle", gxDC As ULong,_
x As Long, y As Long, x2 As Long, y2 As Long, result As Long
If key$="box" Then GoSub [NonNullBrush]
Case "roundbox", "roundboxfilled"
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.
If key$="roundbox" Then GoSub [NullBrush]
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
If key$="roundbox" Then GoSub [NonNullBrush]
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 "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 Long, 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"drawbmp"bitmap$"font"
fontFace$ = Word$(q$,2)
bitmap = HBmp(Word$(q$,2))x = Val(Word$(q$,3)) : y = Val(Word$(q$,4))Struct Size, cx As Long, cy As Longnsize = Len(gxGDIBitmap.struct)CallDLL #gdi32, "GetObjectA",_bitmap As ULong, nsize As Long, gxGDIBitmap As struct, result As Longwidth = gxGDIBitmap.bmWidth.struct :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= gxGDIBitmap.bmHeight.structCallDLL #gdi32, "SelectObject", BmpCache As ULong, bitmap As Long, junkBitmap As ULong' Blit the bitmap.CallDLL #gdi32, "BitBlt",_gxDC As ULong,_x As Long, y As Long, width As Long, height As Long,_BmpCache As Ulong, 0 As Long, 0 As Long,__SRCCOPY As Ulong, result As Long' Unselect the drawn bitmap from the bitmap cache dc:CallDLL #gdi32, "SelectObject", BmpCache As ULong, junkBitmap As Long, bitmap As ULongCase "font"dpi = 96fontFace$ = Word$(q$,2)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))Int( ( (Val(Word$(q$,3)) * dpi*1.25) /72) * dpi)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"
If Word$(q$,5) = "" Then
' One word color.
textColor = gx.Color(Word$(q$,4))
Else
' RGB Color:
textColor = gx.Color(Word$(q$,4);" ";Word$(q$,5);" ";Word$(q$,6))
End If
CallDLL #gdi32, "SetTextColor", gxDC As ULong, textColor As Long, result As Long
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 "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]
End Select
Next i
GoTo [CleanUp]
[Blit]
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
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
[NullBrush]
' The transparent brush for non-filled shapes.
CallDll #gdi32, "GetStockObject", _HOLLOW_BRUSH As Long, hollowBrush As uLong
CallDLL #gdi32, "SelectObject", gxDC As ULong, hollowBrush As Long, oldBrush As Long
Return
[NonNullBrush]
' The other brush that is for filled shapes.
CallDLL #gdi32, "SelectObject", gxDC As ULong, oldBrush As ULong, hollowBrush As ULong
Return
[NullPen]
' The transparent pen for non-outlined shapes.
CallDll #gdi32, "GetStockObject", _NULL_PEN As Long, 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.
If pen Then
' Destroy old pen.
CallDLL #gdi32, "SelectObject", gxDC As ULong, oldPen As ULong, pen As ULong
CallDLL #gdi32, "DeleteObject", pen As ULong, result As ULong : pen = 0
End If
CallDLL #gdi32, "CreatePen", penStyle As Long, penWidth As Long, penColor As Long, pen As ULong
' Select the new pen:
CallDLL #gdi32, "SelectObject", gxDC As ULong, pen As ULong, oldPen As ULong
Return
[ResetBrush]
If brush Then
' Destroy the old brush.
CallDLL #gdi32, "SelectObject", gxDC As ULong, oldBrush As ULong, brush As ULong
CallDLL #gdi32, "DeleteObject", brush As ULong, result As Long : brush = 0
End If
If brushStyle = -1 Then
' Solid brush
CallDLL #gdi32, "CreateSolidBrush", fillColor As Long, brush As ULong
Else
' Some other kind of brush.
CallDLL #gdi32, "CreateHatchBrush",_
brushStyle As Long, fillColor As Long, brush As ULong
End If
' Select the new brush:
CallDLL #gdi32, "SelectObject", gxDC As ULong, brush As ULong, oldBrush As ULong
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
End Sub
Function gx.Color(color$)
' Returns the LONG color version of color$.
' color$ can be a "### ### ###" (rgb string) or a LB recognized color.
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 theLONGGDI RGBcolor.color for internal use of the gx Graphics Library.
gx.RGB = (b*256*256)+(g*256)+r
End Function
Functiongx.Red(color)gx.BlitStyle(style$)
' Returns thered component of the LONG RGB color.b=Int(color/(256*256)) : g=Int((color-blue*256*256)/256) : gx.Red=color-blue*256*256-green*256GDI raster code for the internal gx blit style style$.
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
Functiongx.Green(color)gx.BitmapSize$(bitmap$)
' Returns thegreen componentdimensions of theLONG RGB color.b=Int(color/(256*256)) : gx.Green=Int((color-blue*256*256)/256)End FunctionFunction gx.Blue(color)' Returns the blue component of the LONG RGB color.gx.Blue=Int(color/(256*256))End FunctionFunction Win.GetDesktopWindow()CallDLL #user32, "GetDesktopWindow", Win.GetDesktopWindow As uLongEnd FunctionFunction Win.GetSysColor(nIndex)CallDLL #user32, "GetSysColor", nIndex as Long, Win.GetSysColor as ULongEnd FunctionFunction GDI.GetDC(hWnd)CallDLL #user32, "GetDC", hWnd As Ulong, GDI.GetDC As UlongEnd FunctionSub GDI.ReleaseDC hWnd, hDCCallDLL #user32, "ReleaseDC", hWnd As Long,hDC As Long, GDI.ReleaseDC As LongEnd SubSub GDI.DeleteDC hDCCallDLL #gdi32, "DeleteDC", hDC As ULong, GDI.DeleteDC As BooleanEnd SubFunction GDI.SelectObject(hDC, hObject)CallDLL #gdi32,"SelectObject", hDC As ULong, hObject As Long, GDI.SelectObject As ULongEnd FunctionFunction GDI.CreateCompatibleBitmap(hDC, wMem, hMem)CallDLL #gdi32, "CreateCompatibleBitmap",_hDC As Ulong, wMem As Long, hMem As Long, GDI.CreateCompatibleBitmap As UlongEnd FunctionFunction GDI.CreateCompatibleDC(hDC)CallDLL #gdi32,"CreateCompatibleDC", hDC As Ulong, GDI.CreateCompatibleDC As UlongEnd FunctionFunction GDI.SetPixel(hDC, x, y, rgb)CallDll #gdi32, "SetPixel",_hDC As Ulong, x As long, y As long, rgb As long,_GDI.SetPixel As longEnd FunctionFunction GDI.GetStockObject(object)CallDll #gdi32, "GetStockObject", object As Long, GDI.GetStockObject As uLongEnd FunctionFunction GDI.StretchBlt(hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2,ROP)CallDLL #gdi32, "SetStretchBltMode",_hDCdest As Ulong,_ ' device context_COLORONCOLOR As Long,_ ' color reduction modebitmap with the name bitmap$.
Struct Size, cx As Long, cy As Long
bitmap = HBmp(bitmap$)
nsize = Len(gxGDIBitmap.struct)
CallDLL #gdi32, "GetObjectA",_
bitmap As ULong, nsize As Long, gxGDIBitmap As struct, result As Long
CallDLL #gdi32, "StretchBlt",_hDCdest As Ulong,_ 'destinationx As Long,_ 'destination x posy As Long,_ 'destination y posw As Long,_ 'destinationwidthdesiredh As Long,_ 'destination= gxGDIBitmap.bmWidth.struct : heightdesiredhDCsrc As Ulong,_ 'sourcex2 As Long,_ 'x location to start from sourcey2 As Long,_ 'y location to start from sourcew2 As Long,_ 'width desired from sourceh2 As Long,_ 'height desired from sourceROP As Ulong,_ 'dwRasterOperationGDI.StretchBlt As BooleanEnd FunctionFunction GDI.BitBlt(hdcDest, xDest, yDest, wDest, hDest, hdcSource, xSource, ySource, ROP)CallDLL #gdi32, "BitBlt", _hdcDest As Ulong, _xDest As Long, _yDest As Long, _wDest As Long, _hDest As Long, _hdcSource As Ulong, _xSource As Long, _ySource As Long, _ROP As Ulong, _GDI.BitBlt As LongEnd FunctionFunction GDI.TransparentBlt(hdcDest, xDest, yDest, wDest, hDest, hdcSource, xSource, ySource, wSrc, hSrc, crTransparent)CallDLL #gdi32, "TransparentBlt", _hdcDest As Ulong, _xDest As Long, _yDest As Long, _wDest As Long, _hDest As Long, _hdcSource As Ulong, _xSource As Long, _ySource As Long, _wSrc As Long,_hSrc As Long,_crTransparent As Ulong, _GDI.TransparentBlt As Long= gxGDIBitmap.bmHeight.struct
gx.BitmapSize$ = "";width;" ";height
End Function