Older Version
Newer Version
lbjoseph
Jul 16, 2012
=gx Graphics Library= This the code that makes the [[gxGraphicsLibraryHome|gx Graphics Library]] work. This page will always contain the most up-to-date version. Just paste this code into the bottom of your program to use the gx Graphics Library: [[code format="lb"]] ' ---------------------------------------------------------------------------------------------- ' ' ------------------------------------ gx GRAPHICS LIBRARY ------------------------------------- ' ' ---------------------------------------------------------------------------------------------- ' 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. Struct gxInfo,_ DC As 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. BlitFlip$ As Ptr ,_ ' If the image is to be flipped around. 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.BlitFlip$.struct = "none" gxInfo.BlitOrigin$.struct = "default" gxInfo.TextColor.struct = gx.Color("black") End Sub Sub gx.StretchTo control, destX, destY, destW, destH, 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 destW As Long,_ 'destination width desired destH 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.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 blitFlip$ = WinString(gxInfo.BlitFlip$.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 = Int(Val(Word$(q$,2))) : y = Int(Val(Word$(q$,3))) x2 = x + Int(Val(Word$(q$,4))) : y2 = y + Int(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 "blitflip" Select Case Lower$(Word$(q$,2)) Case "none", "normal" blitFlip$ = "none" Case "horizontal" blitFlip$ = "horizontal" Case "vertical" blitFlip$ = "vertical" Case "both" blitFlip$ = "both" Case Else blitFlip$ = "none" End Select 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 = Int(Val(Word$(afterKey$,q))) y = Int(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: If blitFlip$ = "horizontal" Or blitFlip$ = "both" Then destX = destX + destW destW = 0 - destW End If If blitFlip$ = "vertical" Or blitFlip$ = "both" Then destY = destY + destH destH = 0 - destH End If 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.BlitFlip$.struct = blitFlip$ 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 [[code]]