MODULE WMTabComponents; (** AUTHOR "?/staubesv"; PURPOSE "Tab component" *) IMPORT KernelLog, Strings, XML, WMEvents, WMProperties, WMStandardComponents, WMRectangles, WMComponents, WMGraphics; TYPE Tab* = OBJECT VAR caption- : Strings.String; w : LONGINT; width : LONGINT; (* if 0, automatically determine width based on caption string size *) 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, lines : LONGINT; lineHeight-: WMProperties.Int32Property; tabs-, hover, selected- : Tab; canvasState : WMGraphics.CanvasState; onSelectTab- : WMEvents.EventSource; (* general look *) useBgBitmaps- : WMProperties.BooleanProperty; borderWidth- : WMProperties.Int32Property; (* colors *) clDefault-, clHover-, clSelected-, clAttention-, clSelectedAttention-, clTextDefault-, clTextHover-, clTextSelected-, clTextAttention, clTextSelectedAttention- : WMProperties.ColorProperty; (* background bitmaps *) 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); SetGenerator("WMTabComponents.GenTabControl"); lines := 1; 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); (* general look *) NEW(borderWidth, ProtoTcBorderWidth, NIL, NIL); properties.Add(borderWidth); NEW(useBgBitmaps, ProtoTcUseBgBitmaps, NIL, NIL); properties.Add(useBgBitmaps); (* background colors *) 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); (* text colors *) 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); (* background bitmaps *) 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); NEW(lineHeight, ProtoLineHeight, NIL, NIL); properties.Add(lineHeight); 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; Invalidate; 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; ELSIF (property = bounds) THEN CalcSize; PropertyChanged^(sender, property); 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,y: LONGINT) : Tab; VAR cur : Tab; pos,posy, dl, w,h: LONGINT; BEGIN IF left.visible.Get() THEN dl := left.bounds.GetWidth() ELSE dl := 0 END; h := lineHeight.Get(); IF h = 0 THEN h := bounds.GetHeight() END; pos := - leftOfs + dl; posy := 0; cur := tabs; WHILE cur # NIL DO w := cur.w; IF pos + w > bounds.GetWidth() THEN INC(posy, h); pos := dl; (*RETURN NIL*) END; pos := pos + w; IF (x < pos) & (y < posy+h) THEN RETURN cur END; cur := cur.next END; RETURN NIL END FindTabFromPos; PROCEDURE PointerDown*(x, y: LONGINT; keys: SET); (** PROTECTED *) VAR new : Tab; BEGIN IF 0 IN keys THEN new := FindTabFromPos(x,y); 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); (** PROTECTED *) VAR new : Tab; BEGIN new := FindTabFromPos(x,y); IF hover # new THEN hover := new; Invalidate END END PointerMove; PROCEDURE PointerLeave; BEGIN hover := NIL; Invalidate END PointerLeave; PROCEDURE GetLeftTabs(VAR w: LONGINT; inner: BOOLEAN): BOOLEAN; VAR cur : Tab; font : WMGraphics.Font; dx, dy, lh,dl : LONGINT; width, pos: LONGINT; BEGIN IF left.visible.Get() THEN dl := left.bounds.GetWidth() ELSE dl := 0 END; font := GetFont(); cur := tabs; pos := -leftOfs+dl; 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; IF (pos >= 0) & inner THEN RETURN TRUE END; pos := pos + w; IF (pos >= 0) & ~inner THEN RETURN TRUE END; cur := cur.next; END; RETURN FALSE END GetLeftTabs; PROCEDURE MoveLeft(sender, data : ANY); VAR w: LONGINT; BEGIN IF GetLeftTabs(w, FALSE) THEN DEC(leftOfs, w) END; (*DEC(leftOfs, 10);*) IF leftOfs < 0 THEN leftOfs := 0 END; CalcSize; Invalidate; END MoveLeft; PROCEDURE MoveRight(sender, data : ANY); VAR w: LONGINT; BEGIN IF GetLeftTabs(w, TRUE) THEN INC(leftOfs, w) END; (* INC(leftOfs, 10); *) IF leftOfs > totalWidth - 10 THEN leftOfs := totalWidth - 10 END; CalcSize; 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()) OR (lines > 1) 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, lh : LONGINT; width, w, pos: LONGINT; BEGIN font := GetFont(); totalWidth := 0; width := 0; lines := 1; lh := lineHeight.Get(); cur := tabs; pos := -leftOfs; 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; IF (pos + w > bounds.GetWidth()) & (lh # 0) THEN width := 0; pos := 0; INC(lines); END; width := width + w; pos := pos + w; cur := cur.next; IF width > totalWidth THEN totalWidth := width END; END; IF lh # 0 THEN bounds.SetHeight(lines * lh) 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; (* Set fixed width for the specified tab. If width = 0, the width of the tab is detemined by the width of the caption String *) 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, lh, dl, dr, wLeft, wRight : LONGINT; pos,ypos : LONGINT; dx, dy, dc : LONGINT; cur : Tab; font : WMGraphics.Font; imgLeft, imgMiddle, imgRight : WMGraphics.Image; BEGIN border := borderWidth.Get(); font := GetFont(); dc := font.descent; (* DrawBackground^(canvas); *) lh := lineHeight.Get(); IF lh # 0 THEN h := lh ELSE h:= bounds.GetHeight() END; 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, bounds.GetHeight())); 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; IF pos + w > bounds.GetWidth() THEN pos := 0; ypos := ypos + h; END; r := WMRectangles.MakeRect(pos, ypos, pos + w, ypos+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; (* left *) 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; (* right *) 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; (* middle *) 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 (* no bitmaps are used to decorate the background *) 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; (* caption *) 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); SetGenerator("WMTabComponents.GenTab"); 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); SetGenerator("WMTabComponents.GenTabPanel"); 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*, ProtoLineHeight : 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; (* top *) 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; (* left *) 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; (* bottom *) 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; (* right *) 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); (* tab background *) 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); (* background colors *) 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); (* background bitmaps *) 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); (* text colors *) 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); (* border width *) 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); NEW(ProtoLineHeight, NIL, Strings.NewString("LineHeight"), Strings.NewString("height of a single line. If zero then no multiline support")); ProtoLineHeight.Set(0); WMComponents.propertyListList.UpdateStyle; END InitPrototypes; BEGIN InitStrings; InitPrototypes; END WMTabComponents. SystemTools.Free WMTabComponents ~ WMTabComponents.Open ~