Welcome, Guest |
You have to register before you can post on our site.
|
|
|
ConvertOffset |
Posted by: SMcNeill - 04-20-2022, 02:18 AM - Forum: SMcNeill
- No Replies
|
|
Code: (Select All) DIM x AS INTEGER
DIM m AS _MEM
m = _MEM(x)
PRINT m.OFFSET
PRINT ConvertOffset(m.OFFSET)
FUNCTION ConvertOffset&& (value AS _OFFSET)
$CHECKING:OFF
DIM m AS _MEM 'Define a memblock
m = _MEM(value) 'Point it to use value
$IF 64BIT THEN
'On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64
_MEMGET m, m.OFFSET,temp&&
ConvertOffset&& = temp&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
$ELSE
'However, on 32 bit OSes, an OFFSET is only 4 bytes. We need to put it into a LONG variable first
_MEMGET m, m.OFFSET, temp& 'Like this
ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
$END IF
_MEMFREE m 'Free the memblock
$CHECKING:ON
END FUNCTION
|
|
|
Extended Timer and TimeStamp |
Posted by: SMcNeill - 04-20-2022, 02:17 AM - Forum: SMcNeill
- Replies (3)
|
|
Code: (Select All) SHELL "https://www.epochconverter.com/"
PRINT "Compare to time stamps generated at the website which popped up in your browser.https://www.epochconverter.com/"
CONST MyTimeZone## = 4 * 3600
DO
_LIMIT 1
CLS
PRINT TimeStamp(DATE$, TIMER + MyTimeZone) 'Timezone difference with GMT, which is what the webpage sometimes points to.
' If the times seem off from the website, you'll want to change the timezone
' offset to match your current time zone.
PRINT ExtendedTimer 'Unix Epoch Timer based on local time.
_DISPLAY
LOOP
FUNCTION TimeStamp## (d$, t##) 'date and timer
'Based on Unix Epoch time, which starts at year 1970.
DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
DIM s AS _FLOAT
l = INSTR(d$, "-")
l1 = INSTR(l + 1, d$, "-")
m = VAL(LEFT$(d$, l))
d = VAL(MID$(d$, l + 1))
y = VAL(MID$(d$, l1 + 1))
IF y < 1970 THEN 'calculate shit backwards
SELECT CASE m 'turn the day backwards for the month
CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
CASE 2: d = 28 - d 'special 28 or 29.
CASE 4, 6, 9, 11: d = 30 - d '30 days
END SELECT
IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
d = d + 1 'assume we had a leap year, subtract another day
IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
END IF
'then count the months that passed after the current month
FOR i = m + 1 TO 12
SELECT CASE i
CASE 2: d = d + 28
CASE 3, 5, 7, 8, 10, 12: d = d + 31
CASE 4, 6, 9, 11: d = d + 30
END SELECT
NEXT
'we should now have the entered year calculated. Now lets add in for each year from this point to 1970
d = d + 365 * (1969 - y) '365 days per each standard year
FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
d = d + 1 'subtract an extra day every leap year
IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
NEXT
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = -(s## + 24 * 60 * 60 - t##)
EXIT FUNCTION
ELSE
y = y - 1970
END IF
FOR i = 1 TO m 'for this year,
SELECT CASE i 'Add the number of days for each previous month passed
CASE 1: d = d 'January doestn't have any carry over days.
CASE 2, 4, 6, 8, 9, 11: d = d + 31
CASE 3 'Feb might be a leap year
IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
d = d + 29 'its a leap year
IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
d = d - 1 'the year is divisible by 100, and not divisible by 400
END IF
ELSE 'year not divisible by 4, no worries
d = d + 28
END IF
CASE 5, 7, 10, 12: d = d + 30
END SELECT
NEXT
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
d = d + 1 'add an extra day every leap year
IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
NEXT
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = (s## + t##)
END FUNCTION
FUNCTION ExtendedTimer##
'Simplified version of the TimeStamp routine, streamlined to only give positive values based on the current timer.
'Note: Only good until the year 2100, as we don't do all the fancy calculations for leap years.
'A timer should work quickly and efficiently in the background; and the less we do, the less lag we might insert
'into a program.
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + TIMER)
END FUNCTION
|
|
|
EllipseFill |
Posted by: SMcNeill - 04-20-2022, 02:16 AM - Forum: SMcNeill
- Replies (2)
|
|
Code: (Select All) SUB EllipseFill (cx AS INTEGER, cy AS INTEGER, rx AS INTEGER, ry AS INTEGER, c AS LONG)
DIM a AS LONG, b AS LONG
DIM x AS LONG, y AS LONG
DIM xx AS LONG, yy AS LONG
DIM sx AS LONG, sy AS LONG
DIM e AS LONG
a = 2 * rx * rx
b = 2 * ry * ry
x = rx
xx = ry * ry * (1 - rx - rx)
yy = rx * rx
sx = b * rx
DO WHILE sx >= sy
LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
y = y + 1
sy = sy + a
e = e + yy
yy = yy + a
IF (e + e + xx) > 0 THEN
x = x - 1
sx = sx - b
e = e + xx
xx = xx + b
END IF
LOOP
x = 0
y = ry
xx = rx * ry
yy = rx * rx * (1 - ry - ry)
e = 0
sx = 0
sy = a * ry
DO WHILE sx <= sy
LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
DO
x = x + 1
sx = sx + b
e = e + xx
xx = xx + b
LOOP UNTIL (e + e + yy) > 0
y = y - 1
sy = sy - a
e = e + yy
yy = yy + a
LOOP
END SUB
|
|
|
CircleFill |
Posted by: SMcNeill - 04-20-2022, 02:15 AM - Forum: SMcNeill
- Replies (2)
|
|
Code: (Select All) SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS LONG)
DIM Radius AS LONG, RadiusError AS LONG
DIM X AS LONG, Y AS LONG
Radius = ABS(R)
RadiusError = -Radius
X = Radius
Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB
|
|
|
Tutorial |
Posted by: johnno56 - 04-19-2022, 09:45 PM - Forum: Help Me!
- Replies (7)
|
|
... and yes. Before you ask, I have read and worked my way through Terry's tutorials... but my request is specific. I am looking for a tutorial to create a non-scrolling, multi-level, old fashioned platformer. You remember? Coins; Enemies; Lava; Jump-pads; cheesy sound effects... You 'do' remember, right? Aw, man... Is my age slipping again? I like 'old school'... lol
Any assistance would be appreciated. Thank you.
J
|
|
|
Keybone's GUI (Widgets, Windows, and Background) |
Posted by: Keybone - 04-19-2022, 05:07 PM - Forum: Keybone
- No Replies
|
|
This is a version of the widget toolkit. This version is not finished.
When I stopped working on it, I was in the process of adding windows.
They are included but do not actually do anything other than drawing on the screen.
All the widgets still work, and the background image system is fully operational.
Obligatory screenshot:
Installation:
1) copy kwin2.bas and ggravity.jpg to your qb64 folder
2) compile and run kwin2.bas
ggravity.jpg:
kwin2.bas:
Code: (Select All) Type aDisplayOption
Fullscreen As _Byte
Scaled As _Byte
Smoothed As _Byte
End Type
Type aBackgroundOption
Scaled As _Byte
Centered As _Byte
Tiled As _Byte
Image As _Byte
Solid As _Byte
solidColour As _Unsigned Long
horizontalGradient As _Byte
verticalGradient As _Byte
diagonalGradient As _Byte
horizontalDither As _Byte
verticalDither As _Byte
checkerboxDither As _Byte
horizontalSpacedDither As _Byte
verticalSpacedDither As _Byte
squareSpacedDither As _Byte
squarePattern As _Byte
ditherSpacing As _Unsigned Integer
colour1 As _Unsigned Long
colour2 As _Unsigned Long
End Type
Type anOption
Display As aDisplayOption
Background As aBackgroundOption
End Type
Type aSize
restoredSizeX As _Unsigned Integer
restoredSizeY As _Unsigned Integer
maximizedSizeX As _Unsigned Integer
maximizedSizeY As _Unsigned Integer
End Type
Type aProperty
isMinimizable As _Byte
isRestorable As _Byte
isMaximizable As _Byte
isMovable As _Byte
isResizable As _Byte
End Type
Type aStatus
isMinimized As _Byte
isRestored As _Byte
isMaximized As _Byte
isMoving As _Byte
isResizing As _Byte
End Type
Type aWindow
positionX As Integer
positionY As Integer
Size As aSize
restoredImageHandle As _Unsigned Long
maximizedImageHandle As _Unsigned Long
Properties As aProperty
Status As aStatus
isActive As _Byte
End Type
Type anIcon
positionX As Integer
positionY As Integer
sizeX As _Unsigned Integer
sizeY As _Unsigned Integer
imageHandle As _Unsigned Long
End Type
Type anObject
Title As String
Identifier As String
Windows As aWindow
Icons As anIcon
End Type
Type aButton
positionX As Integer
positionY As Integer
sizeX As _Unsigned Integer
sizeY As _Unsigned Integer
Text As String
imageHandle As _Unsigned Long
End Type
Type aCheckbox
positionX As Integer
positionY As Integer
sizeX As _Unsigned Integer
sizeY As _Unsigned Integer
isChecked As _Byte
Text As String
imageHandle1 As _Unsigned Long
imageHandle2 As _Unsigned Long
End Type
Type aSwitch
positionX As Integer
positionY As Integer
sizeX As _Unsigned Integer
sizeY As _Unsigned Integer
isEnabled As _Byte
Text As String
imageHandle1 As _Unsigned Long
imageHandle2 As _Unsigned Long
End Type
Type aRadiobutton
positionX As Integer
positionY As Integer
sizeX As _Unsigned Integer
sizeY As _Unsigned Integer
groupID As _Unsigned Integer
isSelected As _Byte
Text As String
imageHandle1 As _Unsigned Long
imageHandle2 As _Unsigned Long
End Type
Type aMouse
positionX As Integer
positionY As Integer
buttonLeft As _Byte
buttonMiddle As _Byte
buttonRight As _Byte
End Type
Type aGrayscale
Black As _Unsigned Long
Darkest As _Unsigned Long
Darker As _Unsigned Long
Dark As _Unsigned Long
Neutral As _Unsigned Long
Light As _Unsigned Long
Lighter As _Unsigned Long
Lightest As _Unsigned Long
White As _Unsigned Long
End Type
Type aPrimaryColour
Red As _Unsigned Long
Green As _Unsigned Long
Blue As _Unsigned Long
End Type
Type aSecondaryColour
Cyan As _Unsigned Long
Magenta As _Unsigned Long
Yellow As _Unsigned Long
End Type
Type aTertiaryColour
Azure As _Unsigned Long
Violet As _Unsigned Long
Rose As _Unsigned Long
Orange As _Unsigned Long
Chartreuse As _Unsigned Long
springGreen As _Unsigned Long
End Type
Type aPalette
Grayscale As aGrayscale
Primary As aPrimaryColour
Secondary As aSecondaryColour
Tertiary As aTertiaryColour
End Type
Type aLimit
Minimum As _Unsigned Integer
Current As _Unsigned Integer
Maximum As _Unsigned Integer
End Type
Dim Shared Limit As aLimit
Limit.Minimum = 0
Limit.Current = Limit.Minimum
Limit.Maximum = 0 - 1
Dim Shared limitObjects As aLimit
limitObjects.Minimum = 0
limitObjects.Current = limitObjects.Minimum
limitObjects.Maximum = 0 - 1
Dim Shared limitButtons As aLimit
limitButtons.Minimum = 0
limitButtons.Current = limitButtons.Minimum
limitButtons.Maximum = 0 - 1
Dim Shared limitCheckboxes As aLimit
limitCheckboxes.Minimum = 0
limitCheckboxes.Current = limitCheckboxes.Minimum
limitCheckboxes.Maximum = 0 - 1
Dim Shared limitSwitches As aLimit
limitSwitches.Minimum = 0
limitSwitches.Current = limitSwitches.Minimum
limitSwitches.Maximum = 0 - 1
Dim Shared limitRadiobuttons As aLimit
limitRadiobuttons.Minimum = 0
limitRadiobuttons.Current = limitRadiobuttons.Minimum
limitRadiobuttons.Maximum = 0 - 1
ReDim Shared Objects(Limit.Current) As anObject
ReDim Shared Buttons(limitButtons.Current) As aButton
ReDim Shared Checkboxes(limitCheckboxes.Current) As aCheckbox
ReDim Shared Switches(limitSwitches.Current) As aSwitch
ReDim Shared Radiobuttons(limitRadiobuttons.Current) As aRadiobutton
Dim Shared Mouse As aMouse
Dim Shared theOptions As anOption
theOptions.Display.Fullscreen = 0
theOptions.Display.Scaled = 0
theOptions.Display.Smoothed = -1
Dim Shared theDesktop As _Unsigned Long
theDesktop.sizeX = 640
theDesktop.sizeY = 480
theDesktop.imageHandle = _NewImage(theDesktop.sizeX, theDesktop.sizeY, 32)
Screen theDesktop.imageHandle
If theOptions.Display.Fullscreen Then
If theOptions.Display.Scaled Then
If theOptions.Display.Smoothed Then
_FullScreen _Stretch , _Smooth
Else
_FullScreen _Stretch
End If
Else
If theOptions.Display.Smoothed Then
_FullScreen _SquarePixels , _Smooth
Else
_FullScreen _SquarePixels
End If
End If
End If
_PrintMode _KeepBackground
Dim Shared colorPalette As aPalette
colorPalette.Grayscale.Black = _RGBA32(0, 0, 0, 255)
colorPalette.Grayscale.Darkest = _RGBA32(31, 31, 31, 255)
colorPalette.Grayscale.Darker = _RGBA32(63, 63, 63, 255)
colorPalette.Grayscale.Dark = _RGBA32(95, 95, 95, 255)
colorPalette.Grayscale.Neutral = _RGBA32(127, 127, 127, 255)
colorPalette.Grayscale.Light = _RGBA32(159, 159, 159, 255)
colorPalette.Grayscale.Lighter = _RGBA32(191, 191, 191, 255)
colorPalette.Grayscale.Lightest = _RGBA32(223, 223, 223, 255)
colorPalette.Grayscale.White = _RGBA32(255, 255, 255, 255)
colorPalette.Primary.Red = _RGBA32(255, 0, 0, 255)
colorPalette.Primary.Green = _RGBA32(0, 255, 0, 255)
colorPalette.Primary.Blue = _RGBA32(0, 0, 255, 255)
colorPalette.Secondary.Cyan = _RGBA32(255, 0, 0, 255)
colorPalette.Secondary.Magenta = _RGBA32(255, 0, 0, 255)
colorPalette.Secondary.Yellow = _RGBA32(255, 0, 0, 255)
colorPalette.Tertiary.Azure = _RGBA32(0, 127, 255, 255)
colorPalette.Tertiary.Violet = _RGBA32(127, 0, 255, 255)
colorPalette.Tertiary.Rose = _RGBA32(255, 0, 127, 255)
colorPalette.Tertiary.springGreen = _RGBA32(0, 255, 127, 255)
colorPalette.Tertiary.Orange = _RGBA32(255, 165, 0, 255)
colorPalette.Tertiary.Chartreuse = _RGBA32(127, 255, 0, 255)
Dim Shared theBackground As _Unsigned Long
theBackground.imageHandle = _LoadImage("ggravity.jpg")
theBackground.sizeX = _Width(theBackground.imageHandle)
theBackground.sizeY = _Height(theBackground.imageHandle)
If theBackground.imageHandle Then
theOptions.Background.Image = -1
theOptions.Background.Scaled = 0
theOptions.Background.Centered = 0
theOptions.Background.Tiled = 0
End If
initObject 100, 100, 200, 200, "Window 1", "Window Title 1"
initObject 200, 200, 200, 200, "Window 2", "Window Title 2"
initObject 300, 300, 200, 200, "Window 3", "Window Title 3"
initButton 100, 200, 100, 40, "Button"
initCheckbox 100, 400, 50, -1, "Checkbox"
initSwitch 200, 150, 25, 0, "Switch"
initRadiobutton 550, 100, 50, 1, -1, "Radiobutton 1"
initRadiobutton 550, 175, 50, 1, 0, "Radiobutton 2"
initRadiobutton 550, 250, 50, 1, 0, "Radiobutton 3"
Dim Shared zoneTypeClicked As String
theOptions.Background.Solid = 0
theOptions.Background.solidColour = thePalette.Tertiary.Azure
theOptions.Background.horizontalGradient = 0
theOptions.Background.verticalGradient = 0
theOptions.Background.diagonalGradient = 0
theOptions.Background.horizontalDither = -1
theOptions.Background.verticalDither = 0
theOptions.Background.checkerboxDither = 0
theOptions.Background.horizontalSpacedDither = 0
theOptions.Background.verticalSpacedDither = 0
theOptions.Background.squareSpacedDither = 0
theOptions.Background.squarePattern = 0
theOptions.Background.ditherSpacing = 3
theOptions.Background.colour1 = thePalette.Tertiary.Azure
theOptions.Background.colour2 = thePalette.Tertiary.Violet
Do
If theOptions.Background.Solid Then
Line (0, 0)-(_Width, _Height), theOptions.Background.solidColour, BF
Else
If theOptions.Background.horizontalGradient Then
gradientHorizontal 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2
Else
If theOptions.Background.verticalGradient Then
gradientVertical 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2
Else
If theOptions.Background.diagonalGradient Then
gradientDiagonal 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2
Else
If theOptions.Background.horizontalDither Then
ditherHorizontal 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
If theOptions.Background.verticalDither Then
ditherVertical 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
If theOptions.Background.checkerboxDither Then
ditherCheckerbox 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2
Else
If theOptions.Background.horizontalSpacedDither Then
ditherHorizontalSpaced 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
If theOptions.Background.verticalSpacedDither Then
ditherVerticalSpaced 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
If theOptions.Background.squareSpacedDither Then
ditherSquare 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
If theOptions.Background.squarePattern Then
patternSquare 0, 0, _Width, _Height, theOptions.Background.colour1, theOptions.Background.colour2, theOptions.Background.ditherSpacing
Else
Line (0, 0)-(_Width, _Height), thePalette.Grayscale.Black, BF
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If theOptions.Background.Image Then
If theOptions.Background.Scaled Then
_PutImage (0, 0)-(_Width(theDisplay.imageHandle), _Height(theDisplay.imageHandle)), theBackground.imageHandle, theDisplay.imageHandle
Else
If theOptions.Background.Centered Then
Dim centeredX As Integer: centeredX = (_Width(theDisplay.imageHandle) - _Width(theBackground.imageHandle)) / 2
Dim centeredY As Integer: centeredY = (_Height(theDisplay.imageHandle) - _Height(theBackground.imageHandle)) / 2
_PutImage (centeredX, centeredY)-(_Width(theBackground.imageHandle) + centeredX, _Height(theBackground.imageHandle) + centeredY), theBackground.imageHandle, theDisplay.imageHandle
Else
If theOptions.Background.Tiled Then
Dim numberWide As Single: numberWide = _Width / _Width(Temporary)
Dim numberHigh As Single: numberHigh = _Height / _Height(Temporary)
Dim currentTileY As _Unsigned Integer: For currentTileY = 0 To numberHigh
Dim currentTileX As _Unsigned Integer: For currentTileX = 0 To numberWide
_PutImage (_Width(theBackground.imageHandle) * currentTileX, _Height(theBackground.imageHandle) * currentTileY), theBackground.imageHandle, theDisplay.imageHandle
Next currentTileX
Next currentTileY
Else
_PutImage (0, 0)-(_Width(theBackground.imageHandle), _Height(theBackground.imageHandle)), theBackground.imageHandle, theDisplay.imageHandle
End If
End If
End If
End If
For i1 = 0 To limitButtons.Current
_PutImage (Buttons(i1).positionX, Buttons(i1).positionY), Buttons(i1).imageHandle
Next i1
For i2 = 0 To Limit.Current
_PutImage (Objects(i2).Windows.positionX, Objects(i2).Windows.positionY), Objects(i2).Windows.restoredImageHandle
Next i2
For i3 = 0 To limitCheckboxes.Current
If Checkboxes(i3).isChecked Then
_PutImage (Checkboxes(i3).positionX, Checkboxes(i3).positionY), Checkboxes(i3).imageHandle2
Else
_PutImage (Checkboxes(i3).positionX, Checkboxes(i3).positionY), Checkboxes(i3).imageHandle1
End If
Next i3
For i4 = 0 To limitSwitches.Current
If Switches(i4).isEnabled Then
_PutImage (Switches(i4).positionX, Switches(i4).positionY), Switches(i4).imageHandle2
Else
_PutImage (Switches(i4).positionX, Switches(i4).positionY), Switches(i4).imageHandle1
End If
Next i4
For i5 = 0 To limitRadiobuttons.Current
If Radiobuttons(i5).isSelected Then
_PutImage (Radiobuttons(i5).positionX, Radiobuttons(i5).positionY), Radiobuttons(i5).imageHandle2
Else
_PutImage (Radiobuttons(i5).positionX, Radiobuttons(i5).positionY), Radiobuttons(i5).imageHandle1
End If
Next i5
probeMouse
If Mouse.buttonLeft Then
For i = 0 To LimitWindows.Current
Status1 = isZone~&(i, "window")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "window"
GoTo skip
End If
Next i
For i = 0 To LimitIcons.Current
Status1 = isZone~&(i, "icon")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "icon"
GoTo skip
End If
Next i
For i = 0 To limitButtons.Current
Status1 = isZone~&(i, "button")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "button"
GoTo skip
End If
Next i
For i = 0 To limitCheckboxes.Current
Status1 = isZone~&(i, "checkbox")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "checkbox"
GoTo skip
End If
Next i
For i = 0 To limitSwitches.Current
Status1 = isZone~&(i, "switch")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "switch"
GoTo skip
End If
Next i
For i = 0 To limitRadiobuttons.Current
Status1 = isZone~&(i, "radiobutton")
If Status1 <> 0 Then
status2 = Status1
zoneTypeClicked = "radiobutton"
End If
Next i
skip:
zoneTypeClicked = LCase$(LTrim$(RTrim$(zoneTypeClicked)))
Select Case zoneTypeClicked
Case "window"
Case "icon"
Case "button"
Case "checkbox"
If Checkboxes(status2).isChecked = -1 Then
Checkboxes(status2).isChecked = 0
Else
Checkboxes(status2).isChecked = -1
End If
Case "switch"
If Switches(status2).isEnabled = -1 Then
Switches(status2).isEnabled = 0
Else
Switches(status2).isEnabled = -1
End If
Case "radiobutton"
For i = 0 To limitRadiobuttons.Current
If Radiobuttons(i).groupID = Radiobuttons(status2).groupID Then
Radiobuttons(i).isSelected = 0
End If
Next i
Radiobuttons(status2).isSelected = -1
End Select
End If
_Limit 60
_Display
Loop
Sub initObject (inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer, inIdentifier As String, inTitle As String)
Limit.Current = Limit.Current + 1
ReDim _Preserve Objects(Limit.Current) As anObject
Objects(Limit.Current).Title = inTitle
Objects(Limit.Current).Identifier = inIdentifier
Objects(Limit.Current).Windows.positionX = inPositionX
Objects(Limit.Current).Windows.positionY = inPositionY
Objects(Limit.Current).Windows.Size.restoredSizeX = inSizeX
Objects(Limit.Current).Windows.Size.restoredSizeY = inSizeY
Objects(Limit.Current).Windows.Size.maximizedSizeX = _Width
Objects(Limit.Current).Windows.Size.maximizedSizeY = _Height
Objects(Limit.Current).Windows.restoredImageHandle = _NewImage(Objects(Limit.Current).Windows.Size.restoredSizeX, Objects(Limit.Current).Windows.Size.restoredSizeY, 32)
Objects(Limit.Current).Windows.maximizedImageHandle = _NewImage(Objects(Limit.Current).Windows.Size.maximizedSizeX, Objects(Limit.Current).Windows.Size.maximizedSizeY, 32)
Objects(Limit.Current).Windows.Properties.isMinimizable = -1
Objects(Limit.Current).Windows.Properties.isRestorable = -1
Objects(Limit.Current).Windows.Properties.isMaximizable = -1
Objects(Limit.Current).Windows.Properties.isMovable = -1
Objects(Limit.Current).Windows.Properties.isResizable = -1
Objects(Limit.Current).Windows.Status.isMinimized = -1
Objects(Limit.Current).Windows.Status.isRestored = 0
Objects(Limit.Current).Windows.Status.isMaximized = 0
Objects(Limit.Current).Windows.Status.isMoving = 0
Objects(Limit.Current).Windows.Status.isResizing = 0
Objects(Limit.Current).Windows.isActive = 0
Objects(Limit.Current).Icons.positionX = Objects(Limit.Current).Windows.positionX + (Objects(Limit.Current).Windows.Size.restoredSizeX / 2)
Objects(Limit.Current).Icons.positionY = Objects(Limit.Current).Windows.positionY + (Objects(Limit.Current).Windows.Size.restoredSizeY / 2)
Objects(Limit.Current).Icons.imageHandle = _LoadImage("blank.png")
Objects(Limit.Current).Icons.sizeX = _Width(Objects(Limit.Current).Icons.imageHandle)
Objects(Limit.Current).Icons.sizeY = _Height(Objects(Limit.Current).Icons.imageHandle)
_Dest Objects(Limit.Current).Windows.restoredImageHandle
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(127, 127, 127, 255), BF
box 0, 0, _Width - 1, _Height - 1, 1
box 0, 0, _Width - 1, _Height - 1, 1
If Objects(Identifier).Windows.isActive = -1 Then
Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 255, 255, 255)
Else
Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 127, 127, 255)
End If
box2 _Width - 48, 3, 20, 20, 1, 7
box2 _Width - 25, 3, 20, 20, 1, 2
box3 4, 3, 20, 20, 1, 1, 7
_Dest 0
End Sub
Sub initButton (inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer, inText As String)
limitButtons.Current = limitButtons.Current + 1
ReDim _Preserve Buttons(limitButtons.Current) As aButton
Buttons(limitButtons.Current).positionX = inPositionX
Buttons(limitButtons.Current).positionY = inPositionY
Buttons(limitButtons.Current).sizeX = inSizeX
Buttons(limitButtons.Current).sizeY = inSizeY
Buttons(limitButtons.Current).Text = inText
Buttons(limitButtons.Current).imageHandle = _NewImage(Buttons(limitButtons.Current).sizeX, Buttons(limitButtons.Current).sizeY, 32)
_Dest Buttons(limitButtons.Current).imageHandle
_PrintMode _KeepBackground
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(0, 0, 255, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
_PrintString (5, 5), Buttons(limitButtons.Current).Text
_Dest 0
End Sub
Sub initCheckbox (inPositionX As Integer, inPositionY As Integer, inSize As _Unsigned Integer, inIsChecked As _Byte, inText As String)
limitCheckboxes.Current = limitCheckboxes.Current + 1
ReDim _Preserve Checkboxes(limitCheckboxes.Current) As aCheckbox
Checkboxes(limitCheckboxes.Current).positionX = inPositionX
Checkboxes(limitCheckboxes.Current).positionY = inPositionY
Checkboxes(limitCheckboxes.Current).sizeX = inSize
Checkboxes(limitCheckboxes.Current).sizeY = inSize
Checkboxes(limitCheckboxes.Current).isChecked = inIsChecked
Checkboxes(limitCheckboxes.Current).Text = inText
Checkboxes(limitCheckboxes.Current).imageHandle1 = _NewImage(Checkboxes(limitCheckboxes.Current).sizeX, Checkboxes(limitCheckboxes.Current).sizeY, 32)
Checkboxes(limitCheckboxes.Current).imageHandle2 = _NewImage(Checkboxes(limitCheckboxes.Current).sizeX, Checkboxes(limitCheckboxes.Current).sizeY, 32)
_Dest Checkboxes(limitCheckboxes.Current).imageHandle2
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(0, 127, 0, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
Line (2, 2)-(_Width - 3, _Height - 3), _RGBA32(255, 255, 255, 255)
Line (2, _Height - 3)-(_Width - 3, 2), _RGBA32(255, 255, 255, 255)
_Dest Checkboxes(limitCheckboxes.Current).imageHandle1
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(0, 127, 0, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
_Dest 0
End Sub
Sub initSwitch (inPositionX As Integer, inPositionY As Integer, inSize As _Unsigned Integer, inIsEnabled As _Byte, inText As String)
limitSwitches.Current = limitSwitches.Current + 1
ReDim _Preserve Switches(limitSwitches.Current) As aSwitch
Switches(limitSwitches.Current).positionX = inPositionX
Switches(limitSwitches.Current).positionY = inPositionY
Switches(limitSwitches.Current).sizeX = inSize
Switches(limitSwitches.Current).sizeY = inSize * 2
Switches(limitSwitches.Current).isEnabled = inIsEnabled
Switches(limitSwitches.Current).Text = inText
Switches(limitSwitches.Current).imageHandle1 = _NewImage(Switches(limitSwitches.Current).sizeX, Switches(limitSwitches.Current).sizeY, 32)
Switches(limitSwitches.Current).imageHandle2 = _NewImage(Switches(limitSwitches.Current).sizeX, Switches(limitSwitches.Current).sizeY, 32)
_Dest Switches(limitSwitches.Current).imageHandle2
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(0, 127, 0, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
Line (2, 2)-(_Width - 3, _Height / 2), _RGBA32(255, 255, 255, 255), BF
_Dest Switches(limitSwitches.Current).imageHandle1
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 0, 0, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
Line (2, _Height / 2)-(_Width - 3, _Height - 3), _RGBA32(255, 255, 255, 255), BF
_Dest 0
End Sub
Sub initRadiobutton (inPositionX As Integer, inPositionY As Integer, inSize As _Unsigned Integer, inGroupID As _Unsigned Integer, inIsSelected As _Byte, inText As String)
limitRadiobuttons.Current = limitRadiobuttons.Current + 1
ReDim _Preserve Radiobuttons(limitRadiobuttons.Current) As aRadiobutton
Radiobuttons(limitRadiobuttons.Current).positionX = inPositionX
Radiobuttons(limitRadiobuttons.Current).positionY = inPositionY
Radiobuttons(limitRadiobuttons.Current).sizeX = inSize
Radiobuttons(limitRadiobuttons.Current).sizeY = inSize
Radiobuttons(limitRadiobuttons.Current).groupID = inGroupID
Radiobuttons(limitRadiobuttons.Current).isSelected = inIsSelected
Radiobuttons(limitRadiobuttons.Current).Text = inText
Radiobuttons(limitRadiobuttons.Current).imageHandle1 = _NewImage(Radiobuttons(limitRadiobuttons.Current).sizeX, Radiobuttons(limitRadiobuttons.Current).sizeY, 32)
Radiobuttons(limitRadiobuttons.Current).imageHandle2 = _NewImage(Radiobuttons(limitRadiobuttons.Current).sizeX, Radiobuttons(limitRadiobuttons.Current).sizeY, 32)
_Dest Radiobuttons(limitRadiobuttons.Current).imageHandle2
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 0, 255, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
Line (2, 2)-(_Width - 3, _Height - 3), _RGBA32(255, 255, 255, 255)
Line (2, _Height - 3)-(_Width - 3, 2), _RGBA32(255, 255, 255, 255)
_Dest Radiobuttons(limitRadiobuttons.Current).imageHandle1
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 0, 255, 255), BF
Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255), B
_Dest 0
End Sub
Sub Titlebar (titlebarPositionX As _Unsigned Integer, titlebarPositionY As _Unsigned Integer, titlebarWidth As _Unsigned Integer, titlebarHeight As _Unsigned Integer, titlebarColor As _Unsigned Long)
Line (titlebarPositionX, titlebarPositionY)-(titlebarPositionX + titlebarWidth, titlebarPositionY + titlebarHeight), titlebarColor, BF
End Sub
Sub box (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer)
Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Lighter, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Darker, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), colorPalette.Grayscale.Neutral, BF
End Sub
Sub box2 (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer, interiorDepth As _Unsigned Integer)
interiorDepth = interiorDepth * boxDepth
Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Darker, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Lighter, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), colorPalette.Grayscale.Neutral, BF
Line (boxPositionX + boxDepth + interiorDepth, boxPositionY + boxDepth + interiorDepth)-(boxPositionX + boxWidth - boxDepth - interiorDepth, boxPositionY + boxHeight - boxDepth - interiorDepth), colorPalette.Grayscale.Lighter, BF
Line (boxPositionX + (boxDepth * 2) + interiorDepth, boxPositionY + (boxDepth * 2) + interiorDepth)-(boxPositionX + boxWidth - boxDepth - interiorDepth, boxPositionY + boxHeight - boxDepth - interiorDepth), colorPalette.Grayscale.Darker, BF
Line (boxPositionX + (boxDepth * 2) + interiorDepth, boxPositionY + (boxDepth * 2) + interiorDepth)-(boxPositionX + boxWidth - (boxDepth * 2) - interiorDepth, boxPositionY + boxHeight - (boxDepth * 2) - interiorDepth), colorPalette.Grayscale.Neutral, BF
End Sub
Sub box3 (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer, interiorDepthX As _Unsigned Integer, interiorDepthY As _Unsigned Integer)
interiorDepthX = interiorDepthX * boxDepth
interiorDepthY = interiorDepthY * boxDepth
Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Darker, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), colorPalette.Grayscale.Lighter, BF
Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), colorPalette.Grayscale.Neutral, BF
Line (boxPositionX + boxDepth + interiorDepthX, boxPositionY + boxDepth + interiorDepthY)-(boxPositionX + boxWidth - boxDepth - interiorDepthX, boxPositionY + boxHeight - boxDepth - interiorDepthY), colorPalette.Grayscale.Lighter, BF
Line (boxPositionX + (boxDepth * 2) + interiorDepthX, boxPositionY + (boxDepth * 2) + interiorDepthY)-(boxPositionX + boxWidth - boxDepth - interiorDepthX, boxPositionY + boxHeight - boxDepth - interiorDepthY), colorPalette.Grayscale.Darker, BF
Line (boxPositionX + (boxDepth * 2) + interiorDepthX, boxPositionY + (boxDepth * 2) + interiorDepthY)-(boxPositionX + boxWidth - (boxDepth * 2) - interiorDepthX, boxPositionY + boxHeight - (boxDepth * 2) - interiorDepthY), colorPalette.Grayscale.Neutral, BF
End Sub
Sub probeMouse
While _MouseInput
Wend
Mouse.positionX = _MouseX
Mouse.positionY = _MouseY
Mouse.buttonLeft = _MouseButton(1)
Mouse.buttonRight = _MouseButton(2)
Mouse.buttonMiddle = _MouseButton(3)
End Sub
Function isZone~& (inIdentifier As _Unsigned Integer, inSelector As String)
inSelector = LCase$(LTrim$(RTrim$(inSelector)))
Select Case inSelector
Case "window"
If Mouse.positionX >= Objects(inIdentifier).Windows.positionX Then
If Mouse.positionY >= Objects(inIdentifier).Windows.positionY Then
If Mouse.positionX <= Objects(inIdentifier).Windows.positionX + Objects(inIdentifier).Windows.Size.restoredSizeX Then
If Mouse.positionY <= Objects(inIdentifier).Windows.positionY + Objects(inIdentifier).Windows.Size.restoredSizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
Case "icon"
If Mouse.positionX >= Objects(inIdentifier).Icons.positionX Then
If Mouse.positionY >= Objects(inIdentifier).Icons.positionY Then
If Mouse.positionX <= Objects(inIdentifier).Icons.positionX + Objects(inIdentifier).Icons.sizeX Then
If Mouse.positionY <= Objects(inIdentifier).Icons.positionY + Objects(inIdentifier).Icons.sizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
Case "button"
If Mouse.positionX >= Buttons(inIdentifier).positionX Then
If Mouse.positionY >= Buttons(inIdentifier).positionY Then
If Mouse.positionX <= Buttons(inIdentifier).positionX + Buttons(inIdentifier).sizeX Then
If Mouse.positionY <= Buttons(inIdentifier).positionY + Buttons(inIdentifier).sizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
Case "checkbox"
If Mouse.positionX >= Checkboxes(inIdentifier).positionX Then
If Mouse.positionY >= Checkboxes(inIdentifier).positionY Then
If Mouse.positionX <= Checkboxes(inIdentifier).positionX + Checkboxes(inIdentifier).sizeX Then
If Mouse.positionY <= Checkboxes(inIdentifier).positionY + Checkboxes(inIdentifier).sizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
Case "switch"
If Mouse.positionX >= Switches(inIdentifier).positionX Then
If Mouse.positionY >= Switches(inIdentifier).positionY Then
If Mouse.positionX <= Switches(inIdentifier).positionX + Switches(inIdentifier).sizeX Then
If Mouse.positionY <= Switches(inIdentifier).positionY + Switches(inIdentifier).sizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
Case "radiobutton"
If Mouse.positionX >= Radiobuttons(inIdentifier).positionX Then
If Mouse.positionY >= Radiobuttons(inIdentifier).positionY Then
If Mouse.positionX <= Radiobuttons(inIdentifier).positionX + Radiobuttons(inIdentifier).sizeX Then
If Mouse.positionY <= Radiobuttons(inIdentifier).positionY + Radiobuttons(inIdentifier).sizeY Then
isZone~& = inIdentifier
End If
End If
End If
End If
End Select
End Function
Sub gradientHorizontal (x0, y0, w, h, c1 As _Unsigned Long, c2 As _Unsigned Long)
Dim mr As Double, mg As Double, mb As Double
mr = (_Red(c2) - _Red(c1)) / w
mg = (_Green(c2) - _Green(c1)) / w
mb = (_Blue(c2) - _Blue(c1)) / w
For x = 0 To w - 1
r = _Red(c2) + (x - w) * mr
g = _Green(c2) + (x - w) * mg
b = _Blue(c2) + (x - w) * mb
Line (x + x0, y0)-Step(0, h), _RGBA32(r, g, b, 255), BF
Next
End Sub
Sub gradientVertical (x0, y0, w, h, c1 As _Unsigned Long, c2 As _Unsigned Long)
Dim mr As Double, mg As Double, mb As Double
mr = (_Red(c2) - _Red(c1)) / h
mg = (_Green(c2) - _Green(c1)) / h
mb = (_Blue(c2) - _Blue(c1)) / h
For y = 0 To h - 1
r = _Red(c2) + (y - h) * mr
g = _Green(c2) + (y - h) * mg
b = _Blue(c2) + (y - h) * mb
Line (x0, y + y0)-Step(w, 0), _RGBA32(r, g, b, 255), BF
Next
End Sub
Sub gradientDiagonal (x0, y0, w, h, c1 As _Unsigned Long, c2 As _Unsigned Long)
Dim mr As Double, mg As Double, mb As Double
dw = w + h
mr = (_Red(c2) - _Red(c1)) / dw
mg = (_Green(c2) - _Green(c1)) / dw
mb = (_Blue(c2) - _Blue(c1)) / dw
For d = 0 To dw - 1
r = _Red(c2) + (d - dw) * mr
g = _Green(c2) + (d - dw) * mg
b = _Blue(c2) + (d - dw) * mb
If d <= h - 1 Then
Line (x0 + d, y0)-(x0, y0 + d), _RGBA32(r, g, b, 255)
ElseIf d >= h And d <= w - 1 Then
Line (x0 + d, y0)-(x0 + (d - h), y0 + h), _RGBA32(r, g, b, 255)
ElseIf d >= w And d <= dw - 1 Then
Line (x0 + w, y0 + (d - w))-(x0 + (d - h), y0 + h), _RGBA32(r, g, b, 255)
End If
Next d
End Sub
Sub ditherCheckerbox (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long)
Line (x0, y0)-(x0 + w, y0 + h), inColor2, BF
For j = y0 To y0 + h
If j Mod 2 = 1 Then
For i = x0 To x0 + w
If i Mod 2 = 1 Then
PSet (i, j), inColor2
Else
PSet (i, j), inColor1
End If
Next i
Else
For i = x0 To x0 + w
If i Mod 2 = 0 Then
PSet (i, j), inColor2
Else
PSet (i, j), inColor1
End If
Next i
End If
Next j
End Sub
Sub ditherVertical (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
Line (x0, y0)-(x0 + w, y0 + h), inColor2, BF
For j = y0 To y0 + h
For i = x0 To (x0 + w) - 1 Step inSpacing
PSet (i, j), inColor1
Next i
Next j
End Sub
Sub ditherHorizontal (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
Line (x0, y0)-(x0 + w, y0 + h), inColor2, BF
For i = x0 To (x0 + w) - 1
For j = y0 To y0 + h Step inSpacing
PSet (i, j), inColor1
Next j
Next i
End Sub
Sub ditherHorizontalSpaced (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
cc = 1
Line (x0, y0)-(x0 + w, y0 + h), inColor2, BF
For i = x0 To x0 + w Step inSpacing
Select Case cc
Case 1
For j = y0 To y0 + h
If j Mod 2 <> 0 Then
PSet (i, j), inColor1
End If
Next j
cc = cc + 1
Case 2
For j = y0 To y0 + h
If j Mod 2 = 0 Then
PSet (i, j), inColor1
End If
Next j
cc = 1
End Select
Next i
End Sub
Sub ditherVerticalSpaced (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
cc = 1
Line (x0, y0)-(x0 + w, y0 + h), inColor2, BF
For i = y0 To y0 + h Step inSpacing
Select Case cc
Case 1
For j = x0 To x0 + w
If j Mod 2 <> 0 Then
PSet (j, i), inColor1
End If
Next j
cc = cc + 1
Case 2
For j = x0 To x0 + w
If j Mod 2 = 0 Then
PSet (j, i), inColor1
End If
Next j
cc = 1
End Select
Next i
End Sub
Sub ditherSquare (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
Line (x0, y0)-((x0 + w) - 1, (y0 + h) - 1), inColor2, BF
For i = x0 To x0 + w Step inSpacing
For j = y0 To y0 + h Step inSpacing
PSet (i, j), inColor1
Next j
Next i
End Sub
Sub patternSquare (x0, y0, w, h, inColor1 As _Unsigned Long, inColor2 As _Unsigned Long, inSpacing As _Unsigned Integer)
Line (x0, y0)-((x0 + w) - 1, (y0 + h) - 1), inColor2, BF
For i = x0 To x0 + w Step inSpacing
Line (centerX + i, y0)-(centerX + i, (y0 + h) - 1), inColor1
Next i
For i = y0 To y0 + h Step inSpacing
Line (x0, centerY + i)-((x0 + w) - 1, centerY + i), inColor1
Next i
End Sub
|
|
|
|