Hi,
I'm a recent (re)convert to QB, having used it many years ago, so I'm learning all over again.
Can anyone point me towards any information about using the serial ports (actually the USB ports) under Linux (Mint) please?. I had a browse through this forum, looking at various things which might help, but not had much success, and my very old recollections don't stir any memories.
I haven't found a way. What I'm looking for is the same shadow effect we can achieve in graphics. That means both the foreground and the background of the area the shadow occupies are dimmed, but still maintain the same color, just at a lesser intensity.
Now this gets a bit complicated in SCREEN 0.
1) Make hardware buttons mixed with software buttons and place them all on the screen.
2) Reverse the display order so the hardware images go to the bottom.
3) Make a software popup window that can be moved.
So what is needed in SCREEN 0 is for the popup shadow to be of enough transparency to achieve the previously mentioned results.
Usually in SCREEN 0 we just reprint the characters under the shadow in foreground grey and background black, or white on bright white, etc. That doesn't look quite so nice when the shadow appears over bright red on bright white or bright yellow on bright white, etc. A dimmer red and yellow with a grayish background would be ideal in this instance.
Now if we make the shadow a hardware image, the problem becomes the display order. It was reversed, so now the software buttons go over the shadow instead of under it. So dammit Pete, change the display order back.... Well, that would make the hardware buttons go over the popup (it's a software image, remember) so that would be an even bigger problem, which is why the order was reversed in the first place.
If there is a way to copy both the hardware and software images, already on the screen, to a _newimage 32 surface, and then copy that screen to memory, we'd have one big hardware image to use with the software screen 0 popup and its hardware shadow. In theory, that would visually work, but Is this possible?
Honestly I'd just convert the software buttons to all hardware buttons, but remember, there is also a lot of text to consider and that would not dim when shadowed.
I can see Steve racing for the aspirin bottle now! He needs a really big one, so he can throw it at me after he empties it. (Dammit Pete, just do everything in graphics!)
Pete
Edit: I did think up a tedious method that I believe would work and I know how to do. Make the whole popup a hardware image. The tedious part is it would need to be construct it in stages so when choices like cut, copy, etc. are or are not available, the correct popup gets displayed. So image copy two of every menu item, and "putimage' them together as per circumstances. Highlight the menu with the mouse by putimaging a transparent hardware 'shadow' over each menu choice. Doable, but pretty wonky.
Posted by: PhilOfPerth - 03-27-2025, 09:46 AM - Forum: Games
- No Replies
This is my latest attempt at a word-game. It uses my Random-Access word list R_ALL15, which is attached (I hope).
It uses a text-to-speech subroutine that was posted by bplus recently.
Code: (Select All)
Screen _NewImage(1040, 768, 32) ' Chars Per Row is 80, 36 rows
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font f&
Common Shared CPR, Name$(), NP, Score(), Words$(), Win$
CPR = 1040 / _PrintWidth("X") ' Chars Per Line used for centring text and wiping lines
_ScreenMove (_DesktopWidth - 1040) / 2, 100
Instructions
Randomize Timer
Dim Name$(4), Letter$(100), Value(27), UsedWds$(20), Hand$(20)
Bad$ = "o2l16fedc": OK$ = "o3l64ceg": Win$ = "o3l32cego4ceg"
Play Win$
StockSetup:
Data "A","A","A","A","A","A","B","B","B","C","C","C","C","D","D","D","D","E","E","E"
Data "E","E","E","E","F","F","F","G","G","G","G","H","H","H","H","I","I","I","I","I"
Data "I","J","K","K","K","L","L","L","L","M","M","M","M","N","N","N","N","N","O","O"
Data "O","O","O","P","P","P","P","Q","R","R","R","R","R","S","S","S","S","S","T","T"
Data "T","T","T","U","U","U","U","V","V","V","W","W","W","X","X","Y","Y","Y","Z","Z"
For a = 1 To 100: Read Letter$(a): Next
ShuffleLetters:
For Shuf = 1 To 3 ' shuffle 3 times, just to be sure
For a = 1 To 100
swp = Int(Rnd * 100) + 1
Swap Letter$(a), Letter$(swp)
Next
Next
First = 1
LetterValues: ' for A to Z
Data 1,5,3,3,1,6,4,4,1,9,6,2,4,2,1,4,9,1,1,1,1,7,7,8,5,8
For a = 1 To 26: Read Value(a): Next
NP = 1
GetNames:
WIPE "15"
Locate 15, 15: Print "Enter a name for player"; NP; "(Enter for no more)";
Input Name$(NP) ' get a name
If Len(Name$(NP)) < 1 Then GoTo GotThem
Name$(NP) = UCase$(Name$(NP)) ' change to Upper Case
If Len(Name$(NP)) > 7 Then Name$(NP) = Left$(Name$(NP), 7)
WIPE "15": Centre Name$(NP), 15: _Delay .5 ' display name briefly
NP = NP + 1 ' inc number of players
If NP > 4 Then NP = 5: Cls: GoTo GotThem ' limit to 4 players
GoTo GetNames
ShowUsedWords:
Show = 1
WIPE "15": Locate 15, 30: Print "Keep used letters visible (y/n)?"
While k$ = "": k$ = InKey$: Wend
If UCase$(k$) = "N" Then Show = 0
ShowValues:
Cls: yellow: Centre "Letter Values", 31
Txt$ = " "
For a = 1 To 26: Txt$ = Txt$ + Chr$(a + 64) + " ": Next
Centre Txt$, 32
Txt$ = " "
For a = 1 To 26: Txt$ = Txt$ + LTrim$(Str$(Value(a))) + " ": Next ' show letter-values
white: Centre Txt$, 33
ShowScores:
Txt$ = " "
For a = 1 To NP
Txt$ = Txt$ + " " + Name$(a) + ":" + Str$(Score(a)) + " "
Next
yellow: Centre Txt$, 2
PlayerTurn:
Hand = Hand + 1
If Hand > Hands Then Finish
Plr = Plr + 1: If Plr > NP Then Plr = 1 ' cycle players
First = (Hand - 1) * 10 - 1
If First > NP * 20 Then First = 0
For a = 1 To 10
Hand$(a) = Letter$(First + a)
Next
Locate 8, 35
For a = 1 To 10: Print Hand$(a);: Next
Txt$ = Name$(Plr) + " playing"
WIPE "0516": yellow: Centre Txt$, 5
GetWord:
yellow: Centre "Type your word", 11
Locate 13, 37: white: Input Wrd$
Wrd$ = UCase$(Wrd$)
l = Len(Wrd$)
WIPE "1113": Centre Wrd$, 13
CheckLength:
If l < 2 Then
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre " Too short, or no word entered", 15
yellow: Sleep 1: GoTo GetScore
End If
NonAlphas:
For a = 1 To l
L$ = Mid$(Wrd$, a, 1)
If L$ < "A" Or L$ > "Z" Then ' if non-alpha,
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre "Only letters may be used", 15
yellow: Sleep 1: GoTo GetScore
End If
Next
BadLetrs:
For a = 1 To l ' for each letter of wrd$
L$ = Mid$(Wrd$, a, 1)
Fail = 1 ' flag as failed
For b = 1 To 10 ' for each letter in hand$ L$ = Mid$(Wrd$, a, 1)
If L$ = Hand$(b) Then
Hand$(b) = " "
Fail = 0
Exit For
End If
Next
If Fail = 1 Then
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre "Bad letter", 15
yellow: Sleep 2: Exit For
End If
Next
If Fail = 1 Then GoTo GetScore
CheckWord:
Found = 0 ' set Found flag to fail
Open "R_ALL15" For Random As #1 Len = 19
FL = LOF(1) \ 19 + 1 ' number of words in file
bot = 0: top = FL
While Abs(top - bot) > 1
srch = Int((top + bot) / 2)
Get #1, srch, a$
a$ = UCase$(a$)
Select Case a$
Case Is = Wrd$
Found = 1
Exit While
Case Is < Wrd$
bot = srch
Case Is > Wrd$
top = srch
End Select
Wend
Close
If Found = 0 Then
Txt$ = Wrd$ + " is not a legal word"
Play Bad$: Wrd$ = "": wdval = 0: l = 0
red: Centre Txt$, 15
yellow: Sleep 2: GoTo GetScore ' score zero
Else
Play OK$
For a = 1 To l
L$ = Mid$(Wrd$, a, 1)
wdval = wdval + a + Value(Asc(L$) - 64)
Next
End If
If UsedWds > 0 Then ' if this is not the first good word,
CheckDup: ' check if duplicate
Dup = 0
For a = 1 To UsedWds
If UsedWds$(a) = Wrd$ Then
Txt$ = Wrd$ + " has already been used"
Play Bad$: Wrd$ = ""
wdval = 0: l = 0: Dup = 1
red: Centre Txt$, 15
yellow: Sleep 2 ' score zero
Exit For
End If
Next
If Dup = 1 Then GoTo GetScore
End If
GetScore:
If Show <> 0 Then
Locate 28, 1
For a = 1 To UsedWds: Print UsedWds$(a); " ";: Next ' show used words
End If
Close
Sleep 2
Txt$ = "Hand " + LTrim$(Str$(Hand + 1)) + " of " + LTrim$(Str$(Hands))
Centre Txt$, 18
Txt$ = "You scored" + Str$(wdval)
yellow: Centre Txt$, 16
Score(Plr) = Score(Plr) + wdval
wdval = 0
Sleep 1
WIPE "1315"
GoTo PlayerTurn
Sub Finish
Play Win$
Cls
yellow: Centre "Scores", 6: white
Txt$ = " "
For a = 1 To NP
Txt$ = Txt$ + " " + Name$(a) + ":" + Str$(Score(a)) + " "
Next
yellow: Centre Txt$, 8: white
winr = 1
For a = 2 To NP
If Score(a) > Score(winr) Then winr = a
Next
Locate 10, 1
For a = 1 To NP
Print Tab(30); Name$(a); Tab(45); Words$(a)
Next
Txt$ = "Well done, " + Name$(winr)
yellow: Centre Txt$, 15
Sleep
Run
End Sub
Sub WIPE (LN$) ' LN$ is string with 2 digits for each line to be wiped
If Len(LN$) = 1 Then LN$ = "0" + LN$ ' catch single-digit line numbers
For a = 1 To Len(LN$) - 1 Step 2
WL = Val(Mid$(LN$, a, 2)) ' get 2 digit number of lineto be wiped
Locate WL, 1: Print Space$(CPR - 1); ' print line of spaces on the line
Next
End Sub
Sub Centre (Txt$, LineNum) ' centres text on selected line
ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1 ' centre is half of Chars Per Line minus half Txt$ length
Locate LineNum, ctr
Print Txt$;
End Sub
Sub white
Color _RGB(255, 255, 255)
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub red
Color _RGB(255, 0, 0)
End Sub
Sub Instructions
Centre "Hear the instructions (y/n)", 12
k$ = ""
While k$ = "": k$ = InKey$: Wend
yellow: Centre "Scramble", 5
Centre "A word game for up to 4 players", 6
white: Print: Print
Print " The game uses a Stack of 100 tiles, each holding a letter with a value of"
Print " from 1 to 9 points, and these are shuffled before the game begins.": Print
Print " A Set of 10 tiles is prepared and presented to a player for their turn,"
Print " and they try to form a word (minimum 2 letters) from these tiles. Every"
Print " player plays all Sets of letters, but in a different order, and they all"
Print " have the same number of "; Chr$(34); "first bite at the cherry"; Chr$(34); " for Sets"; ".": Print
Print " Each word is checked, and if it is a real word, points are awarded for the"
Print " tiles used. If not, no points are scored (but no penalty is applied).": Print
Print " Points are also scored for the length of the word: 1 point for the first"
Print " letter, 2 points for the next, 3 for the next etc. so a 6-letter word will"
Print " score 1+2+3+4+5+6, or 21 points, plus the letter-value points.": Print
Print " Each word may only be used once - even from different Sets. At the start,"
Print " players agree on whether used words will remain visible or not during the"
Print " game. If not, memory becomes another factor in winning. Words that are"
Print " repeated score no points (but no penalty is applied).": Print
Print " The game ends when all players have played all Sets, and the player with"
Print " the most points wins."
yellow
If UCase$(k$) = "Y" Then
_KeyClear
speak ("The game uses a Stack of 100 tiles, each holding a letter with a value of from 1 to 9 points, and these are shuffled before the game begins.")
If _KeyHit >= 0 Then GoTo Done
speak ("A Set of 10 tiles is prepared and presented to a player for their turn, and they try to form a word (minimum 2 letters) from these tiles.")
speak ("Every player plays all Sets of letters, but in a differnt order, and they all have the same number of first bite at the cherry for Sets")
speak ("Each word is checked, and if it is a real word, points are awarded for the tiles used. If not, no points are scored (but no penalty is applied).")
speak ("Points are also scored for the length of the word: 1 point for the first letter, 2 points for the next, 3 for the next etc.")
speak ("So a 6-letter word will score 1+2+3+4+5+6, or 21 points, plus the letter-value points.")
speak ("Each word may only be used once - even from different Sets.")
speak ("At the start, players agree on whether used words will remain visible or not during the game.")
speak ("If not, memory becomes another factor in winning. Words that are repeated score no points (but no penalty is applied).")
speak ("The game ends when all players have played all Sets, and the player with the most points wins.")
End If
Centre "Press a key when ready", 31: Sleep
Done: Cls
End Sub
Sub speak (message As String)
Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
End Sub
Hello everyone, I always follow you and continue to appreciate the project and everyone's effort to improve and keep our beloved QB64 alive! I’m sharing with you a code that I thought of and partially developed (and obviously then refined with the help of AI) to interpret a string with a calculation expression, just like scientific calculators do with expressions. I believe it is useful and I hope it helps someone. If you test the code, everything will be clearer. Pass to the function - in the example, this first function is not there because the expression is in the main code - something like: a# = calc# ("1 + (variable#(73) ^ 2 + (variable#(74) + variable#(88) / 100) ) * 100") where variable#() are obviously the variables to be processed. Feel free to modify the expression by adding and removing operators, and you will (always?) get the correct result.
Let me know! Maybe something like this already exists and I just don't know about it yet, or perhaps it's not as useful as it seems to me.
Here's what I have so far, for printing text in a big font.
Then to smoothly scroll, I'd have to redraw slightly shifted over.
Is there a better way to do this?
I'm not crazy about this relying on an array or drawing a rectangle for every pixel, it seems like it could be easier and more efficient.
I vaguely recall seeing different examples of printing a bigger font and smoothly scrolling big text to a hires screen, but can't seem to find them.
Code: (Select All)
Dim in$
Dim iChar As Integer
Dim sChar$
Dim iStartX As Integer
Dim x%, y%
Dim fgColor~&
Dim bgColor~&
Dim scale%
ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
Sub PrintBigText (imgDest&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha() As Integer)
Dim iChar As Integer
Dim sChar$
Dim x1%, y1%
' Make sure we have a valid image handle
If imgDest& < -1 Or imgDest& > 0 Then
' Make sure scale% >0
If scale% > 0 Then
' Make sure sChar$ is not blank and arrAlpha is DIMmed
''ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
if len(in$)>0 and _
lbound(arrAlpha,1)>=32 and ubound(arrAlpha,1) <=127 _
and lbound(arrAlpha,2) =1 and ubound(arrAlpha,2) = _FontWidth _
and lbound(arrAlpha,3) =1 and ubound(arrAlpha,3) = _FontHeight then
x1% = x%: y1% = y%
For iChar = 1 To Len(in$)
sChar$ = Mid$(in$, iChar, 1)
PrintBigChar imgDest&, sChar$, x1%, y1%, fgColor~&, bgColor~&, scale%, arrAlpha()
x1% = x1% + (_FontWidth * scale%) ' move forward 1 character
Next iChar
End If
End If
End If
End Sub ' PrintBigText
' /////////////////////////////////////////////////////////////////////////////
' Usage:
' PrintBigChar imgDest&, sChar$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
Sub PrintBigChar (imgDest&, sChar$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha() As Integer)
Dim iChar As Integer
Dim x1%, y1%, x2%, y2%
' Make sure we have a valid image handle
If imgDest& < -1 Or imgDest& > 0 Then
' Make sure scale% >0
If scale% > 0 Then
' Make sure sChar$ is not blank and arrAlpha is DIMmed
''ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
if len(sChar$)>0 and _
lbound(arrAlpha,1)>=32 and ubound(arrAlpha,1) <=127 _
and lbound(arrAlpha,2) =1 and ubound(arrAlpha,2) = _FontWidth _
and lbound(arrAlpha,3) =1 and ubound(arrAlpha,3) = _FontHeight then
' Make sure ASCII code is in the range of our array
iChar = Asc(Left$(sChar$, 1))
If (iChar >= LBound(arrAlpha, 1)) And (iChar <= UBound(arrAlpha, 1)) Then
' Print sChar$ as big letter at x%, y% in color fg~&, bg~&
y1% = y%
For sy = 1 To _FontHeight
x1% = x% ' start each line at beginning
y2% = y1% + (scale% - 1) ' calculate y endpoint
For sx = 1 To _FontWidth
x2% = x1% + (scale% - 1) ' calculate x endpoint
If arrAlpha(iChar, sx, sy) = _TRUE Then
Line (x1%, y1%)-(x2%, y2%), fgColor~&, BF
Else
Line (x1%, y1%)-(x2%, y2%), bgColor~&, BF
End If
x1% = x1% + scale% ' move x over by scale%
Next sx
y1% = y1% + scale% ' move y down by scale%
Next sy
End If
End If
End If
End If
End Sub ' PrintBigChar
Sub GetBigFont (arrAlpha() As Integer)
Dim imgChar As Long
Dim iChar As Integer
Dim sx, sy As Integer
Dim c~&
Dim r As Integer
ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
InitImage imgChar, _FontWidth, _FontHeight, _RGB32(0, 0, 0)
For iChar = 32 To 127
_Dest imgChar
_Source imgChar
Color _RGB32(255, 0, 0), _RGB32(0, 0, 0)
_PrintString (0, 0), Chr$(iChar)
For sy = 0 To (_FontHeight - 1)
For sx = 0 To (_FontWidth - 1)
c~& = Point(sx, sy)
r = _Red32(c~&): ' g = _Green32(c~&) : b = _Blue32(c~&) : a = _Alpha32(c~&)
If r = 255 Then
arrAlpha(iChar, sx + 1, sy + 1) = _TRUE
Else
arrAlpha(iChar, sx + 1, sy + 1) = _FALSE
End If
Next sx
Next sy
Next iChar
If imgChar< -1 Or imgChar > 0 Then _FreeImage imgChar
End Sub ' GetBigFont
I have my PI-5 hooked up to a large screen 3840x2160 and changed the default display setting for large screen, I don't know the actual aspect ratio as there were only 3 options, set default for large, medium or small screen
setting the default for large screen works well except for QB64pe, if I change the Font size in pixels from 19 to 21 then the IDE looks ok but the programs display in a tiny window with tiny fonts, same when using $Console:Only
any plans to make QB64pe DPI aware ?
Posted by: SierraKen - 03-25-2025, 05:56 AM - Forum: Games
- No Replies
Tonight I put this game together. It has no graphics like Simon does, or colors, but instead it uses numbers. It also uses completely different numbers for each turn.
It might take 1 or 2 tries to get the hang of it. Don't ask me why I made the limit 1000 turns, most likely nobody on Earth could remember 1000 numbers in sequence with only seeing them for 2 seconds each. I just wanted to be sure. LOL
Code: (Select All)
_Title "Numbers Memory Game by SierraKen"
Screen _NewImage(800, 600, 32)
Dim num(1001)
Dim num2(1001)
begin:
turns = 0
Cls
Clear
Print: Print: Print
Print " Numbers Memory Game by SierraKen"
Print: Print: Print
Print " Remember all of the numbers the computer shows."
Print " Each turn has different numbers."
Print " One number is added per turn."
Print: Print: Print
Input " Press Enter to begin."; a$
Cls
Randomize Timer
Do
turns = turns + 1
For n = 1 To turns
num(n) = Int(Rnd * 9) + 1
Locate 15, 50: Print "Turn: " + Str$(turns)
Locate 20, 50: Print num(n)
_Delay 2
Cls
_Delay 1
Next n
For n = 1 To turns
Locate 20, 50: Print "Number " + Str$(n) + ": ";: Input num2(n)
If num2(n) <> num(n) Then
Sound 100, 2, , , 3
Locate 24, 50: Print "Wrong Answer!"
Locate 26, 50: Print "Right Answer: "; num(n)
Locate 28, 50: Input "Again (Y/N)"; ag$
If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then GoTo begin
End
End If
Cls
Next n
If turns = 1000 Then End
Loop
'========================= routines =============================================================
Sub SVGcircle (svgimage$, cx, cy, radius, stroke, strokeK~&, fillK~&)
'converst input data to a svg definition of a circle
'fillK~k& and strokK~& are the 32 biut colors for the fill color and the stroke colors of the circle
'stroke is the thickness of the perimieter fof the circle
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(fillK~&): g& = _Green32(fillK~&): b& = _Blue32(fillK~&): a& = _Alpha32(fillK~&)
fk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
fo$ = _Trim$(Str$(a& / 255))
r& = _Red32(strokeK~&): g& = _Green32(strokeK~&): b& = _Blue32(strokeK~&):: a& = _Alpha32(strokeK~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = _Trim$(Str$(a& / 255))
svgimage$ = svgimage$ + "<circle cx='" + Tnum$(cx) + "' cy='" + Tnum$(cy) + "' r='" + Tnum$(radius) + "'fill-opacity='" + fo$ + "' fill='" + _Trim$(fk$) + "'"
svgimage$ = svgimage$ + "'stroke-opacity='" + so$ + "' stroke='" + _Trim$(sk$) + "' stroke-width='" + _Trim$(Str$(stroke)) + "' />"
End Sub
Sub SVGtriangle (svgimage$, x1, y1, x2, y2, x3, y3, stroke, strokeK~&, fillK~&)
'converst input data to a svg definition of a triangle
'fillK~k& and strokK~& are the 32 biut colors for the fill color and the stroke colors of the circle
'stroke is the thickness of the perimeter of the triangle
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(fillK~&): g& = _Green32(fillK~&): b& = _Blue32(fillK~&): a& = _Alpha32(fillK~&)
fk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
fo$ = Tnum$(a& / 255)
r& = _Red32(strokeK~&): g& = _Green32(strokeK~&): b& = _Blue32(strokeK~&):: a& = _Alpha32(strokeK~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = _Trim$(Str$(a& / 255)) 'stroke opacity doesn't seem to be supported but i'm still calulating it for now
svgimage$ = svgimage$ + "<polygon points='" + Str$(x1) + "," + Str$(y1) + Str$(x2) + " ," + Str$(y2) + Str$(x3) + "," + Str$(y3) + " '"
svgimage$ = svgimage$ + "fill-opacity='" + fo$ + "' fill='" + _Trim$(fk$) + "'"
svgimage$ = svgimage$ + "'stroke-opacity='" + so$ + "' stroke='" + _Trim$(sk$) + "' stroke-width='" + Tnum$(stroke) + "' />"
End Sub
Sub SVGpath (svgimage$, Pt(), stroke, strokek~&)
'draw a path described in the single dimensionalarray Pt()
'stroke is thickness of path draw
'strokek~& is color of the stroke to be drawn
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(strokek~&): g& = _Green32(strokek~&): b& = _Blue32(strokek~&):: a& = _Alpha32(strokek~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = Tnum$(a& / 255)
totp = UBound(Pt): If totp Mod 2 <> 0 Then totp = totp - 1
dpath$ = "M"
For n = 1 To totp
dpath$ = dpath$ + Str$(Pt(n))
Next n
svgimage$ = svgimage$ + "<path d='" + dpath$ + "'fill-opacity='0' stroke ='" + sk$ + "' stroke-width='" + Tnum$(5) + "' />"
End Sub
Sub SVGfpath (svgimage$, Pt(), stroke, strokek~&, fillK~&)
'draws a filled path described in the single dimensionalarray Pt()
'stroke is thickness of path draw
'strokek~& is color of the stroke to be drawn
'fillK~& is the color to fill the contained space withing the drawn path
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(strokek~&): g& = _Green32(strokek~&): b& = _Blue32(strokek~&):: a& = _Alpha32(strokek~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = _Trim$(Str$(a& / 255))
r& = _Red32(fillK~&): g& = _Green32(fillK~&): b& = _Blue32(fillK~&): a& = _Alpha32(fillK~&)
fk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
fo$ = _Trim$(Str$(a& / 255))
totp = UBound(Pt): If totp Mod 2 <> 0 Then totp = totp - 1
dpath$ = "M"
For n = 1 To totp
dpath$ = dpath$ + Str$(Pt(n))
Next n
svgimage$ = svgimage$ + "<path d='" + dpath$ + "' fill='" + fk$ + "' fill-opacity='" + fo$ + "' stroke-linejoin='miter' stroke ='" + sk$ + "' stroke-width='" + Tnum$(stroke) + "' />"
End Sub
Sub SVGpolyA (svgimage$, Pt(), stroke, strokek~&, fillK~&)
'draws a filled polygon described in the single dimensionalarray Pt()
'stroke is thickness of path draw
'strokek~& is color of the stroke to be drawn
'fillK~& is the color to fill the contained space withing the drawn path
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(strokek~&): g& = _Green32(strokek~&): b& = _Blue32(strokek~&):: a& = _Alpha32(strokek~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = _Trim$(Str$(a& / 255))
r& = _Red32(fillK~&): g& = _Green32(fillK~&): b& = _Blue32(fillK~&): a& = _Alpha32(fillK~&)
fk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
fo$ = _Trim$(Str$(a& / 255))
totp = UBound(Pt): If totp Mod 2 <> 0 Then totp = totp - 1
dpath$ = "M"
For n = 1 To totp Step 2
dpath$ = dpath$ + Str$(Pt(n)) + "," + Str$(Pt(n + 1))
Next n
svgimage$ = svgimage$ + "<polygon points='" + dpath$ + " '"
svgimage$ = svgimage$ + " fill='" + fk$ + "' fill-opacity='" + fo$ + "'stroke-linejoin='miter' stroke ='" + sk$ + "' stroke-width='" + Tnum$(stroke) + "' />"
End Sub
Sub SVGellipse (svgimage$, cx, cy, rx, ry, stroke, strokeK~&, Fillk~&)
'converst input data to a svg definition of a circle
'fillK~k& and strokK~& are the 32 biut colors for the fill color and the stroke colors of the circle
'stroke is the thickness of the perimieter fof the circle
'SVGdraw must be used following this routine to display the shape drawn
r& = _Red32(Fillk~&): g& = _Green32(Fillk~&): b& = _Blue32(Fillk~&): a& = _Alpha32(Fillk~&)
fk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
fo$ = _Trim$(Str$(a& / 255))
r& = _Red32(strokeK~&): g& = _Green32(strokeK~&): b& = _Blue32(strokeK~&):: a& = _Alpha32(strokeK~&)
sk$ = _Trim$("#" + hexpad$(r&) + hexpad$(g&) + hexpad$(b&))
so$ = _Trim$(Str$(a& / 255))
svgimage$ = svgimage$ + "<ellipse cx='" + Tnum$(cx) + "' cy='" + Tnum$(cy) + "' rx='" + Tnum$(rx) + "' ry='" + Tnum$(ry)
svgimage$ = svgimage$ + "' fill-opacity='" + fo$ + "' fill='" + _Trim$(fk$) + "'"
svgimage$ = svgimage$ + "'stroke-opacity='" + so$ + "' stroke='" + _Trim$(sk$) + "' stroke-width='" + _Trim$(Str$(stroke))
svgimage$ = svgimage$ + " transform='rotate(" + Tnum$(erot) + ")' />"
End Sub
Function Tnum$ (num)
'returns a numbers as a trimmed string (I worte this because it is briefer in the strings used to define the SVGs)
Tnum$ = _Trim$(Str$(num))
End Function
Function hexpad$ (k&)
'makes sure a hexidecimal value of a number is returned as 2 characters
If k& < 16 Then
hexpad$ = "0" + Hex$(k&)
Else
hexpad$ = Hex$(k&)
End If
End Function
Sub SVGdraw (svgi$, px, py)
'completes an svg layer perviously defined in svgimage$ and display it starting fron the point px.py
'is meant to fill a screen
Dim simg&
'get the screen size and build the header
svgheader$ = "<svg width='" + _Trim$(Str$(_Width)) + "' height='" + _Trim$(Str$(_Height)) + "' >"
svgfooter$ = "</SVG>"
svgimage$ = unpackSVG$(svgi$)
If svgimage$ = "NOT_A_PACKED_SVG" Then
SVGdrawing$ = svgheader$ + svgi$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memory") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
Else
SVGdrawing$ = svgheader$ + svgimage$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memory") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
End If
End Sub
Function SVGpack$ (svg$)
dc$ = _Deflate$(svg$, 10)
SVGpack$ = "SVG64" + _Base64Encode$(dc$)
End Function
Function unpackSVG$ (packed$)
unp$ = "NOT_A_PACKED_SVG"
If Left$(packed$, 5) = "SVG64" Then
datal = Len(packed$) - 5
s0$ = Right$(packed$, datal)
s1$ = _Base64Decode$(s0$)
unp$ = _Inflate$(s1$)
End If
unpackSVG$ = unp$
End Function
Function rand0 (num)
'returns a random # from 0 to num
rand0 = Int(Rnd * (num + 1))
End Function
this one has an embedded SVG image drawn with Adobe Illustartor. It makes used of deflate/inflate and base64 encoding for sharing data via posts.
Code: (Select All)
'Packed SVG example
'this program requires QB64-Phoenix Edition 4.1 or later
'
'displayes an encoded SVG graphic
'the oriignal data was compressed by use of the _deflate$ commad and _base64encode$ to make it safe to share as a text file on HTML
'
Screen _NewImage(1200, 600, 32)
_FullScreen _SquarePixels , _Smooth
'the following lines are a packed SVg file The original SVG was draewn in Adobe Iluustrator and simplified by hand
'to embed in a program and encoded for compression and safe transmission as tetx file
esvg$ = "SVG64eNrdXN2P5MZx/1cGyIMSoDlh9XcDToDzCHpSngzkXaDXvkVGOuF2odj316c+u5uc2Zt1LECwdZglh0M2q6vr81fV+t3PP7x+PP3xP07f/BfA2TsP23o"
esvg$ = esvg$ + "GJ5+gn4SfeF0XCOd2xZ+WcPXntkT66yJdceEX+hGf9Ys+i0dPzy70rD/nxZ/TL/lcr3SBBtwWfQMes97Z8FjxbrqOlLhVKJG/OHpZ6De/4Lscfpa0AZJDz3t8M5KBo+"
esvg$ = esvg$ + "E0Nh4Zn8pKTVt4PH4HOGDagL/RvaC0eqUoLkqe10+aPjhJGVQeokfs1qCfwt+Bbwx8C80P5of5W9B3JqUBJhqC0ABMDDMPzwNNHz+ZGY2/4SQKHouj9cDjBsyA6iL+Hhyxq"
esvg$ = esvg$ + "2zGQs9/AzMy6hIXPvKLL5EEABcU/+DvER/Fk0pDEgfxFaCfiHxGzhOn+Arwh+5grtEPldiAF4nKQKxWsYpMQ7Fludqst91KO10Xp+tCA+JVHsbtecWyNj3t9WmRX2CJIvYkB"
esvg$ = esvg$ + "1sk2cGziJ+CaxLxA3jblehqLL40PV4WRzeDyxMZphIs1gfyov6Wr0gkCeOVWM9SvAgRwEK7LsmE8UDyPAkRXpms/JqEb9fVJWK9qCQuQ8UpZifqELfBW2ABQkpM3VDvgIe/"
esvg$ = esvg$ + "EgnwkX79Zcmomyw/uIR8J1LtZwFfVFK3RcxAXuTdjaTQtDjqnZXPVSNNEhILNDAZ+CzOIJ8zvT5fhc2FKGMLoxpWbczMF2Qq9GLSHhJuz8wkbc94xGkgTz4SLatQuYiCk"
esvg$ = esvg$ + "bj0mYgeIie2rreF7qS/m0xq8bw0cYn8dn448p1NFJqntU6Km9VY1E34zuaLWOiIwEBmaAFVZxEHHPxK37LMsgkJzGXP8w2DvqjMz2ymhI3MXxIwWinVOJ7Dwm/Cv8G4QBxwsiCiloePt2"
esvg$ = esvg$ + "HnC2bCePL2JatNK2JbB4Fi20RepkG6xIAO4HUQMYGHH5JJz6Zj8q/VrWrL9Vn+okSQMIhk04fEuH6v7uvL6Zt//8/fDa8WAyl5/P6N43T7n56vV3ziXz58u5a1n"
esvg$ = esvg$ + "L6R530mo+GJ7CAGZSGtS0gHaV0jBWcHKNwi4V7MnCxiTwr/kFiUKxqe2l2OuKMkvNlALANpNQ+R+Mm6ydAFhy5sCWB4jaaerA4fyGLnJyEtyklQp5H5elCPF5nvkde"
esvg$ = esvg$ + "yikqEs7gu0Y/IvPfb5NvqooadJnQUlKQ3NfOKUT9VFs/WM+rYafFmMESGxOkGkU5QgfJqZIIoC/0gSu412ghibC6+Es9REgqJA/mqvoKy1k/X6/PPL0+n188//PTyp0+"
esvg$ = esvg$ + "ff8RV/vGH18/Pf/lXHG+t4UTEtwinfpCrHpkUSzsVXK+a/w0FxCSmXi45fIcXtr/g17DS2V/xLKGq4vlnuop8plO6jMt0K3V5DRVCl7riUpvimKpGnez3Isvmr0HCGbI"
esvg$ = esvg$ + "n5M7I47D2XBe9MapvvbMQxH1/8YHEip5HJnl+pdNXv4NZrTVkCw6xrt7Hp2X1p90XuwOFpIV6QslLX2EbKmTtjPPGNuaVsC2e2yO2xYzqgdSHrVv8ykIsfo+YRg6DvjD"
esvg$ = esvg$ + "HmGFX+TlqiOnVCIXZCF0i6rNwKhZS5kZn9jbh1een7fXEM0HBRop4IoGIvse+BU6kdcWXmJ4WgNPuC/5ayzn65k+Ahi3WCjPnSooXT+/43+c/vn5k3mT89vHp+c8fX0k"
esvg$ = esvg$ + "E6etMEmpDeCdJaY0lRyVp+oK/4lxjK+W9JNV7JO1W7/eB/vXVQ8mrnGEkiUcLGUG0sMRzkk6nd7xDNmMCVuTakKh+kKtoC9DA43TCUSIvH1rJuSuyZ6axRMbE5yyTeiq"
esvg$ = esvg$ + "q3B7TUkOOREuKlayJHuQq1HMooZ0CTti3rxATxZYYMW0oSDNimK4ji7uSMYtDpfC3qldl1RD7Ki4ELgGj4upCosgMj3G6vakyYBjHjkxtf3Lqlx0FMOy9+G4e2rOhIZc"
esvg$ = esvg$ + "p6Ym8SmJ3r4FRGIGbBAhOk5tNlFCCKkl2KIwiPxY1+KqaXtD97QpBnOAmCQlFtZgJUdSJvnMXcffEYcrG/JyVsedx4p0Sv4hMJbtQ5ZqXly9hThTDZGaLBTqHaO4SGg6"
esvg$ = esvg$ + "FXMX4nYUbRcD1hbkTkNSV/vUl5IC/so+mSJMyw8gxRNzYCdI5z5yOlBOMFBk0V6w32YfkDlWj9Ci5g8U2wmvOmC3ns6wmcDREs0sS325zzmuh8zaFe2H4f+Ecr97CsU"
esvg$ = esvg$ + "uXhTm9jpdA84w0rky+9TNkwx2Gdc0RhlE26yX+AY3xC5Irkpk48OhRRmAueY6+wAI4ySEl2WLc4Q+BPSW5jD76PTpKi9l3OmhUyMJ8N2bZcY5JFmFCUqLKpmQHPUuec+"
esvg$ = esvg$ + "A7SMkQ9KzOrGjYGfX6iLB3HBeRZR3jfF9Vu0mkz0+BkygyaLJMsIN3kvBjTqJcIpGSiBSVEEV0Eg1JeGSilrKpGUqSoR1FCOY8804+osplSpZM95KKmGWEecoI52e2Q1"
esvg$ = esvg$ + "KT7CLcy21IItHskFfSM9dX9xAMBPGDZJ8h8elXPK9fAbrn7V/w14KMSS2eAkYvEHZuIoVYMEodjtfPbvdOpNn4vx5pUmATvYFxRS06x4lmAbxKYVAkjW7optPgu6K2Ay"
esvg$ = esvg$ + "ZkJOqH4b0N+BxZxXAO4yssUk2yGhYfEik6lm1gLkWxlSaC3VcqiSxtGubxOkuO7dV5yPdEZoWtW9LMxsS82+R5pcMULrMfkOxG0nMCHKqlpRZIMzbB0Bybd6I40ksC"
esvg$ = esvg$ + "x4skfMrlezaC/+urwW4gMflwABo4IL0q8Ve9dlV9nqCiomyr3QokHYnTs6uc0whFR+ho67tH4ADtePybRthRb9/Fjg1LNmNIvsO28Q5YOKzpwK02NRNBTQXosWwGQS"
esvg$ = esvg$ + "+CDYuY5IE0aAar96dx/4hGRKQn+GJvlA5JRFpE+IO9w/dUWp4w2Ecye4OVLKMNJBNohVU6Uj+LDyVKQrk84yi/0eyOoFlTGNVmHHg1SJfiUS7+4aU8z"
esvg$ = esvg$ + "NIcp6KE76Z08kjqHjEYl1VuFJA3WsXo+no+XnlKn2Ivs8AUYldxsr+hcuyFASQC7aKQ+EpRUfiVFvL7gOyAX9dYvW+ES+BqAwathRaUEAhdnC+P3DOGD41cSN"
esvg$ = esvg$ + "ykkhI586B8JkqwfDdM1DxFva93RjGvqGOgVKoyBKFvisw7CXWlehTu1DdYPW8KMF7sr9eKmtRY2sKiK+kA+UzgCpagphWBxjTLfJjMRuvuvGluRxbh"
esvg$ = esvg$ + "IXaAmQByuJ3n8uVcs4FRYuuRAzlT5tpVRdu+T7FH1rkXldB7YwQdgyMg+/6uMXIfI+n7d8e/cQw/Vp7vTRIzSVy1HZYszGXYbBAx57ZToiGFS83wk1N1"
esvg$ = esvg$ + "H9YaFMQVdaQiFczxYRrjSnC/mObxrWe7OW6HqqjlKWgDKykA1iEp2at0llxf7C8PxYIVLrP5+Gda6nmJrPTIafgxMrcSfHIKSPz2S60xHv07Fs614Kf2MlOGr2dm"
esvg$ = esvg$ + "O/M7Fj0GgQtg24MXUUn4LfmwTGt0xOSzFGmOJct/QtGNEz1Gx1xdF3ABLuwqGfiJlMJxUtVX93EARAWgzQRQcgjPOWSevFrW7BMmGux6cQKbhJtuCdDiG2jxTUqy0nqSt"
esvg$ = esvg$ + "OhWeN7y5rSHTpyWajT7lcYKulo1isjOPqzBzls50SSoaYLejtqe1XS2OaVvjNl6E367LO6V+XIWpDAoNZzrcnRgxkO9MTpyk1/LubPCudEyMSkcSkXduxnkmdQNLD4EjS"
esvg$ = esvg$ + "aDVfrth2CtBPpEeytL30GwfgKKiiGMQeE9eV/QWrMA4EFfVWedzPqphFIybMrERE1t0AxdfKOqYqIsP9EZYoEkcPcqyh8+pA9pAnARAwmj9p4U+gIlNh8QFK+S5w8y57W"
esvg$ = esvg$ + "2bEA5TA1P1TTz6O4VxjPUxk+Ae5o7B9j6CA4TpfCocB8h/GY3rDmsRxraLCQYD8lP0e6IMGJ9dfBwvxMgjGWzoBB0XXWJ4PBD6bDee0Rj7jbQvqVFupuMVFPTolg3yvum"
esvg$ = esvg$ + "kag23UQG2eEGrXgDvfh1NNOrZooXCxIzNc2+q7bkNB5+ZOZN6zVehUFcFzfvcNk9GPYdFb4irIxZdMFsKXiWVBJWBtxFbO9VKC7Zhzb8L0ZoN3lCEIAAOMUIpEmMLmc2b"
esvg$ = esvg$ + "mnrTXJWHgJrn7LWEdDFFcYkA+CCNtAU6ZHbbnuXxMHcNO2N6pJxsGq7nLofUSQFJkHhS4xD2QVEdQ6gy+vV7As8CNRMh7dSy0Zk7mUKY4kxR3w49Mos5YRfxYeh5FoMHx"
esvg$ = esvg$ + "5fBB9e81pOBYNiSDM8/N13l8uadnXZNAPE8V7R0Af4zveKE9c5fPr+cLzo0R2Ox/u+vHP8v2O8VnMOvdACtDY+sZUqTrwaSIRGjYsvLGrcV+bScFdBO6jSHyDy066Po2/"
esvg$ = esvg$ + "8dP3r9fmnpxFt/B7/fcC3/vzp+afXF0L4qYsC49QTn3gqyELYnfGPdIKHyOICdDPgd/vvZnZ9CWV2bAaw4L8BZ+yMlksr47m8BBXDyF6z/LKwbgGbAL5z0Tu1gKfqzpfp"
esvg$ = esvg$ + "gf+mkXG+RAjSsT1/3q5Pt5RwSZomYCXpQJL7mS6SeD2qiKeKZTHSX+A2ET3IVerjKoUqHbnk8HZBXFsa+O143v5/1XnSnvMKAUJ9WlZcpN0X6m6BtfiYuaEF7VUIxSf68"
esvg$ = esvg$ + "hXCoDNlZQbdkvWwKgNc2S2WLR1rg6N+2KuFMPcNq7PJb1ULB2g0hRdzIJ8M0HL7JKG3uSp2G9ycYok1jYdx/JQQGJwUJogib/tr2QKKt1psd63E1hmlgN4BDItvFfi5gB"
esvg$ = esvg$ + "05QqUOoSiIw/3ioD/WATUxG3XKGeZMvUMUejpoIU1vBLBIJB56BJz1CAD3uVKPgJwV0l4Tivf0ZuXSSMM8dbz0g1xFFG6t9YTDJfiahhHK3DWscofRu1pODqKcuUq6aU7"
esvg$ = esvg$ + "UkUaKKv2LOF6OZFUExWLT4vYG1TlJZu9qLa2hR+ra77z4F/2mTSHJng9TlpEsMKwjG9EOQ5iafsUtWBBSprJ5lcDtHC9AHp7rfMDoPIdyMuPHxT6NqNKxCbd3ksz4SBr4"
esvg$ = esvg$ + "yK6GmXY1zCnC8dLYPLdJUupjJgBGnq3wEUf7EzgzdaN35beMlZtO55W7eIaTKWH33JqhZzLDx7zgVNd68KdG/t6TZ+bL2hdybxcOujqSIw5jF+bS9dC/YMDIVyRgFynKn"
esvg$ = esvg$ + "W+0CQ0VrxTJU9h+AarO4WTQ0TY5wzjCJviwwUc6V4OYjIE7FW2B6sKIsLq0XHEYIfsxqioWJmncCHULq0QFGI5W2Cx0nBLJZKK+zWV+FnFNDeWqzDtq6po7faA9Jkjli6"
esvg$ = esvg$ + "ouz2Lxtx3pfteRvmc/lUA52aYSKLEGXGfSQ3byPhYKELY7Lk9xn+6iNMkryrww4UDJWZFTN/joHgtueiGd7HlbUjwo7FywH51nNw6c38WtSZQSJQ3H8uihhhnU2PerpLm"
esvg$ = esvg$ + "StvW9VJLbggpNPdYee0PxJWqPdKEdP5k4FVzn2Zd70eiK/3XucjEpjwTcOuCsDTxvangTN3a3pTf1xwn7MYxmt52kSHuFDVJ0N0jkbrHezBMOe7SypvHZ1oj9yRzg3Ham"
esvg$ = esvg$ + "DBWpatv88Eaym0aybw2HwlT1k3YrA3fBQUdFLQgpc5fkZjh01Pcn+W3T3QVOdxc4212gmwucbi5w+71KIsUyhuwtWKICOk13s4CE9p1ZMFXbqpnGOC2dZdXSBCb5Ag0nS"
esvg$ = esvg$ + "S4E1vzGOwhAxJUnqXCOQv26Twh1/dEOC96JQb2+m9caRhLL4zj8mUuZsmDbfgmnEtevOfXboEyxoaB9kFlB3Cob5yIrUJRe5T6nOwrUO6WtwBvZTWz7PZcGAI+SMkwO8R"
esvg$ = esvg$ + "D7GpR/iH5NEGe3ZU1TcxfUtFHEv9kIdw9EM3xV9ZEMe9f5MDWN6dLtEwPVNpjSiDRPHhEokjBu9uRmMeq07Ox6zNhCvInWnCitik73TAjIY6wzPHUzunpqMqUhcaptVLl"
esvg$ = esvg$ + "uyzI+BwjQ73fwWQV9h+72Tbb3gow4NTf1pyz+6j0QIzpz08a7uX8sTEvbPWATDnw1uLEmUXH9jP9ue2nai06cNl34fWo6Gltedm3AVvO/3VM2NrHJZr4u92qUh+scM9Wo"
esvg$ = esvg$ + "fbcnrccY271mzmUE+Brve4UU803iZ65YKpSQyDZTJweQ5ekSN/CiP3/6aVi9XC68seXl9fOn/3miS+uqvlQuLYbRhXHpx+fXp8/XZzwQuLLOaJPiYafj8S0cab9XBnFdC"
esvg$ = esvg$ + "NrFMrbxRslr1BSTZxGpS8ZsadTWPo7IDR9Yr00U/a6EFQP7MBn7PRuuUuY8tdWST/3AVwG9WcXpYKE/l+r3oKbyTfZp9H1DyPxoWSqMnUPlXv/IPo4JNGEIWqj1mhUlPt"
esvg$ = esvg$ + "ZN6hxJoYmkTgh0V3bhslDkY6EdFNyjwANCPwsMqh2J+PbbNQ1oj/u9aBODbvClKH6l3coTXg3Owk+x/wo3zJiCGeaimTEHg7ZubxdKbreJy7QjZxW8U5c+wiLd/kstPcS"
esvg$ = esvg$ + "MRTJUaapHDFULausRdZFuqEiTBGllAyqn9Ik/tuqUVkIbNRT7vwYUjXj9dtgcbhGvEB4siJAOvM0soTzMhVU3bWq0SLbZhsVt2D1pW6vTjkuYGr+S9AJTDkxOq+gxUSLY"
esvg$ = esvg$ + "LuzQ6ExqK567hW1qD/ekJqI09nIYWFlTdwamTZuV/ZI05ClWQLVamldRCZKubXd66POUjdku7rOVn/OGf12VeJeQKW3mvpNiiFLNsgvkRLxGEVG2FiCJ8SGJx3Jx36ZtG"
esvg$ = esvg$ + "atXEoO2kN8DMCiwNtKzgGpGuvxPBrLiGmEQmd5NYpmzmaUHScbD7rbsnfsYYspQ0tTWE7ao9rlypM9kN7cvFc8xcRpADv1+SfRMRNMF0oAYXZehh9ImrezTZqCbjs"
esvg$ = esvg$ + "N7hU5Wqy1wZNCo7CFlGEHmxk59rWgLoHfkNmseJahsRBP3QcqGi07TQ+plf07aodWa+lv/8QHbTn07VI82ONgKChOwrXJNq4K7fSaTZG5aUGWF5BuybYt+Q3poX1glUn"
esvg$ = esvg$ + "mHU2aiXSf/8UQpIvFxShh2/Y8UsVT6neOU0s/kmUs/c3fO3iMijdDq9rao6xYMl7UBFawR6g1JMN5l5V0VWQiEofGmikZn4Pqrmcj/A0X9oTA="
'
'lets display the image
SVGdraw esvg$, 100, 100
Print "press any key to see the SVG code"
Sleep
Print unpackSVG$(esvg$)
'_Clipboard$ = unpackSVG$(esvg$) 'uncommnet if you want to dump the unencoded SVG defiiniton paste in a file (without the header and footer)
_Delay .5
Print
Print "pretty large isn't it? The SVg files prodcued by Adobe Illustrator are pretty verbose"
Print "The packed SVG from the string esvg$ in the code is "; Len(esvg$); "characters in size."
Print "The unpacked SVG is "; Len(unpackSVG$(esvg$)); " characters in size."
Print "<press any key>"
Sleep
x = 0
For s = 1 To 8
SVGdrawscale esvg$, x, 0, s 'displaying the SVG image at varios scales
x = x + (s * 32)
Next s
Print "The chief advantage is scalability. Images may be scaled without pixelation."
Sleep
System
Function SVGpack$ (svg$)
'takes an SVG descrpiton (any string really) and deflaets it to save space
'the deflated data is convereted to base64 encoding to male is safe to share as text
dc$ = _Deflate$(svg$, 10)
SVGpack$ = "SVG64" + _Base64Encode$(dc$)
End Function
Function unpackSVG$ (packed$)
unp$ = "NOT_A_PACKED_SVG"
If Left$(packed$, 5) = "SVG64" Then
datal = Len(packed$) - 5
s0$ = Right$(packed$, datal)
s1$ = _Base64Decode$(s0$)
unp$ = _Inflate$(s1$)
End If
unpackSVG$ = unp$
End Function
Sub SVGdraw (svgi$, px, py)
'completes an svg layer perviously defined in svgimage$ and display it starting fron the point px.py
'is meant to fill a screen
Dim simg&
'get the screen size and build the header
svgheader$ = "<svg width='" + _Trim$(Str$(_Width)) + "' height='" + _Trim$(Str$(_Height)) + "' >"
svgfooter$ = "</SVG>"
svgimage$ = unpackSVG$(svgi$)
If svgimage$ = "NOT_A_PACKED_SVG" Then
SVGdrawing$ = svgheader$ + svgi$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memory") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
Else
SVGdrawing$ = svgheader$ + svgimage$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memory") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
svgimage$ = ""
End If
End Sub
Sub SVGdrawscale (svgi$, px, py, scale)
'completes an svg layer perviously defined in svgimage$ and display it starting fron the point px.py
'is meant to fill a screen
'scale changes the scale of the drawing 1.0 is 100% while 0.5 would be 50& and 4 would be 400%
Dim simg&
'get the screen size and build the header
svgheader$ = "<svg width='" + _Trim$(Str$(_Width)) + "' height='" + _Trim$(Str$(_Height)) + "' ><g transform='scale(" + _Trim$(Str$(scale)) + ")' >"
svgfooter$ = " </g></SVG>"
svgimage$ = unpackSVG$(svgi$)
If svgimage$ = "NOT_A_PACKED_SVG" Then
SVGdrawing$ = svgheader$ + svgi$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memory") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
Else
SVGdrawing$ = svgheader$ + svgimage$ + svgfooter$ 'attacjing the header,mains svg definiton string and the footer
simg& = _LoadImage(SVGdrawing$, 32, "memorym") 'loads the completed SVgdrawing described in the string
_PutImage (px, py), simg& 'put the drawing on the screen
_FreeImage simg& 'free up the memory
svgimage$ = ""
End If
End Sub
