' ======================================= '
' โปรแกรมตัวอย่าง event ของ QrichEdit
' ======================================= '
$APPTYPE GUI
$TYPECHECK ON
$ESCAPECHARS ON
' ======================================= '
' const and variable
' ======================================= '
CONST ProgName$="Program ตัวอย่าง Event ใน QRichEdit"
CONST False = 0
CONST True = 1
'-- Control Alignments
CONST alNone = 0
CONST alTop = 1
CONST alBottom = 2
CONST alLeft = 3
CONST alRight = 4
CONST alClient = 5 '-- Expand to fit client
'-- shift state
DIM stana$ AS string
CONST ssShift = 256
CONST ssCtrl = 1
CONST ssAlt = 16
DIM DsBoxFont AS QFONT
CONST DefaultColor=&HFF33CC
DsBoxFont.Color=DefaultColor
DIM Form AS QFORM
DIM pnLeft AS QPanel
DIM Box AS QRichEdit
DIM DsBox AS QRichEdit
DIM pnRight AS QPanel
DIM rdbtn_boxCH AS QRadioButton
DIM rdbtn_boxKD AS QRadioButton
DIM rdbtn_boxKP AS QRadioButton
DIM rdbtn_boxKU AS QRadioButton
' - - - - - - - - - - - - - - - - - - - - EVENT - - - - - - - - - - - - - - - - - - - - '
SUB boxCH
IF Box.Tag=1 THEN
DsBox.Text = "คำสั่งของ event onChange จะทำงานมีการเปลี่ยนแปลงข้อความ "+str$( len( Box.Text ) )
END IF
END SUB
Function DsShift( sh as INTEGER ) as String 'function for boxKD, boxKP
select case sh
case ssShift: DsShift = "กดปุ่ม Shift"
case ssCtrl: DsShift = "กดปุ่ม Ctrl"
case ssAlt: DsShift = "กดปุ่ม Alt"
case ssAlt+ssShift: DsShift = "กด Alt+Shift"
case ssCtrl+ssShift: DsShift = "กด Ctrl+Shift"
case ssCtrl+ssAlt: DsShift = "กด Ctrl+Alt"
case ssCtrl+ssAlt+ssShift: DsShift = "กด Ctrl+Alt+Shift"
case else: DsShift = "ไม่ได้กดปุ่มพิเศษ"
end select
END Function
SUB boxKD(Key AS WORD, Shift AS INTEGER)
IF Box.Tag=2 THEN
DsBox.Text = "event onKeydown นี้จะเกิดเมื่อกดปุ่ม keyboard ใดๆ\r\n" + _
"event นี้สามารถตรวจการ กดปุ่ม Alt , Shift, Ctrl และปุ่ม key ที่กดได้"
stana$ = DsShift( Shift )
Form.Caption = "key ที่กดคือ "+str$(Key)+" ("+stana$+")"
END IF
END SUB
SUB boxKP(Key AS BYTE)
IF Box.Tag=3 THEN
DsBox.Text = "event onKeypress นี้จะทำงานเมื่อกดปุ่ม keyboard \r\nและสามารถตรวจจับรหัสแอสกีได้\r\n"+ _
"แต่จะไม่ทำงานเมื่อมีการกดปุ่มที่ไม่มีผลต่อการเปลี่ยนแปลงของข้อความ"
Form.Caption = "รหัสแอสกีของคือ "+str$(key)+" หรือตัวอักษร \" "+chr$(key)+" \""
END IF
END SUB
SUB boxKU(Key AS WORD, Shift AS INTEGER)
IF Box.Tag=4 THEN
DsBox.Text = "event onKeyup จะทำงานเมื่อหลังจากปล่อยปุ่ม keyboard\r\n" + _
"สังเกตได้ว่า ข้อความบน form caption จะเปลี่ยนหลังจากปล่อยปุ่ม"
stana$ = DsShift( Shift )
Form.Caption = "key ที่กดคือ "+str$(Key)+" ("+stana$+")"
END IF
END SUB
SUB rdbtnClick(sender as qradiobutton)
Box.Tag = sender.Tag
DsBox.Text = ProgName$
select case Box.Tag
case 1: DsBoxFont.Color = DefaultColor
case 2: DsBoxFont.Color = &H0066FF
case 3: DsBoxFont.Color = &H993300
case 4: DsBoxFont.Color = &H006600
end select
DsBox.Font = DsBoxFont
END SUB
' - - - - - - - - - - - - - - - - - - - - PROPERTY - - - - - - - - - - - - - - - - - - - - '
with Form
.Width = 500:.Height = 300:.Center
end with
with pnLeft:.Parent = form
.Align = alClient
end with
with Box:.Parent = pnLeft
.Align = alClient
.onChange = boxCH
.onKeydown = boxKD
.onKeypress = boxKP
.onKeyup = boxKU
.WantTabs = True
.Tag = 1
end with
with DsBox:.Parent = pnLeft
.Align = alBottom
.Height = 120
.Color=&HCCFFFF
.Text = ProgName$
.Font = DsBoxFont
.WordWrap = True
.ShowHint = True
.Hint = "กล่องคำอธิบาย"
end with
with pnRight:.Parent = form
.Align = alRight
.Width = 120
end with
with rdbtn_BoxCH:.Parent = pnRight
.Align = alTop
.Caption = "onChange test"
.Checked = True
.onClick = rdbtnClick
.Tag = 1
end with
with rdbtn_BoxKD:.Parent = pnRight
.Align = alTop
.Caption = "onKeydown test"
.onClick = rdbtnClick
.Tag = 2
end with
with rdbtn_BoxKP:.Parent = pnRight
.Align = alTop
.Caption = "onKeypress test"
.onClick = rdbtnClick
.Tag = 3
end with
with rdbtn_BoxKU:.Parent = pnRight
.Align = alTop
.Caption = "onKeyup test"
.onClick = rdbtnClick
.Tag = 4
end with
' - - - - - - - - - - - - - - - - - - - - DISPLAY - - - - - - - - - - - - - - - - - - - - '
Form.SHOWMODAL