There goes Pete, pushing Steve's buttons again!

[Pete]

Code: QB64: [Select]

1. row% = 10: col% = 34: bw% = 13: bh% = 2
2. button_text$ = "Whole Word"
3.  
4. REM PRINT "Input button column width: ";: INPUT bw%
5. REM PRINT "Input button row height: ";: INPUT bh%
6. REM PRINT "Input button row: ";: INPUT row%
7. REM PRINT "Input button column: ";: INPUT col%
8.  
9. GOSUB formatbutton
10.  
11. GOSUB bdisplay
12.  
13. DO
14.     _LIMIT 60
15.     WHILE _MOUSEINPUT: WEND
16.     mb.l = _MOUSEBUTTON(1)
17.     mx% = _MOUSEX
18.     my% = _MOUSEY
19.  
20.     IF my% = row% + bh% - 1 AND mx% = col% + bw% - 1 OR my% = row% AND mx% = col% THEN
21.         IF capp% <> 1 THEN _MOUSESHOW "TOPLEFT_BOTTOMRIGHT": capp% = 1
22.     ELSEIF my% = row% AND mx% = col% + bw% - 1 OR my% = row% + bh% - 1 AND mx% = col% THEN
23.         IF capp% <> 2 THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": capp% = 2
24.     ELSE
25.         IF capp% THEN _MOUSESHOW "DEFAULT": capp% = 0
26.     END IF
27.  
28.     IF mb.l THEN
29.         IF lbdown% = 0 THEN
30.             lbdown% = 1 ' Left mouse button down
31.         END IF
32.     ELSE
33.         IF lbdown% THEN lbdown% = 0 ' Left mouse button released
34.     END IF
35.  
36.     IF drag% THEN
37.         IF lbdown% THEN
38.             SELECT CASE drag%
39.                 CASE -1
40.                     mx% = _MOUSEX
41.                     my% = _MOUSEY
42.                     row% = my% - rdrag%
43.                     IF row% < 1 THEN row% = 1
44.                     IF row% + bh% > _HEIGHT THEN row% = _HEIGHT - bh% + 1
45.                     col% = mx% - cdrag%
46.                     IF col% < 1 THEN col% = 1
47.                     IF col% + bw% > _WIDTH THEN col% = _WIDTH - bw% + 1
48.                     IF oldrow% <> row% OR oldcol% <> col% THEN GOSUB dhover
49.                     oldrow% = row%: oldcol% = col%
50.                 CASE 1 ' Left side
51.                     IF mx% <> oldmx% THEN
52.                         IF bw% + (oldmx% - mx%) > 2 THEN
53.                             bw% = bw% + (oldmx% - mx%) ' Expand or shrink width.
54.                             col% = col% - (oldmx% - mx%)
55.                         END IF
56.                     END IF
57.                     IF my% <> oldmy% THEN
58.                         IF oldmy% < row% + bh% - 1 THEN
59.                             IF bh% - (my% - oldmy%) > 1 THEN
60.                                 row% = row% + (my% - oldmy%) ' Expand or Shrink height upwards.
61.                                 bh% = bh% - (my% - oldmy%)
62.                             END IF
63.                         ELSE
64.                             IF bh% + (my% - oldmy%) > 1 THEN
65.                                 bh% = bh% + (my% - oldmy%) ' Expand or Shrink height dowmwards.
66.                             END IF
67.                         END IF
68.                     END IF
69.                     GOSUB formatbutton
70.                     GOSUB dhover
71.                 CASE 2 ' Right side.
72.                     IF mx% <> oldmx% THEN
73.                         IF bw% + (mx% - oldmx%) > 2 THEN
74.                             bw% = bw% + (mx% - oldmx%) ' Expand or shrink width.
75.                         END IF
76.                     END IF
77.                     IF my% <> oldmy% THEN
78.                         IF oldmy% >= row% + bh% - 1 THEN
79.                             IF bh% + (my% - oldmy%) > 1 THEN
80.                                 bh% = bh% + (my% - oldmy%) ' Expand or shrink height downwards.
81.                             END IF
82.                         ELSE
83.                             IF bh% - (my% - oldmy%) > 1 THEN
84.                                 row% = row% + (my% - oldmy%) ' Expand or shrink height upwards.
85.                                 bh% = bh% - (my% - oldmy%)
86.                             END IF
87.                         END IF
88.                     END IF
89.                     GOSUB formatbutton
90.                     GOSUB dhover
91.             END SELECT
92.         ELSE
93.             drag% = 0
94.             GOSUB bhover
95.         END IF
96.  
97.     ELSE
98.  
99.         IF my% >= row% AND my% <= row% + bh% AND mx% >= col% AND mx% <= col% + bw% THEN
100.             IF button_hover% = 0 THEN
101.                 button_hover% = -1
102.                 GOSUB bhover
103.             END IF
104.         ELSE
105.             IF button_hover% THEN
106.                 GOSUB bdisplay
107.                 button_hover% = 0
108.             END IF
109.         END IF
110.  
111.         IF lbdown% = 1 AND button_hover% AND button_activated% = 0 THEN
112.             button_activated% = -1
113.             GOSUB bdisplay: _DELAY .1
114.             SOUND 1000, .1
115.             GOSUB bhover
116.         ELSE
117.             IF lbdown% = 0 AND button_activated% THEN
118.                 button_activated% = 0
119.             ELSE
120.                 IF lbdown% = 1 AND button_activated% AND drag% = 0 THEN
121.                     IF mx% = col% AND my% = row% OR mx% = col% AND my% = row% + bh% - 1 THEN
122.                         drag% = 1 ' Left upper or lower corner.
123.                     ELSEIF mx% = col% + bw% - 1 AND my% = row% OR mx% = col% + bw% - 1 AND my% = row% + bh% - 1 THEN
124.                         drag% = 2 ' Right upper or lower corner.
125.                     ELSE
126.                         drag% = -1 ' Move.
127.                         cdrag% = oldmx% - col%
128.                         rdrag% = oldmy% - row%
129.                     END IF
130.                 END IF
131.             END IF
132.         END IF
133.     END IF
134.  
135.     oldmx% = mx%: oldmy% = my%
136.  
137. LOOP UNTIL _KEYHIT = 27
138. SYSTEM
139.  
140. formatbutton:
141. Gdown = Button_HW(bw% * 8, bh% * 16, 170, 170, 170, -9, -7, -1, MID$(button_text$, 1, bw% - 2))
142. Ghover = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -8, -7, -1, MID$(button_text$, 1, bw% - 2))
143. Gdrag = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -1, -1, -1, MID$(button_text$, 1, bw% - 2))
144. RETURN
145.  
146. bdisplay:
147. _PUTIMAGE ((col% - 1) * 8, (row% - 1) * 16), Gdown
148. _DISPLAY
149. RETURN
150.  
151. bhover:
152. _PUTIMAGE ((col% - 1) * 8, (row% - 1) * 16), Ghover
153. _DISPLAY
154. RETURN
155.  
156. dhover:
157. _PUTIMAGE ((col% - 1) * 8, (row% - 1) * 16), Gdrag
158. _DISPLAY
159. RETURN
160.  
161. FUNCTION Button_HW (wide, tall, r, g, b, rc, gc, bc, caption$)
162.     ' Courtesy of The Amazing Steve.
163.     DIM k AS _UNSIGNED LONG, d AS _UNSIGNED LONG, bg AS _UNSIGNED LONG, t AS _UNSIGNED LONG
164.     Dest = _DEST
165.     t = _NEWIMAGE(wide, tall, 32)
166.     _DEST t
167.     FOR i = 0 TO 10
168.         rm = rm + rc
169.         gm = gm + gc
170.         bm = bm + bc
171.         k = _RGB32(r + rm, g + gm, b + bm)
172.         LINE (x + i, y + i)-(x + wide - i, y + tall - i), k, B
173.     NEXT
174.     PAINT (x + i, y + i), k
175.     COLOR _RGB32(r, g, b), 0
176.     _PRINTSTRING (x + (wide - _PRINTWIDTH(caption$)) / 2, y + (tall - _FONTHEIGHT) / 2), caption$
177.     Button_HW = _COPYIMAGE(t, 33)
178.     _FREEIMAGE t
179.  
180.     _DEST Dest
181. END SUB

EDIT: Added button resizing, but you can only do so at any one of the 4-corners. Go to a corner, hold the left mouse button down, and drag in a direction to resize.

You can drag the button anywhere on the screen, and it will make a click sound during a left mouse click. Slight display changes are seen with hover and drag.

I've known about mixing graphics with SCREEN 0 for quite some time, but I thought I'd have some fun today by actually using the _PUTIMAGE function Steve came up with, and adding my my mouse routine. It's a nice marriage, but it probably won't last. There's not enough room in the IDE to hold both of the egos.

Pete

[SMcNeill]

MuHahahaha!! I am THE AMAZING STEVE(tm)!!  I even managed to teach Pete a new trick -- that's how amazing I am!

[Pete]

Added bells and whistles, and yet it's still just a button... but now you can resize it, as well as hover, drag or click it.

Hey, didn't somebody come up with a simple way to change the mouse cursor appearance, to go with resizing?

So learned another new trick, and added Changing the cursor appearance at the corners!

Pete