diff --git a/src/gx/gh_ui.pas b/src/gx/gh_ui.pas
index 774795d13daeecdcb197f396d602cd24b285f71b..9027758fedba90270ae400d49ba50bfd554f0f9a 100644 (file)
--- a/src/gx/gh_ui.pas
+++ b/src/gx/gh_ui.pas
-(* Copyright (C) DooM 2D:Forever Developers
+(* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
+ * Understanding is not required. Only obedience.
*
* 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
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
- * along with this program. If not, see <http://www.gnu.org/licenses/>.
+ * along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
{$INCLUDE ../shared/a_modes.inc}
+{$M+}
unit gh_ui;
interface
uses
SysUtils, Classes,
- GL, GLExt, SDL2,
+ SDL2,
gh_ui_common,
- sdlcarcass, glgfx;
+ gh_ui_style,
+ sdlcarcass, glgfx,
+ xparser;
// ////////////////////////////////////////////////////////////////////////// //
type
- THControl = class
+ TUIControlClass = class of TUIControl;
+
+ TUIControl = class
+ public
+ type TActionCB = procedure (me: TUIControl);
+ type TCloseRequestCB = function (me: TUIControl): Boolean; // top-level windows will call this before closing with icon/keyboard
+
+ // return `true` to stop
+ type TCtlEnumCB = function (ctl: TUIControl): Boolean is nested;
+
public
- type TActionCB = procedure (me: THControl; uinfo: Integer);
+ const ClrIdxActive = 0;
+ const ClrIdxDisabled = 1;
+ const ClrIdxInactive = 2;
+ const ClrIdxMax = 2;
private
- mParent: THControl;
+ mParent: TUIControl;
+ mId: AnsiString;
+ mStyleId: AnsiString;
mX, mY: Integer;
mWidth, mHeight: Integer;
mFrameWidth, mFrameHeight: Integer;
+ mScrollX, mScrollY: Integer;
mEnabled: Boolean;
mCanFocus: Boolean;
- mChildren: array of THControl;
- mFocused: THControl; // valid only for top-level controls
- mGrab: THControl; // valid only for top-level controls
+ mChildren: array of TUIControl;
+ mFocused: TUIControl; // valid only for top-level controls
mEscClose: Boolean; // valid only for top-level controls
- mEatKeys: Boolean;
mDrawShadow: Boolean;
+ mCancel: Boolean;
+ mDefault: Boolean;
+ // colors
+ mCtl4Style: AnsiString;
+ mBackColor: array[0..ClrIdxMax] of TGxRGBA;
+ mTextColor: array[0..ClrIdxMax] of TGxRGBA;
+ mFrameColor: array[0..ClrIdxMax] of TGxRGBA;
+ mFrameTextColor: array[0..ClrIdxMax] of TGxRGBA;
+ mFrameIconColor: array[0..ClrIdxMax] of TGxRGBA;
+ mDarken: array[0..ClrIdxMax] of Integer; // -1: none
private
scis: TScissorSave;
scallowed: Boolean;
+ protected
+ procedure updateStyle (); virtual;
+ procedure cacheStyle (root: TUIStyle); virtual;
+ function getColorIndex (): Integer; inline;
+
protected
function getEnabled (): Boolean;
procedure setEnabled (v: Boolean); inline;
function getFocused (): Boolean; inline;
procedure setFocused (v: Boolean); inline;
- function isMyChild (ctl: THControl): Boolean;
+ function getActive (): Boolean; inline;
+
+ function getCanFocus (): Boolean; inline;
+
+ function isMyChild (ctl: TUIControl): Boolean;
- function findFirstFocus (): THControl;
- function findLastFocus (): THControl;
+ function findFirstFocus (): TUIControl;
+ function findLastFocus (): TUIControl;
- function findNextFocus (cur: THControl): THControl;
- function findPrevFocus (cur: THControl): THControl;
+ function findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
+ function findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
+
+ function findCancelControl (): TUIControl;
+ function findDefaulControl (): TUIControl;
+
+ function findControlById (const aid: AnsiString): TUIControl;
procedure activated (); virtual;
procedure blurred (); virtual;
+ procedure calcFullClientSize ();
+
//WARNING! do not call scissor functions outside `.draw*()` API!
- // reset scissor to whole control
- procedure resetScissor ();
- // set scissor to this internal rect (in local coords)
+ // set scissor to this rect (in local coords)
procedure setScissor (lx, ly, lw, lh: Integer);
+ // reset scissor to whole control
+ procedure resetScissor (fullArea: Boolean); inline; // "full area" means "with frame"
// DO NOT USE!
+ // set scissor to this rect (in global coords)
procedure setScissorGLInternal (x, y, w, h: Integer);
public
actionCB: TActionCB;
+ closeRequestCB: TCloseRequestCB;
private
mDefSize: TLaySize; // default size
mMaxSize: TLaySize; // maximum size
- mActSize: TLaySize; // actual (calculated) size
- mActPos: TLayPos; // actual (calculated) position
mFlex: Integer;
mHoriz: Boolean;
mCanWrap: Boolean;
mVGroup: AnsiString;
mAlign: Integer;
mExpand: Boolean;
+ mLayDefSize: TLaySize;
+ mLayMaxSize: TLaySize;
+ mFullSize: TLaySize;
public
// layouter interface
function getDefSize (): TLaySize; inline; // default size; <0: use max size
- procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
+ //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
+ function getMargins (): TLayMargins; inline;
function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
- procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
+ //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
function getFlex (): Integer; inline; // <=0: not flexible
function isHorizBox (): Boolean; inline; // horizontal layout for children?
procedure setHorizBox (v: Boolean); inline; // horizontal layout for children?
procedure setAlign (v: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
procedure setExpand (v: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
- procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
function getHGroup (): AnsiString; inline; // empty: not grouped
procedure setHGroup (const v: AnsiString); inline; // empty: not grouped
function getVGroup (): AnsiString; inline; // empty: not grouped
procedure setVGroup (const v: AnsiString); inline; // empty: not grouped
+ procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
+
+ procedure layPrepare (); virtual; // called before registering control in layouter
+
+ public
property flex: Integer read mFlex write mFlex;
- property flDefaultSize: TLaySize read getDefSize write setDefSize;
- property flMaxSize: TLaySize read getMaxSize write setMaxSize;
+ property flDefaultSize: TLaySize read mDefSize write mDefSize;
+ property flMaxSize: TLaySize read mMaxSize write mMaxSize;
property flHoriz: Boolean read isHorizBox write setHorizBox;
property flCanWrap: Boolean read canWrap write setCanWrap;
property flLineStart: Boolean read isLineStart write setLineStart;
property flExpand: Boolean read getExpand write setExpand;
property flHGroup: AnsiString read getHGroup write setHGroup;
property flVGroup: AnsiString read getVGroup write setVGroup;
- property flActualSize: TLaySize read mActSize write mActSize;
- property flActualPos: TLayPos read mActPos write mActPos;
+ property fullSize: TLaySize read mFullSize;
+
+ protected
+ function parsePos (par: TTextParser): TLayPos;
+ function parseSize (par: TTextParser): TLaySize;
+ function parseBool (par: TTextParser): Boolean;
+ function parseAnyAlign (par: TTextParser): Integer;
+ function parseHAlign (par: TTextParser): Integer;
+ function parseVAlign (par: TTextParser): Integer;
+ function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
+ procedure parseTextAlign (par: TTextParser; var h, v: Integer);
+ procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
public
- constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
+ // par is on property data
+ // there may be more data in text stream, don't eat it!
+ // return `true` if property name is valid and value was parsed
+ // return `false` if property name is invalid; don't advance parser in this case
+ // throw on property data errors
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
+
+ // par should be on '{'; final '}' is eaten
+ procedure parseProperties (par: TTextParser);
+
+ public
+ constructor Create ();
destructor Destroy (); override;
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
// `sx` and `sy` are screen coordinates
- procedure drawControl (sx, sy: Integer); virtual;
+ procedure drawControl (gx, gy: Integer); virtual;
// called after all children drawn
- procedure drawControlPost (sx, sy: Integer); virtual;
+ procedure drawControlPost (gx, gy: Integer); virtual;
procedure draw (); virtual;
- function topLevel (): THControl; inline;
+ function topLevel (): TUIControl; inline;
// returns `true` if global coords are inside this control
function toLocal (var x, y: Integer): Boolean;
+ function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
procedure toGlobal (var x, y: Integer);
+ procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
+
+ procedure getDrawRect (out gx, gy, wdt, hgt: Integer);
// x and y are global coords
- function controlAtXY (x, y: Integer): THControl;
+ function controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
+
+ function parentScrollX (): Integer; inline;
+ function parentScrollY (): Integer; inline;
+
+ procedure makeVisibleInParent ();
+
+ procedure doAction (); virtual; // so user controls can override it
- function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
- function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
+ 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
- function prevSibling (): THControl;
- function nextSibling (): THControl;
- function firstChild (): THControl; inline;
- function lastChild (): THControl; inline;
+ function prevSibling (): TUIControl;
+ function nextSibling (): TUIControl;
+ function firstChild (): TUIControl; inline;
+ function lastChild (): TUIControl; inline;
- procedure appendChild (ctl: THControl); virtual;
+ procedure appendChild (ctl: TUIControl); virtual;
+
+ function setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB; // returns previous cb
+
+ function forEachChildren (cb: TCtlEnumCB): TUIControl; // doesn't recurse
+ function forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
+
+ procedure close (); // this closes *top-level* control
public
- property x0: Integer read mX;
- property y0: Integer read mY;
- property height: Integer read mHeight;
- property width: Integer read mWidth;
+ property id: AnsiString read mId;
+ property styleId: AnsiString read mStyleId;
+ property scrollX: Integer read mScrollX write mScrollX;
+ property scrollY: Integer read mScrollY write mScrollY;
+ property x0: Integer read mX write mX;
+ property y0: Integer read mY write mY;
+ property width: Integer read mWidth write mWidth;
+ property height: Integer read mHeight write mHeight;
property enabled: Boolean read getEnabled write setEnabled;
- property parent: THControl read mParent;
+ property parent: TUIControl read mParent;
property focused: Boolean read getFocused write setFocused;
+ property active: Boolean read getActive;
property escClose: Boolean read mEscClose write mEscClose;
- property eatKeys: Boolean read mEatKeys write mEatKeys;
+ property cancel: Boolean read mCancel write mCancel;
+ property defctl: Boolean read mDefault write mDefault;
+ property canFocus: Boolean read getCanFocus write mCanFocus;
+ property ctlById[const aid: AnsiString]: TUIControl read findControlById; default;
end;
- THTopWindow = class(THControl)
+ TUITopWindow = class(TUIControl)
+ private
+ type TXMode = (None, Drag, Scroll);
+
private
mTitle: AnsiString;
- mDragging: Boolean;
+ mDragScroll: TXMode;
mDragStartX, mDragStartY: Integer;
mWaitingClose: Boolean;
mInClose: Boolean;
+ mFreeOnClose: Boolean; // default: false
+ mDoCenter: Boolean; // after layouting
protected
+ procedure activated (); override;
procedure blurred (); override;
public
closeCB: TActionCB; // called after window was removed from ui window list
public
- constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
+ constructor Create (const atitle: AnsiString);
+
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
procedure centerInScreen ();
// `sx` and `sy` are screen coordinates
- procedure drawControl (sx, sy: Integer); override;
- procedure drawControlPost (sx, sy: Integer); override;
+ 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
+
+ public
+ property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
+ end;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUIBox = class(TUIControl)
+ private
+ mHasFrame: Boolean;
+ mCaption: AnsiString;
+ mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
+
+ protected
+ procedure setCaption (const acap: AnsiString);
+ procedure setHasFrame (v: Boolean);
+
+ public
+ constructor Create (ahoriz: Boolean);
+
+ 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;
+
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
+
+ public
+ property caption: AnsiString read mCaption write setCaption;
+ property hasFrame: Boolean read mHasFrame write setHasFrame;
+ property captionAlign: Integer read mHAlign write mHAlign;
+ end;
+
+ TUIHBox = class(TUIBox)
+ public
+ constructor Create ();
+
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+ end;
+
+ TUIVBox = class(TUIBox)
+ public
+ constructor Create ();
+
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+ end;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUISpan = class(TUIControl)
+ public
+ 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;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUILine = class(TUIControl)
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
- function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
+ procedure drawControl (gx, gy: Integer); override;
end;
+ TUIHLine = class(TUILine)
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+ end;
+
+ TUIVLine = class(TUILine)
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+ end;
- THCtlSimpleText = class(THControl)
+ // ////////////////////////////////////////////////////////////////////// //
+ TUIStaticText = class(TUIControl)
private
- type
- PItem = ^TItem;
- TItem = record
- title: AnsiString;
- centered: Boolean;
- hline: Boolean;
- end;
+ mText: AnsiString;
+ mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
+ mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
+ mHeader: Boolean; // true: draw with frame text color
+ mLine: Boolean; // true: draw horizontal line
+
private
- mItems: array of TItem;
+ procedure setText (const atext: AnsiString);
public
- constructor Create (ax, ay: Integer; aparent: THControl=nil);
- destructor Destroy (); override;
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
- procedure appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
- procedure drawControl (sx, sy: Integer); override;
+ procedure drawControl (gx, gy: Integer); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ public
+ property text: AnsiString read mText write setText;
+ property halign: Integer read mHAlign write mHAlign;
+ property valign: Integer read mVAlign write mVAlign;
+ property header: Boolean read mHeader write mHeader;
+ property line: Boolean read mLine write mLine;
end;
-
- THCtlCBListBox = class(THControl)
+ // ////////////////////////////////////////////////////////////////////// //
+ TUITextLabel = class(TUIControl)
private
- type
- PItem = ^TItem;
- TItem = record
- title: AnsiString;
- varp: PBoolean;
- actionCB: TActionCB;
- end;
+ mText: AnsiString;
+ mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
+ mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
+ mHotChar: AnsiChar;
+ mHotOfs: Integer; // from text start, in pixels
+ mHotColor: array[0..ClrIdxMax] of TGxRGBA;
+ mLinkId: AnsiString; // linked control
+
+ protected
+ procedure cacheStyle (root: TUIStyle); override;
+
+ procedure setText (const s: AnsiString); virtual;
+
+ public
+ 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;
+
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEventPost (var ev: THKeyEvent); override;
+
+ public
+ property text: AnsiString read mText write setText;
+ property halign: Integer read mHAlign write mHAlign;
+ property valign: Integer read mVAlign write mVAlign;
+ end;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUIButton = class(TUITextLabel)
+ protected
+ procedure setText (const s: AnsiString); override;
+
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ procedure drawControl (gx, gy: Integer); override;
+
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
+ procedure keyEventPost (var ev: THKeyEvent); override;
+ end;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUISwitchBox = class(TUITextLabel)
+ protected
+ mBoolVar: PBoolean;
+ mChecked: Boolean;
+ mCheckedStr: AnsiString;
+ mUncheckedStr: AnsiString;
+ mSwitchColor: array[0..ClrIdxMax] of TGxRGBA;
+
+ protected
+ procedure cacheStyle (root: TUIStyle); override;
+
+ procedure setText (const s: AnsiString); override;
+
+ function getChecked (): Boolean; virtual;
+ procedure setChecked (v: Boolean); virtual; abstract;
+
+ public
+ 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;
+
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
+ procedure keyEventPost (var ev: THKeyEvent); override;
+
+ procedure setVar (pvar: PBoolean);
+
+ public
+ property checked: Boolean read getChecked write setChecked;
+ end;
+
+ TUICheckBox = class(TUISwitchBox)
+ protected
+ procedure setChecked (v: Boolean); override;
+
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ procedure doAction (); override;
+ end;
+
+ TUIRadioBox = class(TUISwitchBox)
private
- mItems: array of TItem;
- mCurIndex: Integer;
+ mRadioGroup: AnsiString;
+
+ protected
+ procedure setChecked (v: Boolean); override;
public
- constructor Create (ax, ay: Integer; aparent: THControl=nil);
- destructor Destroy (); override;
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
- procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
- procedure drawControl (sx, sy: Integer); override;
+ procedure doAction (); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ public
+ property radioGroup: AnsiString read mRadioGroup write mRadioGroup; //FIXME
end;
-function uiMouseEvent (ev: THMouseEvent): Boolean;
-function uiKeyEvent (ev: THKeyEvent): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
+procedure uiMouseEvent (var evt: THMouseEvent);
+procedure uiKeyEvent (var evt: THKeyEvent);
procedure uiDraw ();
-procedure uiAddWindow (ctl: THControl);
-procedure uiRemoveWindow (ctl: THControl);
-function uiVisibleWindow (ctl: THControl): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
+procedure uiAddWindow (ctl: TUIControl);
+procedure uiRemoveWindow (ctl: TUIControl); // will free window if `mFreeOnClose` is `true`
+function uiVisibleWindow (ctl: TUIControl): Boolean;
+
+procedure uiUpdateStyles ();
+
+// ////////////////////////////////////////////////////////////////////////// //
// do layouting
-procedure uiLayoutCtl (ctl: THControl);
+procedure uiLayoutCtl (ctl: TUIControl);
+// ////////////////////////////////////////////////////////////////////////// //
var
gh_ui_scale: Single = 1.0;
implementation
uses
- gh_flexlay;
+ gh_flexlay,
+ utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+var
+ ctlsToKill: array of TUIControl = nil;
+
+
+procedure scheduleKill (ctl: TUIControl);
+var
+ f: Integer;
+begin
+ if (ctl = nil) then exit;
+ ctl := ctl.topLevel;
+ for f := 0 to High(ctlsToKill) do
+ begin
+ if (ctlsToKill[f] = ctl) then exit;
+ if (ctlsToKill[f] = nil) then begin ctlsToKill[f] := ctl; exit; end;
+ end;
+ SetLength(ctlsToKill, Length(ctlsToKill)+1);
+ ctlsToKill[High(ctlsToKill)] := ctl;
+end;
+
+
+procedure processKills ();
+var
+ f: Integer;
+ ctl: TUIControl;
+begin
+ for f := 0 to High(ctlsToKill) do
+ begin
+ ctl := ctlsToKill[f];
+ if (ctl = nil) then break;
+ ctlsToKill[f] := nil;
+ FreeAndNil(ctl);
+ end;
+ if (Length(ctlsToKill) > 0) then ctlsToKill[0] := nil; // just in case
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+var
+ knownCtlClasses: array of record
+ klass: TUIControlClass;
+ name: AnsiString;
+ end = nil;
+
+
+procedure registerCtlClass (aklass: TUIControlClass; const aname: AnsiString);
+begin
+ assert(aklass <> nil);
+ assert(Length(aname) > 0);
+ SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
+ knownCtlClasses[High(knownCtlClasses)].klass := aklass;
+ knownCtlClasses[High(knownCtlClasses)].name := aname;
+end;
+
+
+function findCtlClass (const aname: AnsiString): TUIControlClass;
+var
+ f: Integer;
+begin
+ for f := 0 to High(knownCtlClasses) do
+ begin
+ if (strEquCI1251(aname, knownCtlClasses[f].name)) then
+ begin
+ result := knownCtlClasses[f].klass;
+ exit;
+ end;
+ end;
+ result := nil;
+end;
// ////////////////////////////////////////////////////////////////////////// //
type
- TFlexLayouter = specialize TFlexLayouterBase<THControl>;
+ TFlexLayouter = specialize TFlexLayouterBase<TUIControl>;
-procedure uiLayoutCtl (ctl: THControl);
+procedure uiLayoutCtl (ctl: TUIControl);
var
lay: TFlexLayouter;
begin
lay := TFlexLayouter.Create();
try
lay.setup(ctl);
+ //lay.layout();
+
+ //writeln('============================'); lay.dumpFlat();
+
+ //writeln('=== initial ==='); lay.dump();
+
+ //lay.calcMaxSizeInternal(0);
+ {
+ lay.firstPass();
+ writeln('=== after first pass ===');
+ lay.dump();
+
+ lay.secondPass();
+ writeln('=== after second pass ===');
+ lay.dump();
+ }
+
lay.layout();
+ //writeln('=== final ==='); lay.dump();
+
+ if (ctl.mParent = nil) and (ctl is TUITopWindow) and (TUITopWindow(ctl).mDoCenter) then
+ begin
+ TUITopWindow(ctl).centerInScreen();
+ end;
+
+ // calculate full size
+ ctl.calcFullClientSize();
+
+ // fix focus
+ if (ctl.mParent = nil) then
+ begin
+ if (ctl.mFocused = nil) or (ctl.mFocused = ctl) or (not ctl.mFocused.enabled) then
+ begin
+ ctl.mFocused := ctl.findFirstFocus();
+ end;
+ end;
+
finally
FreeAndNil(lay);
end;
// ////////////////////////////////////////////////////////////////////////// //
var
- uiTopList: array of THControl = nil;
+ uiTopList: array of TUIControl = nil;
+ uiGrabCtl: TUIControl = nil;
+
+
+procedure uiUpdateStyles ();
+var
+ ctl: TUIControl;
+begin
+ for ctl in uiTopList do ctl.updateStyle();
+end;
-function uiMouseEvent (ev: THMouseEvent): Boolean;
+procedure uiMouseEvent (var evt: THMouseEvent);
var
+ ev: THMouseEvent;
f, c: Integer;
lx, ly: Integer;
- ctmp: THControl;
+ ctmp: TUIControl;
begin
+ processKills();
+ if (evt.eaten) or (evt.cancelled) then exit;
+ ev := evt;
ev.x := trunc(ev.x/gh_ui_scale);
ev.y := trunc(ev.y/gh_ui_scale);
ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME
ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME
- if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
- if not result and (ev.press) then
- begin
- for f := High(uiTopList) downto 0 do
+ try
+ if (uiGrabCtl <> nil) then
+ begin
+ uiGrabCtl.mouseEvent(ev);
+ if (ev.release) and ((ev.bstate and (not ev.but)) = 0) 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
begin
- lx := ev.x;
- ly := ev.y;
- if uiTopList[f].toLocal(lx, ly) then
+ for f := High(uiTopList) downto 0 do
begin
- result := true;
- if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
+ if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
begin
- uiTopList[High(uiTopList)].blurred();
- ctmp := uiTopList[f];
- ctmp.mGrab := nil;
- for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
- uiTopList[High(uiTopList)] := ctmp;
- ctmp.activated();
- result := ctmp.mouseEvent(ev);
+ 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;
end;
- exit;
end;
end;
+ finally
+ if (ev.eaten) then evt.eat();
+ if (ev.cancelled) then evt.cancel();
end;
end;
-function uiKeyEvent (ev: THKeyEvent): Boolean;
+procedure uiKeyEvent (var evt: THKeyEvent);
+var
+ ev: THKeyEvent;
begin
+ processKills();
+ if (evt.eaten) or (evt.cancelled) then exit;
+ ev := evt;
ev.x := trunc(ev.x/gh_ui_scale);
ev.y := trunc(ev.y/gh_ui_scale);
- if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
- if (ev.release) then begin result := true; exit; end;
+ 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;
+ finally
+ if (ev.eaten) then evt.eat();
+ if (ev.cancelled) then evt.cancel();
+ end;
end;
procedure uiDraw ();
var
- f: Integer;
- ctl: THControl;
+ f, cidx: Integer;
+ ctl: TUIControl;
begin
- glMatrixMode(GL_MODELVIEW);
- glPushMatrix();
+ processKills();
+ gxBeginUIDraw(gh_ui_scale);
try
- glLoadIdentity();
- glScalef(gh_ui_scale, gh_ui_scale, 1);
for f := 0 to High(uiTopList) do
begin
ctl := uiTopList[f];
ctl.draw();
- if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
+ if (f <> High(uiTopList)) then
+ begin
+ cidx := ctl.getColorIndex;
+ if (ctl.mDarken[cidx] > 0) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, ctl.mDarken[cidx]);
+ end;
end;
finally
- glMatrixMode(GL_MODELVIEW);
- glPopMatrix();
+ gxEndUIDraw();
end;
end;
-procedure uiAddWindow (ctl: THControl);
+procedure uiAddWindow (ctl: TUIControl);
var
f, c: Integer;
begin
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is TUITopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then
if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
SetLength(uiTopList, Length(uiTopList)+1);
uiTopList[High(uiTopList)] := ctl;
+ ctl.updateStyle();
ctl.activated();
end;
-// won't free object
-procedure uiRemoveWindow (ctl: THControl);
+procedure uiRemoveWindow (ctl: TUIControl);
var
f, c: Integer;
begin
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is TUITopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then
ctl.blurred();
for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
SetLength(uiTopList, Length(uiTopList)-1);
- if (ctl is THTopWindow) then
+ if (ctl is TUITopWindow) then
begin
- if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
+ try
+ if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl);
+ finally
+ if (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl);
+ end;
end;
exit;
end;
end;
-function uiVisibleWindow (ctl: THControl): Boolean;
+function uiVisibleWindow (ctl: TUIControl): Boolean;
var
f: Integer;
begin
result := false;
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is TUITopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then begin result := true; exit; end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
+constructor TUIControl.Create ();
+begin
+end;
+
+
+procedure TUIControl.AfterConstruction ();
begin
- mParent := aparent;
- mX := ax;
- mY := ay;
- mWidth := aw;
- mHeight := ah;
+ inherited;
+ mParent := nil;
+ mId := '';
+ mX := 0;
+ mY := 0;
+ mWidth := 64;
+ mHeight := 8;
mFrameWidth := 0;
mFrameHeight := 0;
mEnabled := true;
mCanFocus := true;
mChildren := nil;
mFocused := nil;
- mGrab := nil;
mEscClose := false;
- mEatKeys := false;
scallowed := false;
mDrawShadow := false;
actionCB := nil;
// layouter interface
- mDefSize := TLaySize.Create(64, 10); // default size
+ //mDefSize := TLaySize.Create(64, 8); // default size
+ mDefSize := TLaySize.Create(0, 0); // default size
mMaxSize := TLaySize.Create(-1, -1); // maximum size
- mActSize := TLaySize.Create(0, 0); // actual (calculated) size
- mActPos := TLayPos.Create(0, 0); // actual (calculated) position
mFlex := 0;
mHoriz := true;
mCanWrap := false;
mLineStart := false;
mHGroup := '';
mVGroup := '';
+ mStyleId := '';
+ mCtl4Style := '';
mAlign := -1; // left/top
mExpand := false;
end;
-destructor THControl.Destroy ();
+destructor TUIControl.Destroy ();
var
f, c: Integer;
begin
end;
-function THControl.getDefSize (): TLaySize; inline; begin result := mDefSize; end;
-procedure THControl.setDefSize (const sz: TLaySize); inline; begin mDefSize := sz; end;
-function THControl.getMaxSize (): TLaySize; inline; begin result := mMaxSize; end;
-procedure THControl.setMaxSize (const sz: TLaySize); inline; begin mMaxSize := sz; end;
-function THControl.getFlex (): Integer; inline; begin result := mFlex; end;
-function THControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
-procedure THControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
-function THControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
-procedure THControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
-function THControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
-procedure THControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
-function THControl.getAlign (): Integer; inline; begin result := mAlign; end;
-procedure THControl.setAlign (v: Integer); inline; begin mAlign := v; end;
-function THControl.getExpand (): Boolean; inline; begin result := mExpand; end;
-procedure THControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
-procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin mActPos := apos; mActSize := asize; end;
-function THControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
-procedure THControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
-function THControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
-procedure THControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
-
-
-procedure THControl.activated ();
+function TUIControl.getColorIndex (): Integer; inline;
begin
+ if (not enabled) then begin result := ClrIdxDisabled; exit; end;
+ // top windows: no focus hack
+ if (self is TUITopWindow) then
+ begin
+ if (getActive) then begin result := ClrIdxActive; exit; end;
+ end
+ else
+ begin
+ // if control cannot be focused, take "active" color scheme for it (it is easier this way)
+ if (not canFocus) or (getActive) then begin result := ClrIdxActive; exit; end;
+ end;
+ result := ClrIdxInactive;
end;
+procedure TUIControl.updateStyle ();
+var
+ stl: TUIStyle = nil;
+ ctl: TUIControl;
+begin
+ ctl := self;
+ while (ctl <> nil) do
+ begin
+ if (Length(ctl.mStyleId) <> 0) then begin stl := uiFindStyle(ctl.mStyleId); break; end;
+ ctl := ctl.mParent;
+ end;
+ if (stl = nil) then stl := uiFindStyle(''); // default
+ cacheStyle(stl);
+ for ctl in mChildren do ctl.updateStyle();
+end;
-procedure THControl.blurred ();
+procedure TUIControl.cacheStyle (root: TUIStyle);
+var
+ cst: AnsiString;
begin
- mGrab := nil;
+ //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
+ cst := mCtl4Style;
+ // active
+ mBackColor[ClrIdxActive] := root.get('back-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
+ mTextColor[ClrIdxActive] := root.get('text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
+ 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));
+ mDarken[ClrIdxActive] := root.get('darken', 'active', cst).asInt(-1);
+ // disabled
+ mBackColor[ClrIdxDisabled] := root.get('back-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
+ mTextColor[ClrIdxDisabled] := root.get('text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
+ 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));
+ mDarken[ClrIdxDisabled] := root.get('darken', 'disabled', cst).asInt(-1);
+ // inactive
+ mBackColor[ClrIdxInactive] := root.get('back-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
+ mTextColor[ClrIdxInactive] := root.get('text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
+ 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));
+ mDarken[ClrIdxInactive] := root.get('darken', 'inactive', cst).asInt(-1);
end;
-function THControl.topLevel (): THControl; inline;
+// ////////////////////////////////////////////////////////////////////////// //
+function TUIControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
+function TUIControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
+function TUIControl.getFlex (): Integer; inline; begin result := mFlex; end;
+function TUIControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
+procedure TUIControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
+function TUIControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
+procedure TUIControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
+function TUIControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
+procedure TUIControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
+function TUIControl.getAlign (): Integer; inline; begin result := mAlign; end;
+procedure TUIControl.setAlign (v: Integer); inline; begin mAlign := v; end;
+function TUIControl.getExpand (): Boolean; inline; begin result := mExpand; end;
+procedure TUIControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
+function TUIControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
+procedure TUIControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
+function TUIControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
+procedure TUIControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
+
+function TUIControl.getMargins (): TLayMargins; inline;
begin
- result := self;
- while (result.mParent <> nil) do result := result.mParent;
+ result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth);
end;
-
-function THControl.getEnabled (): Boolean;
-var
- ctl: THControl;
+procedure TUIControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
begin
- result := false;
- if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
- ctl := mParent;
- while (ctl <> nil) do
+ //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
+ if (mParent <> nil) then
begin
- if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
- ctl := ctl.mParent;
+ mX := apos.x;
+ mY := apos.y;
end;
- result := true;
+ mWidth := asize.w;
+ mHeight := asize.h;
end;
-
-procedure THControl.setEnabled (v: Boolean); inline;
+procedure TUIControl.layPrepare ();
begin
- if (mEnabled = v) then exit;
- mEnabled := v;
- if not v and focused then setFocused(false);
+ mLayDefSize := mDefSize;
+ mLayMaxSize := mMaxSize;
+ if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
+ if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
end;
-function THControl.getFocused (): Boolean; inline;
+// ////////////////////////////////////////////////////////////////////////// //
+function TUIControl.parsePos (par: TTextParser): TLayPos;
+var
+ ech: AnsiChar = ')';
begin
- if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
+ if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
+ result.x := par.expectInt();
+ par.eatDelim(','); // optional comma
+ result.y := par.expectInt();
+ par.eatDelim(','); // optional comma
+ par.expectDelim(ech);
end;
-
-procedure THControl.setFocused (v: Boolean); inline;
+function TUIControl.parseSize (par: TTextParser): TLaySize;
var
- tl: THControl;
+ ech: AnsiChar = ')';
begin
- tl := topLevel;
- if not v then
+ if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
+ result.w := par.expectInt();
+ par.eatDelim(','); // optional comma
+ result.h := par.expectInt();
+ par.eatDelim(','); // optional comma
+ par.expectDelim(ech);
+end;
+
+function TUIControl.parseBool (par: TTextParser): Boolean;
+begin
+ result :=
+ par.eatIdOrStrCI('true') or
+ par.eatIdOrStrCI('yes') or
+ par.eatIdOrStrCI('tan');
+ if not result then
begin
- if (tl.mFocused = self) then
+ if (not par.eatIdOrStrCI('false')) and (not par.eatIdOrStrCI('no')) and (not par.eatIdOrStrCI('ona')) then
begin
- tl.blurred();
- tl.mFocused := tl.findNextFocus(self);
- if (tl.mFocused = self) then tl.mFocused := nil;
+ par.error('boolean value expected');
end;
- exit;
end;
- if (not mEnabled) or (not mCanFocus) then exit;
- if (tl.mFocused <> self) then
- begin
- tl.mFocused.blurred();
- tl.mFocused := self;
- if (tl.mGrab <> self) then tl.mGrab := nil;
- activated();
+end;
+
+function TUIControl.parseAnyAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStrCI('left')) or (par.eatIdOrStrCI('top')) then result := -1
+ else if (par.eatIdOrStrCI('right')) or (par.eatIdOrStrCI('bottom')) then result := 1
+ else if (par.eatIdOrStrCI('center')) then result := 0
+ else par.error('invalid align value');
+end;
+
+function TUIControl.parseHAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStrCI('left')) then result := -1
+ else if (par.eatIdOrStrCI('right')) then result := 1
+ else if (par.eatIdOrStrCI('center')) then result := 0
+ else par.error('invalid horizontal align value');
+end;
+
+function TUIControl.parseVAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStrCI('top')) then result := -1
+ else if (par.eatIdOrStrCI('bottom')) then result := 1
+ else if (par.eatIdOrStrCI('center')) then result := 0
+ else par.error('invalid vertical align value');
+end;
+
+procedure TUIControl.parseTextAlign (par: TTextParser; var h, v: Integer);
+var
+ wasH: Boolean = false;
+ wasV: Boolean = false;
+begin
+ while true do
+ begin
+ if (par.eatIdOrStrCI('left')) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := -1;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('right')) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := 1;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('hcenter')) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := 0;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('top')) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := -1;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('bottom')) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := 1;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('vcenter')) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := 0;
+ continue;
+ end;
+ if (par.eatIdOrStrCI('center')) then
+ begin
+ if wasV or wasH then par.error('too many align directives');
+ wasV := true;
+ wasH := true;
+ h := 0;
+ v := 0;
+ continue;
+ end;
+ break;
+ end;
+ if not wasV and not wasH then par.error('invalid align value');
+end;
+
+function TUIControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
+ begin
+ if (par.eatIdOrStrCI('horizontal')) or (par.eatIdOrStrCI('horiz')) then mHoriz := true
+ else if (par.eatIdOrStrCI('vertical')) or (par.eatIdOrStrCI('vert')) then mHoriz := false
+ else par.error('`horizontal` or `vertical` expected');
+ result := true;
+ end
+ else
+ begin
+ result := false;
end;
end;
+// par should be on '{'; final '}' is eaten
+procedure TUIControl.parseProperties (par: TTextParser);
+var
+ pn: AnsiString;
+begin
+ if (not par.eatDelim('{')) then exit;
+ while (not par.eatDelim('}')) do
+ begin
+ if (not par.isIdOrStr) then par.error('property name expected');
+ pn := par.tokStr;
+ par.skipToken();
+ par.eatDelim(':'); // optional
+ if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
+ par.eatDelim(','); // optional
+ end;
+end;
-function THControl.isMyChild (ctl: THControl): Boolean;
+// par should be on '{'
+procedure TUIControl.parseChildren (par: TTextParser);
+var
+ cc: TUIControlClass;
+ ctl: TUIControl;
begin
- result := true;
- while (ctl <> nil) do
+ par.expectDelim('{');
+ while (not par.eatDelim('}')) do
begin
- if (ctl.mParent = self) then exit;
- ctl := ctl.mParent;
+ if (not par.isIdOrStr) then par.error('control name expected');
+ cc := findCtlClass(par.tokStr);
+ if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
+ //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
+ par.skipToken();
+ par.eatDelim(':'); // optional
+ ctl := cc.Create();
+ //writeln(' mHoriz=', ctl.mHoriz);
+ try
+ ctl.parseProperties(par);
+ except
+ FreeAndNil(ctl);
+ raise;
+ end;
+ //writeln(': ', ctl.mDefSize.toString);
+ appendChild(ctl);
+ par.eatDelim(','); // optional
end;
+end;
+
+
+function TUIControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ result := true;
+ if (strEquCI1251(prname, 'id')) then begin mId := par.expectIdOrStr(true); exit; end; // allow empty strings
+ if (strEquCI1251(prname, 'style')) then begin mStyleId := par.expectIdOrStr(); exit; end; // no empty strings
+ if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
+ // sizes
+ if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
+ if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
+ if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
+ if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
+ if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
+ if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
+ // flags
+ if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
+ // align
+ if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
+ if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
+ if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
+ // other
+ if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := true; exit; end;
+ if (strEquCI1251(prname, 'nofocus')) then begin mCanFocus := false; exit; end;
+ if (strEquCI1251(prname, 'disabled')) then begin mEnabled := false; exit; end;
+ if (strEquCI1251(prname, 'enabled')) then begin mEnabled := true; exit; end;
+ if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'default')) then begin mDefault := true; exit; end;
+ if (strEquCI1251(prname, 'cancel')) then begin mCancel := true; exit; end;
result := false;
end;
-// returns `true` if global coords are inside this control
-function THControl.toLocal (var x, y: Integer): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIControl.activated ();
+begin
+ makeVisibleInParent();
+end;
+
+
+procedure TUIControl.blurred ();
+begin
+ if (uiGrabCtl = self) then uiGrabCtl := nil;
+end;
+
+
+procedure TUIControl.calcFullClientSize ();
var
- ctl: THControl;
+ ctl: TUIControl;
begin
- ctl := self;
+ mFullSize := TLaySize.Create(0, 0);
+ if (mWidth < 1) or (mHeight < 1) then exit;
+ for ctl in mChildren do
+ begin
+ ctl.calcFullClientSize();
+ mFullSize.w := nmax(mFullSize.w, ctl.mX-mFrameWidth+ctl.mFullSize.w);
+ mFullSize.h := nmax(mFullSize.h, ctl.mY-mFrameHeight+ctl.mFullSize.h);
+ end;
+ mFullSize.w := nmax(mFullSize.w, mWidth-mFrameWidth*2);
+ mFullSize.h := nmax(mFullSize.h, mHeight-mFrameHeight*2);
+end;
+
+
+function TUIControl.topLevel (): TUIControl; inline;
+begin
+ result := self;
+ while (result.mParent <> nil) do result := result.mParent;
+end;
+
+
+function TUIControl.getEnabled (): Boolean;
+var
+ ctl: TUIControl;
+begin
+ result := false;
+ if (not mEnabled) then exit;
+ ctl := mParent;
while (ctl <> nil) do
begin
- Dec(x, ctl.mX);
- Dec(y, ctl.mY);
+ if (not ctl.mEnabled) then exit;
ctl := ctl.mParent;
end;
- result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
+ result := true;
+end;
+
+
+procedure TUIControl.setEnabled (v: Boolean); inline;
+begin
+ if (mEnabled = v) then exit;
+ mEnabled := v;
+ if (not v) and focused then setFocused(false);
+end;
+
+
+function TUIControl.getFocused (): Boolean; inline;
+begin
+ if (mParent = nil) then
+ begin
+ result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
+ end
+ else
+ begin
+ result := (topLevel.mFocused = self);
+ if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
+ end;
end;
-procedure THControl.toGlobal (var x, y: Integer);
+function TUIControl.getActive (): Boolean; inline;
var
- ctl: THControl;
+ ctl: TUIControl;
begin
- ctl := self;
+ if (mParent = nil) then
+ begin
+ result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
+ end
+ else
+ begin
+ ctl := topLevel.mFocused;
+ while (ctl <> nil) and (ctl <> self) do ctl := ctl.mParent;
+ result := (ctl = self);
+ if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
+ end;
+end;
+
+
+procedure TUIControl.setFocused (v: Boolean); inline;
+var
+ tl: TUIControl;
+begin
+ tl := topLevel;
+ if (not v) then
+ begin
+ if (tl.mFocused = self) then
+ begin
+ blurred(); // this will reset grab, but still...
+ if (uiGrabCtl = self) then uiGrabCtl := nil;
+ tl.mFocused := tl.findNextFocus(self, true);
+ if (tl.mFocused = self) then tl.mFocused := nil;
+ if (tl.mFocused <> nil) then tl.mFocused.activated();
+ end;
+ exit;
+ end;
+ if (not canFocus) then exit;
+ if (tl.mFocused <> self) then
+ begin
+ if (tl.mFocused <> nil) then tl.mFocused.blurred();
+ tl.mFocused := self;
+ if (uiGrabCtl <> self) then uiGrabCtl := nil;
+ activated();
+ end;
+end;
+
+
+function TUIControl.getCanFocus (): Boolean; inline;
+begin
+ result := (getEnabled) and (mCanFocus) and (mWidth > 0) and (mHeight > 0);
+end;
+
+
+function TUIControl.isMyChild (ctl: TUIControl): Boolean;
+begin
+ result := true;
while (ctl <> nil) do
begin
- Inc(x, ctl.mX);
- Inc(y, ctl.mY);
+ if (ctl.mParent = self) then exit;
ctl := ctl.mParent;
end;
+ result := false;
+end;
+
+
+// returns `true` if global coords are inside this control
+function TUIControl.toLocal (var x, y: Integer): Boolean;
+begin
+ if (mParent = nil) then
+ begin
+ Dec(x, mX);
+ Dec(y, mY);
+ result := true; // hack
+ end
+ else
+ begin
+ result := mParent.toLocal(x, y);
+ Inc(x, mParent.mScrollX);
+ Inc(y, mParent.mScrollY);
+ Dec(x, mX);
+ Dec(y, mY);
+ if result then result := (x >= 0) and (y >= 0) and (x < mParent.mWidth) and (y < mParent.mHeight);
+ end;
+ if result then result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
+end;
+
+function TUIControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
+begin
+ x := gx;
+ y := gy;
+ result := toLocal(x, y);
+end;
+
+
+procedure TUIControl.toGlobal (var x, y: Integer);
+begin
+ Inc(x, mX);
+ Inc(y, mY);
+ if (mParent <> nil) then
+ begin
+ Dec(x, mParent.mScrollX);
+ Dec(y, mParent.mScrollY);
+ mParent.toGlobal(x, y);
+ end;
+end;
+
+procedure TUIControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
+begin
+ x := lx;
+ y := ly;
+ toGlobal(x, y);
+end;
+
+procedure TUIControl.getDrawRect (out gx, gy, wdt, hgt: Integer);
+var
+ cgx, cgy: Integer;
+begin
+ if (mParent = nil) then
+ begin
+ gx := mX;
+ gy := mY;
+ wdt := mWidth;
+ hgt := mHeight;
+ end
+ else
+ begin
+ toGlobal(0, 0, cgx, cgy);
+ mParent.getDrawRect(gx, gy, wdt, hgt);
+ if (wdt > 0) and (hgt > 0) then
+ begin
+ if not intersectRect(gx, gy, wdt, hgt, cgx, cgy, mWidth, mHeight) then
+ begin
+ wdt := 0;
+ hgt := 0;
+ end;
+ end;
+ end;
end;
// x and y are global coords
-function THControl.controlAtXY (x, y: Integer): THControl;
+function TUIControl.controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
var
lx, ly: Integer;
f: Integer;
begin
result := nil;
- if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
- lx := x;
- ly := y;
- if not toLocal(lx, ly) then exit;
+ if (not allowDisabled) and (not enabled) then exit;
+ if (mWidth < 1) or (mHeight < 1) then exit;
+ if not toLocal(x, y, lx, ly) then exit;
for f := High(mChildren) downto 0 do
begin
- result := mChildren[f].controlAtXY(x, y);
+ result := mChildren[f].controlAtXY(x, y, allowDisabled);
if (result <> nil) then exit;
end;
result := self;
end;
-function THControl.prevSibling (): THControl;
+function TUIControl.parentScrollX (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollX else result := 0; end;
+function TUIControl.parentScrollY (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollY else result := 0; end;
+
+
+procedure TUIControl.makeVisibleInParent ();
+var
+ sy, ey, cy: Integer;
+ p: TUIControl;
+begin
+ if (mWidth < 1) or (mHeight < 1) then exit;
+ p := mParent;
+ if (p = nil) then exit;
+ if (p.mFullSize.w < 1) or (p.mFullSize.h < 1) then
+ begin
+ p.mScrollX := 0;
+ p.mScrollY := 0;
+ exit;
+ end;
+ p.makeVisibleInParent();
+ cy := mY-p.mFrameHeight;
+ sy := p.mScrollY;
+ ey := sy+(p.mHeight-p.mFrameHeight*2);
+ if (cy < sy) then
+ begin
+ p.mScrollY := nmax(0, cy);
+ end
+ else if (cy+mHeight > ey) then
+ begin
+ p.mScrollY := nmax(0, cy+mHeight-(p.mHeight-p.mFrameHeight*2));
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function TUIControl.prevSibling (): TUIControl;
var
f: Integer;
begin
result := nil;
end;
-function THControl.nextSibling (): THControl;
+function TUIControl.nextSibling (): TUIControl;
var
f: Integer;
begin
result := nil;
end;
-function THControl.firstChild (): THControl; inline;
+function TUIControl.firstChild (): TUIControl; inline;
begin
if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
end;
-function THControl.lastChild (): THControl; inline;
+function TUIControl.lastChild (): TUIControl; inline;
begin
if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
end;
-function THControl.findFirstFocus (): THControl;
+function TUIControl.findFirstFocus (): TUIControl;
var
f: Integer;
begin
result := mChildren[f].findFirstFocus();
if (result <> nil) then exit;
end;
- if mCanFocus then result := self;
+ if (canFocus) then result := self;
end;
end;
-function THControl.findLastFocus (): THControl;
+function TUIControl.findLastFocus (): TUIControl;
var
f: Integer;
begin
result := mChildren[f].findLastFocus();
if (result <> nil) then exit;
end;
- if mCanFocus then result := self;
+ if (canFocus) then result := self;
end;
end;
-function THControl.findNextFocus (cur: THControl): THControl;
+function TUIControl.findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
+var
+ curHit: Boolean = false;
+
+ function checkFocus (ctl: TUIControl): Boolean;
+ begin
+ if curHit then
+ begin
+ result := (ctl.canFocus);
+ end
+ else
+ begin
+ curHit := (ctl = cur);
+ result := false; // don't stop
+ end;
+ end;
+
begin
result := nil;
if enabled then
begin
- if not isMyChild(cur) then cur := nil;
- if (cur = nil) then begin result := findFirstFocus(); exit; end;
- result := cur.findFirstFocus();
- if (result <> nil) and (result <> cur) then exit;
- while true do
+ if not isMyChild(cur) then
begin
- cur := cur.nextSibling;
- if (cur = nil) then break;
- result := cur.findFirstFocus();
- if (result <> nil) then exit;
+ result := findFirstFocus();
+ end
+ else
+ begin
+ result := forEachControl(checkFocus);
+ if (result = nil) and (wrap) then result := findFirstFocus();
end;
- result := findFirstFocus();
end;
end;
-function THControl.findPrevFocus (cur: THControl): THControl;
+function TUIControl.findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
+var
+ lastCtl: TUIControl = nil;
+
+ function checkFocus (ctl: TUIControl): Boolean;
+ begin
+ if (ctl = cur) then
+ begin
+ result := true;
+ end
+ else
+ begin
+ result := false;
+ if (ctl.canFocus) then lastCtl := ctl;
+ end;
+ end;
+
begin
result := nil;
if enabled then
begin
- if not isMyChild(cur) then cur := nil;
- if (cur = nil) then begin result := findLastFocus(); exit; end;
- //FIXME!
- result := cur.findLastFocus();
- if (result <> nil) and (result <> cur) then exit;
- while true do
+ if not isMyChild(cur) then
+ begin
+ result := findLastFocus();
+ end
+ else
+ begin
+ forEachControl(checkFocus);
+ if (lastCtl = nil) and (wrap) then lastCtl := findLastFocus();
+ result := lastCtl;
+ //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
+ end;
+ end;
+end;
+
+
+function TUIControl.findDefaulControl (): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if (enabled) then
+ begin
+ if (mDefault) then begin result := self; exit; end;
+ for ctl in mChildren do
+ begin
+ result := ctl.findDefaulControl();
+ if (result <> nil) then exit;
+ end;
+ end;
+ result := nil;
+end;
+
+function TUIControl.findCancelControl (): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if (enabled) then
+ begin
+ if (mCancel) then begin result := self; exit; end;
+ for ctl in mChildren do
begin
- cur := cur.prevSibling;
- if (cur = nil) then break;
- result := cur.findLastFocus();
+ result := ctl.findCancelControl();
if (result <> nil) then exit;
end;
- result := findLastFocus();
end;
+ result := nil;
+end;
+
+
+function TUIControl.findControlById (const aid: AnsiString): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if (strEquCI1251(aid, mId)) then begin result := self; exit; end;
+ for ctl in mChildren do
+ begin
+ result := ctl.findControlById(aid);
+ if (result <> nil) then exit;
+ end;
+ result := nil;
end;
-procedure THControl.appendChild (ctl: THControl);
+procedure TUIControl.appendChild (ctl: TUIControl);
begin
if (ctl = nil) then exit;
if (ctl.mParent <> nil) then exit;
if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
end;
- if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
end;
-procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
+function TUIControl.setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB;
+var
+ ctl: TUIControl;
begin
- if not scallowed then exit;
- x := trunc(x*gh_ui_scale);
- y := trunc(y*gh_ui_scale);
- w := trunc(w*gh_ui_scale);
- h := trunc(h*gh_ui_scale);
- //y := gWinSizeY-(y+h);
- scis.setRect(x, y, w, h);
-end;
-
+ ctl := self[aid];
+ if (ctl <> nil) then
+ begin
+ result := ctl.actionCB;
+ ctl.actionCB := cb;
+ end
+ else
+ begin
+ result := nil;
+ end;
+end;
-procedure THControl.resetScissor ();
+
+function TUIControl.forEachChildren (cb: TCtlEnumCB): TUIControl;
var
- x, y: Integer;
+ ctl: TUIControl;
begin
- if not scallowed then exit;
- x := 0;
- y := 0;
- toGlobal(x, y);
- setScissorGLInternal(x, y, mWidth, mHeight);
+ result := nil;
+ if (not assigned(cb)) then exit;
+ for ctl in mChildren do
+ begin
+ if cb(ctl) then begin result := ctl; exit; end;
+ end;
+end;
+
+
+function TUIControl.forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
+
+ function forChildren (p: TUIControl; incSelf: Boolean): TUIControl;
+ var
+ ctl: TUIControl;
+ begin
+ result := nil;
+ if (p = nil) then exit;
+ if (incSelf) and (cb(p)) then begin result := p; exit; end;
+ for ctl in p.mChildren do
+ begin
+ result := forChildren(ctl, true);
+ if (result <> nil) then break;
+ end;
+ end;
+
+begin
+ result := nil;
+ if (not assigned(cb)) then exit;
+ result := forChildren(self, includeSelf);
+end;
+
+
+procedure TUIControl.close (); // this closes *top-level* control
+var
+ ctl: TUIControl;
+begin
+ ctl := topLevel;
+ uiRemoveWindow(ctl);
+ if (ctl is TUITopWindow) and (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl); // just in case
+end;
+
+
+procedure TUIControl.doAction ();
+begin
+ if assigned(actionCB) then actionCB(self);
end;
-procedure THControl.setScissor (lx, ly, lw, lh: Integer);
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIControl.setScissorGLInternal (x, y, w, h: Integer);
+begin
+ if not scallowed then exit;
+ x := trunc(x*gh_ui_scale);
+ y := trunc(y*gh_ui_scale);
+ w := trunc(w*gh_ui_scale);
+ h := trunc(h*gh_ui_scale);
+ scis.combineRect(x, y, w, h);
+end;
+
+procedure TUIControl.setScissor (lx, ly, lw, lh: Integer);
var
- x, y: Integer;
+ gx, gy, wdt, hgt, cgx, cgy: Integer;
begin
if not scallowed then exit;
- if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
- x := lx;
- y := ly;
- toGlobal(x, y);
- setScissorGLInternal(x, y, lw, lh);
+
+ if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then
+ begin
+ scis.combineRect(0, 0, 0, 0);
+ exit;
+ end;
+
+ getDrawRect(gx, gy, wdt, hgt);
+ toGlobal(lx, ly, cgx, cgy);
+ if not intersectRect(gx, gy, wdt, hgt, cgx, cgy, lw, lh) then
+ begin
+ scis.combineRect(0, 0, 0, 0);
+ exit;
+ end;
+
+ setScissorGLInternal(gx, gy, wdt, hgt);
+end;
+
+procedure TUIControl.resetScissor (fullArea: Boolean); inline;
+begin
+ if not scallowed then exit;
+ if (fullArea) then
+ begin
+ setScissor(0, 0, mWidth, mHeight);
+ end
+ else
+ begin
+ setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
+ end;
end;
-procedure THControl.draw ();
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIControl.draw ();
var
f: Integer;
- x, y: Integer;
+ gx, gy: Integer;
begin
if (mWidth < 1) or (mHeight < 1) then exit;
- x := 0;
- y := 0;
- toGlobal(x, y);
- //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
+ toGlobal(0, 0, gx, gy);
scis.save(true); // scissoring enabled
try
- //glEnable(GL_SCISSOR_TEST);
scallowed := true;
- resetScissor();
- drawControl(x, y);
- if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
+ resetScissor(true); // full area
+ drawControl(gx, gy);
+ resetScissor(false); // client area
for f := 0 to High(mChildren) do mChildren[f].draw();
- if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
- drawControlPost(x, y);
+ resetScissor(true); // full area
+ drawControlPost(gx, gy);
finally
scis.restore();
scallowed := false;
end;
end;
-
-procedure THControl.drawControl (sx, sy: Integer);
+procedure TUIControl.drawControl (gx, gy: Integer);
begin
- if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
+ //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
end;
-
-procedure THControl.drawControlPost (sx, sy: Integer);
+procedure TUIControl.drawControlPost (gx, gy: Integer);
begin
+ // shadow
if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
begin
- setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
- darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
- darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
+ setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
+ darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
+ darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
end;
end;
-function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIControl.mouseEvent (var ev: THMouseEvent);
var
- ctl: THControl;
+ ctl: TUIControl;
begin
- result := false;
- if not mEnabled then exit;
- if (mParent = nil) then
- begin
- if (mGrab <> nil) then
- begin
- result := mGrab.mouseEvent(ev);
- if (ev.release) then mGrab := nil;
- exit;
- end;
- end;
+ if (not enabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
ctl := controlAtXY(ev.x, ev.y);
- if (ctl <> nil) and (ctl <> self) then
+ if (ctl = nil) then exit;
+ if (ctl.canFocus) and (ev.press) then
begin
if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
- result := ctl.mouseEvent(ev);
- end
- else if (ctl = self) and assigned(actionCB) then
- begin
- actionCB(self, 0);
+ uiGrabCtl := ctl;
end;
+ if (ctl <> self) then ctl.mouseEvent(ev);
+ //ev.eat();
end;
-function THControl.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUIControl.keyEvent (var ev: THKeyEvent);
+
+ 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;
+
+ 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;
+
var
- ctl: THControl;
+ ctl: TUIControl;
begin
- result := false;
- if not mEnabled then exit;
- if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
+ 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
+ begin
+ // bubble keyboard event
+ ctl := topLevel.mFocused;
+ while (ctl <> nil) and (ctl <> self) do
+ begin
+ ctl.keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) then exit;
+ ctl := ctl.mParent;
+ end;
+ end;
+ // for top-level controls
if (mParent = nil) then
begin
if (ev = 'S-Tab') then
begin
- result := true;
- ctl := findPrevFocus(mFocused);
- if (ctl <> mFocused) then
- begin
- mGrab := nil;
- mFocused := ctl;
- end;
+ ctl := findPrevFocus(mFocused, true);
+ if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
+ ev.eat();
exit;
end;
if (ev = 'Tab') then
begin
- result := true;
- ctl := findNextFocus(mFocused);
- if (ctl <> mFocused) then
+ ctl := findNextFocus(mFocused, true);
+ if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
+ ev.eat();
+ exit;
+ end;
+ if (ev = 'Enter') or (ev = 'C-Enter') then
+ begin
+ ctl := findDefaulControl();
+ if (ctl <> nil) then
begin
- mGrab := nil;
- mFocused := ctl;
+ 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;
- exit;
end;
if mEscClose and (ev = 'Escape') then
begin
- result := true;
- uiRemoveWindow(self);
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ ev.eat();
exit;
end;
+ // call post-keys
+ if (ev.eaten) or (ev.cancelled) then exit;
+ forEachControl(doPostKey);
end;
- if mEatKeys then result := true;
+end;
+
+
+procedure TUIControl.keyEventPre (var ev: THKeyEvent);
+begin
+end;
+
+
+procedure TUIControl.keyEventPost (var ev: THKeyEvent);
+begin
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
+constructor TUITopWindow.Create (const atitle: AnsiString);
begin
- inherited Create(ax, ay, aw, ah, nil);
+ inherited Create();
+ mTitle := atitle;
+end;
+
+
+procedure TUITopWindow.AfterConstruction ();
+begin
+ inherited;
mFrameWidth := 8;
mFrameHeight := 8;
- mTitle := atitle;
if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
if (Length(mTitle) > 0) then
begin
if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
end;
- mDragging := false;
+ mCanFocus := false;
+ mDragScroll := TXMode.None;
mDrawShadow := true;
mWaitingClose := false;
mInClose := false;
closeCB := nil;
+ mCtl4Style := 'window';
+end;
+
+
+function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
+ begin
+ mTitle := par.expectIdOrStr(true);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'children')) then
+ begin
+ parseChildren(par);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'position')) then
+ begin
+ if (par.eatIdOrStrCI('default')) then mDoCenter := false
+ else if (par.eatIdOrStrCI('center')) then mDoCenter := true
+ else par.error('`center` or `default` expected');
+ result := true;
+ exit;
+ end;
+ if (parseOrientation(prname, par)) then begin result := true; exit; end;
+ result := inherited parseProperty(prname, par);
end;
-procedure THTopWindow.centerInScreen ();
+procedure TUITopWindow.centerInScreen ();
begin
if (mWidth > 0) and (mHeight > 0) then
begin
end;
-procedure THTopWindow.drawControl (sx, sy: Integer);
+procedure TUITopWindow.drawControl (gx, gy: Integer);
begin
- fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[getColorIndex]);
end;
-procedure THTopWindow.drawControlPost (sx, sy: Integer);
-const r = 255;
-const g = 255;
-const b = 255;
+procedure TUITopWindow.drawControlPost (gx, gy: Integer);
var
- tx: Integer;
+ cidx: Integer;
+ tx, hgt, sbhgt: Integer;
begin
- if mDragging then
+ cidx := getColorIndex;
+ if (mDragScroll = TXMode.Drag) then
begin
- drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
+ drawRectUI(gx+4, gy+4, mWidth-8, mHeight-8, mFrameColor[cidx]);
end
else
begin
- drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
- drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
+ drawRectUI(gx+3, gy+3, mWidth-6, mHeight-6, mFrameColor[cidx]);
+ drawRectUI(gx+5, gy+5, mWidth-10, mHeight-10, mFrameColor[cidx]);
+ // 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;
+ fillRect(gx+mWidth-mFrameWidth+1, gy+7, mFrameWidth-3, sbhgt, mFrameColor[cidx]);
+ 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, 7, mFrameWidth-3, sbhgt);
+ darkenRect(gx+mWidth-mFrameWidth+1, gy+7+hgt, mFrameWidth-3, sbhgt, 128);
+ end;
+ end;
+ // frame icon
setScissor(mFrameWidth, 0, 3*8, 8);
- fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
- drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
- if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
- else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
+ fillRect(gx+mFrameWidth, gy, 3*8, 8, mBackColor[cidx]);
+ drawText8(gx+mFrameWidth, gy, '[ ]', mFrameColor[cidx]);
+ if mInClose then drawText8(gx+mFrameWidth+7, gy, '#', mFrameIconColor[cidx])
+ else drawText8(gx+mFrameWidth+7, gy, '*', mFrameIconColor[cidx]);
end;
+ // title
if (Length(mTitle) > 0) then
begin
setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
- tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
- fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
- drawText8(tx, mY, mTitle, r, g, b);
+ tx := (gx+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
+ fillRect(tx-3, gy, Length(mTitle)*8+3+2, 8, mBackColor[cidx]);
+ drawText8(tx, gy, mTitle, mFrameTextColor[cidx]);
+ end;
+ // shadow
+ inherited drawControlPost(gx, gy);
+end;
+
+
+procedure TUITopWindow.activated ();
+begin
+ if (mFocused = nil) or (mFocused = self) then
+ begin
+ mFocused := findFirstFocus();
end;
- inherited drawControlPost(sx, sy);
+ if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
+ inherited;
end;
-procedure THTopWindow.blurred ();
+procedure TUITopWindow.blurred ();
begin
- mDragging := false;
+ mDragScroll := TXMode.None;
mWaitingClose := false;
mInClose := false;
+ if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
inherited;
end;
-function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
begin
- result := inherited keyEvent(ev);
- if not getFocused then exit;
+ inherited keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit;
if (ev = 'M-F3') then
begin
- uiRemoveWindow(self);
- result := true;
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ ev.eat();
exit;
end;
end;
-function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUITopWindow.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
+ hgt, sbhgt: Integer;
begin
- result := false;
- if not mEnabled then exit;
+ if (not enabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
- if mDragging then
+ if (mDragScroll = TXMode.Drag) then
begin
mX += ev.x-mDragStartX;
mY += ev.y-mDragStartY;
mDragStartX := ev.x;
mDragStartY := ev.y;
- if (ev.release) then mDragging := false;
- result := true;
+ if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
+ ev.eat();
exit;
end;
- lx := ev.x;
- ly := ev.y;
- if toLocal(lx, ly) then
+ if (mDragScroll = TXMode.Scroll) 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;
+ if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
+ ev.eat();
+ exit;
+ end;
+
+ if toLocal(ev.x, ev.y, lx, ly) then
begin
if (ev.press) then
begin
if (ly < 8) then
begin
+ uiGrabCtl := self;
if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
begin
//uiRemoveWindow(self);
end
else
begin
- mDragging := true;
+ mDragScroll := TXMode.Drag;
mDragStartX := ev.x;
mDragStartY := ev.y;
end;
- result := true;
+ ev.eat();
exit;
end;
+ // check for vertical scrollbar
+ if (lx >= mWidth-mFrameWidth+1) and (ly >= 7) and (ly < mHeight-mFrameHeight+1) then
+ 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);
+ uiGrabCtl := self;
+ mDragScroll := TXMode.Scroll;
+ ev.eat();
+ exit;
+ end;
+ end;
+ // drag
if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
begin
- mDragging := true;
+ uiGrabCtl := self;
+ mDragScroll := TXMode.Drag;
mDragStartX := ev.x;
mDragStartY := ev.y;
- result := true;
+ ev.eat();
exit;
end;
end;
if (ev.release) then
begin
- if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
+ if mWaitingClose then
begin
- uiRemoveWindow(self);
- result := true;
+ if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
+ begin
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ end;
+ mWaitingClose := false;
+ mInClose := false;
+ ev.eat();
exit;
end;
- mWaitingClose := false;
- mInClose := false;
end;
if (ev.motion) then
if mWaitingClose then
begin
mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
- result := true;
+ ev.eat();
exit;
end;
end;
+
+ inherited mouseEvent(ev);
end
else
begin
mInClose := false;
- if (not ev.motion) then mWaitingClose := false;
+ if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
end;
-
- result := inherited mouseEvent(ev);
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THCtlSimpleText.Create (ax, ay: Integer; aparent: THControl=nil);
+constructor TUIBox.Create (ahoriz: Boolean);
begin
- mItems := nil;
- inherited Create(ax, ay, 4, 4);
+ inherited Create();
+ mHoriz := ahoriz;
end;
-destructor THCtlSimpleText.Destroy ();
+procedure TUIBox.AfterConstruction ();
begin
- mItems := nil;
inherited;
+ mCanFocus := false;
+ mHAlign := -1; // left
+ mCtl4Style := 'box';
end;
-procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
-var
- it: PItem;
+procedure TUIBox.setCaption (const acap: AnsiString);
+begin
+ mCaption := acap;
+ mDefSize := TLaySize.Create(Length(mCaption)*8+3, 8);
+end;
+
+
+procedure TUIBox.setHasFrame (v: Boolean);
+begin
+ mHasFrame := v;
+ if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
+end;
+
+
+function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
begin
- if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
- SetLength(mItems, Length(mItems)+1);
- it := @mItems[High(mItems)];
- it.title := atext;
- it.centered := acentered;
- it.hline := ahline;
- if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
+ if (parseOrientation(prname, par)) then begin result := true; exit; end;
+ if (strEquCI1251(prname, 'frame')) then
+ begin
+ setHasFrame(parseBool(par));
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
+ begin
+ setCaption(par.expectIdOrStr(true));
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
+ begin
+ mHAlign := parseHAlign(par);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'children')) then
+ begin
+ parseChildren(par);
+ result := true;
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
end;
-procedure THCtlSimpleText.drawControl (sx, sy: Integer);
+procedure TUIBox.drawControl (gx, gy: Integer);
var
- f, tx: Integer;
- it: PItem;
- r, g, b: Integer;
-begin
- for f := 0 to High(mItems) do
- begin
- it := @mItems[f];
- tx := sx;
- r := 255;
- g := 255;
- b := 0;
- if it.centered then begin b := 255; tx := sx+(mWidth-Length(it.title)*8) div 2; end;
- if it.hline then
- begin
- b := 255;
- if (Length(it.title) = 0) then
- begin
- drawHLine(sx+4, sy+3, mWidth-8, r, g, b);
- end
- else if (tx-3 > sx+4) then
- begin
- drawHLine(sx+4, sy+3, tx-3-(sx+3), r, g, b);
- drawHLine(tx+Length(it.title)*8, sy+3, mWidth-4, r, g, b);
- end;
- end;
- drawText8(tx, sy, it.title, r, g, b);
- Inc(sy, 8);
+ cidx: Integer;
+ xpos: Integer;
+begin
+ cidx := getColorIndex;
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+ if mHasFrame then
+ begin
+ // draw frame
+ drawRectUI(gx+3, gy+3, mWidth-6, mHeight-6, mFrameColor[cidx]);
+ end;
+ // draw caption
+ if (Length(mCaption) > 0) then
+ begin
+ if (mHAlign < 0) then xpos := 3
+ else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-Length(mCaption)*8
+ else xpos := (mWidth-mFrameWidth*2-Length(mCaption)*8) div 2;
+ xpos += gx+mFrameWidth;
+
+ setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
+ if mHasFrame then fillRect(xpos-3, gy, Length(mCaption)*8+4, 8, mBackColor[cidx]);
+ drawText8(xpos, gy, mCaption, mFrameTextColor[cidx]);
end;
end;
-function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUIBox.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
- result := inherited mouseEvent(ev);
- lx := ev.x;
- ly := ev.y;
- if not result and toLocal(lx, ly) then
+ inherited mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
- result := true;
+ ev.eat();
end;
end;
-function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUIBox.keyEvent (var ev: THKeyEvent);
+var
+ dir: Integer = 0;
+ cur, ctl: TUIControl;
begin
- result := inherited keyEvent(ev);
+ inherited keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) 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
+ else if (not mHoriz) and (ev = 'Up') then dir := -1
+ else if (not mHoriz) and (ev = 'Down') then dir := 1;
+ if (dir = 0) then exit;
+ ev.eat();
+ cur := topLevel.mFocused;
+ while (cur <> nil) and (cur.mParent <> self) do cur := cur.mParent;
+ //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
+ if (dir < 0) then ctl := findPrevFocus(cur, true) else ctl := findNextFocus(cur, true);
+ //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
+ if (ctl <> nil) and (ctl <> self) then
+ begin
+ ctl.focused := true;
+ end;
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
+constructor TUIHBox.Create ();
begin
- mItems := nil;
- mCurIndex := -1;
- inherited Create(ax, ay, 4, 4);
end;
-destructor THCtlCBListBox.Destroy ();
+procedure TUIHBox.AfterConstruction ();
begin
- mItems := nil;
inherited;
+ mHoriz := true;
end;
-procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
-var
- it: PItem;
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TUIVBox.Create ();
begin
- if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
- SetLength(mItems, Length(mItems)+1);
- it := @mItems[High(mItems)];
- it.title := atext;
- it.varp := bv;
- it.actionCB := aaction;
- if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
- if (mCurIndex < 0) then mCurIndex := 0;
end;
-procedure THCtlCBListBox.drawControl (sx, sy: Integer);
-var
- f, tx: Integer;
- it: PItem;
+procedure TUIVBox.AfterConstruction ();
begin
- for f := 0 to High(mItems) do
- begin
- it := @mItems[f];
- if (mCurIndex = f) then fillRect(sx, sy, mWidth, 8, 0, 128, 0);
- if (it.varp <> nil) then
- begin
- if it.varp^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
- drawText8(sx+3*8+2, sy, it.title, 255, 255, 0);
- end
- else if (Length(it.title) > 0) then
- begin
- tx := sx+(mWidth-Length(it.title)*8) div 2;
- if (tx-3 > sx+4) then
- begin
- drawHLine(sx+4, sy+3, tx-3-(sx+3), 255, 255, 255);
- drawHLine(tx+Length(it.title)*8, sy+3, mWidth-4, 255, 255, 255);
- end;
- drawText8(tx, sy, it.title, 255, 255, 255);
- end
- else
- begin
- drawHLine(sx+4, sy+3, mWidth-8, 255, 255, 255);
- end;
- Inc(sy, 8);
- end;
+ inherited;
+ mHoriz := false;
+ writeln('VBOX: ', canFocus, ':', enabled);
end;
-function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
-var
- lx, ly: Integer;
- it: PItem;
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUISpan.AfterConstruction ();
begin
- result := inherited mouseEvent(ev);
- lx := ev.x;
- ly := ev.y;
- if not result and toLocal(lx, ly) then
- begin
- result := true;
- if (ev = 'lmb') then
- begin
- ly := ly div 8;
- if (ly >= 0) and (ly < Length(mItems)) then
- begin
- it := @mItems[ly];
- if (it.varp <> nil) then
- begin
- mCurIndex := ly;
- it.varp^ := not it.varp^;
- if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
- if assigned(actionCB) then actionCB(self, ly);
- end;
- end;
- end;
- end;
+ inherited;
+ mExpand := true;
+ mCanFocus := false;
+ mCtl4Style := 'span';
end;
-function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
-var
- it: PItem;
+function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
begin
- result := inherited keyEvent(ev);
- if not getFocused then exit;
- //result := true;
- if (ev = 'Home') or (ev = 'PageUp') then
- begin
- result := true;
- mCurIndex := 0;
- end;
- if (ev = 'End') or (ev = 'PageDown') then
- begin
- result := true;
- mCurIndex := High(mItems);
+ if (parseOrientation(prname, par)) then begin result := true; exit; end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure TUISpan.drawControl (gx, gy: Integer);
+begin
+end;
+
+
+// ////////////////////////////////////////////////////////////////////// //
+procedure TUILine.AfterConstruction ();
+begin
+ inherited;
+ mCanFocus := false;
+ mExpand := true;
+ mCanFocus := false;
+ mCtl4Style := 'line';
+end;
+
+
+function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (parseOrientation(prname, par)) then begin result := true; exit; end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure TUILine.drawControl (gx, gy: Integer);
+var
+ cidx: Integer;
+begin
+ cidx := getColorIndex;
+ if mHoriz then
+ begin
+ drawHLine(gx, gy+(mHeight div 2), mWidth, mTextColor[cidx]);
+ end
+ else
+ begin
+ drawVLine(gx+(mWidth div 2), gy, mHeight, mTextColor[cidx]);
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIHLine.AfterConstruction ();
+begin
+ inherited;
+ mHoriz := true;
+ mDefSize.h := 7;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIVLine.AfterConstruction ();
+begin
+ inherited;
+ mHoriz := false;
+ mDefSize.w := 7;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIStaticText.AfterConstruction ();
+begin
+ inherited;
+ mCanFocus := false;
+ mHAlign := -1;
+ mVAlign := 0;
+ mHoriz := true; // nobody cares
+ mHeader := false;
+ mLine := false;
+ mDefSize.h := 8;
+ mCtl4Style := 'static';
+end;
+
+
+procedure TUIStaticText.setText (const atext: AnsiString);
+begin
+ mText := atext;
+ mDefSize := TLaySize.Create(Length(mText)*8, 8);
+end;
+
+
+function TUIStaticText.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
+ begin
+ setText(par.expectIdOrStr(true));
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
+ begin
+ parseTextAlign(par, mHAlign, mVAlign);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'header')) then
+ begin
+ mHeader := true;
+ result := true;
+ exit;
end;
- if (ev = 'Up') then
+ if (strEquCI1251(prname, 'line')) then
begin
+ mLine := true;
result := true;
- if (Length(mItems) > 0) then
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure TUIStaticText.drawControl (gx, gy: Integer);
+var
+ xpos, ypos: Integer;
+ cidx: Integer;
+ clr: TGxRGBA;
+begin
+ cidx := getColorIndex;
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
+ else xpos := (mWidth-Length(mText)*8) div 2;
+
+ if (Length(mText) > 0) then
+ begin
+ if (mHeader) then clr := mFrameTextColor[cidx] else clr := mTextColor[cidx];
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+ drawText8(gx+xpos, gy+ypos, mText, clr);
+ end;
+
+ if (mLine) then
+ begin
+ if (mHeader) then clr := mFrameColor[cidx] else clr := mTextColor[cidx];
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-1
+ else ypos := (mHeight div 2);
+ ypos += gy;
+
+ if (Length(mText) = 0) then
+ begin
+ drawHLine(gx, ypos, mWidth, clr);
+ end
+ else
+ begin
+ drawHLine(gx, ypos, xpos-1, clr);
+ drawHLine(gx+xpos+Length(mText)*8, ypos, mWidth, clr);
+ end;
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUITextLabel.AfterConstruction ();
+begin
+ inherited;
+ mHAlign := -1;
+ mVAlign := 0;
+ mCanFocus := false;
+ mDefSize := TLaySize.Create(Length(mText)*8, 8);
+ mCtl4Style := 'label';
+ mLinkId := '';
+end;
+
+
+procedure TUITextLabel.cacheStyle (root: TUIStyle);
+begin
+ inherited cacheStyle(root);
+ // active
+ mHotColor[ClrIdxActive] := root.get('hot-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
+ // disabled
+ mHotColor[ClrIdxDisabled] := root.get('hot-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
+ // inactive
+ mHotColor[ClrIdxInactive] := root.get('hot-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
+end;
+
+
+procedure TUITextLabel.setText (const s: AnsiString);
+var
+ f: Integer;
+begin
+ mText := '';
+ mHotChar := #0;
+ mHotOfs := 0;
+ f := 1;
+ while (f <= Length(s)) do
+ begin
+ if (s[f] = '\\') then
+ begin
+ Inc(f);
+ if (f <= Length(s)) then mText += s[f];
+ Inc(f);
+ end
+ else if (s[f] = '~') then
begin
- if (mCurIndex < 0) then mCurIndex := Length(mItems);
- while (mCurIndex > 0) do
+ Inc(f);
+ if (f <= Length(s)) then
begin
- Dec(mCurIndex);
- if (mItems[mCurIndex].varp <> nil) then break;
+ if (mHotChar = #0) then
+ begin
+ mHotChar := s[f];
+ mHotOfs := Length(mText)*8;
+ end;
+ mText += s[f];
end;
+ Inc(f);
end
else
begin
- mCurIndex := -1;
+ mText += s[f];
+ Inc(f);
end;
end;
- if (ev = 'Down') then
+ mDefSize := TLaySize.Create(Length(mText)*8, 8);
+end;
+
+
+function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
+ begin
+ setText(par.expectIdOrStr(true));
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'link')) then
+ begin
+ mLinkId := par.expectIdOrStr(true);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
begin
+ parseTextAlign(par, mHAlign, mVAlign);
result := true;
- if (Length(mItems) > 0) then
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure TUITextLabel.drawControl (gx, gy: Integer);
+var
+ xpos, ypos: Integer;
+ cidx: Integer;
+begin
+ cidx := getColorIndex;
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+ if (Length(mText) > 0) then
+ begin
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
+ else xpos := (mWidth-Length(mText)*8) div 2;
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+ drawText8(gx+xpos, gy+ypos, mText, mTextColor[cidx]);
+
+ if (Length(mLinkId) > 0) and (mHotChar <> #0) and (mHotChar <> ' ') then
begin
- if (mCurIndex < 0) then mCurIndex := -1;
- while (mCurIndex < High(mItems)) do
- begin
- Inc(mCurIndex);
- if (mItems[mCurIndex].varp <> nil) then break;
- end;
+ drawText8(gx+xpos+8+mHotOfs, gy+ypos, mHotChar, mHotColor[cidx]);
+ end;
+ end;
+end;
+
+
+procedure TUITextLabel.mouseEvent (var ev: THMouseEvent);
+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
+ begin
+ ev.eat();
+ end;
+end;
+
+
+procedure TUITextLabel.keyEventPost (var ev: THKeyEvent);
+var
+ ctl: TUIControl;
+begin
+ if (not enabled) then exit;
+ if (mHotChar = #0) or (Length(mLinkId) = 0) then exit;
+ if (ev.eaten) or (ev.cancelled) or (not ev.press) then exit;
+ if (not ev.isHot(mHotChar)) then exit;
+ ctl := topLevel[mLinkId];
+ if (ctl <> nil) then
+ begin
+ ev.eat();
+ if (ctl.canFocus) then ctl.focused := true;
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIButton.AfterConstruction ();
+begin
+ inherited;
+ mHAlign := -1;
+ mVAlign := 0;
+ mCanFocus := true;
+ mDefSize := TLaySize.Create(Length(mText)*8+8, 10);
+ mCtl4Style := 'button';
+end;
+
+
+procedure TUIButton.setText (const s: AnsiString);
+begin
+ inherited setText(s);
+ mDefSize := TLaySize.Create(Length(mText)*8+8*2, 10);
+end;
+
+
+procedure TUIButton.drawControl (gx, gy: Integer);
+var
+ xpos, ypos: Integer;
+ cidx: Integer;
+begin
+ cidx := getColorIndex;
+
+ fillRect(gx+1, gy, mWidth-2, mHeight, mBackColor[cidx]);
+ fillRect(gx, gy+1, 1, mHeight-2, mBackColor[cidx]);
+ fillRect(gx+mWidth-1, gy+1, 1, mHeight-2, mBackColor[cidx]);
+
+ if (Length(mText) > 0) then
+ begin
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
+ else xpos := (mWidth-Length(mText)*8) div 2;
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+ setScissor(8, 0, mWidth-16, mHeight);
+ drawText8(gx+xpos+8, gy+ypos, mText, mTextColor[cidx]);
+
+ if (mHotChar <> #0) and (mHotChar <> ' ') then drawText8(gx+xpos+8+mHotOfs, gy+ypos, mHotChar, mHotColor[cidx]);
+ end;
+end;
+
+
+procedure TUIButton.mouseEvent (var ev: THMouseEvent);
+var
+ lx, ly: Integer;
+begin
+ inherited mouseEvent(ev);
+ if (uiGrabCtl = self) then
+ begin
+ ev.eat();
+ if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
+ begin
+ doAction();
+ end;
+ exit;
+ end;
+ if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
+ ev.eat();
+end;
+
+
+procedure TUIButton.keyEvent (var ev: THKeyEvent);
+begin
+ inherited keyEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) then
+ begin
+ if (ev = 'Enter') or (ev = 'Space') then
+ begin
+ ev.eat();
+ doAction();
+ exit;
+ end;
+ end;
+end;
+
+
+procedure TUIButton.keyEventPost (var ev: THKeyEvent);
+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.isHot(mHotChar)) then exit;
+ if (not canFocus) then exit;
+ ev.eat();
+ focused := true;
+ doAction();
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUISwitchBox.AfterConstruction ();
+begin
+ inherited;
+ mHAlign := -1;
+ mVAlign := 0;
+ mCanFocus := true;
+ mDefSize := TLaySize.Create(Length(mText)*8+8*3, 8);
+ mCtl4Style := 'switchbox';
+ mChecked := false;
+ mBoolVar := @mChecked;
+end;
+
+
+procedure TUISwitchBox.cacheStyle (root: TUIStyle);
+begin
+ inherited cacheStyle(root);
+ // active
+ mSwitchColor[ClrIdxActive] := root.get('switch-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
+ // disabled
+ mSwitchColor[ClrIdxDisabled] := root.get('switch-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
+ // inactive
+ mSwitchColor[ClrIdxInactive] := root.get('switch-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
+end;
+
+
+procedure TUISwitchBox.setText (const s: AnsiString);
+begin
+ inherited setText(s);
+ mDefSize := TLaySize.Create(Length(mText)*8+8*3, 8);
+end;
+
+
+function TUISwitchBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'checked')) then
+ begin
+ result := true;
+ setChecked(true);
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+function TUISwitchBox.getChecked (): Boolean;
+begin
+ if (mBoolVar <> nil) then result := mBoolVar^ else result := false;
+end;
+
+
+procedure TUISwitchBox.setVar (pvar: PBoolean);
+begin
+ if (pvar = nil) then pvar := @mChecked;
+ if (pvar <> mBoolVar) then
+ begin
+ mBoolVar := pvar;
+ setChecked(mBoolVar^);
+ end;
+end;
+
+
+procedure TUISwitchBox.drawControl (gx, gy: Integer);
+var
+ xpos, ypos: Integer;
+ cidx: Integer;
+begin
+ cidx := getColorIndex;
+
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-(Length(mText)+4)*8
+ else xpos := (mWidth-(Length(mText)+4)*8) div 2;
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+
+ if (checked) then
+ begin
+ if (Length(mCheckedStr) <> 3) or (mCheckedStr[2] <> '*') then
+ begin
+ drawText8(gx+xpos, gy+ypos, mCheckedStr, mSwitchColor[cidx]);
end
else
begin
- mCurIndex := -1;
+ drawText8(gx+xpos, gy+ypos, mCheckedStr[1], mSwitchColor[cidx]);
+ drawText8(gx+xpos+2*8, gy+ypos, mCheckedStr[3], mSwitchColor[cidx]);
+ drawText8(gx+xpos+7, gy+ypos, '*', mSwitchColor[cidx]);
+ end;
+ end
+ else
+ begin
+ drawText8(gx+xpos, gy+ypos, mUncheckedStr, mSwitchColor[cidx]);
+ end;
+
+ drawText8(gx+xpos+8*3, gy+ypos, mText, mTextColor[cidx]);
+
+ if (mHotChar <> #0) and (mHotChar <> ' ') then drawText8(gx+xpos+8*3+mHotOfs, gy+ypos, mHotChar, mHotColor[cidx]);
+end;
+
+
+procedure TUISwitchBox.mouseEvent (var ev: THMouseEvent);
+var
+ lx, ly: Integer;
+begin
+ inherited mouseEvent(ev);
+ if (uiGrabCtl = self) then
+ begin
+ ev.eat();
+ if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
+ begin
+ doAction();
+ end;
+ exit;
+ end;
+ if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
+ ev.eat();
+end;
+
+
+procedure TUISwitchBox.keyEvent (var ev: THKeyEvent);
+begin
+ inherited keyEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) then
+ begin
+ if (ev = 'Space') then
+ begin
+ ev.eat();
+ doAction();
+ exit;
end;
end;
- if (ev = 'Space') or (ev = 'Enter') then
+end;
+
+
+procedure TUISwitchBox.keyEventPost (var ev: THKeyEvent);
+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.isHot(mHotChar)) then exit;
+ if (not canFocus) then exit;
+ ev.eat();
+ focused := true;
+ doAction();
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUICheckBox.AfterConstruction ();
+begin
+ inherited;
+ mChecked := false;
+ mBoolVar := @mChecked;
+ mCheckedStr := '[x]';
+ mUncheckedStr := '[ ]';
+end;
+
+
+procedure TUICheckBox.setChecked (v: Boolean);
+begin
+ mBoolVar^ := v;
+end;
+
+
+procedure TUICheckBox.doAction ();
+begin
+ if (assigned(actionCB)) then
+ begin
+ actionCB(self);
+ end
+ else
+ begin
+ setChecked(not getChecked);
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TUIRadioBox.AfterConstruction ();
+begin
+ inherited;
+ mChecked := false;
+ mBoolVar := @mChecked;
+ mCheckedStr := '(*)';
+ mUncheckedStr := '( )';
+ mRadioGroup := '';
+end;
+
+
+function TUIRadioBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'group')) then
+ begin
+ mRadioGroup := par.expectIdOrStr(true);
+ if (getChecked) then setChecked(true);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'checked')) then
begin
result := true;
- if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
+ setChecked(true);
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure TUIRadioBox.setChecked (v: Boolean);
+
+ function resetGroup (ctl: TUIControl): Boolean;
+ begin
+ result := false;
+ if (ctl <> self) and (ctl is TUIRadioBox) and (TUIRadioBox(ctl).mRadioGroup = mRadioGroup) then
begin
- it := @mItems[mCurIndex];
- it.varp^ := not it.varp^;
- if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
- if assigned(actionCB) then actionCB(self, mCurIndex);
+ TUIRadioBox(ctl).mBoolVar^ := false;
end;
end;
+
+begin
+ mBoolVar^ := v;
+ if v then topLevel.forEachControl(resetGroup);
+end;
+
+
+procedure TUIRadioBox.doAction ();
+begin
+ if (assigned(actionCB)) then
+ begin
+ actionCB(self);
+ end
+ else
+ begin
+ setChecked(true);
+ end;
end;
+// ////////////////////////////////////////////////////////////////////////// //
+initialization
+ registerCtlClass(TUIHBox, 'hbox');
+ registerCtlClass(TUIVBox, 'vbox');
+ registerCtlClass(TUISpan, 'span');
+ registerCtlClass(TUIHLine, 'hline');
+ registerCtlClass(TUIVLine, 'vline');
+ registerCtlClass(TUITextLabel, 'label');
+ registerCtlClass(TUIStaticText, 'static');
+ registerCtlClass(TUIButton, 'button');
+ registerCtlClass(TUICheckBox, 'checkbox');
+ registerCtlClass(TUIRadioBox, 'radiobox');
end.