' ======================================= ' ' โปรแกรมตัวอย่าง 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