Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
QBJS Color Problem (Solved!)
#7
I took out the recursive calling of pumpkin in case some rogue extra call was being made and then even the carving, just the ellipse fill and ellipsi for pumpkin sections and still get something strange in QBJS:

Code: (Select All)
Option _Explicit
'_Title "Fall Foliage Banner Move Leaves" ' work file for updating
' started 2017-10-21 by bplus as: fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21

' 2023-08-30 start of QBJS Banner
' 2023-08-31 Logo and Hills added

' 2023-09-01 Fellippe I see contributed allot to orig code with moving leaves
' Also thanks to grymmjack for getting me starting of PFont and font patterns.
' Also thanks to dbox for catching all my errors with QBJS.

' 2023-09-03 try to fix font print to print while leaves are falling
' tweak numbers for falling leaves for more and not too leaden.

' 2023-09-03 FontFlag to signal FPrint is done

' 2023-09-04 do not stop leaves falling when on a tree trunk
' Ran into problems with QBJS handling Point see commented code in MoveLeaf
' So this keeps moving leaves without Point
' Clean up code a bit fix letters shadows, toss junk subs
' Aha! found a way to get leaves off tree trunks = redraw trunks!
' New Type Tree

' 2023-09-05A fix wind and make (less) leaves more responsive to wind
' 2023-09-05 1:40P added pumpkin but cheeky in QBJS

' 2023-09-06 add ships

' 2023-09-07 another attempt to fix ellipse drawing in pumpkin with QBJS
' remove ships.
' To use the  2d ellipse draw function in QBJS because it screws up my QB64
' change color and everything drawn with it old color is changed too.
' Fixed my fTri function with a Color parameter.

$If WEB Then
        Import G2D From "lib/graphics/2d.bas"
$End If

Type treeType
    x As Single
    y As Single
    r As Single
    h As Single
End Type

Type new_Leaf
    x As Single
    y As Single
    w As Single
    h As Single
    c As _Unsigned Long
    isFree As Integer
    rx As Integer
    ry As Integer
    yvel As Single
    yacc As Single
End Type

Const gravity = .0010

Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind
Dim Shared stopFrame As Long
Dim Shared FontFlag As Long ' to signal Font has been finished
Dim Shared sx


Dim As Long Logo
$If WEB Then
        Logo = _LoadImage("https://qb64phoenix.com/forum/attachment.php?aid=2206", 32)

$Else
    Logo = _LoadImage("peLogo.png", 32)
$End If

'now for full viewing enjoyment xmx = screen width, ymx = screen height
Dim Shared xmx, ymx
xmx = 1200 ' for banner 1400 doesn't fit my screen so using 1200 for broader expanse look
ymx = 256
Screen _NewImage(xmx, ymx, 32) ' grymmjack set on making this 1400 it appears OK

Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner
LoadPatterns9x9 spattern$()
Dim As Long i, scene, trees, windChange, pumpkinImage, lp, pr, d
Dim gust
pr = 100
While 1
    'Draw scene:
    ReDim Shared leaf(30000) As new_Leaf
    totalLeaves = 0
    stopFrame = 0
    FontFlag = 0
    windChange = 1
    gust = .01

    Cls

    horizon = rand&(.8 * ymx, .9 * ymx)

    'sky and hill background
    drawLandscape
    For i = horizon To ymx
        midInk 160, 188, 50, 100, 60, 25, (i - horizon) / (ymx - horizon)
        Line (0, i)-(xmx, i)
    Next

    'fallen leaves:
    For i = 1 To 300 'less of these at start, as they'll grow in number anyway
        createLeaf rand&(0, xmx), rand&(horizon + 5, ymx)
    Next

    ' trees
    trees = rand&(5, 12)
    ReDim tree(1 To trees) As treeType
    For i = 1 To trees
        tree(i).x = rand&(50, xmx - 50)
        tree(i).y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
        tree(i).r = .01 * tree(i).y
        tree(i).h = rand&(tree(i).y * .15, tree(i).y * .18)
        branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, 7
    Next

    If scene < -1 Then _FreeImage scene
    scene = _CopyImage(0) ' take a picture of bare trees before they are clothed with leaves

    'Animate scene:
    While FontFlag < 2500 ' keep going more loops to drop allot of leaves allow trees to become bare
        lp = (lp + 1) Mod 10
        If lp = 1 Then
            If pumpkinImage < -1 Then _FreeImage pumpkinImage
            pumpkinImage = _NewImage(300, 200, 32)
            _Dest pumpkinImage
            sx = sx + rand&(-4, 4)
            If sx > .7 * pr / 10 Then d = -1 * d: sx = 0
            If sx < -.7 * pr / 10 Then d = -1 * d: sx = 0

            pumpkin 149, 100, pr, 2
            _Dest 0
        End If
        If wind + windChange * gust < 0 Then windChange = -windChange
        If wind + windChange * gust > 5 Then windChange = -windChange
        wind = wind + windChange * gust
        _PutImage , scene
        letLeafGo
        For i = 1 To totalLeaves
            moveLeaf leaf(i)
            Line (leaf(i).x, leaf(i).y)-Step(leaf(i).w, leaf(i).h), leaf(i).c, BF
        Next
        _PutImage (20, 80)-(150, 210), Logo, 0
        _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0

        ' this draws one letter squares at a time until title is complete
        ' the FontFlag is increased by 1 for 1500 loops after letters are complete
        FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00

        ' draw tree trunks again
        For i = 1 To trees
            branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, -1
        Next

        ' hey pumpkin!
        _PutImage (690, 80), pumpkinImage, 0
        ' debugging wind and changes
        '_Title "Wind:" + Str$(wind) + "  WindChange:" + Str$(windChange)

        _Display

        _Limit 30
    Wend
Wend

Sub branch (xx, yy, startrr, angDD, lengthh, levv, stopLev)
    Dim x, y, lev, length, angD, startr, x2, y2, dx, dy, i
    Dim bc~&
    x = xx: y = yy
    lev = levv
    length = lengthh
    angD = angDD
    startr = startrr
    x2 = x + Cos(_D2R(angD)) * length
    y2 = y - Sin(_D2R(angD)) * length
    dx = (x2 - x) / length
    dy = (y2 - y) / length
    bc~& = _RGB32(60 + 12 * lev, 30 + 7 * lev, 15 + 5 * lev)
    If 2 * startr <= 1 Then
        Line (x, y)-(x2, y2), bc~&
    Else
        For i = 0 To length
            fCirc x + dx * i, y + dy * i, startr, bc~&
        Next
    End If
    If lev > 1 Then createLeaf x2, y2
    If .8 * startr < .1 Or lev > stopLev Or length < 3 Then Exit Sub
    lev = lev + 1
    branch x2, y2, .8 * startr, angD + 22 + rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
    branch x2, y2, .8 * startr, angD - 22 - rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
End Sub

Sub fCirc (CX As Long, CY As Long, R As Long, c As _Unsigned Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): 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

Sub createLeaf (x, y)
    Dim sp, xoff, yoff, woff, hoff
    If Rnd < .6 Then
        sp = 15
        xoff = x + Rnd * sp - Rnd * sp
        yoff = y + Rnd * sp - Rnd * sp
        woff = 3 + Rnd * 3
        hoff = 3 + Rnd * 3
        totalLeaves = totalLeaves + 1
        If totalLeaves > UBound(leaf) Then ReDim _Preserve leaf(1 To UBound(leaf) + 5000) As new_Leaf
        leaf(totalLeaves).x = xoff
        leaf(totalLeaves).y = yoff
        leaf(totalLeaves).w = woff
        leaf(totalLeaves).h = hoff
        leaf(totalLeaves).c = _RGB32(rand&(100, 250), rand&(50, 255), rand&(0, 40))
        If Rnd < .5 Then leaf(totalLeaves).rx = -2 Else leaf(totalLeaves).rx = 2
        If Rnd < .5 Then leaf(totalLeaves).ry = -1 Else leaf(totalLeaves).ry = 1
    End If
End Sub

Sub moveLeaf (idx As new_Leaf)

    If idx.isFree Then 'leaves falling
        If idx.y < horizon Then ' above ground
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
        Else ' below horizon  and falling time to stop
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y > horizon Then ' stop leaves from going to bottom of screen
                idx.isFree = 0
            End If
        End If
        idx.x = idx.x + wind

    Else

        If idx.y < horizon Then 'leaves waving in their branch
            If Rnd <= wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            If Rnd <= wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry

        Else 'leaves are on ground but can move too  down and to right only
            If Rnd <= wind / 500 Then ' move down wind
                idx.x = idx.x + 2
            Else
                If Rnd < wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            End If
            If Rnd <= wind / 500 Then ' move down wind
                idx.y = idx.y + 1
            Else
                If Rnd < wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
            End If
        End If
    End If
End Sub

Sub letLeafGo
    Dim which&, i&
    For i& = 1 To 5
        If Rnd <= wind / 30 Then
            which& = rand&(1, totalLeaves)
            'If which& < 1 Then which& = 1
            'If which& > totalLeaves Then which& = totalLeaves
            leaf(which&).isFree = -1
        End If
    Next
End Sub

Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub

Function rand& (lo%, hi%)
    rand& = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function

Sub drawLandscape
    'needs midInk, rand&

    Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
    Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
    Dim lastx As Single, X As Long
    'the sky
    For i = 0 To ymx
        midInk 150, 150, 220, 255, 255, 255, i / ymx
        Line (0, i)-(xmx, i)
    Next
    'the land
    startH = ymx - 200
    rr = 125: gg = 140: bb = 120
    For mountain = 1 To 4
        Xright = 0
        y = startH
        While Xright < xmx
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (Rnd * .8 - .35) * (mountain * .5)
            range = Xright + rand(15, 25) * 2.5 / mountain
            lastx = Xright - 1
            For X = Xright To range
                y = y + upDown
                Color _RGB(rr, gg, bb)
                Line (lastx, y)-(X, ymx), , BF 'just lines weren't filling right
                lastx = X
            Next
            Xright = range
        Wend
        rr = rand&(rr + 65, rr): gg = rand&(gg + 45, gg): bb = rand&(bb - 25, bb)
        If rr < 0 Then rr = 0
        If gg < 0 Then gg = 0
        If bb < 0 Then bb = 0
        startH = startH + rand&(5, 20)
    Next
End Sub

Sub FPrint (s$, PA$(), x%, y%, scale%, spacing%, colr~&)
    ' s$ is string to "print" out
    ' PA$() is the array of string holding the font THE SQUARE pattern (must be NxN pattern)
    ' x, y top, left corner of print just like _PrintString
    ' scale is multiplier of pixeled font at NxN so now is Scale * N x Scale * N
    ' spacing is amount of pixels * scale between letters
    ' color~& type allows up to _RGB32() colors
    Dim As Integer ls, l, a, sq, r, c, i, digi
    Dim As Long frame
    Dim d$

    ls = Len(s$)
    For l = 1 To ls
        a = Asc(s$, l)
        If Len(PA$(a)) Then ' do we have a pattern
            sq = Sqr(Len(PA$(a)))
            'Print Chr$(a), sq  'debug
            For digi = 1 To 9
                d$ = _Trim$(Str$(digi))
                For r = 0 To sq - 1 ' row and col of letter block
                    For c = 0 To sq - 1
                        i = (r * sq) + c + 1
                        $If WEB Then
                                i = i + 1
                        $End If
                        If Mid$(PA$(a), i, 1) = d$ Then
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% + 4, y% + r * scale% + 4)-Step(scale% - 1, scale% - 1), &HFF000000, BF
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% - 1, y% + r * scale% - 1)-Step(scale% - 1, scale% - 1), &HFFFFFFFF, BF
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
                            frame = frame + 1
                            If frame >= stopFrame Then
                                stopFrame = stopFrame + 1
                                Exit Sub
                            End If
                        End If
                    Next
                Next
            Next
        End If
    Next
    FontFlag = FontFlag + 1
    ' _Title Str$(FontFlag) ' checking how long it needs to cycle after letters are complete
End Sub

Sub pumpkin (cx, cy, pr, limit As Integer)
    Dim As Long u, i
    Dim lastr, dx, tx1, tx2, tx3, ty1, ty3, ty2, ty22, sxs
    Dim c As _Unsigned Long
    If limit = 0 Then Exit Sub
    'carve this!
    fEllipse cx, cy, pr, 29 / 35 * pr, &HFFFF5500 ' fill ellipse called with color
    lastr = 2 / 7 * pr
    If limit = 2 Then
        Do
            ' $If WEB Then
            ' G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, 0, &HFF000000
            ' $Else
            ellipse cx, cy, lastr, 29 / 35 * pr, &HFF000000
            ' $End If
            lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
            If pr - lastr < 1 / 80 * pr Then Exit Do
        Loop
    End If
    '' 'flickering candle light
    'c = _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)

    '' eye sockets
    'ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, c
    'ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, c
    'ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, c
    'ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, c

    '' nose
    'ftri cx, cy - rand&(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand&(1, 2) * pr / 12, cy + 2 * pr / 12, c

    '' evil grin
    'ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, c
    'ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, c

    '' moving teeth/talk/grrrr..
    'u = rand&(4, 8)
    'dx = pr / u
    'For i = 1 To u
    '    tx1 = cx - 6 * pr / 12 + (i - 1) * dx
    '    tx2 = tx1 + .5 * dx
    '    tx3 = tx1 + dx
    '    ty1 = cy + 5 * pr / 12
    '    ty3 = cy + 5 * pr / 12
    '    ty2 = cy + (4 - Rnd) * pr / 12
    '    ty22 = cy + (6 + Rnd) * pr / 12
    '    ftri tx1, ty1, tx2, ty2, tx3, ty3, c
    '    ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, c
    'Next
    'If limit = 2 Then
    '    sxs = sx
    '    pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    '    pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    'End If
End Sub

'Andy Amaya's triangle fill modified for QB64, use if color already set
Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3, c As _Unsigned Long)
    Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
    Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single
    Dim slope3 As Single
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3

    'triangle coordinates must be ordered: where x1 < x2 < x3
    If x2 < x1 Then Swap x1, x2: Swap y1, y2
    If x3 < x1 Then Swap x1, x3: Swap y1, y3
    If x3 < x2 Then Swap x2, x3: Swap y2, y3
    If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    If length <> 0 Then
        slope2 = (y2 - y1) / length
        For x = 0 To length
            Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1)), c
            lastx% = Int(x + x1)
        Next
    End If

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    If length <> 0 Then
        slope3 = (y3 - y2) / length
        For x = 0 To length
            If Int(x + x2) <> lastx% Then
                Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2)), c
            End If
        Next
    End If
End Sub

Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)
    Dim scale As Single, x As Long, y As Long
    scale = yRadius / xRadius
    Line (CX, CY - yRadius)-(CX, CY + yRadius), c, BF
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
        Line (CX + x, CY - y)-(CX + x, CY + y), c
        Line (CX - x, CY - y)-(CX - x, CY + y), c
    Next
End Sub

Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)
    Dim scale As Single, xs As Single, x As Single, y As Single
    Dim lastx As Single, lasty As Single
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius), c: PSet (CX, CY + yRadius), c
    lastx = 0: lasty = yRadius
    For x = 0 To xRadius
        y = scale * Sqr(xs - x * x)
        Line (CX + lastx, CY - lasty)-(CX + x, CY - y), c
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y), c
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y), c
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y), c
        lastx = x: lasty = y
    Next
End Sub

Sub LoadPatterns9x9 (SPattern() As String)
    Dim As Integer a
    a = Asc("S")
    SPattern(a) = SPattern(a) + "..111111."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "..3......"
    SPattern(a) = SPattern(a) + "...333..."
    SPattern(a) = SPattern(a) + "......4.."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + "5555555.."
    a = Asc("T")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    a = Asc("A")
    SPattern(a) = SPattern(a) + "...133..."
    SPattern(a) = SPattern(a) + "..1...3.."
    SPattern(a) = SPattern(a) + "..1...3.."
    SPattern(a) = SPattern(a) + ".1.....3."
    SPattern(a) = SPattern(a) + ".1222223."
    SPattern(a) = SPattern(a) + ".1.....3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    a = Asc("F")
    SPattern(a) = SPattern(a) + "122222222"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("I")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("G")
    SPattern(a) = SPattern(a) + ".1111111."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2....4444"
    SPattern(a) = SPattern(a) + "2.......5"
    SPattern(a) = SPattern(a) + "2......35"
    SPattern(a) = SPattern(a) + "2.....3.5"
    SPattern(a) = SPattern(a) + ".33333..5"
    a = Asc("Q")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2....5..4"
    SPattern(a) = SPattern(a) + "2.....5.4"
    SPattern(a) = SPattern(a) + ".2....55."
    SPattern(a) = SPattern(a) + "..33333.5"
    a = Asc("O")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("D")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1444444.."

    a = Asc("6")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2.444444."
    SPattern(a) = SPattern(a) + "24......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("H")
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "133333332"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    a = Asc("4")
    SPattern(a) = SPattern(a) + "...1....3"
    SPattern(a) = SPattern(a) + "..1.....3"
    SPattern(a) = SPattern(a) + ".1......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "122222223"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"

    a = Asc("E")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2444444.."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "233333333"
    a = Asc("N")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "12......3"
    SPattern(a) = SPattern(a) + "1.2.....3"
    SPattern(a) = SPattern(a) + "1..2....3"
    SPattern(a) = SPattern(a) + "1...2...3"
    SPattern(a) = SPattern(a) + "1....2..3"
    SPattern(a) = SPattern(a) + "1.....2.3"
    SPattern(a) = SPattern(a) + "1......23"
    SPattern(a) = SPattern(a) + "1.......3"
    a = Asc("B")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1444444.."
    a = Asc("L")
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "122222222"
    a = Asc("U")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + ".2222222."
    a = Asc("P")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("R")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1.....4.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1.......4"
End Sub

ellipse code bug in QBJS


Attached Files Image(s)
   
b = b + ...
Reply


Messages In This Thread
QBJS Color Problem (Solved!) - by bplus - 09-07-2023, 02:44 PM
RE: QBJS Color Problem - by dbox - 09-07-2023, 03:51 PM
RE: QBJS Color Problem - by bplus - 09-07-2023, 04:01 PM
RE: QBJS Color Problem - by dbox - 09-07-2023, 04:52 PM
RE: QBJS Color Problem - by bplus - 09-07-2023, 06:50 PM
RE: QBJS Color Problem - by dbox - 09-07-2023, 07:15 PM
RE: QBJS Color Problem - by bplus - 09-07-2023, 08:12 PM
RE: QBJS Color Problem - by mnrvovrfc - 09-07-2023, 09:01 PM
RE: QBJS Color Problem - by dbox - 09-07-2023, 09:25 PM
RE: QBJS Color Problem (Solved!) - by bplus - 09-07-2023, 10:34 PM



Users browsing this thread: 2 Guest(s)