PPRINT - Prints larger font size using _PUTIMAGE

[Dav]

I needed a way to make larger screen text than the default one (without using font files) and came up with this method.  Or is there already an easier way to do this?  I don't know.  Also, I need to learn to use _DEST more so I was playing around with it.

It would be more efficient and faster to just do one print and _PUTIMAGE than step through each letter - I will update to that later.

- Dav

Edit: Changed this to output to current output screen instead of DEST 0. 

Code: QB64: [Select]

1. '==========
2. 'PPRINT.BAS
3. '==========
4. 'Prints larger screen text using _PUTIMAGE.
5. 'Works in 8-bit and 32-bit screen modes.
6. 'Coded by Dav, JAN/2021
7.  
8.  
9. '=== Set screen mode, and color
10. SCREEN _NEWIMAGE(600, 600, 32)
11.  
12. CLS , _RGB(32, 32, 32)
13.  
14. '=== draw stuff
15. FOR x = 1 TO 600 STEP 3
16.     FOR y = 1 TO 600 STEP 3
17.         PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
18.     NEXT
19. NEXT
20.  
21. '=== Sample usage
22. FOR t = 20 TO 500 STEP 30
23.     t$ = STR$(RND * 1000) 'make some random text
24.     PPRINT 22, t + 2, 30, _RGB(1, 1, 1), 0, t$ 'give it a shadow
25.     PPRINT 20, t, 30, _RGB(200, 200, 200), 0, t$
26. NEXT
27.  
28. END
29.  
30.  
31. SUB PPRINT (x, y, size, clr&, trans&, text$)
32.     'This sub outputs to the current _DEST set
33.     'It makes trans& the transparent color
34.  
35.     'x/y is where to print text
36.     'size is the font size to use
37.     'clr& is the color of your text
38.     'trans& is the background transparent color
39.     'text$ is the string to print
40.  
41.     '=== get users current write screen
42.     orig& = _DEST
43.  
44.     '=== if you are using an 8 or 32 bit screen
45.     bit = 32: IF _PIXELSIZE(0) = 1 THEN bit = 256
46.  
47.     '=== step through your text
48.     FOR t = 0 TO LEN(text$) - 1
49.         '=== make a temp screen to use
50.         pprintimg& = _NEWIMAGE(16, 16, bit)
51.         _DEST pprintimg&
52.         '=== set colors and print text
53.         CLS , trans&: COLOR clr&
54.         PRINT MID$(text$, t + 1, 1);
55.         '== make background color the transprent one
56.         _CLEARCOLOR _RGB(0, 0, 0), pprintimg&
57.         '=== go back to original screen  to output
58.         _DEST orig&
59.         '=== set it and forget it
60.         x1 = x + (t * size): x2 = x1 + size
61.         y1 = y: y2 = y + size
62.         _PUTIMAGE (x1 - (size / 2)), y1)-(x2, y2 + (size / 3)), pprintimg&
63.         _FREEIMAGE pprintimg&
64.     NEXT
65. END SUB
66.  

 

[SMcNeill]

TextToImage is what I use for these type needs.

Code: QB64: [Select]

1.  FUNCTION TextToImage& (text$, font&, fc&, bfc&, mode AS _BYTE)
2.     'text$ is the text that we wish to transform into an image.
3.     'font& is the handle of the font we want to use.
4.     'fc& is the color of the font we want to use.
5.     'bfc& is the background color of the font.
6.  
7.     'Mode 1 is print forwards
8.     'Mode 2 is print backwards
9.     'Mode 3 is print from top to bottom
10.     'Mode 4 is print from bottom up
11.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
12.  
13.     IF mode < 1 OR mode > 4 THEN mode = 1
14.     dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
15.     D = _DEST
16.     F = _FONT
17.     IF font& <> 0 THEN _FONT font&
18.     IF mode < 3 THEN
19.         'print the text lengthwise
20.         w& = _PRINTWIDTH(text$): h& = _FONTHEIGHT
21.     ELSE
22.         'print the text vertically
23.         FOR i = 1 TO LEN(text$)
24.             IF w& < _PRINTWIDTH(MID$(text$, i, 1)) THEN w& = _PRINTWIDTH(MID$(text$, i, 1))
25.         NEXT
26.         h& = _FONTHEIGHT * (LEN(text$))
27.     END IF
28.  
29.     TextToImage& = _NEWIMAGE(w&, h&, 32)
30.     _DEST TextToImage&
31.     IF font& <> 0 THEN _FONT font&
32.     COLOR fc&, bfc&
33.  
34.     SELECT CASE mode
35.         CASE 1
36.             'Print text forward
37.             _PRINTSTRING (0, 0), text$
38.         CASE 2
39.             'Print text backwards
40.             temp$ = ""
41.             FOR i = 0 TO LEN(text$) - 1
42.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
43.             NEXT
44.             _PRINTSTRING (0, 0), temp$
45.         CASE 3
46.             'Print text upwards
47.             'first lets reverse the text, so it's easy to place
48.             temp$ = ""
49.             FOR i = 0 TO LEN(text$) - 1
50.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
51.             NEXT
52.             'then put it where it belongs
53.             FOR i = 1 TO LEN(text$)
54.                 fx = (w& - _PRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
55.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
56.             NEXT
57.         CASE 4
58.             'Print text downwards
59.             FOR i = 1 TO LEN(text$)
60.                 fx = (w& - _PRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
61.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(text$, i, 1)
62.             NEXT
63.     END SELECT
64.     _DEST D
65.     COLOR dc&, bgc&
66.     _FONT F
67. END FUNCTION
68.  

Send it some text and basic information, get back an image handle that you can then manipulate however you want.  Often, I use this in conjuction with ScaleImage and DisplayImage, to generate all sorts of effects.  (Rotating text, tall text, wide text, centered text, mirrored text, ect...)

Do a search for any of them, and you’ll find a ton of programs here on the forums which make use of the three routines in one form or another.  :)

(For default font, just use 16 as your font handle, or 8 if you’re using 8x8 fonts.)

[Dav]

That's pretty slick, Steve!  Sure blows mine away.  I'll be using it...

- Dav

[SMcNeill]

A quick demo of the 3 routines working together to produce various effects for us:

Code: QB64: [Select]

1. DIM TI(4) AS LONG
2.  
3. SCREEN _NEWIMAGE(800, 600, 32)
4. FOR i = 1 TO 4
5.     TI(i) = TextToImage("Here's some text for you.", 16, &HFFFF0000, 0, i)
6.     'print forward, backward, up to down, down to up
7. NEXT
8. DisplayImage TI(1), 100, 100, 0, 1
9. DisplayImage TI(2), 100, 510, 0, 1
10. DisplayImage TI(3), 100, 110, 0, 1
11. DisplayImage TI(4), 300, 110, 0, 1
12.  
13. a$ = INPUT$(1)
14.  
15. 'And now to scale these fonts
16.  
17. CLS
18. Scaled1 = ScaleImage(TI(1), 2, 2) 'double width, double height
19. DisplayImage Scaled1, 100, 100, 0, 1
20. Scaled2 = ScaleImage(TI(1), 2, 1) 'double width, normal height
21. DisplayImage Scaled2, 100, 150, 0, 1
22. Scaled3 = ScaleImage(TI(1), 1, 2) 'normal width, double height
23. DisplayImage Scaled3, 100, 200, 0, 1
24. Scaled4 = ScaleImage(TI(1), 1.5, 1.5) '1.5 times as  wide, 1.5 times as high
25. DisplayImage Scaled4, 100, 250, -45, 1 'rotated at -45 degrees
26.  
27. a$ = INPUT$(1)
28. _KEYCLEAR
29. DO
30.     _LIMIT 60
31.     CLS
32.     DisplayImage Scaled4, 400, 300, angle, 0 'and just to show how we can rotate with the displayimage routine
33.     angle = angle - 3
34.     _DISPLAY
35. LOOP UNTIL _KEYHIT > 0
36.  
37.  
38.  
39.  
40.  
41. SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, angle AS SINGLE, mode AS _BYTE)
42.     'Image is the image handle which we use to reference our image.
43.     'x,y is the X/Y coordinates where we want the image to be at on the screen.
44.     'angle is the angle which we wish to rotate the image.
45.     'mode determines HOW we place the image at point X,Y.
46.     'Mode 0 we center the image at point X,Y
47.     'Mode 1 we place the Top Left corner of oour image at point X,Y
48.     'Mode 2 is Bottom Left
49.     'Mode 3 is Top Right
50.     'Mode 4 is Bottom Right
51.  
52.  
53.     DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
54.     DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
55.     w = _WIDTH(Image): h = _HEIGHT(Image)
56.     SELECT CASE mode
57.         CASE 0 'center
58.             px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
59.             px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
60.         CASE 1 'top left
61.             px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
62.             px(1) = 0: py(1) = h: px(2) = w: py(2) = h
63.         CASE 2 'bottom left
64.             px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
65.             px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
66.         CASE 3 'top right
67.             px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
68.             px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
69.         CASE 4 'bottom right
70.             px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
71.             px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
72.     END SELECT
73.     sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
74.     FOR i = 0 TO 3
75.         x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
76.         px(i) = x2: py(i) = y2
77.     NEXT
78.     _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
79.     _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
80. END SUB
81.  
82. FUNCTION TextToImage& (text$, font&, fc&, bfc&, mode AS _BYTE)
83.     'text$ is the text that we wish to transform into an image.
84.     'font& is the handle of the font we want to use.
85.     'fc& is the color of the font we want to use.
86.     'bfc& is the background color of the font.
87.  
88.     'Mode 1 is print forwards
89.     'Mode 2 is print backwards
90.     'Mode 3 is print from top to bottom
91.     'Mode 4 is print from bottom up
92.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
93.  
94.     IF mode < 1 OR mode > 4 THEN mode = 1
95.     dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
96.     D = _DEST
97.     F = _FONT
98.     IF font& <> 0 THEN _FONT font&
99.     IF mode < 3 THEN
100.         'print the text lengthwise
101.         w& = _PRINTWIDTH(text$): h& = _FONTHEIGHT
102.     ELSE
103.         'print the text vertically
104.         FOR i = 1 TO LEN(text$)
105.             IF w& < _PRINTWIDTH(MID$(text$, i, 1)) THEN w& = _PRINTWIDTH(MID$(text$, i, 1))
106.         NEXT
107.         h& = _FONTHEIGHT * (LEN(text$))
108.     END IF
109.  
110.     TextToImage& = _NEWIMAGE(w&, h&, 32)
111.     _DEST TextToImage&
112.     IF font& <> 0 THEN _FONT font&
113.     COLOR fc&, bfc&
114.  
115.     SELECT CASE mode
116.         CASE 1
117.             'Print text forward
118.             _PRINTSTRING (0, 0), text$
119.         CASE 2
120.             'Print text backwards
121.             temp$ = ""
122.             FOR i = 0 TO LEN(text$) - 1
123.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
124.             NEXT
125.             _PRINTSTRING (0, 0), temp$
126.         CASE 3
127.             'Print text upwards
128.             'first lets reverse the text, so it's easy to place
129.             temp$ = ""
130.             FOR i = 0 TO LEN(text$) - 1
131.                 temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
132.             NEXT
133.             'then put it where it belongs
134.             FOR i = 1 TO LEN(text$)
135.                 fx = (w& - _PRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
136.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
137.             NEXT
138.         CASE 4
139.             'Print text downwards
140.             FOR i = 1 TO LEN(text$)
141.                 fx = (w& - _PRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
142.                 _PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(text$, i, 1)
143.             NEXT
144.     END SELECT
145.     _DEST D
146.     COLOR dc&, bgc&
147.     _FONT F
148. END FUNCTION
149.  
150. FUNCTION TextArrayToImage& (text() AS STRING, font&, fc&, bfc&, mode AS _BYTE)
151.     'text is the text array that we wish to transform into an image.
152.     'text(0) tells us how many lines of text we wish to use.
153.     'font& is the handle of the font we want to use.
154.     'fc& is the color of the font we want to use.
155.     'bfc& is the background color of the font.
156.  
157.     'Mode 1 is print forwards
158.     'Mode 2 is print backwards
159.     'Mode 3 is print from top to bottom
160.     'Mode 4 is print from bottom up
161.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
162.  
163.     NumberOfLines = VAL(text(0))
164.  
165.     IF mode < 1 OR mode > 4 THEN mode = 1
166.     dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
167.     D = _DEST
168.     F = _FONT
169.     IF font& <> 0 THEN _FONT font&
170.     IF mode < 3 THEN
171.         'print the text lengthwise
172.         FOR i = 1 TO NumberOfLines
173.             IF _PRINTWIDTH(text(i)) > w& THEN w& = _PRINTWIDTH(text(i))
174.         NEXT
175.         h& = _FONTHEIGHT
176.         TextArrayToImage& = _NEWIMAGE(w&, h& * NumberOfLines, 32)
177.     ELSE
178.         'print the text vertically
179.         FOR j = 1 TO NumberOfLines
180.             IF LEN(text(j)) > longestline THEN longestline = LEN(text(j))
181.             FOR i = 1 TO LEN(text(j))
182.                 IF w& < _PRINTWIDTH(MID$(text(j), i, 1)) THEN w& = _PRINTWIDTH(MID$(text(j), i, 1))
183.             NEXT
184.         NEXT
185.         h& = _FONTHEIGHT
186.         TextArrayToImage& = _NEWIMAGE(w& * NumberOfLines, h& * longestline, 32)
187.     END IF
188.  
189.     _DEST TextArrayToImage&
190.     IF font& <> 0 THEN _FONT font&
191.     COLOR fc&, bfc&
192.  
193.  
194.     FOR i = 0 TO NumberOfLines - 1
195.         SELECT CASE mode
196.             CASE 1
197.                 'Print text forward
198.                 _PRINTSTRING (0, i * h&), text(i + 1)
199.             CASE 2
200.                 'Print text backwards
201.                 temp$ = ""
202.                 FOR j = 0 TO LEN(text(i + 1)) - 1
203.                     temp$ = temp$ + MID$(text(i + 1), LEN(text(i + 1)) - j, 1)
204.                 NEXT
205.                 _PRINTSTRING (0, i * h&), temp$
206.             CASE 3
207.                 'Print text upwards
208.                 'first lets reverse the text, so it's easy to place
209.                 temp$ = ""
210.                 FOR j = 0 TO LEN(text(i + 1)) - 1
211.                     temp$ = temp$ + MID$(text(i + 1), LEN(text(i + 1)) - j, 1)
212.                 NEXT
213.                 'then put it where it belongs
214.                 FOR j = 1 TO LEN(text(i + 1))
215.                     fx = (w& - _PRINTWIDTH(MID$(temp$, j, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
216.                     _PRINTSTRING (fx + w& * i, _FONTHEIGHT * (j - 1)), MID$(temp$, j, 1)
217.                 NEXT
218.             CASE 4
219.                 'Print text downwards
220.                 FOR j = 1 TO LEN(text(i + 1))
221.                     fx = (w& - _PRINTWIDTH(MID$(text(i + 1), j, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
222.                     _PRINTSTRING (fx + w& * i, _FONTHEIGHT * (j - 1)), MID$(text(i + 1), j, 1)
223.                 NEXT
224.         END SELECT
225.     NEXT
226.     _DEST D
227.     COLOR dc&, bgc&
228.     _FONT F
229. END FUNCTION
230.  
231. FUNCTION ScaleImage& (Image AS LONG, xscale AS SINGLE, yscale AS SINGLE)
232.     w = _WIDTH(Image): h = _HEIGHT(Image)
233.     w2 = w * xscale: h2 = h * yscale
234.     NewImage& = _NEWIMAGE(w2, h2, 32)
235.     _PUTIMAGE , Image&, NewImage&
236.     ScaleImage& = NewImage&
237. END SUB

Just don't forget to _FREEIMAGE the handles once you're finished with them.  I don't do so in the demo above, but with a single run-and-shut program like this, that's not going to become a concern like having a program run them in a loop would be. 

[Dav]

Really cool.  I don't know how I missed this snippet!

- Dav