10.10 QDiamondBox Source Code Listing
$APPTYPE GUI
$TYPECHECK ON
TYPE QDiamondBox EXTENDS QCanvas '' You can extend any QObject
'-- New Properties, you can also add components
Caption AS STRING
Checked AS INTEGER
HiLightColor AS INTEGER
'-- There are no protected methods, but you should let the user know anyway.
'-- PROTECTED (meaning you shouldn't directly call it in your program).
SUB DrawComponent
IF QDiamondBox.Checked THEN
QDiamondBox.Line(QDiamondBox.Height/2,0,0,QDiamondBox.Height/2,0)
QDiamondBox.Line(0,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,0)
QDiamondBox.Line(QDiamondBox.Height/2,0,QDiamondBox.Height,QDiamondBox.Height/2,0)
QDiamondBox.Line(QDiamondBox.Height,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,0)
QDiamondBox.Paint(QDiamondBox.Height/2, QDiamondBox.Height/2, QDiamondBox.HiLightColor, 0)
QDiamondBox.Line(QDiamondBox.Height/2,0,QDiamondBox.Height,QDiamondBox.Height/2,&HFFFFFF)
QDiamondBox.Line(QDiamondBox.Height,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,&HFFFFFF)
ELSE
QDiamondBox.Line(QDiamondBox.Height/2,0,0,QDiamondBox.Height/2,0)
QDiamondBox.Line(0,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,0)
QDiamondBox.Line(QDiamondBox.Height/2,0,QDiamondBox.Height,QDiamondBox.Height/2,0)
QDiamondBox.Line(QDiamondBox.Height,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,0)
QDiamondBox.Paint(QDiamondBox.Height/2, QDiamondBox.Height/2, &HBBBBBB, 0)
QDiamondBox.Line(QDiamondBox.Height/2,0,0,QDiamondBox.Height/2,&HFFFFFF)
QDiamondBox.Line(0,QDiamondBox.Height/2,QDiamondBox.Height/2,QDiamondBox.Height,&HFFFFFF)
END IF
QDiamondBox.TextOut(QDiamondBox.Height + 5, QDiamondBox.Height/2-QDiamondBox.Height/4, QDiamondBox.Caption, 0, -1)
END SUB
'-- Inherited Events (sorry, can't create any new events)
'-- The user can still override these events, but it's not a good idea.
EVENT OnClick
IF QDiamondBox.Checked THEN
QDiamondBox.Checked = 0
ELSE
QDiamondBox.Checked = 1
END IF
QDiamondBox.DrawComponent
END EVENT
EVENT OnPaint
QDiamondBox.DrawComponent
END EVENT
'-- Default values
CONSTRUCTOR
Height = 30
Width = 100
HiLightColor = &H00FF00
Caption = "DiamondBox"
Checked = 0
END CONSTRUCTOR
END TYPE
'----- Test our new component
DECLARE SUB DBox2Click
DIM Font AS QFont
Font.Name = "Arial"
Font.Size = 10
CREATE Form AS QForm
Center
Height = 120
Caption = "Custom Check Boxes"
CREATE DBox1 AS QDiamondBox
Caption = "Diamond Box 1"
Left = 100
Height = 20
END CREATE
CREATE DBox2 AS QDiamondBox
Caption = "Diamond Box 2"
Top = 30
Left = 100
Height = 20
Width = 140
HiLightColor = &H0000FF
Font = Font
ShowHint = 1 ' True
Hint = "Click me"
OnClick = DBox2Click
END CREATE
CREATE DBox3 AS QDiamondBox
Caption = "Diamond Box 3"
Top = 60
Left = 100
Height = 20
END CREATE
ShowModal
END CREATE
SUB DBox2Click
DBox2.InheritOnClick '' Inherit event
ShowMessage("Diamond Box 2 clicked")
END SUB