एक्सेल VBA, 816 बाइट्स
एक अनाम VBE तत्काल विंडो फ़ंक्शन जो रेंज से इनपुट लेता है [A1] और कंसोल को आउटपुट करता है।
जहां तक मुझे जानकारी है, यह base64संपीड़न का उपयोग करने वाला पहला VBA उत्तर है ।
For i=1To[Len(A1)]:c=Mid(UCase([A1]),i,1):y=y &IIf(c Like"[0-9A-Z]",c,""):Next:l=Len(y):Set d=New MSXML2.DOMDocument:Set d=d.createElement("b64"):d.DataType="bin.base64":d.Text="HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=":b=d.nodeTypedValue:For i=0To 112:k=Right("00000" &Evaluate("=Dec2Bin("&b(i)&")"),8)&k:Next:For i=1To 5:For j=1To l:c=UCase(Mid(y,j,1)):Z=c Like"[0-9]":s=s &IIf(c Like"[A-Z]",Mid(k,IIf(Z,1,25*(Asc(c)-55)+5*i),5)&" ",IIf(Z,Mid(k,25*(Asc(c)-48)+5*i,5)&" ","")):Next:s=Replace(Replace(s,0," "),1,"#") &vbLf:Next:Do:i=InStr(1+(g*l+h)*6+g,s,"#"):p=(p-e)Mod l:e=i<(g*l+h+1)*6+g:s=IIf(e,Left(s,i-1)&Replace(s,"#",Mid(y,p+1,1),i,1),s):g=g-(0=e):h=h-(g>4):g=g Mod 5:Loop While InStr(1,s,"#"):?s
नोट: यह उत्तर Microsoft XML, v3.0VBA संदर्भ पर निर्भर करता है
उदाहरण I / O
[A1]="'0123456789"
For i=1To[Len(A1)]:c=Mid(UCase([A1]),i,1):y=y &IIf(c Like"[0-9A-Z]",c,""):Next:l=Len(y):Set d=New MSXML2.DOMDocument:Set d=d.createElement("b64"):d.DataType="bin.base64":d.Text="HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=":b=d.nodeTypedValue:For i=0To 112:k=Right("00000" &Evaluate("=Dec2Bin("&b(i)&")"),8)&k:Next:For i=1To 5:For j=1To l:c=UCase(Mid(y,j,1)):Z=c Like"[0-9]":s=s &IIf(c Like"[A-Z]",Mid(k,IIf(Z,1,25*(Asc(c)-55)+5*i),5)&" ",IIf(Z,Mid(k,25*(Asc(c)-48)+5*i,5)&" ","")):Next:s=Replace(Replace(s,0," "),1,"#") &vbLf:Next:Do:i=InStr(1+(g*l+h)*6+g,s,"#"):p=(p-e)Mod l:e=i<(g*l+h+1)*6+g:s=IIf(e,Left(s,i-1)&Replace(s,"#",Mid(y,p+1,1),i,1),s):g=g-(0=e):h=h-(g>4):g=g Mod 5:Loop While i<InStrRev(s,"#"):?s
012 567 6789 0123 34 45678 9012 34567 234 567
3 45 8 0 4 5 6 9 3 8 5 6 8 9
6 7 8 9 123 567 78901 0123 4567 9 789 0123
90 1 0 4 8 2 4 8 9 0 0 1 4
234 12345 56789 9012 3 5678 012 1 234 5678
अनगढ़ और समझाया हुआ
इस समाधान का प्रमुख हिस्सा बड़े फ़ॉन्ट को आधार 64 स्ट्रिंग के रूप में संग्रहीत करता है। यह पहले फ़ॉन्ट को बाइनरी में परिवर्तित करके किया जाता है, जहां 1पिक्सेल पर 0प्रतिनिधित्व करता है और एक ऑफ पिक्सेल का प्रतिनिधित्व करता है। उदाहरण के लिए 0, इस के रूप में, इसका प्रतिनिधित्व किया जाता है
### 01110
# ## 10011
0 -> # # # -> 10101 --> 0111010011101011100101110
## # 11001
### 01110
इस दृष्टिकोण के साथ, अल्फ़ान्यूमेरिक्स को तब प्रतिनिधित्व किया जा सकता है
0: 0111010011101011100101110 1: 1110000100001000010011111
2: 1111000001011101000011111 3: 1111000001001110000111110
4: 0011001010111110001000010 5: 1111110000111100000111110
6: 0111110000111101000101110 7: 1111100001000100010001000
8: 0111010001011101000101110 9: 0111010001011110000111110
A: 0111010001111111000110001 B: 1111010001111101000111110
C: 0111110000100001000001111 D: 1111010001100011000111110
E: 1111110000111001000011111 F: 1111110000111001000010000
G: 0111110000100111000101111 H: 1000110001111111000110001
I: 1111100100001000010011111 J: 1111100100001000010011000
K: 1000110010111001001010001 L: 1000010000100001000011111
M: 1000111011101011000110001 N: 1000111001101011001110001
O: 0111010001100011000101110 P: 1111010001111101000010000
Q: 0110010010101101001001101 R: 1111010001111101001010001
S: 0111110000011100000111110 T: 1111100100001000010000100
U: 1000110001100011000101110 V: 1000110001010100101000100
W: 1000110001101011101110001 X: 1000101010001000101010001
Y: 1000101010001000010000100 Z: 1111100010001000100011111
इन खंडों को समाप्त कर दिया गया और MSXML बेस 64 में परिवर्तित कर दिया गया
HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=
नीचे दिया गया सबरूटीन इसे वापस लेता है, बाइनरी में कनवर्ट करता है, और इस संदर्भ का उपयोग करता है जिसमें से आउटपुट स्ट्रिंग, लाइन द्वारा लाइन बनाने के लिए, प्रत्येक वर्ण के पहले शीर्ष 5 पिक्सल को पकड़ता है, फिर दूसरी पंक्ति और इसी तरह जब तक स्ट्रिंग का निर्माण नहीं किया जाता है। ।
तब उप-आउटपुट आउटपुट स्ट्रिंग पर पुनरावृत्त करता है और इनपुट स्ट्रिंग से वर्णों के साथ 'ऑन' पिक्सल को बदलता है।
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Embiggen Function
''
'' @Title : Embiggen
'' @Author : Taylor Scott
'' @Date : 15 June 2018
'' @Desc : Function that takes input, value, and outputs a string in which
'' value has been filtered to alphnumerics only, each char is then
'' scaled up to a 5x5 ASCII art, and each 'pixel' is replaced with
'' a char from value. Replacement occurs letter by letter, line by
'' line
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function EMBIGGEN(ByVal value As String) As String
Dim DOM As New MSXML2.DOMDocument, _
bytes() As Byte
Dim isNum As Boolean, _
found As Boolean, _
index As Integer, _
length As Integer, _
line As Integer, _
letter As Integer, _
pos As Integer, _
alphanum As String, _
char As String, _
filValue As String, _
outValue As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Filter input
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For letter = 1 To Len(value) Step 1 '' Iterate Accross `Value`
Let char = Mid$(UCase(value), letter, 1) '' Take the nth char
'' If the char is alphnumeric, append it to a filtered input string
Let filValue = filValue & IIf(char Like "[0-9A-Z]", char, "")
Next letter
Let length = Len(filValue) '' store length of filValue
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Convert Constant from Base 64 to Byte Array
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With DOM.createElement("b64") '' Construct b64 DOM object
Let .DataType = "bin.base64" '' define type of object`
'' Input constructed constant string shown above
Let .Text = "HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnz" & _
"THGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/" & _
"zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc="
Let bytes = .nodeTypedValue '' Pass resulting bytes to array
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Convert Byte Array to Byte String
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For index = 0 To 112 Step 1
'' convert each byte to binary, fill left with `0`s and prepend
Let alphanum = _
Right("00000" & Evaluate("=Dec2Bin(" & bytes(index) & ")"), 8) & _
alphanum
Next index
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Construct Embiggened Binary String of Input Value
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For line = 1 To 5 Step 1 '' iterate across lines
For letter = 1 To length Step 1 '' iterate across letters
'' take the corresponding letter from
Let char = UCase(Mid(filValue, letter, 1))
If char Like "[0-9]" Then '' if it is a number,
'' Add the 5 bit corresponding to number at line
Let outValue = outValue & _
Mid$(alphanum, 25 * Val(char) + 5 * line, 5) & " "
ElseIf char Like "[A-Z]" Then '' if it is a letter,
'' Add the 5 bits corresponding to letter at line
Let outValue = outValue & _
Mid$(alphanum, 25 * (Asc(char) - 55) + 5 * line, 5) & " "
End If
Next letter
Let outValue = outValue & IIf(line < 5, vbLf, "")
Next line
Let outValue = Replace(Replace(outValue, 0, " "), 1, "#")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Replace #s with Input Value
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Let pos = 0 '' Reset position in filValue
Let line = 0 '' Reset line index
Let letter = 0 '' Reset letter index
Do
'' Find the index of the first `#` starting at line and letter
Let index = _
InStr(1 + (line * length + letter) * 6 + line, outValue, "#")
'' Iterate position in filValue if a `#` is found in that letter & line
Let pos = (pos - found) Mod length
'' check to see if found index is in the correct letter
Let found = index < (line * length + letter + 1) * 6 + line
'' iff so, replace that # with letter in filValue corresponding to pos
Let outValue = IIf(found, _
Left(outValue, index - 1) & _
Replace(outValue, "#", Mid(filValue, pos + 1, 1), index, 1), _
outValue)
'' if not found, them iterate line
Let line = line - (found = False)
'' iterate letter every five iterations of line
Let letter = letter - (line > 4)
'' Ensure that line between 0 and 4 (inc)
Let line = line Mod 5
'' Loop while there are '#'s in outValue
Loop While InStr(1, outValue, "#")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Output
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Let EMBIGGEN = outValue
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Clean Up
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set DOM = Nothoing
End Function
[A-Z\d]- मुझे नहीं लगता कि अमान्य वर्णों को फ़िल्टर करना चुनौती के लिए कुछ भी जोड़ता है।