BASIMAGE - Put image files in BAS code to use with _PUTIMAGE

[mdijkens]

I use these functions to include all images in my code:

Code: (Select All)

Function image2data (image$)

  Const I2DBLOCK = 2048

  hImg& = _LoadImage(image$, 32): If hImg& < -1 Then _Source hImg& Else Print "LOAD ERROR": Exit Function

  iWidth% = _Width(hImg&): iHeight% = _Height(hImg&)

  pathsep$ = Mid$("/\", 1 - (Left$(_OS$, 4) = "[WIN"), 1)

  in% = _InStrRev(image$, pathsep$): If in% > 0 Then datafile$ = Mid$(image$, in% + 1) Else datafile$ = image$

  in% = _InStrRev(datafile$, "."): If in% > 0 Then lbl$ = Left$(datafile$, in% - 1) Else lbl$ = datafile$

  datafile$ = lbl$ + ".img"

  Print "Generating "; datafile$; " ("; _Trim$(Str$(iWidth%)); "x"; _Trim$(Str$(iHeight%)); "x32) ... ";

  Dim alpha As _Byte, cval As Long, imgArray(iWidth% * iHeight%) As Long

  Get (0, 0)-(iWidth% - 1, iHeight% - 1), imgArray(): _Source 0: _FreeImage hImg&

  alpha = _Alpha32(imgArray(1)): If alpha = &H10 Then imgArray(1) = imgArray(1) + (2 ^ 24)

  cn& = 1: cval = imgArray(1): o$ = String$(4 * iWidth% * iHeight%, 0): opos~& = 1

  For n& = 2 To iWidth% * iHeight%

    alpha = _Alpha32(imgArray(n&)): If alpha = &H10 Then imgArray(n&) = imgArray(n&) + (2 ^ 24)

    it& = n& - cn&

    If cval <> imgArray(n&) Or it& = (2 ^ 24) - 1 Then

      If it& > 2 Then

        Mid$(o$, opos~&, 8) = MKL$(&H10000000 + it&) + MKL$(cval): opos~& = opos~& + 8

      ElseIf it& = 2 Then

        Mid$(o$, opos~&, 8) = MKL$(cval) + MKL$(cval): opos~& = opos~& + 8

      Else

        Mid$(o$, opos~&, 4) = MKL$(cval): opos~& = opos~& + 4

      End If

      cn& = n&: cval = imgArray(n&)

    End If

  Next n&

  it& = n& - cn&

  If it& > 2 Then

    Mid$(o$, opos~&, 8) = MKL$(&H10000000 + it&) + MKL$(cval): opos~& = opos~& + 8

  ElseIf it& = 2 Then

    Mid$(o$, opos~&, 8) = MKL$(cval) + MKL$(cval): opos~& = opos~& + 8

  Else

    Mid$(o$, opos~&, 4) = MKL$(cval): opos~& = opos~& + 4

  End If

  o64$ = base64encode$(_Deflate$(Left$(o$, opos~& - 1)))

  Print Using "##,###,### bytes"; Len(o64$)

  Open datafile$ For Output As #1

  Print #1, lbl$ + ": '"; image$; "' ("; _Trim$(Str$(iWidth%)); "x"; _Trim$(Str$(iHeight%)); ")"

  Print #1, "Data"; RTrim$(Str$(iWidth%)); ","; RTrim$(Str$(iHeight%))

  For n& = 1 To Len(o64$) Step I2DBLOCK

    Print #1, "Data " + Chr$(34) + Mid$(o64$, n&, I2DBLOCK) + Chr$(34)

  Next n&

  Print #1, "Data " + Chr$(34) + "*" + Chr$(34)

  Print #1, "Restore "; lbl$

  Close #1: image2data = -1

End Function



Function data2image&

  Read iWidth%, iHeight%

  Dim alpha As _Byte, cval As Long, imgArray(iWidth% * iHeight%) As Long: imgArray(0) = iHeight% * 2 ^ 16 + iWidth%

  Read lin$: i64$ = String$(6 * iWidth% * iHeight%, 0): i64pos~& = 1

  Do While lin$ <> "*"

    l& = Len(lin$): Mid$(i64$, i64pos~&, l&) = lin$: i64pos~& = i64pos~& + l&: Read lin$

  Loop

  i$ = _Inflate$(base64decode$(Left$(i64$, i64pos~& - 1))): cn& = -3

  Do While n& < iWidth% * iHeight%

    cn& = cn& + 4: cval = CVL(Mid$(i$, cn&, 4)): alpha = _Alpha32(cval)

    If alpha = &H10 Then

      it& = cval - &H10000000: cn& = cn& + 4: cval = CVL(Mid$(i$, cn&, 4))

      Do While it& > 0

        n& = n& + 1: imgArray(n&) = cval: it& = it& - 1

      Loop

    Else

      n& = n& + 1: imgArray(n&) = cval

    End If

  Loop

  hImg& = _NewImage(iWidth%, iHeight%, 32): _Dest hImg&: Put (0, 0), imgArray(): _Dest 0: data2image& = hImg&

End Function



Function base64encode$ (b$)

  ' elke 3 bytes > 4 bytes

  ' +1 + elke overige byte

  d$ = b$: dl~& = Len(d$): d$ = d$ + String$((3 - (Len(b$) Mod 3)) Mod 3, 0): e$ = Space$(_Ceil((dl~& * 4) / 3)): ep~& = 0

  For i3~& = 1 To dl~& Step 3

    v~& = 0

    For p = 0 To 2

      c = Asc(Mid$(d$, i3~& + p, 1)): x2~& = 2 ^ ((2 - p) * 8): v~& = v~& + c * x2~&

    Next p

    For p1 = 3 To 0 Step -1

      c1 = v~& \ 2 ^ (p1 * 6): v~& = v~& - c1 * 2 ^ (p1 * 6): ep~& = ep~& + 1

      Select Case c1

        Case 0 To 25

          Mid$(e$, ep~&, 1) = Chr$(c1 + Asc("A"))

        Case 26 To 51

          Mid$(e$, ep~&, 1) = Chr$(c1 - 26 + Asc("a"))

        Case 52 To 61

          Mid$(e$, ep~&, 1) = Chr$(c1 - 52 + Asc("0"))

        Case 62

          Mid$(e$, ep~&, 1) = "+"

        Case 63

          Mid$(e$, ep~&, 1) = "/"

        Case Else

      End Select

    Next p1

  Next i3~&

  e$ = Left$(e$, _Ceil((dl~& * 4) / 3)): base64encode$ = e$ + String$((4 - (Len(e$) Mod 4)) Mod 4, "=")

End Function



Function base64decode$ (b$)

  ' elke 4 bytes > 3 bytes

  ' + Int(overige bytes*3/4)

  e$ = b$ + String$((4 - (Len(b$) Mod 4)) Mod 4, "="): el~& = Len(e$): d$ = Space$(el~& / 4 * 3): dp~& = -2

  For i4~& = 1 To el~& Step 4

    v~& = 0

    For p = 0 To 3

      c = Asc(Mid$(e$, i4~& + p, 1)): x2~& = 2 ^ ((3 - p) * 6)

      Select Case c

        Case Asc("A") To Asc("Z")

          v~& = v~& + (c - Asc("A")) * x2~&

        Case Asc("a") To Asc("z")

          v~& = v~& + (c - Asc("a") + 26) * x2~&

        Case Asc("0") To Asc("9")

          v~& = v~& + (c - Asc("0") + 52) * x2~&

        Case Asc("+")

          v~& = v~& + (c - Asc("+") + 62) * x2~&

        Case Asc("/")

          v~& = v~& + (c - Asc("/") + 63) * x2~&

        Case Asc("=")

          el~& = el~& - 1

        Case Else

      End Select

    Next p

    c1 = v~& \ 2 ^ 16: v~& = v~& - c1 * 2 ^ 16: c2 = v~& \ 2 ^ 8: v~& = v~& - c2 * 2 ^ 8: c3 = v~&: dp~& = dp~& + 3

    Mid$(d$, dp~&, 3) = Chr$(c1) + Chr$(c2) + Chr$(c3)

  Next i4~&

  base64decode$ = Left$(d$, Int(el~& / 4 * 3))

End Function

Use like this:

Code: (Select All)

'Print image2data("E:\TEMP\pattern.png"): End  'Uncomment first time to generate *.img includefile



Screen _NewImage(_DesktopWidth, _DesktopHeight, 32): Do: _Delay .01: Loop Until _ScreenExists: _FullScreen



'$include: 'E:\TEMP\pattern.img'

h& = data2image&: If h& >= 0 Then End



_PutImage (0, 0), h&