|
Post by Walt Decker on Mar 22, 2022 9:53:36 GMT -5
Here is a demo straight out of "Things You Don't Want to Know ..." in the General Discussion thread. It does not use "flush" at all but does use "discard". The slowdown in the rendering routine comes from collision detection and calculating new vectors.
'################################################################## ' ' IMAGE MOVEMENT ' ' Moves multiple objects with some minimal collision detection. '##################################################################
OPEN "User32.dll" FOR DLL AS #USER OPEN "Gdi32.dll" FOR DLL AS #GDI OPEN "Kernel32.dll" FOR DLL AS #KERN
'DIM Bkgnd(0, 1) REM uncomment DIM Balls(5, 4)
RetVal = 0 MrgCmDc = 0 MskCmDc = 0 GfxDc = 0
'RetVal = FN.CreateBkgnd(32, 32) REM uncomment
RetVal = FN.ConfigImages(32, 32) '<--- create the images RetVal = FN.SetForm(50, 50, 0.75, 0.75) '<--- define window and graphic 'control RetVal = FN.Render(MrgCmDc, MskCmDc, GfxDc) '<--- draw and manipulate 'the images
WAIT END
'-------------------------------------------------------------------------- '--------------------------------------------------------------------------
SUB END.IMG WinHndl$
CLOSE #USER CLOSE #GDI CLOSE #KERN CLOSE #DMO END END SUB
'-------------------------------------------------------------------------- '--------------------------------------------------------------------------
FUNCTION FN.SetForm(Ulx, Uly, Wide, High) WinHndl = 0 '<--- form window handle
Bx = 0 '<--- form client size By = 0
GRAPHICBOX #DMO.GFX, 0, 0, 32, 32
UpperLeftX = Ulx UpperLeftY = Uly WindowWidth = DisplayWidth * Wide WindowHeight = DisplayHeight * High
OPEN "BALLS" FOR WINDOW AS #DMO WinHndl = FN.GetHandle("#DMO") '<--- get handle of form window
RetVal = FN.ClientSize(WinHndl, Bx, By) '<--- get lower bounds of form 'window
PRINT #DMO.GFX, "locate 0 0 ";Bx;" ";By '<--- resize graphic control PRINT #DMO, "REFRESH" PRINT #DMO.GFX, "place 0, 0" PRINT #DMO.GFX, "fill 0 128 0" PRINT #DMO.GFX, "getbmp BKG 1 1 33 33" '<--- get background bmp for 'later use PRINT #DMO.GFX, "flush" PRINT #DMO, "TRAPCLOSE END.IMG" END FUNCTION
'-------------------------------------------------------------------------- '--------------------------------------------------------------------------
FUNCTION FN.CreateBkgnd(Sizx, Sizy)
GREEN = HEXDEC("&H008000")
PS.SOLID = 0
RetVal = 0 DktHndl = 0 DktCmDc = 0 DktDc = 0
MergeHndl = 0 MaskHndl = 0
Brush = 0 Pen = 0 OrdBrs = 0 OldPen = 0 OldBmp = 0
DktHndl = FN.DeskTop() DktDc = FN.GetDc(DktHndl) DktCmDc = FN.CompatDc(DktDc) DktDc = FN.DetachDc(DktHndl, DktDc)
Pen = FN.Pen(PS.SOLID, 1, GREEN) Brush = FN.SolidBrush(GREEN)
MergeHndl = FN.CreateDIB(DktCmDc, Sizx, Sizy) OldBmp = FN.AttachObj(DktCmDc, MergeHndl) OldPen = FN.AttachObj(DktCmDc, Pen) OldBrs = FN.AttachObj(DktCmDc, Brush)
CALLDLL #GDI, "Ellipse", DktCmDc AS ULONG, 0 AS LONG, 0 AS LONG, _ Sizx AS LONG, Sizy AS LONG, RetVal AS VOID
OldBmp = FN.AttachObj(DktCmDc, OldBmp) OldPen = FN.AttachObj(DktCmDc, OldPen) OldBrs = FN.AttachObj(DktCmDc, OldBrs) Pen = FN.KillObj(Pen) Brush = FN.KillObj(Brush) DktCmDc = FN.KillDc(DktCmDc)
Balls(0, 0) = MergeHndl Balls(0, 1) = FN.CreateMasks(0, Sizx, Sizy, 0) Bkgnd(0, 0) = Balls(0, 0) Bkgnd(0, 1) = Balls(0, 1)
END FUNCTION
'-------------------------------------------------------------------------- '--------------------------------------------------------------------------
FUNCTION FN.ConfigImages(ImgWide, ImgHigh)
'<----------- colors --------------> RED = 255 YELLOW = HEXDEC("&H00FFFF") GREEN = HEXDEC("&H008000") TEAL = HEXDEC("&H808000") CYAN = HEXDEC("&HFFFF00") BLUE = HEXDEC("&HFF0000") BLACK = 1 SNOW = HEXDEC("&HFAFAFF")
I = 0 '<--- counter
'<---------- create and save the handles of memory bitmaps ------> FOR I = 0 TO 5 SELECT CASE I CASE 0 Balls(I, 0) = FN.CreateBalls(32, 32, RED) CASE 1 Balls(I, 0) = FN.CreateBalls(32, 32, YELLOW) CASE 2 Balls(I, 0) = FN.CreateBalls(32, 32, CYAN) CASE 3 Balls(I, 0) = FN.CreateBalls(32, 32, BLUE) CASE 4 Balls(I, 0) = FN.CreateBalls(32, 32, BLACK) CASE 5 Balls(I, 0) = FN.CreateBalls(32, 32, SNOW) END SELECT NEXT I
'<------- create and save merge and mask memory bitmaps --------> FOR I = 0 TO 5 Balls(I, 1) = FN.CreateMasks(I, 32, 32, 0) NEXT I END FUNCTION
'-------------------------------------------------------------------------- '--------------------------------------------------------------------------
FUNCTION FN.CreateBalls(Szx, Szy, Colour)
PS.SOLID = 0 '<--- pen style
RetVal = 0 '<--- dummy variable WinHndl = 0 '<--- desktop window handle MemHndl = 0 '<--- memory bitmap handle WinDc = 0 '<--- desktop device context WinCmDc = 0 '<--- personal device context
PenHndl = 0 '<--- pen handle BrsHndl = 0 '<--- brush handle
OrigBmp = 0 '<--- original components OrigPen = 0 OrigBrs = 0
WinHndl = FN.DeskTop() '<--- get desktop handle WinDc = FN.GetDc(WinHndl) '<--- get desktop device context WinCmDc = FN.CompatDc(WinDc) '<--- create personal context WinDc = FN.DetachDc(WinHndl, WinDc) '<--- release desktop device context
MemHndl = FN.CreateDIB(WinCmDc, Szx, Szy) '<--- create memory bitmap
PenHndl = FN.Pen(PS.SOLID, 1, Colour) '<--- create a pen BrsHndl = FN.SolidBrush(Colour) '<--- create a brush
OrigBmp = FN.AttachObj(WinCmDc, MemHndl) '<--- activate memory bitmap OrigPen = FN.AttachObj(WinCmDc, PenHndl) '<--- activate pen OrigBrs = FN.AttachObj(WinCmDc, BrsHndl) '<--- activate brush
'<------------------ draw a filled circle on memory bitmap --------> CALLDLL #GDI, "Ellipse", WinCmDc AS ULONG, 0 AS LONG, 0 AS LONG, _ Szx AS LONG, Szy AS LONG, RetVal AS VOID
RetVal = FN.AttachObj(WinCmDc, OrigBmp) '<--- restore original objects RetVal = FN.AttachObj(WinCmDc, OrigPen) RetVal = FN.AttachObj(WinCmDc, OrigBrs) RetVal = FN.KillObj(PenHndl) '<--- delete pen and brush RetVal = FN.KillObj(BrsHndl) RetVal = FN.KillDc(WinCmDc) '<--- destroy personal context
FN.CreateBalls = MemHndl '<--- return memory bmp handle END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.CreateMasks(Index, BmWide, BmHigh, BkgColour)
WHITE = HEXDEC("&HFFFFFF")
SRCCOPY = HEXDEC("&H00CC0020") '<--- raster code, point by point 'without modification
RetVal = 0 '<--- dummy variable
WinHndl = 0 '<--- desktop handle BmpHndl = 0 '<--- new memory bitmap MemHndl = 0 '<--- existing memory bitmap WinDc = 0 '<--- desktop device context WinCmDc = 0 '<--- personal device context
OldDst = 0 '<--- original objects OldBmp = 0
PixClr = 0 '<--- pixel color
Y = 0 '<--- coordinates on memory bitmap X = 0
WinHndl = FN.DeskTop() '<--- get desktop handle WinDc = FN.GetDc(WinHndl) '<--- get desktop device context WinCmDc = FN.CompatDc(WinDc) '<--- create a personal context WinDc = FN.DetachDc(WinHndl, WinDc) '<--- release desktop device context WinDc = FN.CompatDc(WinCmDc) '<--- create a personal context
MemHndl = FN.CreateDIB(WinCmDc, BmHigh, BmWide) '<--- create memory bitmap BmpHndl = Balls(Index, 0) '<--- handle of existing memory bitmap
OldBmp = FN.AttachObj(WinDc, BmpHndl) '<--- make bitmaps active OldDst = FN.AttachObj(WinCmDc, MemHndl)
'<---------- copy existing bitmap to new bitmap ----------------> CALLDLL #GDI, "BitBlt", WinCmDc AS ULONG, 0 AS LONG, 0 AS LONG, _ BmWide AS LONG, BmHigh AS LONG, WinDc AS ULONG, _ 0 AS LONG, 0 AS LONG, SRCCOPY AS ULONG, RetVal AS LONG
'<-------------- create mask bitmap ---------------> FOR Y = 0 TO BmHigh - 1 FOR X = 0 TO BmWide - 1 PixClr = FN.GetPixelColor(WinCmDc, X, Y)
IF PixClr = BkgColour THEN PixClr = WHITE
RetVal = FN.SetPixelColor(WinCmDc, X, Y, PixClr) NEXT X NEXT Y
RetVal = FN.AttachObj(WinCmDc, OldDst) '<--- release mask bitmap
'<-------- create merge bitmap --------------> FOR Y = 0 TO BmHigh - 1 FOR X = 0 TO BmWide - 1 PixClr = FN.GetPixelColor(WinDc, X, Y)
IF PixClr = BkgColour THEN PixClr = 0 ELSE PixClr = WHITE END IF
RetVal = FN.SetPixelColor(WinDc, X, Y, PixClr) NEXT X NEXT Y
OldBmp = FN.AttachObj(WinDc, OldBmp) '<--- release merge bitmap WinDc = FN.KillDc(WinDc) '<--- destroy personal contexts WinCmDc = FN.KillDc(WinCmDc)
FN.CreateMasks = MemHndl '<--- return maks bitmap handle END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.Render(BYREF MrgHndl, BYREF MskHndl,BYREF GfxDc)
MERGESRC = HEXDEC("&H00E003A5") MASKSRC = HEXDEC("&H008800C6")
RetVal = 0 '<--- dummy variable GfxHndl = 0 '<--- graphic control handle DktHndl = 0 '<--- desktop handle MrgHndl = 0 '<--- merge bitmap handle MskHndl = 0 '<--- mask bitmap handle MrgCmDc = 0 '<--- personal context for merge bitmap MskCmDc = 0 '<--- personal context for mask bitmap DktDc = 0 '<--- desktop device context GfxDc = 0 '<--- graphic control device context
OldMrg = 0 '<--- original objects OldMsk = 0
Distx = 0 '<--- distances Disty = 0 PosX = 0 '<--- bitmap locations on graphic control PosY = 0 BkgX = 0 '<--- erase locations BkgY = 0 Azimuth = 0 '<--- movement vectors Azi = 0
Bx = 0 '<--- sizes By = 0 Gcx = 0 Gcy = 0
Bcx = 32 / 2 '<--- sizes Bcy = Bcx
'BkgMrg = Bkgnd(0, 0) 'BkgMsk = Bkgnd(0, 1)
Rad = 4 * ATN(1) / 180.0 '<--- calclate radians
GfxHndl = FN.GetHandle("DMO.GFX") '<--- handle of graphic control GfxDc = FN.GetDc(GfxHndl) '<--- graphic control device context
DktHndl = FN.DeskTop() '<--- desktop handle DktDc = FN.GetDc(DktHndl) '<--- desktop device context MrgCmDc = FN.CompatDc(DktDc) '<--- merge personal context MskCmDc = FN.CompatDc(MrgCmDc) '<--- mask persoal context 'BkgMrgCmDc = FN.CompatDc(MskCmDc) 'BkgMskCmDc = FN.CompatDc(BkgMrgCmDc) DktDc = FN.DetachDc(DktHndl, DktDc) '<--- release desktop device context
RetVal = FN.ClientSize(GfxHndl, Bx, By) '<--- size of graphic control
Gcx = Bx / 2 '<--- center of graphic control Gcy = By / 2
'<--------------- define beginning image positions -----> FOR I = 0 TO 5 Distx = RND(Bx) * Gcx + 1 Disty = RND(By) * Gcy + 1 Azimuth = RND(360) * 361 '<--- polar vector from center of control Azimuth = Azimuth * Rad
PosX = INT(Gcx + Distx * SIN(Azimuth) - Bcx) PosY = INT(Gcy - Disty * COS(Azimuth) - Bcy)
MrgHndl = Balls(I, 0) '<--- merge and mask handles MskHndl = Balls(I, 1)
OldMrg = FN.AttachObj(MrgCmDc, MrgHndl) '<--- activate memory bitmaps OldMsk = FN.AttachObj(MskCmDc, MskHndl)
'<------------------- place the images ---------------> CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, PosX AS LONG, PosY AS LONG, _ 32 AS LONG, 32 AS LONG, MrgCmDc AS ULONG, 0 AS LONG, _ 0 AS LONG, MERGESRC AS ULONG, RetVal AS LONG
CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, PosX AS LONG, PosY AS LONG, _ 32 AS LONG, 32 AS LONG, MskCmDc AS ULONG, 0 AS LONG, _ 0 AS LONG, MASKSRC AS ULONG, RetVal AS LONG
OldMrg = FN.AttachObj(MrgCmDc, OldMrg) '<--- deactivate memory bitmaps OldMsk = FN.AttachObj(MskCmDc, OldMsk)
Azimuth = INT(RND(PosX) * (360 - 1)) + 1 '<--- define movemeht vector Balls(I, 2) = Azimuth '<--- save information Balls(I, 3) = PosX Balls(I, 4) = PosY NEXT I
'RetVal = FN.AttachObj(BkgMrgCmDc, BkgMrg) REM uncomment 'RetVal = FN.AttachObj(BkgMskCmDc, BkgMsk) REM uncomment
CALLDLL #KERN, "Sleep", 5000 AS LONG, RetVal AS VOID
[AGAIN] '<---- move objects FOR J = 0 TO 5 MrgHndl = Balls(J, 0) '<--- object information MskHndl = Balls(J, 1) PosX = Balls(J, 3) PosY = Balls(J, 4) BkgX = PosX '<--- erase position BkgY = PosY
'<--- calculate new postion along vector ------> Azimuth = Balls(J, 2) Azi = Azimuth * Rad PosX = INT(PosX + 8 * SIN(Azi)) '<--- move 8 units along vector PosY = INT(PosY - 8 * COS(Azi))
'######################################################## ' Check new position. If the new position is beyond the ' limits of the graphic control calculate a new vector and ' position '######################################################## True = 0 SELECT CASE CASE PosX < 0.0 SELECT CASE CASE Azimuth > 270 Azimuth = 360 - Azimuth True = 1
CASE Azimuth = 270 Azimuth = 90 True = 1
CASE Azimuth < 270 Azi = 270 - Azimuth Azimuth = 90 + Azi True = 1 END SELECT
CASE PosX + 32 > Bx SELECT CASE CASE Azimuth = 90 Azimuth = 270 True = 1
CASE Azimuth < 90 Azimuth = 360 - Azimuth True = 1
CASE Azimuth > 90 Azi = 180 - Azimuth Azimuth = 180 + Azi True = 1 END SELECT
CASE PosY < 0 SELECT CASE CASE Azimuth = 0, Azimuth = 360 Azimuth = 180 True = 1
CASE Azimuth < 90 Azi = 90 - Azimuth Azimuth = 90 + Azi True = 1
CASE Azimuth > 270 Azi = Azimuth - 270 Azimuth = 270 - Azi True = 1 END SELECT
CASE PosY + 32 > By SELECT CASE CASE Azimuth = 180 Azimuth = 360 True = 1
CASE Azimuth < 180 Azimuth = 180 - Azimuth True = 1
CASE Azimuth > 180 Azi = 270 - Azimuth Azimuth = 270 + Azi True = 1 END SELECT END SELECT
IF True THEN '<--- recalculate new position Azi = Azimuth * Rad PosX = INT(PosX + 8 * SIN(Azi)) PosY = INT(PosY - 8 * COS(Azi)) END IF
REM comment below PRINT #DMO.GFX, "drawbmp BKG ";BkgX;" ";BkgY '<--- erase object
REM uncomment below ' CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, BkgX AS LONG, BkgY AS LONG, _ ' 32 AS LONG, 32 AS LONG, BkgMrgCmDc AS ULONG, 0 AS LONG, _ ' 0 AS LONG, MERGESRC AS ULONG, RetVal AS LONG
' CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, BkgX AS LONG, BkgY AS LONG, _ ' 32 AS LONG, 32 AS LONG, BkgMskCmDc AS ULONG, 0 AS LONG, _ ' 0 AS LONG, MASKSRC AS ULONG, RetVal AS LONG
OldMrg = FN.AttachObj(MrgCmDc, MrgHndl) '<--- active objects OldMsk = FN.AttachObj(MskCmDc, MskHndl)
'<--------------- render them on graphic control --------------> CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, PosX AS LONG, PosY AS LONG, _ 32 AS LONG, 32 AS LONG, MrgCmDc AS ULONG, 0 AS LONG, _ 0 AS LONG, MERGESRC AS ULONG, RetVal AS LONG
CALLDLL #GDI, "BitBlt", GfxDc AS ULONG, PosX AS LONG, PosY AS LONG, _ 32 AS LONG, 32 AS LONG, MskCmDc AS ULONG, 0 AS LONG, _ 0 AS LONG, MASKSRC AS ULONG, RetVal AS LONG OldMrg = FN.AttachObj(MrgCmDc, OldMrg) '<--- deactivate objects OldMsk = FN.AttachObj(MskCmDc, OldMsk)
Balls(J, 2) = Azimuth '<--- save information Balls(J, 3) = PosX Balls(J, 4) = PosY
NEXT J
REM comment below PRINT #DMO.GFX, "discard" '<--- comment
TIMER 25, [GO] WAIT
[GO] TIMER 0 GOTO [AGAIN]
END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.DeskTop() '###################################################################### ' Get a handle to the monitor '######################################################################
DtHndl = 0 CALLDLL #USER, "GetDesktopWindow", DtHndl AS ULONG
FN.DeskTop = DtHndl END FUNCTION True = 1
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.GetDc(WinHndl) '###################################################################### ' Get a context from MSWIN for the device (form window, control, ' printer, audio, external device). '######################################################################
WinDc = 0 CALLDLL #USER, "GetDC", WinHndl AS ULONG, WinDc AS ULONG
FN.GetDc = WinDc END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.CompatDc(WinDc) '###################################################################### ' Create a context compatible with a device. ' ' ARGUMENTS: ' WinDc: Device context. ' Do NOT use user32.dll ReleaseDC(), use gdi32.DLL ' DeleteDC() instead. '######################################################################
ComPatDc = 0 CALLDLL #GDI, "CreateCompatibleDC", WinDc AS ULONG, ComPatDc AS ULONG
FN.CompatDc = ComPatDc END FUNCTION
'------------------------------------------------------------------- '-------------------------------------------------------------------
FUNCTION FN.DetachDc(WinHndl, WinDc) '###################################################################### ' Release a device context and its resources ' ' ARGUMENTS: ' WinHndl: The handle of a form window or control. ' WinDc: Device context obtained from GetDc(). '######################################################################
RetVal = 0 CALLDLL #USER, "ReleaseDC", WinHndl AS ULONG, WinDc AS ULONG, RetVal AS VOID END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.AttachObj(WinDc, ThisObject) '###################################################################### ' Make an object (pen, brush, font, bitmap) active. ' ' ARGUMENTS: ' WinDc: Device context handle ' ThisObject: Object to make active. '######################################################################
OrgObj = 0 CALLDLL #GDI, "SelectObject", WinDc AS ULONG, ThisObject AS ULONG, _ OrgObj AS ULONG
FN.AttachObj = OrgObj END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.CreateDIB(ComPatDc, BmWide, BmHigh)
STRUCT tBITMAPINFO, _ '<--- bitmap information structure StrSize AS ULONG, _ '<--- size of structure Width AS LONG, _ '<--- width of bitmap Height AS LONG, _ '<--- height of bitmap Planes AS SHORT, _ '<--- number of color planes BitCount AS SHORT, _ '<--- number of bits to define colors Compression AS ULONG, _ '<--- type of compression; See Below SizeImage AS ULONG, _ '<--- size of image XPelsPerMeter AS LONG, _ '<--- number of pixels per meter YPelsPerMeter AS LONG, _ ClrUsed AS ULONG, _ '<--- number of colors in the bitmap ClrImportant AS ULONG, _ '<--- important colors Colors AS ULONG '<--- array of color in BRG format
BI.RGB = 0 'An uncompressed format.
DIB.RGB.COLORS = 0
BmpHndl = 0
tBITMAPINFO.StrSize.struct = LEN(tBITMAPINFO.struct) tBITMAPINFO.Width.struct = BmWide tBITMAPINFO.Height.struct = -1 * BmHigh '<--- top-down instead of bottom up tBITMAPINFO.Planes.struct = 1 tBITMAPINFO.BitCount.struct = 32 tBITMAPINFO.Compression.struct = BI.RGB
CALLDLL #GDI, "CreateDIBSection", ComPatDc AS ULONG, tBITMAPINFO AS STRUCT, _ DIB.RGB.COLORS AS LONG, 0 AS LONG, 0 AS LONG, 0 AS LONG, _ BmpHndl AS ULONG
FN.CreateDIB = BmpHndl END FUNCTION
'----------------------------------------------------------- '-----------------------------------------------------------
FUNCTION FN.SolidBrush(FillColor) '########################################################### ' Creats a fill bitmap of the specified color '###########################################################
BrushHndl = 0 CALLDLL #GDI, "CreateSolidBrush", FillColor AS ULONG, BrushHndl AS ULONG
FN.SolidBrush = BrushHndl END FUNCTION
'------------------------------------------------------------------------ '------------------------------------------------------------------------
FUNCTION FN.Pen(Pstyle, Wide, Pcolor) '########################################################### ' Creates a pen of the specied style, width and color. ' If the Pstyle parameter is not PS.SOLID and the ' Wide parmeter is greather than one, the style will ' be PS.SOLID regardless of the style specified by ' Pstyle '###########################################################
PenHndl = 0 CALLDLL #GDI, "CreatePen", Pstyle AS LONG, Wide AS LONG, _ Pcolor AS ULONG, PenHndl AS ULONG
FN.Pen = PenHndl END FUNCTION
'------------------------------------------------------------------------- '-------------------------------------------------------------------------
FUNCTION FN.KillObj(ThisObj) '###################################################################### ' Destroy an object (brush, pen, font) and release its resources '######################################################################
DeadObj = 0 CALLDLL #GDI, "DeleteObject", ThisObj AS ULONG, DeadObj AS VOID
END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.KillDc(WinDc) '############################################################ ' Destroy a device context and release WIN resources ' ' ARGUMENTS: ' WinDc: Device context to destroy. ' Do NOT use this function to destroy a device ' context obtained with the GetDC() function. '############################################################
RetVal = 0 CALLDLL #GDI, "DeleteDC", WinDc AS ULONG, RetVal AS VOID
END FUNCTION
'----------------------------------------------------------------- '-----------------------------------------------------------------
FUNCTION FN.GetPixelColor(WinDc, PixX, PixY) '########################################################### ' Retrieves a 32-bit color value from screen, form, or control ' ARGUMENTS: ' WinDc: Device context of object ' PixX, PixY: Position from which to obtain the color '########################################################### PixColor = 0 CALLDLL #GDI, "GetPixel", WinDc AS ULONG, PixX AS LONG, _ PixY AS LONG, PixColor AS ULONG
FN.GetPixelColor = PixColor END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.SetPixelColor(WinDc, PixX, PixY, PixColour) '########################################################### ' Set a 32-bit color value on the screen form, or control ' ARGUMENTS: ' WinDc: Device context of object ' PixX, PixY: Position at which to color ' PixColour: Color to place at PixX, PixY '###########################################################
RetVal = 0 CALLDLL #GDI, "SetPixelV", WinDc AS ULONG, PixX AS LONG, PixY AS LONG, _ PixColour AS ULONG, RetVal AS LONG FN.SetPixelColor = RetVal END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.ClientSize(WinHndl, BYREF Bx, BYREF By) '################################################################ ' Retrieve the client area of a window (form or control). Since ' the upper left corner of the client area is always zero, zero ' the size of the client area is determined by the lower right ' corner of the client rectangle. ' ' ARGUMENTS: ' WinHndl: Handle of the window (form or control). ' Bx, By: Lower right corner of the client rectangle '################################################################
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 '<--- dummy variable CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, _ RetVal AS VOID
Bx = tRect.X1.struct By = tRect.Y1.struct END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.GetHandle(WinTag$) '########################################################### ' Return the numeric handle of a Liberty Basic form window ' or control. ' ARGUMENTS: ' WinTag$: Form window tag or control tag. ' EXAMPLE: #1, #1.TXB, #1.GFX '###########################################################
Hndl = 0 '<--- numeric handle returned from LB's HWND() function
'<------------------ check for proper syntax ---------------> WinTag$ = FN.CheckTag$(WinTag$)
Hndl = HWND(#WinTag$) '<--- get numeric handle
FN.GetHandle = Hndl '<--- return handle END FUNCTION
'--------------------------------------------------------------------- '---------------------------------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$ END FUNCTION
'--------------------------------------------------------------------- '---------------------------------------------------------------------
|
|