X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fflexui%2Ffui_ctls.pas;h=12f710c21bbc3aae1845bc6b1c68bc8d8e5fd79e;hb=987c4a835a103345b59937e8e1be8524a6228712;hp=797c73fa5ba87a81a31fa5f0a5f7a49e0d0f0842;hpb=4eb0c3143f39926323e44d590cae60131d11001e;p=d2df-sdl.git diff --git a/src/flexui/fui_ctls.pas b/src/flexui/fui_ctls.pas index 797c73f..12f710c 100644 --- a/src/flexui/fui_ctls.pas +++ b/src/flexui/fui_ctls.pas @@ -3,8 +3,7 @@ * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -71,6 +70,8 @@ type mFrameColor: array[0..ClrIdxMax] of TGxRGBA; mFrameTextColor: array[0..ClrIdxMax] of TGxRGBA; mFrameIconColor: array[0..ClrIdxMax] of TGxRGBA; + mSBarFullColor: array[0..ClrIdxMax] of TGxRGBA; + mSBarEmptyColor: array[0..ClrIdxMax] of TGxRGBA; mDarken: array[0..ClrIdxMax] of Integer; // >255: none protected @@ -114,6 +115,8 @@ type //WARNING! do not call scissor functions outside `.draw*()` API! // set scissor to this rect (in local coords) procedure setScissor (lx, ly, lw, lh: Integer); // valid only in `draw*()` calls + procedure resetScissor (); inline; // only client area, w/o frame + procedure resetScissorNC (); inline; // full drawing area, with frame public actionCB: TActionCB; @@ -226,10 +229,15 @@ type procedure doAction (); virtual; // so user controls can override it - procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten - procedure keyEvent (var ev: THKeyEvent); virtual; // returns `true` if event was eaten - procedure keyEventPre (var ev: THKeyEvent); virtual; // will be called before dispatching the event - procedure keyEventPost (var ev: THKeyEvent); virtual; // will be called after if nobody processed the event + procedure onEvent (var ev: TFUIEvent); virtual; // general dispatcher + + procedure mouseEvent (var ev: TFUIEvent); virtual; + procedure mouseEventSink (var ev: TFUIEvent); virtual; + procedure mouseEventBubble (var ev: TFUIEvent); virtual; + + procedure keyEvent (var ev: TFUIEvent); virtual; + procedure keyEventSink (var ev: TFUIEvent); virtual; + procedure keyEventBubble (var ev: TFUIEvent); virtual; function prevSibling (): TUIControl; function nextSibling (): TUIControl; @@ -268,7 +276,7 @@ type TUITopWindow = class(TUIControl) private - type TXMode = (None, Drag, Scroll); + type TXMode = (None, Drag, VScroll, HScroll); private mTitle: AnsiString; @@ -302,8 +310,8 @@ type procedure drawControl (gx, gy: Integer); override; procedure drawControlPost (gx, gy: Integer); override; - procedure keyEvent (var ev: THKeyEvent); override; // returns `true` if event was eaten - procedure mouseEvent (var ev: THMouseEvent); override; // returns `true` if event was eaten + procedure keyEventBubble (var ev: TFUIEvent); override; // returns `true` if event was eaten + procedure mouseEvent (var ev: TFUIEvent); override; // returns `true` if event was eaten public property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose; @@ -330,8 +338,8 @@ type procedure drawControl (gx, gy: Integer); override; - procedure mouseEvent (var ev: THMouseEvent); override; - procedure keyEvent (var ev: THKeyEvent); override; + procedure mouseEvent (var ev: TFUIEvent); override; + procedure keyEvent (var ev: TFUIEvent); override; public property caption: AnsiString read mCaption write setCaption; @@ -359,8 +367,6 @@ type procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override; - - procedure drawControl (gx, gy: Integer); override; end; // ////////////////////////////////////////////////////////////////////// // @@ -427,8 +433,8 @@ type procedure drawControl (gx, gy: Integer); override; - procedure mouseEvent (var ev: THMouseEvent); override; - procedure keyEventPost (var ev: THKeyEvent); override; + procedure mouseEvent (var ev: TFUIEvent); override; + procedure keyEventBubble (var ev: TFUIEvent); override; public property text: AnsiString read mText write setText; @@ -450,6 +456,8 @@ type procedure cacheStyle (root: TUIStyle); override; + procedure blurred (); override; + public procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser @@ -457,8 +465,8 @@ type procedure drawControl (gx, gy: Integer); override; - procedure mouseEvent (var ev: THMouseEvent); override; - procedure keyEvent (var ev: THKeyEvent); override; + procedure mouseEvent (var ev: TFUIEvent); override; + procedure keyEvent (var ev: TFUIEvent); override; end; // ////////////////////////////////////////////////////////////////////// // @@ -497,8 +505,8 @@ type procedure drawControl (gx, gy: Integer); override; - procedure mouseEvent (var ev: THMouseEvent); override; - procedure keyEvent (var ev: THKeyEvent); override; + procedure mouseEvent (var ev: TFUIEvent); override; + procedure keyEvent (var ev: TFUIEvent); override; procedure setVar (pvar: PBoolean); @@ -536,16 +544,21 @@ type // ////////////////////////////////////////////////////////////////////////// // -procedure uiMouseEvent (var evt: THMouseEvent); -procedure uiKeyEvent (var evt: THKeyEvent); +procedure uiDispatchEvent (var evt: TFUIEvent); procedure uiDraw (); +procedure uiFocus (); +procedure uiBlur (); + // ////////////////////////////////////////////////////////////////////////// // procedure uiAddWindow (ctl: TUIControl); procedure uiRemoveWindow (ctl: TUIControl); // will free window if `mFreeOnClose` is `true` function uiVisibleWindow (ctl: TUIControl): Boolean; +// this can return `nil` or disabled control +function uiGetFocusedCtl (): TUIControl; + procedure uiUpdateStyles (); @@ -554,6 +567,11 @@ procedure uiUpdateStyles (); procedure uiLayoutCtl (ctl: TUIControl); +// ////////////////////////////////////////////////////////////////////////// // +procedure uiInitialize (); +procedure uiDeinitialize (); + + // ////////////////////////////////////////////////////////////////////////// // var fuiRenderScale: Single = 1.0; @@ -567,6 +585,26 @@ uses utils; +var + uiInsideDispatcher: Boolean = false; + uiTopList: array of TUIControl = nil; + uiGrabCtl: TUIControl = nil; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure uiDeinitialize (); +begin + FreeAndNil(uiContext); +end; + + +procedure uiInitialize (); +begin + if (uiContext <> nil) then raise Exception.Create('FlexUI already initialized'); + uiContext := TGxContext.Create(); +end; + + // ////////////////////////////////////////////////////////////////////////// // var ctlsToKill: array of TUIControl = nil; @@ -597,6 +635,7 @@ begin begin ctl := ctlsToKill[f]; if (ctl = nil) then break; + if (uiGrabCtl <> nil) and (ctl.isMyChild(uiGrabCtl)) then uiGrabCtl := nil; // just in case ctlsToKill[f] := nil; FreeAndNil(ctl); end; @@ -697,11 +736,6 @@ end; // ////////////////////////////////////////////////////////////////////////// // -var - uiTopList: array of TUIControl = nil; - uiGrabCtl: TUIControl = nil; - - procedure uiUpdateStyles (); var ctl: TUIControl; @@ -710,73 +744,180 @@ begin end; -procedure uiMouseEvent (var evt: THMouseEvent); +procedure uiDispatchEvent (var evt: TFUIEvent); var - ev: THMouseEvent; - f, c: Integer; - lx, ly: Integer; - ctmp: TUIControl; -begin - processKills(); - if (evt.eaten) or (evt.cancelled) then exit; - ev := evt; - ev.x := trunc(ev.x/fuiRenderScale); - ev.y := trunc(ev.y/fuiRenderScale); - ev.dx := trunc(ev.dx/fuiRenderScale); //FIXME - ev.dy := trunc(ev.dy/fuiRenderScale); //FIXME - try + ev: TFUIEvent; + destCtl: TUIControl; + + procedure doSink (ctl: TUIControl); + begin + if (ctl = nil) or (not ev.alive) then exit; + if (ctl.mParent <> nil) then + begin + doSink(ctl.mParent); + if (not ev.alive) then exit; + end; + //if (ctl = destCtl) then writeln(' SINK: MINE! <', ctl.className, '>'); + ev.setSinking(); + ctl.onEvent(ev); + if (ctl = destCtl) and (ev.alive) then + begin + ev.setMine(); + ctl.onEvent(ev); + end; + end; + + procedure dispatchTo (ctl: TUIControl); + begin + if (ctl = nil) then exit; + destCtl := ctl; + // sink + doSink(ctl); + // bubble + //ctl := ctl.mParent; // 'cause "mine" is processed in `doSink()` + while (ctl <> nil) and (ev.alive) do + begin + ev.setBubbling(); + ctl.onEvent(ev); + ctl := ctl.mParent; + end; + end; + + procedure doMouseEvent (); + var + doUngrab: Boolean; + ctl: TUIControl; + win: TUIControl; + lx, ly: Integer; + f, c: Integer; + begin + // pass mouse events to control with grab, if there is any if (uiGrabCtl <> nil) then begin - uiGrabCtl.mouseEvent(ev); - if (ev.release) and ((ev.bstate and (not ev.but)) = 0) then uiGrabCtl := nil; + //writeln('GRABBED: ', uiGrabCtl.className); + doUngrab := (ev.release) and ((ev.bstate and (not ev.but)) = 0); + dispatchTo(uiGrabCtl); + //FIXME: create API to get grabs, so control can regrab itself event on release + if (doUngrab) and (uiGrabCtl = destCtl) then uiGrabCtl := nil; ev.eat(); exit; end; - if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].mouseEvent(ev); - if (not ev.eaten) and (not ev.cancelled) and (ev.press) then + // get top window + if (Length(uiTopList) > 0) then win := uiTopList[High(uiTopList)] else win := nil; + // check if we're still in top window + if (ev.press) and (win <> nil) and (not win.toLocal(0, 0, lx, ly)) then begin - for f := High(uiTopList) downto 0 do + // we have other windows too; check for window switching + for f := High(uiTopList)-1 downto 0 do begin - if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then + if (uiTopList[f].enabled) and (uiTopList[f].toLocal(ev.x, ev.y, lx, ly)) then begin - if (uiTopList[f].enabled) and (f <> High(uiTopList)) then - begin - uiTopList[High(uiTopList)].blurred(); - ctmp := uiTopList[f]; - uiGrabCtl := nil; - for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c]; - uiTopList[High(uiTopList)] := ctmp; - ctmp.activated(); - ctmp.mouseEvent(ev); - end; - ev.eat(); - exit; + // switch + win.blurred(); + win := uiTopList[f]; + for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c]; + uiTopList[High(uiTopList)] := win; + win.activated(); + break; end; end; end; - finally - if (ev.eaten) then evt.eat(); - if (ev.cancelled) then evt.cancel(); + // dispatch event + if (win <> nil) and (win.toLocal(ev.x, ev.y, lx, ly)) then + begin + ctl := win.controlAtXY(ev.x, ev.y); // don't allow disabled controls + if (ctl = nil) or (not ctl.canFocus) or (not ctl.enabled) then ctl := win; + // pass focus to another event and set grab, if necessary + if (ev.press) then + begin + // pass focus, if necessary + if (win.mFocused <> ctl) then + begin + if (win.mFocused <> nil) then win.mFocused.blurred(); + uiGrabCtl := ctl; + win.mFocused := ctl; + if (ctl <> win) then ctl.activated(); + end + else + begin + uiGrabCtl := ctl; + end; + end; + dispatchTo(ctl); + end; end; -end; - -procedure uiKeyEvent (var evt: THKeyEvent); var - ev: THKeyEvent; + svx, svy, svdx, svdy: Integer; + svscale: Single; + odp: Boolean; begin processKills(); - if (evt.eaten) or (evt.cancelled) then exit; + if (not evt.alive) then exit; + odp := uiInsideDispatcher; + uiInsideDispatcher := true; + //writeln('ENTER: FUI DISPATCH'); ev := evt; - ev.x := trunc(ev.x/fuiRenderScale); - ev.y := trunc(ev.y/fuiRenderScale); + // normalize mouse coordinates + svscale := fuiRenderScale; + ev.x := trunc(ev.x/svscale); + ev.y := trunc(ev.y/svscale); + ev.dx := trunc(ev.dx/svscale); //FIXME + ev.dy := trunc(ev.dy/svscale); //FIXME + svx := ev.x; + svy := ev.y; + svdx := ev.dx; + svdy := ev.dy; try - if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].keyEvent(ev); - //if (ev.release) then begin ev.eat(); exit; end; + // "event grab" eats only mouse events + if (ev.mouse) then + begin + // we need to so some special processing here + doMouseEvent(); + end + else + begin + // simply dispatch to focused control + dispatchTo(uiGetFocusedCtl); + end; finally - if (ev.eaten) then evt.eat(); - if (ev.cancelled) then evt.cancel(); + uiInsideDispatcher := odp; + if (ev.x = svx) and (ev.y = svy) and (ev.dx = svdx) and (ev.dy = svdy) then + begin + // due to possible precision loss + svx := evt.x; + svy := evt.y; + svdx := evt.dx; + svdy := evt.dy; + evt := ev; + evt.x := svx; + evt.y := svy; + evt.dx := svdx; + evt.dy := svdy; + end + else + begin + // scale back + evt := ev; + evt.x := trunc(evt.x*svscale); + evt.y := trunc(evt.y*svscale); + evt.dx := trunc(evt.dx*svscale); + evt.dy := trunc(evt.dy*svscale); + end; end; + processKills(); + //writeln('EXIT: FUI DISPATCH'); +end; + +procedure uiFocus (); +begin + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].activated(); +end; + + +procedure uiBlur (); +begin + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].blurred(); end; @@ -806,6 +947,17 @@ begin end; +function uiGetFocusedCtl (): TUIControl; +begin + result := nil; + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then + begin + result := uiTopList[High(uiTopList)].mFocused; + if (result = nil) then result := uiTopList[High(uiTopList)]; + end; +end; + + procedure uiAddWindow (ctl: TUIControl); var f, c: Integer; @@ -819,7 +971,7 @@ begin begin if (f <> High(uiTopList)) then begin - uiTopList[High(uiTopList)].blurred(); + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].blurred(); for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c]; uiTopList[High(uiTopList)] := ctl; ctl.activated(); @@ -827,7 +979,7 @@ begin exit; end; end; - if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred(); + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].blurred(); SetLength(uiTopList, Length(uiTopList)+1); uiTopList[High(uiTopList)] := ctl; if (not ctl.mStyleLoaded) then ctl.updateStyle(); @@ -849,6 +1001,7 @@ begin ctl.blurred(); for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c]; SetLength(uiTopList, Length(uiTopList)-1); + if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].activated(); if (ctl is TUITopWindow) then begin try @@ -923,7 +1076,27 @@ end; destructor TUIControl.Destroy (); var f, c: Integer; + doActivateOtherWin: Boolean = false; begin + if (uiInsideDispatcher) then raise Exception.Create('FlexUI: cannot destroy objects in event dispatcher'); + if (uiGrabCtl = self) then uiGrabCtl := nil; + // just in case, check if this is top-level shit + for f := 0 to High(uiTopList) do + begin + if (uiTopList[f] = self) then + begin + if (uiGrabCtl <> nil) and (isMyChild(uiGrabCtl)) then uiGrabCtl := nil; + for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c]; + SetLength(uiTopList, Length(uiTopList)-1); + doActivateOtherWin := true; + break; + end; + end; + if (doActivateOtherWin) and (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then + begin + uiTopList[High(uiTopList)].activated(); + end; + // other checks if (mParent <> nil) then begin setFocused(false); @@ -990,6 +1163,8 @@ begin mFrameColor[ClrIdxActive] := root.get('frame-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); mFrameTextColor[ClrIdxActive] := root.get('frame-text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); mFrameIconColor[ClrIdxActive] := root.get('frame-icon-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 255, 0)); + mSBarFullColor[ClrIdxActive] := root.get('scrollbar-full-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); + mSBarEmptyColor[ClrIdxActive] := root.get('scrollbar-empty-color', 'active', cst).asRGBADef(TGxRGBA.Create(128, 128, 128)); mDarken[ClrIdxActive] := root.get('darken', 'active', cst).asInt(666); // disabled mBackColor[ClrIdxDisabled] := root.get('back-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 0, 128)); @@ -997,6 +1172,8 @@ begin mFrameColor[ClrIdxDisabled] := root.get('frame-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127)); mFrameTextColor[ClrIdxDisabled] := root.get('frame-text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127)); mFrameIconColor[ClrIdxDisabled] := root.get('frame-icon-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 127, 0)); + mSBarFullColor[ClrIdxDisabled] := root.get('scrollbar-full-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127)); + mSBarEmptyColor[ClrIdxDisabled] := root.get('scrollbar-empty-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(98, 98, 98)); mDarken[ClrIdxDisabled] := root.get('darken', 'disabled', cst).asInt(666); // inactive mBackColor[ClrIdxInactive] := root.get('back-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 0, 128)); @@ -1004,6 +1181,8 @@ begin mFrameColor[ClrIdxInactive] := root.get('frame-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); mFrameTextColor[ClrIdxInactive] := root.get('frame-text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); mFrameIconColor[ClrIdxInactive] := root.get('frame-icon-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 255, 0)); + mSBarFullColor[ClrIdxInactive] := root.get('scrollbar-full-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255)); + mSBarEmptyColor[ClrIdxInactive] := root.get('scrollbar-empty-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(128, 128, 128)); mDarken[ClrIdxInactive] := root.get('darken', 'inactive', cst).asInt(666); end; @@ -1874,6 +2053,22 @@ begin //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt); end; +procedure TUIControl.resetScissorNC (); inline; +begin + setScissor(0, 0, mWidth, mHeight); +end; + +procedure TUIControl.resetScissor (); inline; +begin + if ((mFrameWidth <= 0) and (mFrameHeight <= 0)) then + begin + resetScissorNC(); + end + else + begin + setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2); + end; +end; // ////////////////////////////////////////////////////////////////////////// // @@ -1955,53 +2150,17 @@ var f: Integer; gx, gy: Integer; - procedure resetScissor (fullArea: Boolean); inline; - begin - uiContext.clip := savedClip; - if (fullArea) or ((mFrameWidth = 0) and (mFrameHeight = 0)) then - begin - setScissor(0, 0, mWidth, mHeight); - end - else - begin - //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')'); - setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2); - end; - end; - begin if (mWidth < 1) or (mHeight < 1) or (uiContext = nil) or (not uiContext.active) then exit; toGlobal(0, 0, gx, gy); savedClip := uiContext.clip; try - resetScissor(true); // full area + resetScissorNC(); drawControl(gx, gy); - resetScissor(false); // client area + resetScissor(); for f := 0 to High(mChildren) do mChildren[f].draw(); - resetScissor(true); // full area - if (self is TUISwitchBox) then - begin - uiContext.color := TGxRGBA.Create(255, 0, 0, 255); - //uiContext.fillRect(gx, gy, mWidth, mHeight); - //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, '); sz=(', mWidth, 'x', mHeight, '); clip=', uiContext.clip.toString); - end; - if false and (mId = 'cbtest') then - begin - uiContext.color := TGxRGBA.Create(255, 127, 0, 96); - uiContext.fillRect(gx, gy, mWidth, mHeight); - if (mFrameWidth > 0) and (mFrameHeight > 0) then - begin - uiContext.color := TGxRGBA.Create(255, 255, 0, 96); - uiContext.fillRect(gx+mFrameWidth, gy+mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2); - end; - end - else if false and (self is TUISwitchBox) then - begin - uiContext.color := TGxRGBA.Create(255, 0, 0, 255); - uiContext.fillRect(gx, gy, mWidth, mHeight); - //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')'); - end; + resetScissorNC(); drawControlPost(gx, gy); finally uiContext.clip := savedClip; @@ -2010,15 +2169,13 @@ end; procedure TUIControl.drawControl (gx, gy: Integer); begin - //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64); end; procedure TUIControl.drawControlPost (gx, gy: Integer); begin - // shadow + // shadow for top-level controls if (mParent = nil) and (mDrawShadow) and (mWidth > 0) and (mHeight > 0) then begin - //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight); uiContext.resetClip(); uiContext.darkenRect(gx+mWidth, gy+8, 8, mHeight, 128); uiContext.darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128); @@ -2027,122 +2184,102 @@ end; // ////////////////////////////////////////////////////////////////////////// // -procedure TUIControl.mouseEvent (var ev: THMouseEvent); -var - ctl: TUIControl; +procedure TUIControl.onEvent (var ev: TFUIEvent); begin - if (not enabled) then exit; - if (mWidth < 1) or (mHeight < 1) then exit; - ctl := controlAtXY(ev.x, ev.y); - if (ctl = nil) then exit; - if (ctl.canFocus) and (ev.press) then + if (not ev.alive) or (not enabled) then exit; + //if (ev.mine) then writeln(' MINE: <', className, '>'); + if (ev.key) then + begin + if (ev.sinking) then keyEventSink(ev) + else if (ev.bubbling) then keyEventBubble(ev) + else if (ev.mine) then keyEvent(ev); + end + else if (ev.mouse) then begin - if (ctl <> topLevel.mFocused) then ctl.setFocused(true); - uiGrabCtl := ctl; + if (ev.sinking) then mouseEventSink(ev) + else if (ev.bubbling) then mouseEventBubble(ev) + else if (ev.mine) then mouseEvent(ev); end; - if (ctl <> self) then ctl.mouseEvent(ev); - //ev.eat(); end; -procedure TUIControl.keyEvent (var ev: THKeyEvent); +procedure TUIControl.mouseEventSink (var ev: TFUIEvent); +begin +end; - function doPreKey (ctl: TUIControl): Boolean; - begin - if (not ctl.enabled) then begin result := false; exit; end; - ctl.keyEventPre(ev); - result := (ev.eaten) or (ev.cancelled); // stop if event was consumed - end; +procedure TUIControl.mouseEventBubble (var ev: TFUIEvent); +begin +end; + +procedure TUIControl.mouseEvent (var ev: TFUIEvent); +begin +end; - function doPostKey (ctl: TUIControl): Boolean; - begin - if (not ctl.enabled) then begin result := false; exit; end; - ctl.keyEventPost(ev); - result := (ev.eaten) or (ev.cancelled); // stop if event was consumed - end; +procedure TUIControl.keyEventSink (var ev: TFUIEvent); var ctl: TUIControl; begin if (not enabled) then exit; - if (ev.eaten) or (ev.cancelled) then exit; - // call pre-key - if (mParent = nil) then - begin - forEachControl(doPreKey); - if (ev.eaten) or (ev.cancelled) then exit; - end; - // focused control should process keyboard first - if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and (topLevel.mFocused.enabled) then + if (not ev.alive) then exit; + // for top-level controls + if (mParent <> nil) then exit; + if (mEscClose) and (ev = 'Escape') then begin - // bubble keyboard event - ctl := topLevel.mFocused; - while (ctl <> nil) and (ctl <> self) do + if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then begin - ctl.keyEvent(ev); - if (ev.eaten) or (ev.cancelled) then exit; - ctl := ctl.mParent; + uiRemoveWindow(self); end; + ev.eat(); + exit; end; - // for top-level controls - if (mParent = nil) then + if (ev = 'Enter') or (ev = 'C-Enter') then begin - if (ev = 'S-Tab') then - begin - ctl := findPrevFocus(mFocused, true); - if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true); - ev.eat(); - exit; - end; - if (ev = 'Tab') then + ctl := findDefaulControl(); + if (ctl <> nil) then begin - ctl := findNextFocus(mFocused, true); - if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true); ev.eat(); + ctl.doAction(); exit; end; - if (ev = 'Enter') or (ev = 'C-Enter') then - begin - ctl := findDefaulControl(); - if (ctl <> nil) then - begin - ev.eat(); - ctl.doAction(); - exit; - end; - end; - if (ev = 'Escape') then - begin - ctl := findCancelControl(); - if (ctl <> nil) then - begin - ev.eat(); - ctl.doAction(); - exit; - end; - end; - if mEscClose and (ev = 'Escape') then + end; + if (ev = 'Escape') then + begin + ctl := findCancelControl(); + if (ctl <> nil) then begin - if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then - begin - uiRemoveWindow(self); - end; ev.eat(); + ctl.doAction(); exit; end; - // call post-keys - if (ev.eaten) or (ev.cancelled) then exit; - forEachControl(doPostKey); end; end; - -procedure TUIControl.keyEventPre (var ev: THKeyEvent); +procedure TUIControl.keyEventBubble (var ev: TFUIEvent); +var + ctl: TUIControl; begin + if (not enabled) then exit; + if (not ev.alive) then exit; + // for top-level controls + if (mParent <> nil) then exit; + if (ev = 'S-Tab') then + begin + ctl := findPrevFocus(mFocused, true); + if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true); + ev.eat(); + exit; + end; + if (ev = 'Tab') then + begin + ctl := findNextFocus(mFocused, true); + if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true); + ev.eat(); + exit; + end; end; - -procedure TUIControl.keyEventPost (var ev: THKeyEvent); +procedure TUIControl.keyEvent (var ev: TFUIEvent); begin end; @@ -2229,6 +2366,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // procedure TUITopWindow.drawControl (gx, gy: Integer); begin uiContext.color := mBackColor[getColorIndex]; @@ -2237,36 +2375,34 @@ end; procedure TUITopWindow.drawControlPost (gx, gy: Integer); var - cidx: Integer; - hgt, sbhgt, iwdt, ihgt: Integer; + cidx, iwdt, ihgt: Integer; + ybot, xend, vhgt, vwdt: Integer; begin cidx := getColorIndex; iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close); if (mDragScroll = TXMode.Drag) then begin - //uiContext.color := mFrameColor[cidx]; drawFrame(gx, gy, iwdt, 0, mTitle, false); end else begin ihgt := uiContext.iconWinHeight(TGxContext.TWinIcon.Close); - //uiContext.color := mFrameColor[cidx]; drawFrame(gx, gy, iwdt, 0, mTitle, true); // vertical scroll bar - hgt := mHeight-mFrameHeight*2; - if (hgt > 0) and (mFullSize.h > hgt) then - begin - //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString); - sbhgt := mHeight-mFrameHeight*2+2; - uiContext.fillRect(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1, mFrameWidth-3, sbhgt); - hgt += mScrollY; - if (hgt > mFullSize.h) then hgt := mFullSize.h; - hgt := sbhgt*hgt div mFullSize.h; - if (hgt > 0) then - begin - setScissor(mWidth-mFrameWidth+1, mFrameHeight-1, mFrameWidth-3, sbhgt); - uiContext.darkenRect(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1+hgt, mFrameWidth-3, sbhgt, 128); - end; + vhgt := mHeight-mFrameHeight*2; + if (mFullSize.h > vhgt) then + begin + ybot := mScrollY+vhgt; + resetScissorNC(); + uiContext.drawVSBar(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1, mFrameWidth-3, vhgt+2, ybot, 0, mFullSize.h, mSBarFullColor[cidx], mSBarEmptyColor[cidx]); + end; + // horizontal scroll bar + vwdt := mWidth-mFrameWidth*2; + if (mFullSize.w > vwdt) then + begin + xend := mScrollX+vwdt; + resetScissorNC(); + uiContext.drawHSBar(gx+mFrameWidth+1, gy+mHeight-mFrameHeight+1, vwdt-2, mFrameHeight-3, xend, 0, mFullSize.w, mSBarFullColor[cidx], mSBarEmptyColor[cidx]); end; // frame icon setScissor(mFrameWidth, 0, iwdt, ihgt); @@ -2275,11 +2411,12 @@ begin uiContext.color := mFrameIconColor[cidx]; uiContext.drawIconWin(TGxContext.TWinIcon.Close, gx+mFrameWidth, gy, mInClose); end; - // shadow + // shadow (no need to reset scissor, as draw should do it) inherited drawControlPost(gx, gy); end; +// ////////////////////////////////////////////////////////////////////////// // procedure TUITopWindow.activated (); begin if (mFocused = nil) or (mFocused = self) then @@ -2301,10 +2438,10 @@ begin end; -procedure TUITopWindow.keyEvent (var ev: THKeyEvent); +procedure TUITopWindow.keyEventBubble (var ev: TFUIEvent); begin inherited keyEvent(ev); - if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit; + if (not ev.alive) or (not enabled) {or (not getFocused)} then exit; if (ev = 'M-F3') then begin if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then @@ -2317,10 +2454,11 @@ begin end; -procedure TUITopWindow.mouseEvent (var ev: THMouseEvent); +procedure TUITopWindow.mouseEvent (var ev: TFUIEvent); var lx, ly: Integer; - hgt, sbhgt: Integer; + vhgt, ytop: Integer; + vwdt, xend: Integer; begin if (not enabled) then exit; if (mWidth < 1) or (mHeight < 1) then exit; @@ -2336,26 +2474,23 @@ begin exit; end; - if (mDragScroll = TXMode.Scroll) then + if (mDragScroll = TXMode.VScroll) then begin - // check for vertical scrollbar ly := ev.y-mY; - if (ly < 7) then - begin - mScrollY := 0; - end - else - begin - sbhgt := mHeight-mFrameHeight*2+2; - hgt := mHeight-mFrameHeight*2; - if (hgt > 0) and (mFullSize.h > hgt) then - begin - hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2); - mScrollY := nmax(0, hgt); - hgt := mHeight-mFrameHeight*2; - if (mScrollY+hgt > mFullSize.h) then mScrollY := nmax(0, mFullSize.h-hgt); - end; - end; + vhgt := mHeight-mFrameHeight*2; + ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt; + mScrollY := nmax(0, ytop); + if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None; + ev.eat(); + exit; + end; + + if (mDragScroll = TXMode.HScroll) then + begin + lx := ev.x-mX; + vwdt := mWidth-mFrameWidth*2; + xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt; + mScrollX := nmax(0, xend); if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None; ev.eat(); exit; @@ -2384,17 +2519,30 @@ begin exit; end; // check for vertical scrollbar - if (lx >= mWidth-mFrameWidth+1) and (ly >= 7) and (ly < mHeight-mFrameHeight+1) then + if (lx >= mWidth-mFrameWidth+1) and (ly >= mFrameHeight-1) and (ly < mHeight-mFrameHeight+2) then + begin + vhgt := mHeight-mFrameHeight*2; + if (mFullSize.h > vhgt) then + begin + uiGrabCtl := self; + mDragScroll := TXMode.VScroll; + ev.eat(); + ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt; + mScrollY := nmax(0, ytop); + exit; + end; + end; + // check for horizontal scrollbar + if (ly >= mHeight-mFrameHeight+1) and (lx >= mFrameWidth+1) and (lx < mWidth-mFrameWidth-1) then begin - sbhgt := mHeight-mFrameHeight*2+2; - hgt := mHeight-mFrameHeight*2; - if (hgt > 0) and (mFullSize.h > hgt) then + vwdt := mWidth-mFrameWidth*2; + if (mFullSize.w > vwdt) then begin - hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2); - mScrollY := nmax(0, hgt); uiGrabCtl := self; - mDragScroll := TXMode.Scroll; + mDragScroll := TXMode.HScroll; ev.eat(); + xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt; + mScrollX := nmax(0, xend); exit; end; end; @@ -2521,7 +2669,7 @@ end; procedure TUIBox.drawControl (gx, gy: Integer); var cidx: Integer; - xpos: Integer; + //xpos: Integer; begin cidx := getColorIndex; uiContext.color := mBackColor[cidx]; @@ -2529,10 +2677,10 @@ begin if (mHasFrame) then begin // draw frame - drawFrame(gx, gy, 0, -1, mCaption, false); - //uiContext.color := mFrameColor[cidx]; - //uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6); - end + drawFrame(gx, gy, 0, mHAlign, mCaption, false); + end; + // no frame -- no caption + { else if (Length(mCaption) > 0) then begin // draw caption @@ -2542,38 +2690,32 @@ begin xpos += gx+mFrameWidth; setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, uiContext.textHeight(mCaption)); - { - if (mHasFrame) then - begin - uiContext.color := mBackColor[cidx]; - uiContext.fillRect(xpos-3, gy, uiContext.textWidth(mCaption)+4, 8); - end; - } uiContext.color := mFrameTextColor[cidx]; uiContext.drawText(xpos, gy, mCaption); end; + } end; -procedure TUIBox.mouseEvent (var ev: THMouseEvent); +procedure TUIBox.mouseEvent (var ev: TFUIEvent); var lx, ly: Integer; begin inherited mouseEvent(ev); - if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then + if (ev.alive) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then begin ev.eat(); end; end; -procedure TUIBox.keyEvent (var ev: THKeyEvent); +procedure TUIBox.keyEvent (var ev: TFUIEvent); var dir: Integer = 0; cur, ctl: TUIControl; begin inherited keyEvent(ev); - if (ev.eaten) or (ev.cancelled) or (not ev.press) or (not enabled) or (not getActive) then exit; + if (not ev.alive) or (not ev.press) or (not enabled) or (not getActive) then exit; if (Length(mChildren) = 0) then exit; if (mHoriz) and (ev = 'Left') then dir := -1 else if (mHoriz) and (ev = 'Right') then dir := 1 @@ -2638,11 +2780,6 @@ begin end; -procedure TUISpan.drawControl (gx, gy: Integer); -begin -end; - - // ////////////////////////////////////////////////////////////////////// // procedure TUILine.AfterConstruction (); begin @@ -2911,12 +3048,12 @@ begin end; -procedure TUITextLabel.mouseEvent (var ev: THMouseEvent); +procedure TUITextLabel.mouseEvent (var ev: TFUIEvent); var lx, ly: Integer; begin inherited mouseEvent(ev); - if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then + if (ev.alive) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then begin ev.eat(); end; @@ -2942,11 +3079,11 @@ begin end; -procedure TUITextLabel.keyEventPost (var ev: THKeyEvent); +procedure TUITextLabel.keyEventBubble (var ev: TFUIEvent); begin if (not enabled) then exit; if (mHotChar = #0) then exit; - if (ev.eaten) or (ev.cancelled) or (not ev.press) then exit; + if (not ev.alive) or (not ev.press) then exit; if (ev.kstate <> ev.ModAlt) then exit; if (not ev.isHot(mHotChar)) then exit; ev.eat(); @@ -3040,16 +3177,26 @@ begin mDefSize.w += ww+mShadowSize; mDefSize.h += mShadowSize; end; + end + else + begin + ods := TLaySize.Create(0, 0); // fpc is dumb! end; inherited layPrepare(); if (not mSkipLayPrepare) then mDefSize := ods; end; +procedure TUIButton.blurred (); +begin + mPushed := false; +end; + + procedure TUIButton.drawControl (gx, gy: Integer); var wdt, hgt: Integer; - xpos, ypos, xofsl, xofsr{, sofs}: Integer; + xpos, ypos, xofsl, xofsr, sofs: Integer; cidx: Integer; lch, rch: AnsiChar; lstr, rstr: AnsiString; @@ -3060,13 +3207,13 @@ begin hgt := mHeight-mShadowSize; if (mPushed) {or (cidx = ClrIdxActive)} then begin - //sofs := mShadowSize; + sofs := mShadowSize; gx += mShadowSize; gy += mShadowSize; end else begin - //sofs := 0; + sofs := 0; if (mShadowSize > 0) then begin uiContext.darkenRect(gx+mShadowSize, gy+hgt, wdt, mShadowSize, 96); @@ -3075,7 +3222,6 @@ begin end; uiContext.color := mBackColor[cidx]; - //setScissor(sofs, sofs, wdt, hgt); uiContext.fillRect(gx, gy, wdt, hgt); if (mVAlign < 0) then ypos := 0 @@ -3124,7 +3270,7 @@ begin else begin xpos := wdt-xofsl-xofsr-uiContext.textWidth(mText); if (mHAlign = 0) then xpos := xpos div 2; end; xpos += xofsl; - //setScissor(xofsl+sofs, sofs, wdt-xofsl-xofsr, hgt); + setScissor(sofs+xofsl, sofs, wdt-xofsl-xofsr, hgt); uiContext.drawText(gx+xpos, ypos, mText); if (mHotChar <> #0) and (mHotChar <> ' ') then @@ -3136,7 +3282,7 @@ begin end; -procedure TUIButton.mouseEvent (var ev: THMouseEvent); +procedure TUIButton.mouseEvent (var ev: TFUIEvent); var lx, ly: Integer; begin @@ -3145,28 +3291,43 @@ begin begin ev.eat(); mPushed := toLocal(ev.x, ev.y, lx, ly); - if (ev = '-lmb') and focused and mPushed then + if (ev = '-lmb') and (focused) and (mPushed) then begin mPushed := false; doAction(); end; exit; end; - if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit; + if (not ev.alive) or (not enabled) or (not focused) then exit; mPushed := true; ev.eat(); end; -procedure TUIButton.keyEvent (var ev: THKeyEvent); +procedure TUIButton.keyEvent (var ev: TFUIEvent); begin inherited keyEvent(ev); - if (not ev.eaten) and (not ev.cancelled) and (enabled) then + if (ev.alive) and (enabled) then begin - if (ev = 'Enter') or (ev = 'Space') then + if (ev = '+Enter') or (ev = '+Space') then begin + focused := true; + mPushed := true; ev.eat(); - doAction(); + exit; + end; + if (focused) and ((ev = '-Enter') or (ev = '-Space')) then + begin + if (mPushed) then + begin + mPushed := false; + ev.eat(); + doAction(); + end + else + begin + ev.eat(); + end; exit; end; end; @@ -3350,7 +3511,7 @@ begin end; -procedure TUISwitchBox.mouseEvent (var ev: THMouseEvent); +procedure TUISwitchBox.mouseEvent (var ev: TFUIEvent); var lx, ly: Integer; begin @@ -3364,15 +3525,15 @@ begin end; exit; end; - if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit; + if (not ev.alive) or (not enabled) or not focused then exit; ev.eat(); end; -procedure TUISwitchBox.keyEvent (var ev: THKeyEvent); +procedure TUISwitchBox.keyEvent (var ev: TFUIEvent); begin inherited keyEvent(ev); - if (not ev.eaten) and (not ev.cancelled) and (enabled) then + if (ev.alive) and (enabled) then begin if (ev = 'Space') then begin @@ -3476,6 +3637,13 @@ end; // ////////////////////////////////////////////////////////////////////////// // +var + oldFocus: procedure () = nil; + oldBlur: procedure () = nil; + +procedure onWinFocus (); begin uiFocus(); if (assigned(oldFocus)) then oldFocus(); end; +procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); if (assigned(oldBlur)) then oldBlur(); end; + initialization registerCtlClass(TUIHBox, 'hbox'); registerCtlClass(TUIVBox, 'vbox'); @@ -3488,5 +3656,8 @@ initialization registerCtlClass(TUICheckBox, 'checkbox'); registerCtlClass(TUIRadioBox, 'radiobox'); - uiContext := TGxContext.Create(); + oldFocus := winFocusCB; + oldBlur := winBlurCB; + winFocusCB := onWinFocus; + winBlurCB := onWinBlur; end.