'===========================================================================
' Subject: BUTTON WORKSHOP                   Date: 05-21-96 (22:15)       
' Author:  Tika Carr                         Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: EGAVGA.ABC
'===========================================================================
' Button Workshop
' Popups, radio buttons, check boxes, buttons, frames!
' by Tika Carr 1:2613/601
' kari@rochgte.fidonet.org
'
' 5/21/96
'
' This code is part of my work on my GUI Interface, and is also hereby
' donated to the Basic Compiler Project as long as these terms are
' followed:
'
' 1. You may use this code in any of your own programs as long as you
'    put somewhere in the program where users can see it:
'      Popup (or button, check box, or whatever you used) code written
'      by Tika Carr copyright (c) 1996. Used with permission.
'    NOTE: If you do this, you always have my permission. :)
'
' 2. BASIC Compiler Project: It could read that some of the code
'    was written by me. You don't have to list what routines. Just give me
'    credit for contributing. :)
'
' 3. This code is not for COMMERCIAL use (ie. software packages sold in
'    shrinkwrapped boxes in stores) unless you contact me for arrangements
'    first.

' *** CODE FOLLOWS ***

DECLARE SUB drwbtn (ds!, dc!, dfs!, dfc!, dx1!, dy1!, dx2!, dy2!)

SCREEN 12: CLS      '640 x 480 16 color VGA 80 x 30 text

'** PALETTE ASSIGNMENT **

FOR count = 0 TO 15
    READ b, g, r
    PALETTE count, (65536 * b + 256 * g + r)
NEXT

'Background Color 0 = Aqua (Cyan)
DATA 42,42,0

'1 = black      4 = white   7 = brown    10 = green      13 = blue
'2 = dk. grey   5 = pink    8 = orange   11 = dk. green  14 = dk. blue
'3 = lt. greay  6 = red     9 = yellow   12 = aqua       15 = violet

DATA 0,0,0,21,21,21,45,45,45,63,63,63,45,45,63,20,18,63
DATA 0,26,45,0,28,63,0,55,60,8,50,8,0,24,0,42,42,0
DATA 63,26,0,50,0,0,63,0,40

'**************** Main Examples Here *******************

' Demo of Pop up styles
'
' Syntax:
'     drwbtn (ds!, dc!, dfs!, dfc!, dx1!, dy1!, dx2!, dy2!)
'
'ds = style, dc = color, dfs = frame size, dfc=frame color
'dx1, dy1 upper left; dx2, dy2 lower right

CALL drwbtn(1, 3, 0, 0, 3, 3, 55, 18)       'Plain On Button
CALL drwbtn(2, 3, 0, 0, 75, 3, 121, 18)     'Plain Off Button
CALL drwbtn(3, 6, 10, 5, 3, 25, 103, 125)   'Frame Style 3 (On/Off)
CALL drwbtn(4, 3, 10, 2, 110, 25, 210, 125) 'Frame Style 4 (Off/On)
CALL drwbtn(5, 8, 10, 7, 220, 25, 320, 125) 'Frame Style 5 (On/On)
CALL drwbtn(6, 11, 10, 10, 340, 25, 440, 125)'Frame Style 6 (Off/Off)
CALL drwbtn(7, 4, 0, 0, 3, 135, 18, 150)      'Plain Check Box
CALL drwbtn(8, 4, 0, 0, 23, 135, 38, 150)    'Plain Check Box Checked
CALL drwbtn(9, 9, 8, 0, 50, 143, 0, 0)     'Radio Button
CALL drwbtn(10, 9, 8, 15, 70, 143, 0, 0)   'Radio Button On

'Pause
Pause$ = INPUT$(1)

'Normal Screen/End
SCREEN 0, 0, 0: COLOR 7, 0: CLS : END

SUB drwbtn (ds, dc, dfs, dfc, dx1, dy1, dx2, dy2)
IF ds >= 3 AND ds <= 6 THEN c = dfc ELSE c = dc
SELECT CASE ds
    CASE 1: GOSUB dOn
    CASE 2: GOSUB dOff
    CASE 3: GOSUB dOn: GOSUB Inside: GOSUB dOff
    CASE 4: GOSUB dOff: GOSUB Inside: GOSUB dOn
    CASE 5: GOSUB dOn: GOSUB Inside: GOSUB dOn
    CASE 6: GOSUB dOff: GOSUB Inside: GOSUB dOff
    CASE 7: GOSUB Dsqu
    CASE 8: GOSUB Dsqu: LINE (dx1, dy1)-(dx2, dy2), 1: LINE (dx1, dy2)-(dx2, dy1), 1
    CASE 9: GOSUB Dcir
    CASE 10: GOSUB Dcir: CIRCLE (dx1, dy1), (15 - dfs) \ 2, dfc: PAINT (dx1, dy1), dfc, dfc
END SELECT

GOTO Ddone

Dsqu:
    LINE (dx1, dy1)-(dx2, dy2), 1, B
    PAINT (dx2 - 4, dy2 - 4), c, 1
RETURN

DBold:
    GOSUB Dsqu
    LINE (dx1 + 1, dy1 + 1)-(dx2 - 1, dy2 - 1), 1, B
RETURN

dOn:
    GOSUB DBold
    LINE (dx1 + 1, dy2 - 1)-(dx2 - 1, dy2 - 1), 4
    LINE -(dx2 - 1, dy1 + 1), 4
RETURN

dOff:
    GOSUB DBold
    LINE (dx1 + 1, dy2 - 1)-(dx1 + 1, dy1 + 1), 4
    LINE -(dx2 - 1, dy1 + 1), 4
RETURN

Dcir:
    CIRCLE (dx1, dy1), dfs, 1
    PAINT (dx1, dy1), dc, 1
RETURN

Inside:
    dx1 = dx1 + dfs: dy1 = dy1 + dfs
    dx2 = dx2 - dfs: dy2 = dy2 - dfs
    c = dc
RETURN

Ddone:

END SUB