summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 34282db)
raw | patch | inline | side by side (parent: 34282db)
| author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Sat, 30 Sep 2017 21:24:41 +0000 (00:24 +0300) | ||
| committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Mon, 2 Oct 2017 23:34:41 +0000 (02:34 +0300) |
| src/game/g_holmes.pas | patch | blob | history | |
| src/gx/gh_ui.pas | patch | blob | history | |
| src/gx/gh_ui_style.pas | patch | blob | history |
diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas
index b47011af62e2516f986d9e48794430de986f9bc5..d27dea1dbb0d53fc832727c7544db9aad78dcc23 100644 (file)
--- a/src/game/g_holmes.pas
+++ b/src/game/g_holmes.pas
procedure createOutlinesWindow (); forward;
-procedure toggleLayersWindowCB (me: TUIControl; checked: Integer);
+procedure toggleLayersWindowCB (me: TUIControl);
begin
+ showLayersWindow := not showLayersWindow;
if showLayersWindow then
begin
if (winLayers = nil) then createLayersWindow();
end;
end;
-
-procedure toggleOutlineWindowCB (me: TUIControl; checked: Integer);
+procedure toggleOutlineWindowCB (me: TUIControl);
begin
+ showOutlineWindow := not showOutlineWindow;
if showOutlineWindow then
begin
if (winOutlines = nil) then createOutlinesWindow();
s: AnsiString;
}
begin
- winHelp := TUITopWindow.Create('Holmes Help', 10, 10);
+ winHelp := TUITopWindow.Create('Holmes Help');
winHelp.escClose := true;
winHelp.flHoriz := false;
end;
-procedure winLayersClosed (me: TUIControl; dummy: Integer); begin showLayersWindow := false; end;
-procedure winOutlinesClosed (me: TUIControl; dummy: Integer); begin showOutlineWindow := false; end;
+procedure winLayersClosed (me: TUIControl); begin showLayersWindow := false; end;
+procedure winOutlinesClosed (me: TUIControl); begin showOutlineWindow := false; end;
+
+procedure addCheckBox (parent: TUIControl; const text: AnsiString; pvar: PBoolean);
+var
+ cb: TUICheckBox;
+begin
+ cb := TUICheckBox.Create();
+ cb.flExpand := true;
+ cb.setVar(pvar);
+ cb.text := text;
+ parent.appendChild(cb);
+end;
+
+procedure addButton (parent: TUIControl; const text: AnsiString; cb: TUIControl.TActionCB);
+var
+ but: TUIButton;
+begin
+ but := TUIButton.Create();
+ //but.flExpand := true;
+ but.actionCB := cb;
+ but.text := text;
+ parent.appendChild(but);
+end;
+
procedure createLayersWindow ();
var
- llb: TUICBListBox;
+ box: TUIVBox;
begin
- llb := TUICBListBox.Create(0, 0);
- llb.appendItem('background', @g_rlayer_back);
- llb.appendItem('steps', @g_rlayer_step);
- llb.appendItem('walls', @g_rlayer_wall);
- llb.appendItem('doors', @g_rlayer_door);
- llb.appendItem('acid1', @g_rlayer_acid1);
- llb.appendItem('acid2', @g_rlayer_acid2);
- llb.appendItem('water', @g_rlayer_water);
- llb.appendItem('foreground', @g_rlayer_fore);
- winLayers := TUITopWindow.Create('layers', 10, 10);
+ winLayers := TUITopWindow.Create('layers');
+ winLayers.x0 := 10;
+ winLayers.y0 := 10;
+ winLayers.flHoriz := false;
winLayers.escClose := true;
- winLayers.appendChild(llb);
winLayers.closeCB := winLayersClosed;
+
+ box := TUIVBox.Create();
+ addCheckBox(box, '~background', @g_rlayer_back);
+ addCheckBox(box, '~steps', @g_rlayer_step);
+ addCheckBox(box, '~walls', @g_rlayer_wall);
+ addCheckBox(box, '~doors', @g_rlayer_door);
+ addCheckBox(box, 'acid~1', @g_rlayer_acid1);
+ addCheckBox(box, 'acid~2', @g_rlayer_acid2);
+ addCheckBox(box, 'wate~r', @g_rlayer_water);
+ addCheckBox(box, '~foreground', @g_rlayer_fore);
+ winLayers.appendChild(box);
+
+ uiLayoutCtl(winLayers);
end;
procedure createOutlinesWindow ();
var
- llb: TUICBListBox;
+ box: TUIVBox;
begin
- llb := TUICBListBox.Create(0, 0);
- llb.appendItem('background', @g_ol_rlayer_back);
- llb.appendItem('steps', @g_ol_rlayer_step);
- llb.appendItem('walls', @g_ol_rlayer_wall);
- llb.appendItem('doors', @g_ol_rlayer_door);
- llb.appendItem('acid1', @g_ol_rlayer_acid1);
- llb.appendItem('acid2', @g_ol_rlayer_acid2);
- llb.appendItem('water', @g_ol_rlayer_water);
- llb.appendItem('foreground', @g_ol_rlayer_fore);
- llb.appendItem('OPTIONS', nil);
- llb.appendItem('fill walls', @g_ol_fill_walls);
- llb.appendItem('contours', @g_ol_nice);
- winOutlines := TUITopWindow.Create('outlines', 100, 10);
+ winOutlines := TUITopWindow.Create('outlines');
+ winOutlines.x0 := 100;
+ winOutlines.y0 := 30;
+ winOutlines.flHoriz := false;
winOutlines.escClose := true;
- winOutlines.appendChild(llb);
winOutlines.closeCB := winOutlinesClosed;
+
+ box := TUIVBox.Create();
+ box.hasFrame := true;
+ box.caption := 'layers';
+ addCheckBox(box, '~background', @g_ol_rlayer_back);
+ addCheckBox(box, '~steps', @g_ol_rlayer_step);
+ addCheckBox(box, '~walls', @g_ol_rlayer_wall);
+ addCheckBox(box, '~doors', @g_ol_rlayer_door);
+ addCheckBox(box, 'acid~1', @g_ol_rlayer_acid1);
+ addCheckBox(box, 'acid~2', @g_ol_rlayer_acid2);
+ addCheckBox(box, 'wate~r', @g_ol_rlayer_water);
+ addCheckBox(box, '~foreground', @g_ol_rlayer_fore);
+ winOutlines.appendChild(box);
+
+ box := TUIVBox.Create();
+ box.hasFrame := true;
+ box.caption := 'options';
+ addCheckBox(box, 'fi~ll walls', @g_ol_fill_walls);
+ addCheckBox(box, 'con~tours', @g_ol_nice);
+ winOutlines.appendChild(box);
+
+ uiLayoutCtl(winOutlines);
end;
procedure createOptionsWindow ();
var
- llb: TUICBListBox;
+ box: TUIBox;
+ span: TUISpan;
begin
- llb := TUICBListBox.Create(0, 0);
- llb.appendItem('map grid', @showGrid);
- llb.appendItem('cursor position on map', @showMapCurPos);
- llb.appendItem('monster info', @showMonsInfo);
- llb.appendItem('monster LOS to player', @showMonsLOS2Plr);
- llb.appendItem('monster cells (SLOW!)', @showAllMonsCells);
- llb.appendItem('draw triggers (SLOW!)', @showTriggers);
- llb.appendItem('WINDOWS', nil);
- llb.appendItem('layers window', @showLayersWindow, toggleLayersWindowCB);
- llb.appendItem('outline window', @showOutlineWindow, toggleOutlineWindowCB);
- winOptions := TUITopWindow.Create('Holmes Options', 100, 100);
+ winOptions := TUITopWindow.Create('Holmes Options');
+ winOptions.flHoriz := false;
winOptions.escClose := true;
- winOptions.appendChild(llb);
+
+ box := TUIVBox.Create();
+ box.hasFrame := true;
+ box.caption := 'visual';
+ addCheckBox(box, 'map ~grid', @showGrid);
+ addCheckBox(box, 'cursor ~position on map', @showMapCurPos);
+ addCheckBox(box, '~monster info', @showMonsInfo);
+ addCheckBox(box, 'monster LO~S to player', @showMonsLOS2Plr);
+ addCheckBox(box, 'monster ~cells (SLOW!)', @showAllMonsCells);
+ addCheckBox(box, 'draw ~triggers (SLOW!)', @showTriggers);
+ winOptions.appendChild(box);
+
+ box := TUIHBox.Create();
+ box.hasFrame := true;
+ box.caption := 'windows';
+ box.flAlign := 0;
+ addButton(box, '~layers', toggleLayersWindowCB);
+ span := TUISpan.Create();
+ span.flExpand := true;
+ span.flDefaultSize := TLaySize.Create(4, 1);
+ box.appendChild(span);
+ addButton(box, '~outline', toggleOutlineWindowCB);
+ winOptions.appendChild(box);
+
+ uiLayoutCtl(winOptions);
winOptions.centerInScreen();
end;
procedure toggleLayersWindow (arg: Integer=-1);
begin
if (arg < 0) then showLayersWindow := not showLayersWindow else showLayersWindow := (arg > 0);
- toggleLayersWindowCB(nil, 0);
+ showLayersWindow := not showLayersWindow; // hack for callback
+ toggleLayersWindowCB(nil);
end;
procedure toggleOutlineWindow (arg: Integer=-1);
begin
if (arg < 0) then showOutlineWindow := not showOutlineWindow else showOutlineWindow := (arg > 0);
- toggleOutlineWindowCB(nil, 0);
+ showOutlineWindow := not showOutlineWindow; // hack for callback
+ toggleOutlineWindowCB(nil);
end;
procedure toggleHelpWindow (arg: Integer=-1);
diff --git a/src/gx/gh_ui.pas b/src/gx/gh_ui.pas
index ef68af5fe5efd3c7a710faa5336bab7c0beb97e8..72008e0233a0cfe8d88b1360e95de059bf0229f7 100644 (file)
--- a/src/gx/gh_ui.pas
+++ b/src/gx/gh_ui.pas
TUIControl = class
public
- type TActionCB = procedure (me: TUIControl; uinfo: Integer);
+ 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
function findFirstFocus (): TUIControl;
function findLastFocus (): TUIControl;
- function findNextFocus (cur: TUIControl): TUIControl;
- function findPrevFocus (cur: TUIControl): TUIControl;
+ function findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
+ function findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
function findCancelControl (): TUIControl;
function findDefaulControl (): TUIControl;
public
constructor Create ();
- constructor Create (ax, ay, aw, ah: Integer);
destructor Destroy (); override;
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
// `sx` and `sy` are screen coordinates
procedure drawControl (gx, gy: Integer); virtual;
function parentScrollX (): Integer; inline;
function parentScrollY (): Integer; inline;
+ procedure makeVisibleInParent ();
+
procedure doAction (); virtual; // so user controls can override it
procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten
property styleId: AnsiString read mStyleId;
property scrollX: Integer read mScrollX write mScrollX;
property scrollY: Integer read mScrollY write mScrollY;
- property x0: Integer read mX;
- property y0: Integer read mY;
- property height: Integer read mHeight;
- property width: Integer read mWidth;
+ 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: TUIControl read mParent;
property focused: Boolean read getFocused write setFocused;
mFreeOnClose: Boolean; // default: false
mDoCenter: Boolean; // after layouting
- protected
- procedure cacheStyle (root: TUIStyle); override;
-
protected
procedure activated (); override;
procedure blurred (); override;
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
property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
end;
- // ////////////////////////////////////////////////////////////////////// //
- TUISimpleText = class(TUIControl)
- private
- type
- PItem = ^TItem;
- TItem = record
- title: AnsiString;
- centered: Boolean;
- hline: Boolean;
- end;
-
- private
- mItems: array of TItem;
-
- public
- constructor Create (ax, ay: Integer);
- 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);
-
- procedure drawControl (gx, gy: Integer); override;
-
- procedure mouseEvent (var ev: THMouseEvent); override;
- end;
-
- TUICBListBox = class(TUIControl)
- private
- type
- PItem = ^TItem;
- TItem = record
- title: AnsiString;
- varp: PBoolean;
- actionCB: TActionCB;
- end;
-
- private
- mItems: array of TItem;
- mCurIndex: Integer;
- mCurItemBack: array[0..ClrIdxMax] of TGxRGBA;
-
- protected
- procedure cacheStyle (root: TUIStyle); override;
-
- public
- constructor Create (ax, ay: Integer);
- 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);
-
- procedure drawControl (gx, gy: Integer); override;
-
- procedure mouseEvent (var ev: THMouseEvent); override;
- procedure keyEvent (var ev: THKeyEvent); override;
- 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 keyEvent (var ev: THKeyEvent); override;
public
- property caption: AnsiString read mCaption write mCaption;
- property hasFrame: Boolean read mHasFrame write mHasFrame;
+ property caption: AnsiString read mCaption write setCaption;
+ property hasFrame: Boolean read mHasFrame write setHasFrame;
end;
TUIHBox = class(TUIBox)
protected
procedure cacheStyle (root: TUIStyle); override;
- procedure setText (const s: AnsiString);
+ procedure setText (const s: AnsiString); virtual;
public
procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
// ////////////////////////////////////////////////////////////////////// //
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
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
+ mRadioGroup: AnsiString;
+
+ protected
+ procedure setChecked (v: Boolean); override;
+
+ public
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
+
+ procedure doAction (); override;
+
+ public
+ property radioGroup: AnsiString read mRadioGroup write mRadioGroup; //FIXME
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;
ev.eat();
exit;
end;
- if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].mEnabled) then uiTopList[High(uiTopList)].mouseEvent(ev);
+ 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
for f := High(uiTopList) downto 0 do
begin
if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
begin
- if (uiTopList[f].mEnabled) and (f <> High(uiTopList)) then
+ if (uiTopList[f].enabled) and (f <> High(uiTopList)) then
begin
uiTopList[High(uiTopList)].blurred();
ctmp := uiTopList[f];
ev.x := trunc(ev.x/gh_ui_scale);
ev.y := trunc(ev.y/gh_ui_scale);
try
- if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].mEnabled) then uiTopList[High(uiTopList)].keyEvent(ev);
+ 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();
begin
ctl := uiTopList[f];
ctl.draw();
- cidx := ctl.getColorIndex;
- //if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
- if (ctl.mDarken[cidx] > 0) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, ctl.mDarken[cidx]);
+ 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
gxEndUIDraw();
if (ctl is TUITopWindow) then
begin
try
- if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl, 0);
+ if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl);
finally
if (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl);
end;
// ////////////////////////////////////////////////////////////////////////// //
constructor TUIControl.Create ();
begin
+end;
+
+
+procedure TUIControl.AfterConstruction ();
+begin
+ inherited;
mParent := nil;
mId := '';
mX := 0;
end;
-constructor TUIControl.Create (ax, ay, aw, ah: Integer);
-begin
- Create();
- mX := ax;
- mY := ay;
- mWidth := aw;
- mHeight := ah;
-end;
-
-
destructor TUIControl.Destroy ();
var
f, c: Integer;
function TUIControl.getColorIndex (): Integer; inline;
begin
- if (not mEnabled) then begin result := ClrIdxDisabled; exit; end;
- // 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;
+ 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.activated ();
begin
+ makeVisibleInParent();
end;
tl: TUIControl;
begin
tl := topLevel;
- if not v then
+ if (not v) then
begin
if (tl.mFocused = self) then
begin
- tl.blurred();
- tl.mFocused := tl.findNextFocus(self);
+ 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 mEnabled) or (not canFocus) then exit;
+ if (not canFocus) then exit;
if (tl.mFocused <> self) then
begin
- if (tl.mFocused <> nil) and (tl.mFocused <> nil) then tl.mFocused.blurred();
+ if (tl.mFocused <> nil) then tl.mFocused.blurred();
tl.mFocused := self;
if (uiGrabCtl <> self) then uiGrabCtl := nil;
activated();
function TUIControl.getCanFocus (): Boolean; inline;
begin
- result := (mCanFocus) and (mWidth > 0) and (mHeight > 0);
+ result := (getEnabled) and (mCanFocus) and (mWidth > 0) and (mHeight > 0);
end;
begin
Dec(x, mX);
Dec(y, mY);
- result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
+ result := true; // hack
end
else
begin
result := mParent.toLocal(x, y);
- if result then
- begin
- Inc(x, mParent.mScrollX);
- Inc(y, mParent.mScrollY);
- result := (x >= 0) and (y >= 0) and (x < mParent.mWidth) and (y < mParent.mHeight);
- Dec(x, mX);
- Dec(y, mY);
- end
- else
- begin
- Inc(x, mParent.mScrollX);
- Inc(y, mParent.mScrollY);
- Dec(x, mX);
- Dec(y, mY);
- end;
+ 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;
f: Integer;
begin
result := nil;
- if (not allowDisabled) and (not mEnabled) 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
@@ -1476,6 +1494,35 @@ function TUIControl.parentScrollX (): Integer; inline; begin if (mParent <> nil)
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
result := mChildren[f].findFirstFocus();
if (result <> nil) then exit;
end;
- if canFocus then result := self;
+ if (canFocus) then result := self;
end;
end;
result := mChildren[f].findLastFocus();
if (result <> nil) then exit;
end;
- if canFocus then result := self;
+ if (canFocus) then result := self;
end;
end;
-function TUIControl.findNextFocus (cur: TUIControl): TUIControl;
+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 TUIControl.findPrevFocus (cur: TUIControl): TUIControl;
+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
- cur := cur.prevSibling;
- if (cur = nil) then break;
- result := cur.findLastFocus();
- if (result <> nil) then exit;
+ 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;
- result := findLastFocus();
end;
end;
var
ctl: TUIControl;
begin
- if (mEnabled) then
+ if (enabled) then
begin
if (mDefault) then begin result := self; exit; end;
for ctl in mChildren do
var
ctl: TUIControl;
begin
- if (mEnabled) then
+ if (enabled) then
begin
if (mCancel) then begin result := self; exit; end;
for ctl in mChildren do
procedure TUIControl.doAction ();
begin
- if assigned(actionCB) then actionCB(self, 0);
+ if assigned(actionCB) then actionCB(self);
end;
var
ctl: TUIControl;
begin
- if (not mEnabled) then exit;
+ if (not enabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
ctl := controlAtXY(ev.x, ev.y);
if (ctl = nil) then exit;
function doPreKey (ctl: TUIControl): Boolean;
begin
- if (not ctl.mEnabled) then begin result := false; exit; end;
+ 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.mEnabled) then begin result := false; exit; end;
+ 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: TUIControl;
begin
- if (not mEnabled) then exit;
+ if (not enabled) then exit;
if (ev.eaten) or (ev.cancelled) then exit;
// call pre-key
if (mParent = nil) then
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.mEnabled) then
+ 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
begin
if (ev = 'S-Tab') then
begin
- ctl := findPrevFocus(mFocused);
- if (ctl <> mFocused) then ctl.setFocused(true);
+ ctl := findPrevFocus(mFocused, true);
+ if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
ev.eat();
exit;
end;
if (ev = 'Tab') then
begin
- ctl := findNextFocus(mFocused);
- if (ctl <> mFocused) then ctl.setFocused(true);
+ ctl := findNextFocus(mFocused, true);
+ if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
ev.eat();
exit;
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor TUITopWindow.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);
- mFrameWidth := 8;
- mFrameHeight := 8;
+ inherited Create();
mTitle := atitle;
end;
procedure TUITopWindow.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
+ mFrameWidth := 8;
+ mFrameHeight := 8;
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;
+ mCanFocus := false;
mDragScroll := TXMode.None;
mDrawShadow := true;
mWaitingClose := false;
end;
-procedure TUITopWindow.cacheStyle (root: TUIStyle);
-begin
- inherited cacheStyle(root);
-end;
-
-
procedure TUITopWindow.centerInScreen ();
begin
if (mWidth > 0) and (mHeight > 0) then
if (mFocused = nil) or (mFocused = self) then
begin
mFocused := findFirstFocus();
- if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
end;
+ if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
inherited;
end;
mDragScroll := TXMode.None;
mWaitingClose := false;
mInClose := false;
+ if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
inherited;
end;
procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
begin
inherited keyEvent(ev);
- if (ev.eaten) or (ev.cancelled) or (not mEnabled) {or (not getFocused)} then exit;
+ if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit;
if (ev = 'M-F3') then
begin
if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
lx, ly: Integer;
hgt, sbhgt: Integer;
begin
- if (not mEnabled) then exit;
+ if (not enabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
if (mDragScroll = TXMode.Drag) then
// ////////////////////////////////////////////////////////////////////////// //
-constructor TUISimpleText.Create (ax, ay: Integer);
+constructor TUIBox.Create (ahoriz: Boolean);
begin
- mItems := nil;
- inherited Create(ax, ay, 4, 4);
- mDefSize := TLaySize.Create(mWidth, mHeight);
+ inherited Create();
+ mHoriz := ahoriz;
end;
-destructor TUISimpleText.Destroy ();
+procedure TUIBox.AfterConstruction ();
begin
- mItems := nil;
inherited;
+ mCanFocus := false;
+ mHAlign := -1; // left
+ mCtl4Style := 'box';
end;
-procedure TUISimpleText.AfterConstruction ();
+procedure TUIBox.setCaption (const acap: AnsiString);
begin
- inherited;
- mCanFocus := false;
- mCtl4Style := 'simple_text';
+ mCaption := acap;
+ mDefSize := TLaySize.Create(Length(mCaption)*8+3, 8);
end;
-procedure TUISimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
-var
- it: PItem;
+procedure TUIBox.setHasFrame (v: 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;
- mDefSize := TLaySize.Create(mWidth, mHeight);
+ 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 (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 TUISimpleText.drawControl (gx, gy: Integer);
+procedure TUIBox.drawControl (gx, gy: Integer);
var
cidx: Integer;
- f, xofs: Integer;
- it: PItem;
+ xpos: Integer;
begin
cidx := getColorIndex;
- for f := 0 to High(mItems) do
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+ if mHasFrame then
begin
- it := @mItems[f];
- xofs := 0;
- if it.centered then begin xofs := (mWidth-Length(it.title)*8) div 2; end;
- if it.hline then
- begin
- if (Length(it.title) = 0) then
- begin
- drawHLine(gx+4, gy+3, mWidth-8, mFrameColor[cidx]);
- end
- else
- begin
- drawHLine(gx+4, gy+3, gx+xofs-3-(gx+3), mFrameColor[cidx]);
- drawHLine(gx+xofs+Length(it.title)*8, gy+3, mWidth-(xofs+Length(it.title)*8)-4, mFrameColor[cidx]);
- drawText8(gx+xofs, gy, it.title, mFrameTextColor[cidx]);
- end;
- end
- else
- begin
- drawText8(gx+xofs, gy, it.title, mTextColor[cidx]);
- end;
- Inc(gy, 8);
+ // 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;
-procedure TUISimpleText.mouseEvent (var ev: THMouseEvent);
+procedure TUIBox.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
inherited mouseEvent(ev);
- if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
ev.eat();
end;
end;
-// ////////////////////////////////////////////////////////////////////////// //
-constructor TUICBListBox.Create (ax, ay: Integer);
+procedure TUIBox.keyEvent (var ev: THKeyEvent);
+var
+ dir: Integer = 0;
+ cur, ctl: TUIControl;
begin
- inherited Create(ax, ay, 4, 4);
- mDefSize := TLaySize.Create(mWidth, mHeight);
+ 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;
-destructor TUICBListBox.Destroy ();
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TUIHBox.Create ();
begin
- mItems := nil;
- inherited;
end;
-procedure TUICBListBox.AfterConstruction ();
+procedure TUIHBox.AfterConstruction ();
begin
inherited;
- mItems := nil;
- mCurIndex := -1;
- mCtl4Style := 'cb_listbox';
-end;
-
-
-procedure TUICBListBox.cacheStyle (root: TUIStyle);
-begin
- inherited cacheStyle(root);
- // active
- mCurItemBack[ClrIdxActive] := root.get('current-item-back-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
- // disabled
- mCurItemBack[ClrIdxDisabled] := root.get('current-item-back-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
- // inactive
- mCurItemBack[ClrIdxInactive] := root.get('current-item-back-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
-end;
-
-
-procedure TUICBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
-var
- it: PItem;
-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;
- mDefSize := TLaySize.Create(mWidth, mHeight);
-end;
-
-
-procedure TUICBListBox.drawControl (gx, gy: Integer);
-var
- cidx: Integer;
- f, tx: Integer;
- it: PItem;
-begin
- cidx := getColorIndex;
- for f := 0 to High(mItems) do
- begin
- it := @mItems[f];
- if (mCurIndex = f) then fillRect(gx, gy, mWidth, 8, mCurItemBack[cidx]);
- if (it.varp <> nil) then
- begin
- if it.varp^ then drawText8(gx, gy, '[x]', mFrameTextColor[cidx]) else drawText8(gx, gy, '[ ]', mFrameTextColor[cidx]);
- drawText8(gx+3*8+2, gy, it.title, mTextColor[cidx]);
- end
- else if (Length(it.title) > 0) then
- begin
- tx := gx+(mWidth-Length(it.title)*8) div 2;
- if (tx-3 > gx+4) then
- begin
- drawHLine(gx+4, gy+3, tx-3-(gx+3), mFrameColor[cidx]);
- drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, mFrameColor[cidx]);
- end;
- drawText8(tx, gy, it.title, mFrameTextColor[cidx]);
- end
- else
- begin
- drawHLine(gx+4, gy+3, mWidth-8, mFrameColor[cidx]);
- end;
- Inc(gy, 8);
- end;
-end;
-
-
-procedure TUICBListBox.mouseEvent (var ev: THMouseEvent);
-var
- lx, ly: Integer;
- it: PItem;
-begin
- inherited mouseEvent(ev);
- if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
- begin
- ev.eat();
- 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;
-end;
-
-
-procedure TUICBListBox.keyEvent (var ev: THKeyEvent);
-var
- it: PItem;
-begin
- inherited keyEvent(ev);
- if (ev.eaten) or (ev.cancelled) or (not mEnabled) or (not getFocused) then exit;
- //result := true;
- if (ev = 'Home') or (ev = 'PageUp') then
- begin
- ev.eat();
- mCurIndex := 0;
- end;
- if (ev = 'End') or (ev = 'PageDown') then
- begin
- ev.eat();
- mCurIndex := High(mItems);
- end;
- if (ev = 'Up') then
- begin
- ev.eat();
- if (Length(mItems) > 0) then
- begin
- if (mCurIndex < 0) then mCurIndex := Length(mItems);
- while (mCurIndex > 0) do
- begin
- Dec(mCurIndex);
- if (mItems[mCurIndex].varp <> nil) then break;
- end;
- end
- else
- begin
- mCurIndex := -1;
- end;
- end;
- if (ev = 'Down') then
- begin
- ev.eat();
- if (Length(mItems) > 0) then
- begin
- if (mCurIndex < 0) then mCurIndex := -1;
- while (mCurIndex < High(mItems)) do
- begin
- Inc(mCurIndex);
- if (mItems[mCurIndex].varp <> nil) then break;
- end;
- end
- else
- begin
- mCurIndex := -1;
- end;
- end;
- if (ev = 'Space') or (ev = 'Enter') then
- begin
- ev.eat();
- if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) 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);
- end;
- end;
-end;
-
-
-// ////////////////////////////////////////////////////////////////////////// //
-constructor TUIBox.Create (ahoriz: Boolean);
-begin
- inherited Create();
- mHoriz := ahoriz;
-end;
-
-
-procedure TUIBox.AfterConstruction ();
-begin
- inherited AfterConstruction();
- mCanFocus := false;
- mCtl4Style := 'box';
-end;
-
-
-function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
-begin
- if (parseOrientation(prname, par)) then begin result := true; exit; end;
- if (strEquCI1251(prname, 'frame')) then
- begin
- mHasFrame := parseBool(par);
- if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
- result := true;
- exit;
- end;
- if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
- begin
- mCaption := par.expectIdOrStr(true);
- mDefSize := TLaySize.Create(Length(mCaption)*8+3, 8);
- result := true;
- exit;
- end;
- if (strEquCI1251(prname, 'children')) then
- begin
- parseChildren(par);
- result := true;
- exit;
- end;
- result := inherited parseProperty(prname, par);
-end;
-
-
-procedure TUIBox.drawControl (gx, gy: Integer);
-var
- cidx: Integer;
- tx: 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
- setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
- tx := gx+((mWidth-Length(mCaption)*8) div 2);
- if mHasFrame then fillRect(tx-2, gy, Length(mCaption)*8+3, 8, mBackColor[cidx]);
- drawText8(tx, gy, mCaption, mFrameTextColor[cidx]);
- end;
-end;
-
-
-procedure TUIBox.mouseEvent (var ev: THMouseEvent);
-var
- lx, ly: Integer;
-begin
- inherited mouseEvent(ev);
- if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
- begin
- ev.eat();
- end;
-end;
-
-
-//TODO: navigation with arrow keys, according to box orientation
-procedure TUIBox.keyEvent (var ev: THKeyEvent);
-var
- dir: Integer = 0;
- cur, ctl: TUIControl;
-begin
- inherited keyEvent(ev);
- if (ev.eaten) or (ev.cancelled) or (not ev.press) or (not mEnabled) 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) else ctl := findNextFocus(cur);
- //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 TUIHBox.Create ();
-begin
-end;
-
-
-procedure TUIHBox.AfterConstruction ();
-begin
- inherited AfterConstruction();
mHoriz := true;
end;
procedure TUIVBox.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mHoriz := false;
+ writeln('VBOX: ', canFocus, ':', enabled);
end;
// ////////////////////////////////////////////////////////////////////////// //
procedure TUISpan.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mExpand := true;
mCanFocus := false;
mCtl4Style := 'span';
// ////////////////////////////////////////////////////////////////////// //
procedure TUILine.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mCanFocus := false;
mExpand := true;
mCanFocus := false;
// ////////////////////////////////////////////////////////////////////////// //
procedure TUIHLine.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mHoriz := true;
mDefSize.h := 7;
end;
// ////////////////////////////////////////////////////////////////////////// //
procedure TUIVLine.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mHoriz := false;
mDefSize.w := 7;
end;
result := true;
exit;
end;
- if (strEquCI1251(prname, 'textalign')) then
+ if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
begin
parseTextAlign(par, mHAlign, mVAlign);
result := true;
// ////////////////////////////////////////////////////////////////////////// //
procedure TUITextLabel.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mHAlign := -1;
mVAlign := 0;
mCanFocus := false;
Inc(f);
end;
end;
+ mDefSize := TLaySize.Create(Length(mText)*8, 8);
end;
if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
begin
setText(par.expectIdOrStr(true));
- mDefSize := TLaySize.Create(Length(mText)*8, 8);
result := true;
exit;
end;
result := true;
exit;
end;
- if (strEquCI1251(prname, 'textalign')) then
+ if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
begin
parseTextAlign(par, mHAlign, mVAlign);
result := true;
lx, ly: Integer;
begin
inherited mouseEvent(ev);
- if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
ev.eat();
end;
var
ctl: TUIControl;
begin
- if (not mEnabled) then exit;
+ 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;
// ////////////////////////////////////////////////////////////////////////// //
procedure TUIButton.AfterConstruction ();
begin
- inherited AfterConstruction();
+ inherited;
mHAlign := -1;
mVAlign := 0;
mCanFocus := true;
end;
-function TUIButton.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+procedure TUIButton.setText (const s: AnsiString);
begin
- if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
- begin
- result := inherited parseProperty(prname, par);
- if result then mDefSize := TLaySize.Create(Length(mText)*8+8*2, 10);
- exit;
- end;
- result := inherited parseProperty(prname, par);
+ inherited setText(s);
+ mDefSize := TLaySize.Create(Length(mText)*8+8*2, 10);
end;
begin
cidx := getColorIndex;
- if (mVAlign < 0) then ypos := 0
- else if (mVAlign > 0) then ypos := mHeight-8
- else ypos := (mHeight-8) div 2;
-
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]);
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
- begin
- drawText8(gx+xpos+8+mHotOfs, gy+ypos, mHotChar, mHotColor[cidx]);
- end;
+ if (mHotChar <> #0) and (mHotChar <> ' ') then drawText8(gx+xpos+8+mHotOfs, gy+ypos, mHotChar, mHotColor[cidx]);
end;
end;
end;
exit;
end;
- if (ev.eaten) or (ev.cancelled) or (not mEnabled) or not focused then exit;
+ 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 (mEnabled) then
+ if (not ev.eaten) and (not ev.cancelled) and (enabled) then
begin
if (ev = 'Enter') or (ev = 'Space') then
begin
procedure TUIButton.keyEventPost (var ev: THKeyEvent);
begin
- if (not mEnabled) then exit;
+ 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;
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
+ 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;
+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;
+ 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
+ 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(TUITextLabel, 'label');
registerCtlClass(TUIStaticText, 'static');
registerCtlClass(TUIButton, 'button');
+ registerCtlClass(TUICheckBox, 'checkbox');
+ registerCtlClass(TUIRadioBox, 'radiobox');
end.
diff --git a/src/gx/gh_ui_style.pas b/src/gx/gh_ui_style.pas
index 97dcb79eabf279a79678211762adc01faa8525c4..3b55797280a9c11d8edb18a73654f683cd551865 100644 (file)
--- a/src/gx/gh_ui_style.pas
+++ b/src/gx/gh_ui_style.pas
defaultStyleStr =
'default {'#10+
' back-color: #008;'#10+
- ' #active: { text-color: #fff; frame-color: #fff; frame-text-color: #fff; frame-icon-color: #0f0; }'#10+
- ' #inactive: { text-color: #aaa; frame-color: #aaa; frame-text-color: #aaa; frame-icon-color: #0a0; }'#10+
+ ' #active: { text-color: #fff; hot-color: #f00; frame-color: #fff; frame-text-color: #fff; frame-icon-color: #0f0; }'#10+
+ ' #inactive: { text-color: #aaa; hot-color: #a00; frame-color: #aaa; frame-text-color: #aaa; frame-icon-color: #0a0; }'#10+
' #disabled: { text-color: #666; frame-color: #888; frame-text-color: #888; frame-icon-color: #080; }'#10+
- ' @simple_text: { text-color: #ff0; #inactive(#active); }'#10+
- ' @cb_listbox: { current-item-back-color: #080; text-color: #ff0; #inactive(#active) { current-item-back-color: #000; } }'#10+
' @window: { #inactive(#active): { darken: 128; } }'#10+
' @button: { back-color: #999; text-color: #000; hot-color: #600; #active: { back-color: #fff; hot-color: #c00; } #disabled: { back-color: #444; text-color: #333; hot-color: #333; } }'#10+
- ' @label: { #active: {back-color: #440;} #inactive(#active); }'#10+
+ ' @label: { #inactive(#active); }'#10+
' @static: { text-color: #ff0; #inactive(#active); }'#10+
' @box: { #inactive(#active); }'#10+
+ ' @switchbox: { switch-color: #fff; #active: { back-color: #080; } }'#10+
+ ' @checkbox(@switchbox): {}'#10+
+ ' @radiobox(@switchbox): {}'#10+
'}'#10+
'';
var