Scale and Rotate Text Strings

[bplus]

Here's one for your toolbox.

Code: QB64: [Select]

1. _TITLE "Scale and rotate (default font) text strings." 'B+ started 2019-03-17
2.  
3. ' The following CONSTants or TYPES are for the demo and NOT needed for the 2 main subs
4.  
5. RANDOMIZE TIMER
6. CONST xmax = 1200
7. CONST ymax = 700
8. CONST x0 = 600
9. CONST y0 = 350
10. CONST radius = 240
11. CONST r2 = 20
12.  
13. TYPE vectorType
14.     x AS SINGLE
15.     y AS SINGLE
16. END TYPE
17.  
18. SCREEN _NEWIMAGE(xmax, ymax, 32)
19. _SCREENMOVE 100, 40
20.  
21.  
22. a = 1: dir = 1: dir2 = 1
23. ca = _PI(2 / 20)
24. DIM vdigit(0 TO 19) AS vectorType
25. DIM outer(0 TO 19) AS vectorType
26. FOR i = 0 TO 19
27.     vdigit(i).x = x0 + radius * COS(ca * i - 4.5 * ca)
28.     vdigit(i).y = y0 + radius * SIN(ca * i - 4.5 * ca)
29. NEXT
30. t$ = "Scale and rotate text strings"
31. WHILE _KEYDOWN(27) = 0
32.     CLS
33.  
34.     'this demos putting double sized numbers around a circle angled so the circle is the bottom of number
35.     CIRCLE (x0, y0), radius
36.     FOR i = 0 TO 19
37.         CIRCLE (vdigit(i).x, vdigit(i).y), 2
38.         x = x0 + (radius + 18) * COS(ca * i - 4.5 * ca)
39.         y = y0 + (radius + 18) * SIN(ca * i - 4.5 * ca)
40.         drwString LTRIM$(STR$(i)), &HFFFFFFFF, x, y, 2, 2, ca * i - 4.5 * ca + _PI(.5)
41.     NEXT
42.  
43.     'this demos stretching and shrinking the xScale while the text string is turned + and - Pi/2 or 90 degrees
44.     'left side red
45.     drwString t$, &HFF552200, 300, ymax / 2, 50 * ABS(rot), 3, _PI(-.5)
46.     'right side green
47.     drwString t$, &HFF004400, xmax - 300, ymax / 2, 50 * ABS(rot), 3, _PI(.5)
48.  
49.     'this demos rotaing a text string about the x axis at 3 times default font scale, rot range -1 to 1
50.     drwString t$, &HFF0000FF, xmax / 2, 32, 3, 3 * rot, 0
51.  
52.     'this demos rotaing a text string about the y axis at 3 times default font scale, rot range -1 to 1
53.     drwString t$, &HFF00FF00, xmax / 2, ymax - 32, 3 * rot, 3, 0
54.  
55.     'this demos rotating a text string from 0 to 2 Pi radians and reverse 0 to -2 Pi
56.     'and shrinking both the xScale and yScale at same time and amount
57.     drwString t$, &HFFFF0000, xmax / 2, ymax / 2, ABS(rot) * 4, ABS(rot) * 4, a
58.  
59.     rot = rot + .1 * dir
60.     IF rot > 1 THEN dir = -dir: rot = .9
61.     IF rot < -1 THEN dir = -dir: rot = -.9
62.     a = a + _PI(1 / 45) * dir2
63.     IF a > _PI(2) THEN dir2 = -dir2: a = _PI(2)
64.     IF a < _PI(-2) THEN dir2 = -dir2: a = _PI(-2)
65.  
66.     _DISPLAY
67.     _LIMIT 10
68. WEND
69.  
70. 'drwString needs sub RotoZoom2, intended for graphics screens using the default font.
71. 'S$ is the string to display
72. 'c is the color (will have a transparent background)
73. 'midX and midY is the center of where you want to display the string
74. 'xScale would multiply 8 pixel width of default font
75. 'yScale would multiply the 16 pixel height of the default font
76. 'Rotation is in Radian units, use _D2R to convert Degree units to Radian units
77. SUB drwString (S$, c AS _UNSIGNED LONG, midX, midY, xScale, yScale, Rotation)
78.     I& = _NEWIMAGE(8 * LEN(S$), 16, 32)
79.     _DEST I&
80.     COLOR c, _RGBA32(0, 0, 0, 0)
81.     _PRINTSTRING (0, 0), S$
82.     _DEST 0
83.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
84.     _FREEIMAGE I&
85. END SUB
86.  
87. 'This sub gives really nice control over displaying an Image.
88. SUB RotoZoom2 (centerX AS LONG, centerY AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, Rotation AS SINGLE)
89.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
90.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
91.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
92.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
93.     sinr! = SIN(-Rotation): cosr! = COS(-Rotation)
94.     FOR i& = 0 TO 3
95.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
96.         px(i&) = x2&: py(i&) = y2&
97.     NEXT
98.     _MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
99.     _MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
100. END SUB
101.  
102.  

[bplus]

I have updated the code in the original post with more comments, descriptive variable names... in attempts to make it easier to pickup and use the 2 main subroutines. I had forgotten to mention, drwString works with default font in a graphics screen.
A font that is 8x16 pixels should also work.

[bplus]

Here I have created a 16x16 Font from the default 8x16 with the help of the subs featured above and then some subs that function the same as PRINT, LOCATE and INPUT, their name is same with f prefix. So you could use the 16x16 font as you would the default 8x16 for locating and printing on the screen.

Code: QB64: [Select]

1. _TITLE "Font procedures using default font squared 16x16" 'b+ started 2019-03-18
2. 'from font procedures originally written to handle different fonts
3. '2018-09-03 started to duplicate subs I used to do large printing with Print, Locate, Input
4. '2018-09-04 post testing different fonts
5.  
6. ' 2019-03-18 test with print double wide default font
7.  
8. SCREEN _NEWIMAGE(800, 600, 32)
9. _SCREENMOVE (1280 - _WIDTH) / 2 + 30, (760 - _HEIGHT) / 2
10.  
11. DIM SHARED curCol AS INTEGER, curRow AS INTEGER, CW AS INTEGER, CH AS INTEGER, MAXCOL AS INTEGER, MAXROW AS INTEGER
12. CH = 16: CW = 16
13. MAXCOL = INT(_WIDTH / CW): MAXROW = INT(_HEIGHT / CH): curCol = 1: curRow = 1
14.  
15.  
16. fLP 1, 1, "max (row, col) = (" + LTRIM$(STR$(MAXCOL)) + "," + LTRIM$(STR$(MAXROW)) + ")"
17. fPRINT "     ;"
18. fPRINT "max (row, col) = (" + LTRIM$(STR$(MAXCOL)) + "," + LTRIM$(STR$(MAXROW)) + ")"
19. fPRINT "This is another row."
20. fLOCATE 10, 10
21. fPRINT "This is a located (10, 10) print line."
22. FOR i = 4 TO 10
23.     IF i = 9 THEN 'can't print over an area and deleted its
24.         FOR j = 1 TO MAXCOL
25.             fPRINT RIGHT$(STR$(j), 1) + ";"
26.         NEXT
27.     END IF
28.     fLOCATE i, 1: fPRINT LTRIM$(STR$(i))
29. NEXT
30. fCP "Center this text in the line."
31. fPRINT "This follows the centered text on the next line."
32. COLOR _RGB32(0, 0, 128), _RGB32(200, 200, 255)
33. fCP "How about some color?"
34. COLOR _RGB32(200, 200, 0), _RGB32(0, 0, 0)
35. fINPUT "Can you answer y for yes or n for no ?", ans$
36. fPRINT "Ah! you answered, *" + ans$ + "*"
37. fLOCATE MAXROW, MAXCOL
38. fPRINT "B" + ";"
39. fLOCATE 25, 1
40. COLOR _RGB32(255, 0, 0)
41. fPRINT "Let's try fPRINT with a string that won't fit on one line, what will it do?"
42. fPRINT "And how does fPRINT handle the next line?"
43. fLOCATE 35, 1
44. COLOR _RGB32(0, 128, 0)
45. fCP "This is a demo of a 16x16 pixel font"
46. fCP " created from the default 8x16 font."
47. SLEEP
48.  
49. 'the f for font subs
50. SUB fLOCATE (row, col) 'locate xColumnCell, yRowCell for printing
51.     IF 0 < col AND col <= MAXCOL AND 0 < row AND row <= MAXROW THEN
52.         curCol = col: curRow = row
53.     ELSE
54.         BEEP
55.     END IF
56. END SUB
57.  
58. 'font Print should work same as PRINT for default font, nope lines too long are dropped
59. SUB fPRINT (s$) 'print line (feed)
60.     IF RIGHT$(s$, 1) = ";" THEN LFTF = 0: mess$ = LEFT$(s$, LEN(s$) - 1) ELSE LFTF = -1: mess$ = s$
61.     IF curCol + LEN(mess$) > MAXCOL + 1 THEN
62.         WHILE curCol + LEN(mess$) > MAXCOL + 1
63.             diff = curCol + LEN(mess$) - (MAXCOL + 1)
64.             printString (curCol - 1) * CW, (curRow - 1) * CH, MID$(mess$, 1, LEN(mess$) - diff)
65.             curCol = 1
66.             curRow = curRow + 1
67.             mess$ = MID$(mess$, LEN(mess$) - diff + 1)
68.         WEND
69.         printString (curCol - 1) * CW, (curRow - 1) * CH, mess$
70.     ELSE
71.         printString (curCol - 1) * CW, (curRow - 1) * CH, mess$
72.     END IF
73.     IF LFTF THEN
74.         curCol = 1
75.         curRow = curRow + 1
76.         IF curRow > MAXROW THEN curRow = MAXROW 'yuck!
77.     ELSE
78.         curCol = curCol + LEN(mess$)
79.     END IF
80. END SUB
81.  
82. 'font Locate and Print
83. SUB fLP (row, col, mess$) 'locate x, y : print mess$ lp = locate and print assume LF
84.     'if locate = x col and y row then and top left corner locates as 1, 1
85.     IF 0 < col AND col <= MAXCOL AND 0 < row AND row <= MAXROW THEN
86.         printString (col - 1) * CW, (row - 1) * CH, mess$
87.         curCol = 1
88.         curRow = curRow + 1
89.         IF curRow > MAXROW THEN curRow = MAXROW 'yuck!
90.     END IF
91. END SUB
92.  
93. 'font Center Print
94. SUB fCP (s$) 'cp Center Print on line y the cpText$
95.     col = (MAXCOL - LEN(s$)) / 2
96.     fLP curRow, col, s$
97. END SUB
98.  
99. SUB fINPUT (prompt$, var$) 'input
100.     DIM pRow AS INTEGER, pCol AS INTEGER, done AS _BYTE
101.     'save current location
102.     pRow = curRow: pCol = curCol 'save these for redrawing var
103.     fLOCATE pRow, pCol
104.     fPRINT prompt$ + " {} ;"
105.     OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
106.     OK$ = OK$ + CHR$(8) + CHR$(27) + CHR$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
107.     DO
108.         k$ = INKEY$
109.         IF INSTR(OK$, k$) THEN
110.             IF k$ = CHR$(8) THEN
111.                 IF t$ <> "" THEN
112.                     IF LEN(t$) = 1 THEN t$ = "" ELSE t$ = LEFT$(t$, LEN(t$) - 1)
113.                 END IF
114.             ELSE
115.                 IF k$ = CHR$(13) OR k$ = CHR$(27) THEN
116.                     IF k$ = CHR$(27) THEN t$ = ""
117.                     EXIT DO
118.                 ELSE
119.                     t$ = t$ + k$
120.                 END IF
121.             END IF
122.             fLOCATE pRow, pCol
123.             LINE (pCol * CW - CW, (pRow - 1) * CH)-(MAXCOL * CW, pRow * CH), _BACKGROUNDCOLOR, BF
124.             fPRINT prompt$ + " {" + t$ + "} ;"
125.             k$ = ""
126.         END IF
127.         _DISPLAY
128.         _LIMIT 60
129.     LOOP UNTIL done
130.     _AUTODISPLAY
131.     curCol = 1: curRow = pRow + 1 'update the next print location
132.     var$ = t$ 'return the sub's var$ with desired entered or escape string.
133. END SUB
134.  
135. SUB printString (x, y, mess$) 'convert printstring to drwString
136.     midX = x + (LEN(mess$) * CW) / 2
137.     midY = y + 8
138.     drwString mess$, _DEFAULTCOLOR, midX, midY, 2, 1, 0
139. END SUB
140.  
141.  
142. 'drwString needs sub RotoZoom2, intended for graphics screens using the default font.
143. 'S$ is the string to display
144. 'c is the color (will have a transparent background)
145. 'midX and midY is the center of where you want to display the string
146. 'xScale would multiply 8 pixel width of default font
147. 'yScale would multiply the 16 pixel height of the default font
148. 'Rotation is in Radian units, use _D2R to convert Degree units to Radian units
149. SUB drwString (S$, c AS _UNSIGNED LONG, midX, midY, xScale, yScale, Rotation)
150.     I& = _NEWIMAGE(8 * LEN(S$), 16, 32)
151.     _DEST I&
152.     COLOR c
153.     _PRINTSTRING (0, 0), S$
154.     _DEST 0
155.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
156.     _FREEIMAGE I&
157. END SUB
158.  
159. 'This sub gives really nice control over displaying an Image.
160. SUB RotoZoom2 (centerX AS LONG, centerY AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, Rotation AS SINGLE)
161.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
162.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
163.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
164.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
165.     sinr! = SIN(-Rotation): cosr! = COS(-Rotation)
166.     FOR i& = 0 TO 3
167.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
168.         px(i&) = x2&: py(i&) = y2&
169.     NEXT
170.     _MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
171.     _MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
172. END SUB
173.  
174.  

[SMcNeill]

Here's how I generally scale and rotate text:

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 _KEYDOWN(27) 'ESC to end
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
238.  

Print text forward, backwards, up to down, down to up.  Rotate it to display at any angle.  Scale it to any size.  In Steve's Extended Toolset, you'll also see functions which work with arrays of text for moving/scaling whole blocks of text at once as needed, along with several other text related subs and functions.  ;)

And, for an even more flexible way to handle things, check out the print replacement routines which I have over at the other forums: http://qb64.freeforums.net/thread/37/custom-routines-supports-textures-shading

Print with or without wordwrap.  On the same line, or across multiple lines.  Use textures or patterns to color the text...  And it's *FASTER* than QB64's native PRINT routines... 

Put the two routines together and then PrintOut to a new image like TextToImage does, and then ScaleImage and DisplayImage all sorts of fancy looking text in various ways, angles, shades, and custom colors... 

The sky's the limit!

[bplus]

Thanks Steve, the textures shading sounds interesting.

[SMcNeill]

Also take a moment to compare RotoZoom to DisplayImage.  They’re both very similar routines, with the exception that DisplayImage has a mode option which allows you to choose which corner you want to place at your X/Y coordinate.  Often, I find myself swapping between the use of centering an image at a particular point, and needing to place the top left corner at that point.  DisplayImage toggles easily between both.

[bplus]

Well Steve you have me thinking about adding textures to text. I think I have a way but likely too slow to be practical?
I like to try something my way, if I can, before learning the right way. ;)

BTW with my system you don't need a separate mode for verticals use +-Pi/2 or +-3/2*Pi for rotation and use neg scales for mirror images. You don't even have to be expert in Radian angle measures, just convert Degrees with _D2R(degree angle)

For me, the #1 reason I have to load a separate font is to get larger or smaller font sizes. With these 2 little subs I provide (around 20 lines of actual code), you don't have to load a separate font file, you can just use the default. That saves having to .zip the code into a package to share with others who may not have Windows font files. PLUS as a bonus you can Rotate text!

Not bad for around 20 lines of actual code.

Also for converting Top, Left corner to the centerX, centerY for using the 2 little subs I used this wrapper sub in the 2nd code demo I provided. It takes normal _PRINTSTRING arguments and convert to centerX, centerY and calls drwString for the 16x16 font.

Code: QB64: [Select]

1. SUB printString (x, y, mess$) 'convert printstring to drwString
2.     midX = x + (LEN(mess$) * CW) / 2  'CW is Character Width DIM SHARED
3.     midY = y + 8  
4.     drwString mess$, _DEFAULTCOLOR, midX, midY, 2, 1, 0
5. END SUB
6.  
7.