Pixilation
The other day I was sitting at a stoplight. It’s one of those stoplights that I can never seem to hit. It’s always red when I approach the intersection. In addition, it’s one of the longest stoplights in the history of traffic, or at least it seems so.
My insurance agent’s office is at that intersection. In the landscaped area there is a large brick structure that has their name, logo, etc. It also has a programmable sign. I estimate that the sign is about 30 light bulbs tall by 180 light bulbs wide. I’m sure you’ve seen this kind of sign before. It has customized messages that move around or blink and every 4th, or so, display is the time and temperature.
Someone inside the agency has to sit at a computer, or a proprietary terminal, and type in what the sign is supposed to say. Then, I imagine, they have to select some options like “scroll in from left” or “blink three times”.
Then I started to think about the fact that someone had to program the interface for the sign. When the user types in “We sell auto” and tells it to blink, there is a program that determines which lights are lit and which aren’t.
Finally, the light turned green and I chided myself for being such a nerd. I’m sure I was the only car at that intersection thinking about the programming for the sign. Later, however, those thoughts came creeping back into my consciousness. Surely that was a pretty trivial program. It’s pure simplicity in that you have a big array of lights and every element of the array is a 1 or a 0. I thought I could whip that program out in no time. Now where am I going to find an interface with a bank of “cells” that I could light up?
Step one, I thought, was to provide a space for the user to enter text. Easy. Once I get the text on the screen I can worry about blinking and scrolling. Let’s start with one letter, A. Okay, then I got stuck. How in the hell am I going to pixelate a letter?
I started with a blank worksheet and set all the ColumnWidths to 1.57 - roughly square cells. Then I wrote the sub:
Sub MakeAnA()
Dim aPixel As Variant
Dim rStart As Range
Dim i As Long
aPixel = Array(5, 13, 15, 21, 25, 29, 35, 37, 38, 39, 40, _
41, 42, 43, 44, 45, 46, 54, 55, 63, 64, 72, 73, 81)
Set rStart = Sheet2.Range(”A1″)
For i = LBound(aPixel) To UBound(aPixel)
rStart.Resize(9, 9).Cells(aPixel(i)).Interior.Color = vbRed
Next i
End Sub
Great, a 9×9 letter A. Now I only need 254 more arrays and I can do the rest of the characters. But wait. I’ll need at least a few more fonts so I can make the degrees symbol when the temperature shows. Figure five fonts total. Well, that’s only 1,300 individual arrays I’ll need. That’s not a Select Case statement that I’d be willing to write. This was proving more difficult than I had thought. Time to limit the scope.
If I stick to only capital letters, maybe the right way to do this will magically appear. I got out a pencil and paper (that’s old school, baby) and wrote out the alphabet. There’s some common shapes among them, so I could at least reduce the code. Here’s what I have now
Enum mqLineType
mqHoriTop
mqHoriBottom
mqHoriMiddle
mqVertLeft
mqVertRight
mqvertmiddle
mqCarat
mqInvCarat
End Enum
Sub testit()
PrintLetter “V”, Sheet2.Range(”A1″)
PrintLetter “A”, Sheet2.Range(”K1″)
PrintLetter “I”, Sheet2.Range(”U1″)
End Sub
Sub PrintLetter(sLetter As String, rStart As Range)
Dim i As Long
Dim vaPixels As Variant
vaPixels = LetterToArray(sLetter)
For i = LBound(vaPixels) To UBound(vaPixels)
rStart.Range(”a1:i9″).Cells(vaPixels(i)).Interior.Color = vbRed
Next i
End Sub
Function LetterToArray(sLetter As String) As Variant
Dim vaCells As Variant
Select Case sLetter
Case “A”
vaCells = GetLine(mqCarat)
Case “I”
vaCells = GetLine(mqvertmiddle)
Case “V”
vaCells = GetLine(mqInvCarat)
End Select
LetterToArray = vaCells
End Function
Function GetLine(eType As mqLineType, _
Optional bInvert As Boolean = False) As Variant
Select Case eType
Case mqHoriTop
GetLine = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Case mqHoriBottom
GetLine = Array(73, 74, 75, 76, 77, 78, 79, 80, 81)
Case mqVertLeft
GetLine = Array(1, 10, 19, 28, 37, 46, 55, 64, 73)
Case mqVertRight
GetLine = Array(9, 18, 27, 36, 45, 54, 63, 72, 81)
Case mqCarat
GetLine = Array(5, 13, 15, 21, 25, 29, 35, 37, 45, 46, 54, 55, 63, 64, 72, 73, 81)
Case mqInvCarat
GetLine = Array(1, 9, 10, 18, 19, 27, 28, 36, 37, 45, 47, 53, 57, 61, 67, 69, 77)
Case mqHoriMiddle
GetLine = Array(37, 38, 39, 40, 41, 42, 43, 44, 45)
Case mqvertmiddle
GetLine = Array(5, 14, 23, 32, 41, 50, 59, 68, 77)
End Select
End Function
I need to make that Enum additive so I can pass (mqCarat + mgHoriMiddle) to make an A all in one shot. Also, this doesn’t really reduce my Select Case statement. I’m starting to think that I need a big array that holds all the Enum members necessary to make a letter. So aBigArray(65) will contain mqCarat+mqHoriMiddle and since the ASCII code for a capital A is 65, I won’t need a big Select Case. Rather I can just use the Asc function and pull that element of aBigArray to pass to my functions. Setting up aBigArray won’t be an easy task though.
Still with me? I’m a bit long-winded today. My questions are these: Does anyone have any bright ideas on how to pixilate text into a 9×9 grid of cells? Has anyone ever used one of these signs or even programmed them and can share how they do it?
Andy Miller:
I always pictured people who actually create fonts as lonely guys with thick glasses sitting in front of their computer using MS Paint (or some other bitmap program) clicking each square for each letter, trying to make it look just right. I had thought about some of these same things (being another self-admitted nerd), but my brain always veered in other directions once I imagined the complexity of such “simple” tasks.
21 July 2004, 2:37 pmMatt H:
Dick, take a look at Nobuya Chikada’s Excel version of Space Invaders–completely done on a worksheet:
http://www.xl-logic.com/pages/games.html
It’s pretty amazing!
22 July 2004, 7:54 amross:
I saw that ages ago - it amazing, pacman too!!! this must have taken hours!!!!!!!!!
22 July 2004, 9:33 amJuan Pablo G:
Nice idea Dick,
9×9 is pretty big though… however, I modified your code a bit to handle the additive portion of it (doing VAIO now…)
Option Explicit
Enum mqLineType
mqHoriTop = 1
mqHoriBottom = 2
mqHoriMiddle = 4
mqVertLeft = 8
mqVertRight = 16
mqvertmiddle = 32
mqCarat = 64
mqInvCarat = 128
End Enum
Sub testit()
PrintLetter “V”, Sheet2.Range(”A1″)
PrintLetter “A”, Sheet2.Range(”K1″)
PrintLetter “I”, Sheet2.Range(”U1″)
PrintLetter “O”, Sheet2.Range(”AE1″)
End Sub
Sub PrintLetter(sLetter As String, rStart As Range)
Dim i As Long
Dim vaPixels As Variant
vaPixels = LetterToArray(sLetter)
For i = LBound(vaPixels) To UBound(vaPixels)
rStart.Range(”a1:i9″).Cells(vaPixels(i)).Interior.Color = vbRed
Next i
End Sub
Function LetterToArray(sLetter As String) As Variant
Dim vaCells As Variant
Select Case sLetter
Case “A”
vaCells = GetLine(mqCarat + mqHoriMiddle)
Case “I”
vaCells = GetLine(mqvertmiddle)
Case “V”
vaCells = GetLine(mqInvCarat)
Case “O”
vaCells = GetLine(mqHoriTop + mqHoriBottom + mqVertLeft + mqVertRight)
End Select
LetterToArray = vaCells
End Function
Function GetLine(eType As mqLineType, _
Optional bInvert As Boolean = False) As Variant
If eType And mqHoriTop Then
GetLine = ArrayUnion(GetLine, Array(1, 2, 3, 4, 5, 6, 7, 8, 9))
End If
If eType And mqHoriBottom Then
GetLine = ArrayUnion(GetLine, Array(73, 74, 75, 76, 77, 78, 79, 80, 81))
End If
If eType And mqVertLeft Then
GetLine = ArrayUnion(GetLine, Array(1, 10, 19, 28, 37, 46, 55, 64, 73))
End If
If eType And mqVertRight Then
GetLine = ArrayUnion(GetLine, Array(9, 18, 27, 36, 45, 54, 63, 72, 81))
End If
If eType And mqCarat Then
GetLine = ArrayUnion(GetLine, Array(5, 13, 15, 21, 25, 29, 35, 37, 45, 46, 54, 55, 63, 64, 72, 73, 81))
End If
If eType And mqInvCarat Then
GetLine = ArrayUnion(GetLine, Array(1, 9, 10, 18, 19, 27, 28, 36, 37, 45, 47, 53, 57, 61, 67, 69, 77))
End If
If eType And mqHoriMiddle Then
GetLine = ArrayUnion(GetLine, Array(37, 38, 39, 40, 41, 42, 43, 44, 45))
End If
If eType And mqvertmiddle Then
GetLine = ArrayUnion(GetLine, Array(5, 14, 23, 32, 41, 50, 59, 68, 77))
End If
End Function
Function ArrayUnion(ByVal va1 As Variant, ByVal va2 As Variant) As Variant
22 July 2004, 1:32 pmDim i As Long, Upper As Long
If TypeName(va1) = “Empty” Then
va1 = va2
Else
Upper = UBound(va1)
If LBound(va2) = 0 Then Upper = Upper + 1
ReDim Preserve va1(LBound(va1) To UBound(va1) + UBound(va2) - LBound(va2) + 1)
For i = LBound(va2) To UBound(va2)
va1(Upper + i) = va2(i)
Next i
End If
ArrayUnion = va1
End Function
Dick:
Nice Juan. I’m planning on doing a post about bitwise And. I just have to make sure I fully understand it first. I saw a post on google groups by Andy Pope that did it in a loop, which I though was clever. I was wondering how I was going to go about joining the arrays. That ArrayUnion function is perfect.
22 July 2004, 3:00 pmJuan Pablo G:
Ivan F Moala wrote a nice explanation a while ago too here:
http://www.mrexcel.com/board2/viewtopic.php?p=210579#210579
It still confuses me from time to time, especially using non decimal notation for the numbers !!!
22 July 2004, 4:24 pmJamie Collins:
“I’m planning on doing a post about bitwise”
What would be good for me is a function that works a bit like the VBA.Split function i.e. pass in a +ve Long and return an array e.g. pass in 41 and get back Array(1, 8, 32).
Jamie.
–
23 July 2004, 3:55 amJuan Pablo G:
That shouldn’t be so hard Jamie… how about this ?
Option Explicit
Function Bits(Number As Long) As Variant
Dim Col As Collection
Dim Ar As Variant
Dim i As Long
Set Col = New Collection
i = 1
While i <= Number
If i And Number Then
Col.Add i
End If
i = i * 2
Wend
If Col.Count = 0 Then Exit Function
ReDim Ar(1 To Col.Count) As Long
For i = 1 To Col.Count
Ar(i) = Col(i)
Next i
Bits = Ar
End Function
Sub Test()
23 July 2004, 9:15 amDim Ar As Variant
Ar = Bits(0)
Ar = Bits(1)
Ar = Bits(2)
Ar = Bits(41)
Ar = Bits(127)
Ar = Bits(256)
End Sub
Jon Peltier:
I’m stealing Juan Pablo’s ArrayUnion UDF. It will come in very handy.
30 July 2004, 7:58 am