MODULE WMTabComponents;
IMPORT
KernelLog, Strings, XML, WMEvents, WMProperties,
WMStandardComponents, WMRectangles, WMComponents, WMGraphics;
TYPE
Tab* = OBJECT
VAR
caption- : Strings.String;
w : LONGINT;
width : LONGINT;
color- : LONGINT;
data- : ANY;
inserted, attention* : BOOLEAN;
next- : Tab;
PROCEDURE &Init*;
BEGIN
caption := NIL;
w := 0; width := 0; color := 0;
data := NIL;
inserted := FALSE; attention := FALSE;
next := NIL;
END Init;
END Tab;
Tabs* = OBJECT(WMComponents.VisualComponent)
VAR
left, right : WMStandardComponents.Button;
leftOfs, totalWidth, border : LONGINT;
tabs-, hover, selected- : Tab;
canvasState : WMGraphics.CanvasState;
onSelectTab- : WMEvents.EventSource;
useBgBitmaps- : WMProperties.BooleanProperty;
borderWidth- : WMProperties.Int32Property;
clDefault-, clHover-, clSelected-, clAttention-, clSelectedAttention-,
clTextDefault-, clTextHover-, clTextSelected-, clTextAttention, clTextSelectedAttention- : WMProperties.ColorProperty;
bgLeftDefault-, bgMiddleDefault-, bgRightDefault-,
bgLeftHover-, bgMiddleHover-, bgRightHover-,
bgLeftSelected-, bgMiddleSelected-, bgRightSelected-,
bgLeftAttention-, bgMiddleAttention-, bgRightAttention- : WMProperties.StringProperty;
imgLeftDefault, imgMiddleDefault, imgRightDefault,
imgLeftHover, imgMiddleHover, imgRightHover,
imgLeftSelected, imgMiddleSelected, imgRightSelected,
imgLeftAttention, imgMiddleAttention, imgRightAttention : WMGraphics.Image;
PROCEDURE &Init*;
BEGIN
Init^;
SetNameAsString(StrTabs);
NEW(left);
left.alignment.Set(WMComponents.AlignLeft);
left.bounds.SetWidth(10);
left.isRepeating.Set(TRUE);
left.onClick.Add(MoveLeft);
left.visible.Set(FALSE);
NEW(right);
right.alignment.Set(WMComponents.AlignRight);
right.bounds.SetWidth(10);
right.isRepeating.Set(TRUE);
right.onClick.Add(MoveRight);
right.visible.Set(FALSE);
AddInternalComponent(left); AddInternalComponent(right);
NEW(onSelectTab, SELF, Strings.NewString("onSelectTab"), Strings.NewString("if tab clicked"), SELF.StringToCompCommand);
NEW(borderWidth, ProtoTcBorderWidth, NIL, NIL); properties.Add(borderWidth);
NEW(useBgBitmaps, ProtoTcUseBgBitmaps, NIL, NIL); properties.Add(useBgBitmaps);
fillColor.SetPrototype(ProtoTcDefault);
NEW(clDefault, ProtoTcDefault, NIL, NIL); properties.Add(clDefault);
NEW(clHover, ProtoTcHover, NIL, NIL); properties.Add(clHover);
NEW(clSelected, ProtoTcSelected, NIL, NIL); properties.Add(clSelected);
NEW(clAttention, ProtoTcAttention, NIL, NIL); properties.Add(clAttention);
NEW(clSelectedAttention, ProtoTcSelectedAttention, NIL, NIL); properties.Add(clSelectedAttention);
NEW(clTextDefault, ProtoTcTextDefault, NIL, NIL); properties.Add(clTextDefault);
NEW(clTextHover, ProtoTcTextHover, NIL, NIL); properties.Add(clTextHover);
NEW(clTextSelected, ProtoTcTextSelected, NIL, NIL); properties.Add(clTextSelected);
NEW(clTextAttention, ProtoTcTextAttention, NIL, NIL); properties.Add(clTextAttention);
NEW(clTextSelectedAttention, ProtoTcTextSelectedAttention, NIL, NIL); properties.Add(clTextSelectedAttention);
NEW(bgLeftDefault, ProtoTcBgLeftDefault, NIL, NIL); properties.Add(bgLeftDefault);
NEW(bgMiddleDefault, ProtoTcBgMiddleDefault, NIL, NIL); properties.Add(bgMiddleDefault);
NEW(bgRightDefault, ProtoTcBgRightDefault, NIL, NIL); properties.Add(bgRightDefault);
NEW(bgLeftHover, ProtoTcBgLeftHover, NIL, NIL); properties.Add(bgLeftHover);
NEW(bgMiddleHover, ProtoTcBgMiddleHover, NIL, NIL); properties.Add(bgMiddleHover);
NEW(bgRightHover, ProtoTcBgRightHover, NIL, NIL); properties.Add(bgRightHover);
NEW(bgLeftSelected, ProtoTcBgLeftSelected, NIL, NIL); properties.Add(bgLeftSelected);
NEW(bgMiddleSelected, ProtoTcBgMiddleSelected, NIL, NIL); properties.Add(bgMiddleSelected);
NEW(bgRightSelected, ProtoTcBgRightSelected, NIL, NIL); properties.Add(bgRightSelected);
NEW(bgLeftAttention, ProtoTcBgLeftAttention, NIL, NIL); properties.Add(bgLeftAttention);
NEW(bgMiddleAttention, ProtoTcBgMiddleAttention, NIL, NIL); properties.Add(bgMiddleAttention);
NEW(bgRightAttention, ProtoTcBgRightAttention, NIL, NIL); properties.Add(bgRightAttention);
END Init;
PROCEDURE Initialize*;
BEGIN
Initialize^;
CheckLeftRightButtons;
END Initialize;
PROCEDURE PropertyChanged(sender, property : ANY);
BEGIN
IF (property = useBgBitmaps) OR
(property = bgLeftDefault) OR (property = bgMiddleDefault) OR (property = bgRightDefault) OR
(property = bgLeftHover) OR (property = bgMiddleHover) OR (property = bgRightHover) OR
(property = bgLeftSelected) OR (property = bgMiddleSelected) OR (property = bgRightSelected) OR
(property = bgLeftAttention) OR (property = bgMiddleAttention) OR (property = bgRightAttention)
THEN
RecacheProperties;
ELSIF (property = borderWidth) OR
(property = clDefault) OR (property = clHover) OR (property = clSelected) OR (property = clAttention) OR
(property = clSelectedAttention) OR (property = clTextDefault) OR (property = clTextHover) OR
(property = clTextSelected) OR (property = clTextAttention) OR (property = clTextSelectedAttention)
THEN
Invalidate;
ELSE
PropertyChanged^(sender, property);
END;
END PropertyChanged;
PROCEDURE RecacheProperties;
VAR s : Strings.String;
BEGIN
RecacheProperties^;
IF useBgBitmaps.Get() THEN
s := bgLeftDefault.Get(); IF s # NIL THEN imgLeftDefault := WMGraphics.LoadImage(s^, TRUE) END;
s := bgMiddleDefault.Get(); IF s # NIL THEN imgMiddleDefault := WMGraphics.LoadImage(s^, TRUE) END;
s := bgRightDefault.Get(); IF s # NIL THEN imgRightDefault := WMGraphics.LoadImage(s^, TRUE) END;
s := bgLeftHover.Get(); IF s # NIL THEN imgLeftHover := WMGraphics.LoadImage(s^, TRUE) END;
s := bgMiddleHover.Get(); IF s # NIL THEN imgMiddleHover := WMGraphics.LoadImage(s^, TRUE) END;
s := bgRightHover.Get(); IF s # NIL THEN imgRightHover := WMGraphics.LoadImage(s^, TRUE) END;
s := bgLeftSelected.Get(); IF s # NIL THEN imgLeftSelected := WMGraphics.LoadImage(s^, TRUE) END;
s := bgMiddleSelected.Get(); IF s # NIL THEN imgMiddleSelected := WMGraphics.LoadImage(s^, TRUE) END;
s := bgRightSelected.Get(); IF s # NIL THEN imgRightSelected := WMGraphics.LoadImage(s^, TRUE) END;
s := bgLeftAttention.Get(); IF s # NIL THEN imgLeftAttention := WMGraphics.LoadImage(s^, TRUE) END;
s := bgMiddleAttention.Get(); IF s # NIL THEN imgMiddleAttention := WMGraphics.LoadImage(s^, TRUE) END;
s := bgRightAttention.Get(); IF s # NIL THEN imgRightAttention := WMGraphics.LoadImage(s^, TRUE) END;
ELSE
imgLeftDefault := NIL; imgMiddleDefault := NIL; imgRightDefault := NIL;
imgLeftHover := NIL; imgMiddleHover := NIL; imgRightHover := NIL;
imgLeftSelected := NIL; imgMiddleSelected := NIL; imgRightSelected := NIL;
imgLeftAttention := NIL; imgMiddleAttention := NIL; imgRightAttention := NIL;
END;
Invalidate
END RecacheProperties;
PROCEDURE FindTabFromPos(x: LONGINT) : Tab;
VAR cur : Tab; pos, dl, w: LONGINT;
BEGIN
IF left.visible.Get() THEN dl := left.bounds.GetWidth() ELSE dl := 0 END;
pos := - leftOfs + dl;
cur := tabs;
WHILE cur # NIL DO
w := cur.w;
IF pos > bounds.GetWidth() THEN RETURN NIL END;
pos := pos + w;
IF x < pos THEN RETURN cur END;
cur := cur.next
END;
RETURN NIL
END FindTabFromPos;
PROCEDURE PointerDown*(x, y: LONGINT; keys: SET);
VAR new : Tab;
BEGIN
IF 0 IN keys THEN
new := FindTabFromPos(x);
IF (selected # new) & (new # NIL) THEN
selected := new;
onSelectTab.Call(selected);
Invalidate
END
END
END PointerDown;
PROCEDURE Select*(new : Tab);
BEGIN
Acquire;
IF selected # new THEN
selected := new;
Invalidate
END;
Release
END Select;
PROCEDURE SelectByName*(CONST name : ARRAY OF CHAR);
VAR tab : Tab; found : BOOLEAN;
BEGIN
found := FALSE;
Acquire;
tab := tabs;
WHILE ~found & (tab # NIL) DO
IF tab.inserted & (tab.caption # NIL) THEN
found := tab.caption^ = name;
END;
IF ~found THEN tab := tab.next; END;
END;
IF found & (selected # tab) THEN selected := tab; Invalidate; END;
Release;
END SelectByName;
PROCEDURE PointerMove*(x, y: LONGINT; keys: SET);
VAR new : Tab;
BEGIN
new := FindTabFromPos(x);
IF hover # new THEN
hover := new;
Invalidate
END
END PointerMove;
PROCEDURE PointerLeave;
BEGIN
hover := NIL;
Invalidate
END PointerLeave;
PROCEDURE MoveLeft(sender, data : ANY);
BEGIN
DEC(leftOfs, 10);
IF leftOfs < 0 THEN leftOfs := 0 END;
Invalidate;
END MoveLeft;
PROCEDURE MoveRight(sender, data : ANY);
BEGIN
INC(leftOfs, 10);
IF leftOfs > totalWidth - 10 THEN leftOfs := totalWidth - 10 END;
Invalidate;
END MoveRight;
PROCEDURE AddTab*(tab : Tab);
VAR cur : Tab;
BEGIN
Acquire;
tab.next := NIL; tab.inserted := TRUE;
IF tabs = NIL THEN tabs := tab; selected := tab;
ELSE
cur := tabs;
WHILE cur.next # NIL DO cur := cur.next END;
cur.next := tab
END;
CalcSize;
Release;
Invalidate
END AddTab;
PROCEDURE RemoveTab*(tab : Tab);
VAR cur : Tab;
BEGIN
IF (tabs = NIL) OR (tab = NIL) THEN RETURN END;
Acquire;
IF tabs = tab THEN tabs := tabs.next
ELSE
cur := tabs;
WHILE (cur # NIL) & (cur.next # tab) DO cur := cur.next END;
IF cur # NIL THEN cur.next := cur.next.next END
END;
CalcSize;
tab.inserted := FALSE;
Release;
Invalidate
END RemoveTab;
PROCEDURE RemoveAllTabs*;
BEGIN
Acquire;
tabs := NIL;
CalcSize;
Release;
Invalidate
END RemoveAllTabs;
PROCEDURE CheckLeftRightButtons;
BEGIN
IF totalWidth >= bounds.GetWidth() THEN
right.visible.Set(TRUE);
left.visible.Set(TRUE)
ELSE
leftOfs := 0;
right.visible.Set(FALSE);
left.visible.Set(FALSE)
END
END CheckLeftRightButtons;
PROCEDURE Resized;
BEGIN
Resized^;
CheckLeftRightButtons
END Resized;
PROCEDURE CalcSize;
VAR cur : Tab; font : WMGraphics.Font; dx, dy : LONGINT;
BEGIN
font := GetFont();
totalWidth := 0;
cur := tabs;
WHILE cur # NIL DO
IF cur.width # 0 THEN
totalWidth := totalWidth + cur.width;
ELSIF cur.caption # NIL THEN
font.GetStringSize(cur.caption^, dx, dy);
totalWidth := totalWidth + dx + 2 * border
ELSE
totalWidth := totalWidth + 2 * border
END;
cur := cur.next
END;
CheckLeftRightButtons
END CalcSize;
PROCEDURE SetTabCaption*(tab : Tab; caption : Strings.String);
BEGIN
Acquire;
tab.caption := caption;
CalcSize;
Release;
IF tab.inserted THEN Invalidate END
END SetTabCaption;
PROCEDURE SetTabColor*(tab : Tab; color : LONGINT);
BEGIN
Acquire;
tab.color := color;
Release;
IF tab.inserted THEN Invalidate END
END SetTabColor;
PROCEDURE SetTabWidth*(tab : Tab; width : LONGINT);
BEGIN
Acquire;
tab.width := width;
CalcSize;
Release;
IF tab.inserted THEN Invalidate; END;
END SetTabWidth;
PROCEDURE SetTabData*(tab : Tab; data : ANY);
BEGIN
Acquire;
tab.data := data;
Release;
IF tab.inserted THEN Invalidate END
END SetTabData;
PROCEDURE NewTab*() : Tab;
VAR tab : Tab;
BEGIN
NEW(tab); RETURN tab
END NewTab;
PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
VAR r : WMRectangles.Rectangle;
w, h, dl, dr, wLeft, wRight : LONGINT;
pos : LONGINT; dx, dy, dc : LONGINT;
cur : Tab; font : WMGraphics.Font;
imgLeft, imgMiddle, imgRight : WMGraphics.Image;
BEGIN
border := borderWidth.Get();
font := GetFont();
dc := font.descent;
h := bounds.GetHeight(); w := bounds.GetWidth();
IF left.visible.Get() THEN dl := left.bounds.GetWidth() ELSE dl := 0 END;
IF right.visible.Get() THEN dr := right.bounds.GetWidth() ELSE dr := 0 END;
canvas.SaveState(canvasState);
canvas.SetClipRect(WMRectangles.MakeRect(dl, 0, w - dr, h));
canvas.ClipRectAsNewLimits(dl, 0);
pos := - leftOfs;
cur := tabs;
WHILE cur # NIL DO
IF cur.width # 0 THEN
w := cur.width;
ELSIF cur.caption # NIL THEN
font.GetStringSize(cur.caption^, dx, dy); w := dx + 2 * border;
ELSE
w := 2 * border
END;
cur.w := w;
r := WMRectangles.MakeRect(pos, 0, pos + w, h);
IF useBgBitmaps.Get() THEN
IF cur = hover THEN
imgLeft := imgLeftHover;
imgMiddle := imgMiddleHover;
imgRight := imgRightHover;
ELSIF cur = selected THEN
imgLeft := imgLeftSelected;
imgMiddle := imgMiddleSelected;
imgRight := imgRightSelected;
ELSIF cur.attention THEN
imgLeft := imgLeftAttention;
imgMiddle := imgMiddleAttention;
imgRight := imgRightAttention;
ELSE
imgLeft := imgLeftDefault;
imgMiddle := imgMiddleDefault;
imgRight := imgRightDefault
END;
IF imgLeft # NIL THEN
wLeft := imgLeft.width;
canvas.ScaleImage( imgLeft,
WMRectangles.MakeRect(0, 0, imgLeft.width, imgLeft.height),
WMRectangles.MakeRect(pos, 0, pos+wLeft, bounds.GetHeight()),
WMGraphics.ModeSrcOverDst, 10)
ELSE
wLeft := 0
END;
IF imgRight # NIL THEN
wRight := imgRight.width;
canvas.ScaleImage( imgRight,
WMRectangles.MakeRect(0, 0, imgRight.width, imgRight.height),
WMRectangles.MakeRect(pos+w-wRight, 0, pos+w, bounds.GetHeight()),
WMGraphics.ModeSrcOverDst, 10)
ELSE
wRight := 0
END;
IF imgMiddle # NIL THEN
canvas.ScaleImage( imgMiddle,
WMRectangles.MakeRect(0, 0, imgMiddle.width, imgMiddle.height),
WMRectangles.MakeRect(pos+wLeft, 0, pos+w-wRight, bounds.GetHeight()), WMGraphics.ModeSrcOverDst, 10)
END
ELSE
IF cur = hover THEN
canvas.Fill(r, clHover.Get(), WMGraphics.ModeSrcOverDst)
ELSIF cur = selected THEN
IF (cur.attention) THEN
canvas.Fill(r, clSelectedAttention.Get(), WMGraphics.ModeSrcOverDst);
ELSE
canvas.Fill(r, clSelected.Get(), WMGraphics.ModeSrcOverDst)
END;
ELSIF cur.attention THEN
canvas.Fill(r, clAttention.Get(), WMGraphics.ModeSrcOverDst)
ELSE
IF cur.color # 0 THEN canvas.Fill(r, cur.color, WMGraphics.ModeSrcOverDst)
ELSE canvas.Fill(r, clDefault.Get(), WMGraphics.ModeSrcOverDst)
END
END;
RectGlassShade(canvas, r, {2}, 2, cur = selected)
END;
IF cur = hover THEN
canvas.SetColor(clTextHover.Get());
ELSIF cur = selected THEN
IF (cur.attention) THEN
canvas.SetColor(clTextSelectedAttention.Get());
ELSE
canvas.SetColor(clTextSelected.Get());
END;
ELSIF cur.attention THEN
canvas.SetColor(clTextAttention.Get());
ELSE
canvas.SetColor(clTextDefault.Get());
END;
IF cur.caption # NIL THEN canvas.DrawString(r.l + border , r.b - dc - 1, cur.caption^) END;
pos := pos + w;
cur := cur.next
END;
canvas.RestoreState(canvasState)
END DrawBackground;
END Tabs;
TYPE
TabEntry* = OBJECT(WMStandardComponents.Panel)
VAR
caption- : WMProperties.StringProperty;
color- : WMProperties.ColorProperty;
tabWidth- : WMProperties.Int32Property;
tab : Tab;
tabs : Tabs;
next : TabEntry;
PROCEDURE PropertyChanged(sender, property : ANY);
BEGIN
IF (property = caption) THEN
IF (tabs # NIL) & (tab # NIL) THEN
tabs.SetTabCaption(tab, caption.Get());
END;
ELSIF (property = color) THEN
IF (tabs # NIL) & (tab # NIL) THEN
tabs.SetTabColor(tab, color.Get());
END;
ELSIF (property = tabWidth) THEN
IF (tabs # NIL) & (tab # NIL) THEN
tabs.SetTabWidth(tab, tabWidth.Get());
END;
ELSE
PropertyChanged^(sender, property);
END;
END PropertyChanged;
PROCEDURE &Init*;
BEGIN
Init^;
SetNameAsString(StrTab);
NEW(caption, NIL, StrCaption, StrCaptionDescription); properties.Add(caption);
caption.Set(StrNoCaption);
NEW(color, NIL, StrColor, StrColorDescription); properties.Add(color);
color.Set(0);
NEW(tabWidth, NIL, StrTabWidth, StrTabWidthDescription); properties.Add(tabWidth);
tabWidth.Set(0);
tab := NIL;
tabs := NIL;
next := NIL;
END Init;
END TabEntry;
TYPE
TabPanel* = OBJECT(WMStandardComponents.Panel)
VAR
selection- : WMProperties.StringProperty;
entries : TabEntry;
first : BOOLEAN;
tabs : Tabs;
PROCEDURE &Init*;
BEGIN
Init^;
SetNameAsString(StrTabPanel);
NEW(selection, NIL, StrSelection, StrSelectionDescription); properties.Add(selection);
selection.Set(StrNoSelection);
first := TRUE;
tabs := NIL;
entries := NIL;
END Init;
PROCEDURE PropertyChanged(sender, property : ANY);
VAR string : Strings.String;
BEGIN
IF (property = selection) THEN
string := selection.Get();
IF (tabs # NIL) & (string # NIL) THEN
tabs.SelectByName(string^);
END;
ELSE
PropertyChanged^(sender, property);
END;
END PropertyChanged;
PROCEDURE TabSelected(sender, data : ANY);
VAR e : TabEntry; tab : Tab;
BEGIN
IF (data # NIL) & (data IS Tab) THEN
tab := data(Tab);
DisableUpdate;
BEGIN {EXCLUSIVE}
e := entries;
WHILE (e # NIL) DO
IF (tab.data # NIL) & (tab.data IS TabEntry) THEN
e.visible.Set(tab.data = e);
END;
e := e.next;
END;
END;
EnableUpdate;
Invalidate;
selection.Set(Strings.NewString(data(Tab).caption^));
END;
END TabSelected;
PROCEDURE AddContent*(c : XML.Content);
VAR entry : TabEntry; tab : Tab; string : Strings.String; select : BOOLEAN;
BEGIN
IF (c IS Tabs) THEN
IF (tabs = NIL) THEN
tabs := c(Tabs);
tabs.onSelectTab.Add(TabSelected);
ELSE
KernelLog.String("WMTabComponents: Warning: Cannot add TabControl component (already set)");
KernelLog.Ln;
END;
ELSIF (c IS TabEntry) THEN
entry := c(TabEntry);
IF (tabs # NIL) THEN
tab := tabs.NewTab();
tab.data := entry;
tab.caption := entry.caption.Get();
tab.color := entry.color.Get();
tab.width := entry.tabWidth.Get();
IF (tab.caption = NIL) THEN tab.caption := Strings.NewString("NoCaption"); END;
entry.alignment.Set(WMComponents.AlignClient);
string := selection.Get();
IF (string = StrNoSelection) & first THEN
entry.visible.Set(TRUE);
first := FALSE;
select := TRUE;
ELSIF (string # NIL) & (string^ = tab.caption^) THEN
entry.visible.Set(TRUE);
select := TRUE;
ELSE
entry.visible.Set(FALSE);
select := FALSE;
END;
BEGIN {EXCLUSIVE}
IF (entries = NIL) THEN
entries := entry;
ELSE
entry.next := entries;
entries := entry;
END;
END;
entry.tabs := tabs; entry.tab := tab;
tabs.AddTab(tab);
IF select THEN tabs.Select(tab); END;
ELSE
KernelLog.String("WMTabComponents: Warning: Cannot add tab (missing TabControl component)");
KernelLog.Ln;
END;
END;
AddContent^(c);
END AddContent;
END TabPanel;
VAR
ColorPrototype, ProtoTcDefault*, ProtoTcHover*, ProtoTcSelected*, ProtoTcAttention*, ProtoTcSelectedAttention*,
ProtoTcTextDefault*, ProtoTcTextHover*, ProtoTcTextSelected*, ProtoTcTextAttention, ProtoTcTextSelectedAttention* : WMProperties.ColorProperty;
Int32Prototype, ProtoTcBorderWidth* : WMProperties.Int32Property;
StringPrototype, ProtoTcBgLeftDefault, ProtoTcBgMiddleDefault, ProtoTcBgRightDefault,
ProtoTcBgLeftHover, ProtoTcBgMiddleHover, ProtoTcBgRightHover,
ProtoTcBgLeftSelected, ProtoTcBgMiddleSelected, ProtoTcBgRightSelected,
ProtoTcBgLeftAttention, ProtoTcBgMiddleAttention, ProtoTcBgRightAttention : WMProperties.StringProperty;
BooleanPrototype, ProtoTcUseBgBitmaps : WMProperties.BooleanProperty;
StrTabs, StrTabPanel, StrTab,
StrCaption, StrCaptionDescription, StrNoCaption,
StrColor, StrColorDescription,
StrTabWidth, StrTabWidthDescription,
StrSelection, StrSelectionDescription, StrNoSelection : Strings.String;
PROCEDURE GenTabPanel*() : XML.Element;
VAR p : TabPanel;
BEGIN
NEW(p); RETURN p;
END GenTabPanel;
PROCEDURE GenTabControl*() : XML.Element;
VAR c : Tabs;
BEGIN
NEW(c); RETURN c;
END GenTabControl;
PROCEDURE GenTab*() : XML.Element;
VAR t : TabEntry;
BEGIN
NEW(t); RETURN t;
END GenTab;
PROCEDURE RectGlassShade*(canvas : WMGraphics.Canvas; rect : WMRectangles.Rectangle; openSides : SET; borderWidth : LONGINT; down : BOOLEAN);
VAR i, ul, dr, da, w, a, b, c, d : LONGINT;
BEGIN
IF down THEN ul := 090H; dr := LONGINT(0FFFFFF90H)
ELSE dr := 090H; ul := LONGINT(0FFFFFF90H)
END;
da := 90H DIV borderWidth;
FOR i := 0 TO borderWidth - 1 DO
IF (0 IN openSides) THEN a := 0 ELSE a := i END;
IF (1 IN openSides) THEN b := 0 ELSE b := i + 1 END;
IF (2 IN openSides) THEN c := 0 ELSE c := i END;
IF (3 IN openSides) THEN d := 0 ELSE d := i + 1 END;
IF ~(0 IN openSides) THEN canvas.Fill(WMRectangles.MakeRect(rect.l + b , rect.t + i, rect.r - d, rect.t + i + 1), ul, WMGraphics.ModeSrcOverDst) END;
IF ~(1 IN openSides) THEN canvas.Fill(WMRectangles.MakeRect(rect.l + i, rect.t + a, rect.l + i + 1, rect.b - c), ul, WMGraphics.ModeSrcOverDst) END;
IF ~(2 IN openSides) THEN canvas.Fill(WMRectangles.MakeRect(rect.l + b, rect.b - 1 - i, rect.r - d, rect.b - i), dr, WMGraphics.ModeSrcOverDst) END;
IF ~(3 IN openSides) THEN canvas.Fill(WMRectangles.MakeRect(rect.r - 1 - i, rect.t + a, rect.r - i, rect.b - c), dr, WMGraphics.ModeSrcOverDst) END;
DEC(ul, da); DEC(dr, da)
END;
i := 3; ul := LONGINT(0FFFFFF40H); w := 5;
canvas.Fill(WMRectangles.MakeRect(rect.l + i , rect.t + i, rect.l + i + w, rect.t + i + 2), ul, WMGraphics.ModeSrcOverDst);
canvas.Fill(WMRectangles.MakeRect(rect.l + i, rect.t + i, rect.l + i + 2, rect.t + i + w), ul, WMGraphics.ModeSrcOverDst);
END RectGlassShade;
PROCEDURE InitStrings;
BEGIN
StrTabs := Strings.NewString("Tabs");
StrTabPanel := Strings.NewString("TabPanel");
StrTab := Strings.NewString("Tab");
StrCaption := Strings.NewString("Caption");
StrNoCaption := Strings.NewString("NoCaption");
StrCaptionDescription := Strings.NewString("Caption of tab");
StrColor := Strings.NewString("Color");
StrColorDescription := Strings.NewString("Color of tab (0: use tab default color)");
StrTabWidth := Strings.NewString("TabWidth");
StrTabWidthDescription := Strings.NewString("Width of the tab button");
StrSelection := Strings.NewString("Selection");
StrSelectionDescription := Strings.NewString("SelectionDescription");
StrNoSelection := Strings.NewString("");
END InitStrings;
PROCEDURE InitPrototypes;
VAR plTabs: WMProperties.PropertyList;
BEGIN
NEW(plTabs); WMComponents.propertyListList.Add("Tab", plTabs);
NEW(BooleanPrototype, NIL, Strings.NewString("UseBgBitmaps"), Strings.NewString("Will the background be decorated with bitmaps?"));
BooleanPrototype.Set(FALSE);
NEW(ProtoTcUseBgBitmaps, BooleanPrototype, NIL, NIL); plTabs.Add(ProtoTcUseBgBitmaps);
NEW(ColorPrototype, NIL, Strings.NewString("ClDefault"), Strings.NewString("color of the tab item"));
ColorPrototype.Set(0000FF88H);
NEW(ProtoTcDefault, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcDefault);
NEW(ColorPrototype, NIL, Strings.NewString("ClHover"), Strings.NewString("color of the tab item, if the mouse is over it"));
ColorPrototype.Set(LONGINT(0FFFF00FFH));
NEW(ProtoTcHover, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcHover);
NEW(ColorPrototype, NIL, Strings.NewString("ClSelected"), Strings.NewString("color of the the tab item, if it is selected"));
ColorPrototype.Set(LONGINT(0FFFF00FFH));
NEW(ProtoTcSelected, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcSelected);
NEW(ColorPrototype, NIL, Strings.NewString("ClAttention"), Strings.NewString("color of the the tab item, if attention is required"));
ColorPrototype.Set(LONGINT(0FF8040FFH));
NEW(ProtoTcAttention, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcAttention);
NEW(ColorPrototype, NIL, Strings.NewString("ClSelectedAttention"), Strings.NewString("color of the tab item, if it is selected and requires attention"));
ColorPrototype.Set(LONGINT(0FF9020FFH));
NEW(ProtoTcSelectedAttention, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcSelectedAttention);
NEW(StringPrototype, NIL, Strings.NewString("BgLeftDefault"), Strings.NewString("Left default background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgLeftDefault, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgLeftDefault);
NEW(StringPrototype, NIL, Strings.NewString("BgMiddleDefault"), Strings.NewString("Middle default background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgMiddleDefault, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgMiddleDefault);
NEW(StringPrototype, NIL, Strings.NewString("BgRightDefault"), Strings.NewString("Right default background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgRightDefault, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgRightDefault);
NEW(StringPrototype, NIL, Strings.NewString("BgLeftHover"), Strings.NewString("Left mouseover background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgLeftHover, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgLeftHover);
NEW(StringPrototype, NIL, Strings.NewString("BgMiddleHover"), Strings.NewString("Middle mouseover background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgMiddleHover, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgMiddleHover);
NEW(StringPrototype, NIL, Strings.NewString("BgRightHover"), Strings.NewString("Right mouseover background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgRightHover, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgRightHover);
NEW(StringPrototype, NIL, Strings.NewString("BgLeftSelected"), Strings.NewString("Left selected background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgLeftSelected, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgLeftSelected);
NEW(StringPrototype, NIL, Strings.NewString("BgMiddleSelected"), Strings.NewString("Middle selected background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgMiddleSelected, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgMiddleSelected);
NEW(StringPrototype, NIL, Strings.NewString("BgRightSelected"), Strings.NewString("Right selected background bitmap"));
StringPrototype.Set(NIL); NEW(ProtoTcBgRightSelected, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgRightSelected);
NEW(StringPrototype, NIL, Strings.NewString("BgLeftAttention"), Strings.NewString("Left background bitmap when attention is required"));
StringPrototype.Set(NIL); NEW(ProtoTcBgLeftAttention, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgLeftAttention);
NEW(StringPrototype, NIL, Strings.NewString("BgMiddleAttention"), Strings.NewString("Middle background bitmap when attention is required"));
StringPrototype.Set(NIL); NEW(ProtoTcBgMiddleAttention, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgMiddleAttention);
NEW(StringPrototype, NIL, Strings.NewString("BgRightAttention"), Strings.NewString("Right background bitmap when attention is required"));
StringPrototype.Set(NIL); NEW(ProtoTcBgRightAttention, StringPrototype, NIL, NIL); plTabs.Add(ProtoTcBgRightAttention);
NEW(ColorPrototype, NIL, Strings.NewString("ClTextDefault"), Strings.NewString("default text color of the tab item")); ColorPrototype.Set(WMGraphics.Yellow);
NEW(ProtoTcTextDefault, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcTextDefault);
NEW(ColorPrototype, NIL, Strings.NewString("ClTextHover"), Strings.NewString("text color of the tab item, if the mouse is over it")); ColorPrototype.Set(00000FFFFH);
NEW(ProtoTcTextHover, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcTextHover);
NEW(ColorPrototype, NIL, Strings.NewString("ClTextSelected"), Strings.NewString("text color of the tab item, when selected")); ColorPrototype.Set(0000FFFFH);
NEW(ProtoTcTextSelected, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcTextSelected);
NEW(ColorPrototype, NIL, Strings.NewString("ClTextAttention"), Strings.NewString("text color of the tab item, when attention is required")); ColorPrototype.Set(0000FFFFH);
NEW(ProtoTcTextAttention, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcTextAttention);
NEW(ColorPrototype, NIL, Strings.NewString("ClTextSelectedAttention"),
Strings.NewString("text color of the tab item, when selected and attention is required")); ColorPrototype.Set(0000FFFFH);
NEW(ProtoTcTextSelectedAttention, ColorPrototype, NIL, NIL); plTabs.Add(ProtoTcTextSelectedAttention);
NEW(Int32Prototype, NIL, Strings.NewString("BorderWidth"), Strings.NewString("Width of the border of the tabs")); Int32Prototype.Set(3);
NEW(ProtoTcBorderWidth, Int32Prototype, NIL, NIL); plTabs.Add(ProtoTcBorderWidth);
WMComponents.propertyListList.UpdateStyle;
END InitPrototypes;
BEGIN
InitStrings;
InitPrototypes;
END WMTabComponents.
SystemTools.Free WMTabComponents ~
WMTabComponents.Open ~