Bounded font

[Petr]

Hi. Maybe it could be useful for someone.

Code: QB64: [Select]

1.  
2.  
3. 'usage: NewImage& = OKRAJ&(the color of the point around which to draw the border, border color, border size, source image handle)
4. SCREEN _NEWIMAGE(1024, 768, 32)
5. COLOR &HFFFF0000
6. F = _LOADFONT("arial.ttf", 100, "bold")
7. _FONT F, 0
8.  
9. LOCATE 3, 30
10. PRINT "Hi, QB64 Gang!"
11.  
12. _PUTIMAGE , OKRAJ(&HFFFF0000, &HFFFFFFFF, 3, 0)
13.  
14.  
15. FUNCTION OKRAJ& (K~&, K2~&, SIZE&, D&)
16.     OKRAJ& = _NEWIMAGE(_WIDTH(D&), _HEIGHT(D&), 32)
17.     DIM m AS _MEM, s AS _MEM, T AS LONG, KLR AS _UNSIGNED LONG, W AS LONG
18.     m = _MEMIMAGE(OKRAJ&)
19.     s = _MEMIMAGE(D&)
20.     DO UNTIL T& = s.SIZE
21.  
22.         IF _MEMGET(s, s.OFFSET + T&, _UNSIGNED LONG) = K~& THEN 'Find point with K~& color
23.  
24.             'hledam od bodu doprava:       Search to right from point K~&
25.             left& = T&
26.             cil& = SIZE& * 4 + T&
27.             IF cil& < s.SIZE THEN
28.                 DO UNTIL left& = cil&
29.                     KLR = _MEMGET(s, s.OFFSET + left&, _UNSIGNED LONG)
30.                     IF KLR <> K2~& AND KLR <> K~& THEN _MEMPUT m, m.OFFSET + left&, K2~& ELSE _MEMPUT m, m.OFFSET + left&, KLR
31.                     left& = left& + 4
32.                 LOOP
33.             END IF
34.  
35.             'hledam od bodu doleva:        Search to left from point K~&
36.             left& = T&
37.             cil& = T& - SIZE& * 4
38.             IF cil& > 0 THEN
39.                 DO UNTIL left& = cil&
40.                     KLR = _MEMGET(s, s.OFFSET + left&, _UNSIGNED LONG)
41.                     IF KLR <> K2~& AND KLR <> K~& THEN _MEMPUT m, m.OFFSET + left&, K2~& ELSE _MEMPUT m, m.OFFSET + left&, KLR
42.                     left& = left& - 4
43.                 LOOP
44.             END IF
45.  
46.             'hledam od bodu nahoru         Search to up from point K~&
47.             left& = T&
48.             cil& = T& - (_WIDTH(D&) * 4 * SIZE&)
49.             W& = _WIDTH(D&) * 4
50.  
51.             IF cil& > 0 THEN
52.                 DO UNTIL left& = cil&
53.                     KLR = _MEMGET(s, s.OFFSET + left&, _UNSIGNED LONG)
54.                     IF KLR <> K2~& AND KLR <> K~& THEN _MEMPUT m, m.OFFSET + left&, K2~& ELSE _MEMPUT m, m.OFFSET + left&, KLR
55.                     left& = left& - W&
56.                 LOOP
57.             END IF
58.  
59.             'hledam od bodu dolu            Search to down from point K~&
60.             left& = T&
61.             cil& = T& + (_WIDTH(D&) * 4 * SIZE&)
62.             IF cil& < s.SIZE THEN
63.                 DO UNTIL left& = cil&
64.                     KLR = _MEMGET(s, s.OFFSET + left&, _UNSIGNED LONG)
65.                     IF KLR <> K2~& AND KLR <> K~& THEN _MEMPUT m, m.OFFSET + left&, K2~& ELSE _MEMPUT m, m.OFFSET + left&, KLR
66.                     left& = left& + W&
67.                 LOOP
68.             END IF
69.         END IF
70.         T& = T& + 4
71.     LOOP
72.     _MEMFREE m
73.     _MEMFREE s
74. END FUNCTION
75.  

[Dav]

Hi @Petr!  Thanks for posting it.   I like useful code snippets like this.

- Dav