MODULE WMGrids;
IMPORT
Inputs, XML, WMComponents,
WMStandardComponents, Strings, Graphics := WMGraphics, WMRectangles,
WMProperties, WMEvents,
WM := WMWindowManager;
TYPE
String = Strings.String;
MeasureCellProc* = PROCEDURE {DELEGATE} (x, y : LONGINT; VAR width, height : LONGINT);
DrawCellProc* = PROCEDURE {DELEGATE} (canvas : Graphics.Canvas; w, h : LONGINT; state : SET; x, y : LONGINT);
GetCellSpansProc* = PROCEDURE {DELEGATE} (x, y : LONGINT; VAR spanx, spany : LONGINT);
GetCellStateProc* = PROCEDURE {DELEGATE} (x, y : LONGINT) : SET;
Spacings* = POINTER TO ARRAY OF LONGINT;
CONST
CellHighlighted* = 0; CellSelected* = 1; CellFocused* = 2; CellFixed* = 3;
GridSelectNone* = 0;
GridSelectSingleCell* = 1;
GridSelectSingleCol* = 2;
GridSelectSingleRow* = 3;
GridSelectHorizontal = 4;
GridSelectVertical = 5;
GridSelectCols* = 6;
GridSelectRows* = 7;
GridSelectBlock* = 8;
CONST
PixelRange = 2;
DragDist = 10;
TYPE
CellPos* = RECORD col*, row* : LONGINT END;
CellPositionInfo* = OBJECT
VAR
pos* : CellPos;
END CellPositionInfo;
GenericGrid* = OBJECT(WMComponents.VisualComponent)
VAR
getCellSpans : GetCellSpansProc;
drawCell : DrawCellProc;
getCellState : GetCellStateProc;
tableStart : CellPos;
state, tempState : Graphics.CanvasState;
scrollx, scrolly : WMStandardComponents.Scrollbar;
showScrollX-, showScrollY- : WMProperties.BooleanProperty;
showScrollXC, showScrollYC : BOOLEAN;
alwaysShowScrollX-, alwaysShowScrollY- : WMProperties.BooleanProperty;
alwaysShowScrollXC, alwaysShowScrollYC : BOOLEAN;
nofRows-, nofCols-, cellDist- : WMProperties.Int32Property;
nofRowsC, nofColsC, cellDistC : LONGINT;
rowHeights, colWidths : Spacings;
fixedCols-, fixedRows- : WMProperties.Int32Property;
fixedColsC, fixedRowsC : LONGINT;
defaultColWidth-, defaultRowHeight- : WMProperties.Int32Property;
defaultColWidthC, defaultRowHeightC : LONGINT;
allowColResize-, allowRowResize- : WMProperties.BooleanProperty;
adjustFocusPosition- : WMProperties.BooleanProperty;
focus, focusCell, highlight : CellPos;
selectionMode : LONGINT;
selStart, selEnd : CellPos;
selA : CellPos;
selecting : BOOLEAN;
drag : BOOLEAN;
pointerInside : BOOLEAN;
lastPointerX, lastPointerY :LONGINT;
wasSelected- : BOOLEAN;
onSelect- : WMEvents.EventSource;
onClick- : WMEvents.EventSource;
onClickSelected- : WMEvents.EventSource;
shiftDown : BOOLEAN;
hasOldPointer : BOOLEAN;
prevPointerInfo : WM.PointerInfo;
dragCellSpacingNr : LONGINT;
dragCellSpacingPos : LONGINT;
dragCellSpacingWidth : BOOLEAN;
dragCellSpacingHeight : BOOLEAN;
downX, downY : LONGINT;
dragPossible : BOOLEAN;
selectOnPointerOver : BOOLEAN;
lastkeys : SET;
PROCEDURE &Init*;
BEGIN
Init^;
SetNameAsString(GSGenericGrid);
takesFocus.Set(TRUE);
NEW(scrollx); NEW(scrolly);
AddInternalComponent(scrollx); AddInternalComponent(scrolly);
scrollx.alignment.Set(WMComponents.AlignBottom);
scrollx.vertical.Set(FALSE);
scrolly.alignment.Set(WMComponents.AlignRight);
scrolly.vertical.Set(TRUE);
scrollx.onPositionChanged.Add(Scrolled);
scrolly.onPositionChanged.Add(Scrolled);
selectionMode := GridSelectSingleCell;
selStart.col := -1; selStart.row := -1;
selEnd.col := -1; selEnd.row := -1;
highlight.col := -1; highlight.row := -1;
NEW(defaultColWidth, defaultColWidthProto, NIL, NIL); properties.Add(defaultColWidth);
NEW(defaultRowHeight, defaultRowHeightProto, NIL, NIL); properties.Add(defaultRowHeight);
NEW(fixedCols, fixedColsProto, NIL, NIL); properties.Add(fixedCols);
NEW(fixedRows, fixedRowsProto, NIL, NIL); properties.Add(fixedRows);
NEW(allowColResize, allowColResizeProto, NIL, NIL); properties.Add(allowColResize);
NEW(allowRowResize, allowRowResizeProto, NIL, NIL); properties.Add(allowRowResize);
NEW(nofRows, nofRowsProto, NIL, NIL); properties.Add(nofRows);
NEW(nofCols, nofColsProto, NIL, NIL); properties.Add(nofCols);
NEW(cellDist, cellDistProto, NIL, NIL); properties.Add(cellDist);
NEW(showScrollX, showScrollXProto, NIL, NIL); properties.Add(showScrollX);
NEW(showScrollY, showScrollYProto, NIL, NIL); properties.Add(showScrollY);
NEW(alwaysShowScrollX, alwaysShowScrollXProto, NIL, NIL); properties.Add(alwaysShowScrollX);
NEW(alwaysShowScrollY, alwaysShowScrollYProto, NIL, NIL); properties.Add(alwaysShowScrollY);
NEW(adjustFocusPosition, adjustFocusPositionProto, NIL, NIL); properties.Add(adjustFocusPosition);
pointerInside := FALSE;
selectOnPointerOver := FALSE;
NEW(onSelect, SELF, GSonSelect, GSonSelectInfo, SELF.StringToCompCommand); events.Add(onSelect);
NEW(onClick, SELF, GSonClick, GSonClickInfo, SELF.StringToCompCommand); events.Add(onClick);
NEW(onClickSelected, SELF, GSonClickSelected, GSonClickSelectedInfo, SELF.StringToCompCommand); events.Add(onClickSelected);
END Init;
PROCEDURE Initialize*;
BEGIN
Initialize^;
RecacheAllProperties
END Initialize;
PROCEDURE RecacheAllProperties;
BEGIN
defaultColWidthC := defaultColWidth.Get();
defaultRowHeightC := defaultRowHeight.Get();
fixedColsC := fixedCols.Get();
fixedRowsC := fixedRows.Get();
tableStart.row := Strings.Max(tableStart.row, fixedRowsC);
tableStart.col := Strings.Max(tableStart.col, fixedColsC);
nofRowsC := nofRows.Get();
nofColsC := nofCols.Get();
IF nofColsC = 1 THEN defaultColWidthC := bounds.GetWidth() END;
cellDistC := cellDist.Get();
showScrollXC := showScrollX.Get();
showScrollYC := showScrollY.Get();
alwaysShowScrollXC := alwaysShowScrollX.Get();
alwaysShowScrollYC := alwaysShowScrollY.Get();
CheckScrollbarsNeeded;
AlignSubComponents
END RecacheAllProperties;
PROCEDURE RecacheProperties;
BEGIN
RecacheProperties^;
RecacheAllProperties
END RecacheProperties;
PROCEDURE PropertyChanged*(sender, property : ANY);
BEGIN
RecacheAllProperties;
Invalidate;
PropertyChanged^(sender, property)
END PropertyChanged;
PROCEDURE GetColWidth(i : LONGINT) : LONGINT;
BEGIN
CheckReadLock;
IF colWidths = NIL THEN RETURN defaultColWidthC
ELSIF (i < 0) OR (i > nofColsC) THEN RETURN 0
ELSE
IF i >= LEN(colWidths^) THEN RETURN defaultColWidthC ELSE RETURN colWidths[i] END
END
END GetColWidth;
PROCEDURE SetColSpacings*(colWidths : Spacings);
BEGIN
Acquire;
SELF.colWidths := colWidths;
Invalidate();
Release
END SetColSpacings;
PROCEDURE GetColSpacings*() : Spacings;
VAR t : Spacings; i : LONGINT;
BEGIN
Acquire;
IF colWidths # NIL THEN NEW(t, LEN(colWidths)); FOR i := 0 TO LEN(colWidths) - 1 DO t[i] := colWidths[i] END END;
Release;
RETURN t
END GetColSpacings;
PROCEDURE SetRowSpacings*(rowHeights : Spacings);
BEGIN
Acquire;
SELF.rowHeights := rowHeights;
Invalidate();
Release
END SetRowSpacings;
PROCEDURE GetRowSpacings*() : Spacings;
VAR t : Spacings; i : LONGINT;
BEGIN
Acquire;
IF rowHeights # NIL THEN NEW(t, LEN(rowHeights)); FOR i := 0 TO LEN(rowHeights) - 1 DO t[i] := rowHeights[i] END END;
Release;
RETURN t
END GetRowSpacings;
PROCEDURE SetSelectOnPointerOver*(select : BOOLEAN);
BEGIN
selectOnPointerOver := select;
END SetSelectOnPointerOver;
PROCEDURE GetRowHeight(i : LONGINT) : LONGINT;
BEGIN
CheckReadLock;
IF rowHeights = NIL THEN RETURN defaultRowHeightC
ELSIF (i < 0) OR (i > nofRowsC) THEN RETURN 0
ELSE
IF i >= LEN(rowHeights^) THEN RETURN defaultRowHeightC ELSE RETURN rowHeights[i] END
END
END GetRowHeight;
PROCEDURE SetSelectionMode*(mode : LONGINT);
BEGIN
Acquire;
IF mode # selectionMode THEN
selectionMode := mode;
Invalidate()
END;
Release
END SetSelectionMode;
PROCEDURE GetSelectionMode*():LONGINT;
BEGIN
RETURN selectionMode
END GetSelectionMode;
PROCEDURE SetDrawCellProc*(dcp :DrawCellProc);
BEGIN
Acquire;
IF SELF.drawCell # dcp THEN
SELF.drawCell := dcp;
Invalidate()
END;
Release
END SetDrawCellProc;
PROCEDURE GetFixedPixels(VAR w, h :LONGINT);
VAR i : LONGINT;
BEGIN
w := 0; h := 0;
FOR i := 0 TO fixedColsC - 1 DO INC(w, GetColWidth(i) + cellDistC) END;
FOR i := 0 TO fixedRowsC - 1 DO INC(h, GetRowHeight(i) + cellDistC) END;
END GetFixedPixels;
PROCEDURE SetCellSpansProc*(gcsp : GetCellSpansProc);
BEGIN
IF getCellSpans # gcsp THEN
Acquire;
getCellSpans := gcsp;
Release
END
END SetCellSpansProc;
PROCEDURE GetCellSpans(x, y : LONGINT; VAR spanx, spany : LONGINT);
BEGIN
IF getCellSpans # NIL THEN getCellSpans(x, y, spanx, spany)
ELSE spanx := 1; spany := 1
END
END GetCellSpans;
PROCEDURE IsSkipCell(x, y : LONGINT) : BOOLEAN;
VAR spanx, spany : LONGINT;
BEGIN
GetCellSpans(x, y, spanx, spany);
RETURN (spanx = 0) OR (spany = 0)
END IsSkipCell;
PROCEDURE GetCellDimensions(x, y : LONGINT; VAR width, height : LONGINT);
VAR spanx, spany, i : LONGINT;
BEGIN
GetCellSpans(x, y, spanx, spany);
width := -cellDistC; height := -cellDistC;
FOR i := 0 TO spanx - 1 DO width := width + GetColWidth(x) + cellDistC END;
FOR i := 0 TO spany - 1 DO height := height + GetRowHeight(y) + cellDistC END
END GetCellDimensions;
PROCEDURE GetCellData*(col, row : LONGINT) : ANY;
VAR position : CellPositionInfo;
BEGIN
NEW(position); position.pos.row := row; position.pos.col := col;
RETURN position
END GetCellData;
PROCEDURE GetCellState(x, y : LONGINT) : SET;
VAR state : SET;
BEGIN
IF getCellState # NIL THEN RETURN getCellState(x, y)
ELSE
state := {};
IF (x = focus.col) & (y = focus.row) THEN state := state + {CellFocused} END;
IF (x < fixedColsC) OR (y < fixedRowsC) THEN state := state + {CellFixed} END;
CASE selectionMode OF
| GridSelectSingleCell :
IF (x = selStart.col) & (y = selStart.row) THEN state := state + {CellSelected} END;
IF (x = highlight.col) & (y = highlight.row) THEN state := state + {CellHighlighted} END
| GridSelectSingleCol, GridSelectCols :
IF (x >= selStart.col) & (x <= selEnd.col) THEN state := state + {CellSelected} END;
IF (x = highlight.col) THEN state := state + {CellHighlighted} END
| GridSelectSingleRow, GridSelectRows :
IF (y >= selStart.row) & (y <= selEnd.row) THEN state := state + {CellSelected} END;
IF (y = highlight.row) THEN state := state + {CellHighlighted} END
| GridSelectBlock, GridSelectHorizontal, GridSelectVertical :
IF (x >= selStart.col) & (x <= selEnd.col) &(y >= selStart.row) & (y <= selEnd.row) THEN state := state + {CellSelected} END;
IF (x = highlight.col) & (y = highlight.row) THEN state := state + {CellHighlighted} END;
ELSE
END;
RETURN state
END
END GetCellState;
PROCEDURE FindMasterCell(x, y : LONGINT; VAR col, row, xpos, ypos : LONGINT);
VAR cw, ch : LONGINT;
BEGIN
col := x; row := y;
GetCellSpans(col, row, cw, ch);
WHILE (cw = 0) OR (ch = 0) DO
IF cw = 0 THEN DEC(col); DEC(xpos, GetColWidth(col) + cellDistC) END;
IF ch = 0 THEN DEC(row); DEC(ypos, GetRowHeight(row) + cellDistC) END;
GetCellSpans(col, row, cw, ch)
END
END FindMasterCell;
PROCEDURE FindCellXY* (x, y : LONGINT; VAR col, row : LONGINT);
VAR tx, ty, dummy : LONGINT;
BEGIN
GetFixedPixels(tx, ty);
IF (x < tx) & (y < ty) THEN
col := 0; row := 0; tx := 0; ty := 0;
REPEAT tx := tx + GetColWidth(col) + cellDistC; INC(col) UNTIL (col >= fixedColsC) OR (tx >= x); DEC(col);
REPEAT ty := ty + GetRowHeight(row) + cellDistC; INC(row) UNTIL (row >= fixedRowsC) OR (ty >= y); DEC(row);
ELSIF (x < tx) THEN
col := 0; row := tableStart.row; tx := 0;
REPEAT tx := tx + GetColWidth(col) + cellDistC; INC(col) UNTIL (col >= fixedColsC) OR (tx >= x); DEC(col);
REPEAT ty := ty + GetRowHeight(row) + cellDistC; INC(row) UNTIL (row >= nofRowsC) OR (ty >= y); DEC(row);
ELSIF (y < ty) THEN
col := tableStart.col; row := 0; ty := 0;
REPEAT tx := tx + GetColWidth(col) + cellDistC; INC(col) UNTIL (col >= nofColsC) OR (tx >= x); DEC(col);
REPEAT ty := ty + GetRowHeight(row) + cellDistC; INC(row) UNTIL (row >= fixedRowsC) OR (ty >= y); DEC(row);
ELSE
col := tableStart.col; row := tableStart.row;
REPEAT tx := tx + GetColWidth(col) + cellDistC; INC(col) UNTIL (col >= nofColsC) OR (tx >= x); DEC(col);
REPEAT ty := ty + GetRowHeight(row) + cellDistC; INC(row) UNTIL (row >= nofRowsC) OR (ty >= y); DEC(row);
END;
FindMasterCell(col, row, col, row, dummy, dummy)
END FindCellXY;
PROCEDURE CheckScrollbarsNeeded;
VAR xmax, ymax : LONGINT;
BEGIN
xmax := nofColsC - 1; ymax := nofRowsC - 1;
scrollx.max.Set(xmax); scrolly.max.Set(ymax);
scrollx.visible.Set((alwaysShowScrollXC OR (xmax > 1)) & showScrollXC);
scrolly.visible.Set((alwaysShowScrollYC OR (ymax > 1)) & showScrollYC)
END CheckScrollbarsNeeded;
PROCEDURE GetVisibleCellRect(col, row : LONGINT): WMRectangles.Rectangle;
VAR x, y, i, tc, tr, tx, ty, w, h: LONGINT; rect : WMRectangles.Rectangle;
BEGIN
GetFixedPixels(tx, ty);
IF (col < fixedColsC) & (row < fixedRowsC) THEN
x := 0; FOR i := 0 TO col - 1 DO INC(x, GetColWidth(i) + cellDistC) END;
y := 0; FOR i := 0 TO row -1 DO INC(y, GetRowHeight(i) + cellDistC) END
ELSIF col < fixedColsC THEN
x := 0; FOR i := 0 TO col - 1 DO INC(x, GetColWidth(i) + cellDistC) END;
y := ty; FOR i := tableStart.row TO row -1 DO INC(y, GetRowHeight(i) + cellDistC) END
ELSIF row < fixedRowsC THEN
x := tx; FOR i := tableStart.col TO col - 1 DO INC(x, GetColWidth(i) + cellDistC) END;
y := 0; FOR i := 0 TO row -1 DO INC(y, GetRowHeight(i) + cellDistC) END
ELSE
x := tx; FOR i := tableStart.col TO col - 1 DO INC(x, GetColWidth(i) + cellDistC) END;
y := ty; FOR i := tableStart.row TO row -1 DO INC(y, GetRowHeight(i) + cellDistC) END;
END;
FindMasterCell(col, row, tc, tr, x, y);
rect.l := x; rect.t := y;
GetCellDimensions(tc, tr, w, h); rect.r := rect.l + w; rect.b := rect.t + h;
RETURN rect
END GetVisibleCellRect;
PROCEDURE DrawBackground(canvas : Graphics.Canvas);
VAR i, j, x, y, w, h, cw, ch, ti, tj, tx, ty, fx, fy : LONGINT;
skip : BOOLEAN;
r, clip : WMRectangles.Rectangle;
BEGIN
DrawBackground^(canvas);
tableStart.row := Strings.Max(tableStart.row, fixedRowsC);
tableStart.col := Strings.Max(tableStart.col, fixedColsC);
canvas.GetClipRect(clip);
canvas.SaveState(state);
GetFixedPixels(fx, fy);
y := 0;
FOR j := 0 TO fixedRowsC - 1 DO
x := 0; h := GetRowHeight(j);
FOR i := 0 TO fixedColsC - 1 DO
w := GetColWidth(i);
r := WMRectangles.MakeRect(x, y, x + w, y + h);
IF WMRectangles.Intersect(r, clip) THEN
canvas.SetClipRect(r);
canvas.ClipRectAsNewLimits(x, y);
IF drawCell # NIL THEN drawCell(canvas, w, h, GetCellState(i, j), i, j) END;
canvas.RestoreState(state)
END;
INC(x, w + cellDistC)
END;
INC(y, h + cellDistC)
END;
y := 0;
FOR j := 0 TO fixedRowsC - 1 DO
h := GetRowHeight(j);
i := tableStart.col; x := fx;
WHILE (i < nofColsC) & (x < bounds.GetWidth()) DO
w := GetColWidth(i);
r := WMRectangles.MakeRect(x, y, x + w, y + h);
IF WMRectangles.Intersect(r, clip) THEN
canvas.SetClipRect(r);
canvas.ClipRectAsNewLimits(x, y);
IF drawCell # NIL THEN drawCell(canvas, w, h, GetCellState(i, j), i, j) END;
canvas.RestoreState(state)
END;
INC(i);
INC(x, w + cellDistC)
END;
INC(y, h + cellDistC)
END;
y := fy;
j := tableStart.row;
WHILE (j < nofRowsC) & (y < bounds.GetHeight()) DO
h := GetRowHeight(j);
i := 0; x := 0;
FOR i := 0 TO fixedColsC - 1 DO
w := GetColWidth(i);
r := WMRectangles.MakeRect(x, y, x + w, y + h);
IF WMRectangles.Intersect(r, clip) THEN
canvas.SetClipRect(r);
canvas.ClipRectAsNewLimits(x, y);
IF drawCell # NIL THEN drawCell(canvas, w, h, GetCellState(i, j), i, j) END;
canvas.RestoreState(state)
END;
INC(x, w + cellDistC)
END;
INC(j);
INC(y, h + cellDistC)
END;
canvas.SetClipRect(WMRectangles.MakeRect(fx, fy, bounds.GetWidth(), bounds.GetHeight()));
canvas.ClipRectAsNewLimits(0, 0);canvas.SaveState(tempState);
j := tableStart.row; y := fy;
WHILE (j < nofRowsC) & (y < bounds.GetHeight()) DO
i := tableStart.col; x := fx;
h := GetRowHeight(j);
WHILE (i < nofColsC) & (x < bounds.GetWidth()) DO
w := GetColWidth(i);
tx := x; ty := y; ti := i; tj := j;
skip := IsSkipCell(ti, tj);
IF (~skip) OR (i = tableStart.col) OR (j = tableStart.row) THEN
IF skip THEN
FindMasterCell(ti, tj, ti, tj, tx, ty);
END;
GetCellDimensions(ti, tj, cw, ch);
r := WMRectangles.MakeRect(tx, ty, tx + cw, ty + ch);
IF WMRectangles.Intersect(r, clip) THEN
canvas.SetClipRect(r);
canvas.ClipRectAsNewLimits(tx, ty);
IF drawCell # NIL THEN drawCell(canvas, w, h, GetCellState(i, j), i, j) END;
canvas.RestoreState(tempState)
END
END;
INC(i); INC(x, w + cellDistC)
END;
INC(j); INC(y, h + cellDistC)
END;
canvas.RestoreState(state)
END DrawBackground;
PROCEDURE InvalidateCell*(col, row : LONGINT);
BEGIN
Acquire;
InvalidateRect(GetVisibleCellRect(col, row));
Release
END InvalidateCell;
PROCEDURE SetTopPosition*(col, row : LONGINT; updateScrollbar : BOOLEAN);
BEGIN
Acquire;
col := Strings.Min(Strings.Max(col, fixedColsC), nofColsC - 1);
row := Strings.Min(Strings.Max(row, fixedRowsC), nofRowsC - 1);
IF (col # tableStart.col) OR (row # tableStart.row) THEN
tableStart.col := col; tableStart.row := row;
IF pointerInside THEN FindCellXY(lastPointerX, lastPointerY, highlight.col, highlight.row) END;
Invalidate();
IF updateScrollbar THEN scrollx.pos.Set(col); scrolly.pos.Set(row) END
END;
Release
END SetTopPosition;
PROCEDURE GetTopPosition*(VAR col, row : LONGINT);
BEGIN
Acquire;
col := tableStart.col; row := tableStart.row;
Release
END GetTopPosition;
PROCEDURE ScrollCellVisible(col, row : LONGINT);
VAR cur : CellPos; r : WMRectangles.Rectangle; w, h: LONGINT;
BEGIN
cur := tableStart;
w := bounds.GetWidth(); h := bounds.GetHeight();
r := GetVisibleCellRect(col, row);
WHILE (r.r > w) & (cur.col < col) DO DEC(r.r, GetColWidth(cur.col)); INC(cur.col) END;
WHILE (r.b > h) & (cur.row < row) DO DEC(r.b, GetRowHeight(cur.row)); INC(cur.row) END;
cur.col := Strings.Min(cur.col, col);
cur.row := Strings.Min(cur.row, row);
SetTopPosition(cur.col, cur.row, TRUE)
END ScrollCellVisible;
PROCEDURE SetFocusPos(col, row : LONGINT);
VAR oldfocus : CellPos; dummy : LONGINT;
BEGIN
IF ~adjustFocusPosition.Get() THEN RETURN; END;
oldfocus := focus; focus.col := col; focus.row := row;
FindMasterCell(focus.col, focus.row, focusCell.col, focusCell.row, dummy, dummy);
InvalidateCell(oldfocus.col, oldfocus.row); InvalidateCell(focusCell.col, focusCell.row);
ScrollCellVisible(focusCell.col, focusCell.row)
END SetFocusPos;
PROCEDURE KeyEvent(ucs : LONGINT; flags: SET; VAR keysym: LONGINT);
PROCEDURE AdjustSelection;
BEGIN
IF shiftDown THEN SetSelection(selA.col, selA.row, focus.col, focus.row)
ELSE selA := focus; SetSelection(focus.col, focus.row, focus.col, focus.row)
END
END AdjustSelection;
BEGIN
shiftDown := Inputs.Shift * flags # {};
IF (keysym = 0FF51H) & (focus.col > fixedColsC) THEN SetFocusPos(focus.col - 1, focus.row); AdjustSelection
ELSIF (keysym = 0FF53H) & (focus.col < nofColsC - 1) THEN SetFocusPos(focus.col + 1, focus.row); AdjustSelection
ELSIF (keysym = 0FF52H) & (focus.row > fixedRowsC) THEN SetFocusPos(focus.col, focus.row - 1); AdjustSelection
ELSIF (keysym = 0FF54H) & (focus.row < nofRowsC - 1) THEN SetFocusPos(focus.col, focus.row + 1); AdjustSelection
END
END KeyEvent;
PROCEDURE Scrolled(sender, data : ANY);
BEGIN
IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Scrolled, sender, data)
ELSE SetTopPosition(scrollx.pos.Get(), scrolly.pos.Get(), FALSE)
END
END Scrolled;
PROCEDURE SetHighlight(col, row : LONGINT);
VAR or, nr, cr : WMRectangles.Rectangle;
BEGIN
Acquire;
IF (col = highlight.col) & (row = highlight.row)
OR (selectionMode IN {GridSelectSingleCol, GridSelectCols}) & (col = highlight.col)
OR (selectionMode IN {GridSelectSingleRow, GridSelectRows}) & (row = highlight.row)
THEN Release; RETURN
END;
CASE selectionMode OF
| GridSelectSingleCol, GridSelectCols : nr := GetVisibleColRect(col); or := GetVisibleColRect(highlight.col)
| GridSelectSingleRow, GridSelectRows : nr := GetVisibleRowRect(row); or := GetVisibleRowRect(highlight.row)
ELSE
or := GetVisibleCellRect(highlight.col, highlight.row);
nr := GetVisibleCellRect(col, row);
END;
highlight.col := col; highlight.row := row;
cr := or; WMRectangles.ExtendRect(cr, nr);
IF WMRectangles.Area(or) + WMRectangles.Area(nr) < WMRectangles.Area(cr) THEN InvalidateRect(or); InvalidateRect(nr)
ELSE InvalidateRect(cr)
END;
Release
END SetHighlight;
PROCEDURE GetVisibleColRect(col : LONGINT) : WMRectangles.Rectangle;
VAR r : WMRectangles.Rectangle;
BEGIN
r := GetVisibleCellRect(col, tableStart.row);
r.t := 0; r.b := bounds.GetHeight();
RETURN r
END GetVisibleColRect;
PROCEDURE GetVisibleRowRect(row: LONGINT) : WMRectangles.Rectangle;
VAR r : WMRectangles.Rectangle;
BEGIN
r := GetVisibleCellRect(tableStart.col, row);
r.l := 0; r.r := bounds.GetWidth();
RETURN r
END GetVisibleRowRect;
PROCEDURE SetSelection*(scol, srow, ecol, erow : LONGINT);
VAR or, nr, cr : WMRectangles.Rectangle; done : BOOLEAN;
oldStart, oldEnd : CellPos;
BEGIN
Acquire;
oldStart := selStart; oldEnd := selEnd;
selStart.col := Strings.Min(scol, ecol); selStart.row := Strings.Min(srow, erow);
selEnd.col := Strings.Max(scol, ecol); selEnd.row := Strings.Max(srow, erow);
IF (oldStart.col = selStart.col) & (oldStart.row= selStart.row) &
(oldEnd.col = selEnd.col) & (oldEnd.row= selEnd.row) THEN
Release;
RETURN
END;
done := FALSE;
CASE selectionMode OF
| GridSelectSingleCell :
or := GetVisibleCellRect(oldStart.col, oldStart.row); nr := GetVisibleCellRect(selStart.col, selStart.row)
| GridSelectSingleCol : or := GetVisibleColRect(oldStart.col); nr := GetVisibleColRect(selStart.col)
| GridSelectSingleRow : or := GetVisibleRowRect(oldStart.row); nr := GetVisibleRowRect(selStart.row)
ELSE
Invalidate(); done := TRUE
END;
IF ~done THEN
cr := or; WMRectangles.ExtendRect(cr, nr);
IF WMRectangles.Area(or) + WMRectangles.Area(nr) < WMRectangles.Area(cr) THEN InvalidateRect(or); InvalidateRect(nr)
ELSE InvalidateRect(cr)
END;
END;
Release;
onSelect.Call(NIL)
END SetSelection;
PROCEDURE GetSelection*(VAR scol, srow, ecol, erow : LONGINT);
BEGIN
Acquire;
scol := selStart.col; srow := selStart.row;
ecol := selEnd.col; erow := selEnd.row;
Release
END GetSelection;
PROCEDURE OnFixedXGridLine(x, y : LONGINT; VAR xCell, pos : LONGINT) : BOOLEAN;
VAR ty, tx : LONGINT;
PROCEDURE Find(startX, endX, startCol, endCol : LONGINT; VAR col, xPos : LONGINT) : BOOLEAN;
VAR cw : LONGINT;
BEGIN
col := startCol; xPos := startX;
REPEAT
cw := GetColWidth(col);
IF ABS(xPos + cw + cellDistC - x) < PixelRange THEN RETURN TRUE END;
xPos := xPos + cw + cellDistC; INC(col);
UNTIL (col >= endCol) OR (xPos >= endX);
RETURN FALSE
END Find;
BEGIN
GetFixedPixels(tx, ty);
IF (x < tx) & (y < ty) OR (x < tx) THEN
RETURN Find(0, x + PixelRange, 0, fixedColsC, xCell, pos)
ELSIF (y < ty) THEN
RETURN Find(tx, x + PixelRange, tableStart.col, nofColsC, xCell, pos)
ELSE
RETURN FALSE
END
END OnFixedXGridLine;
PROCEDURE OnFixedYGridLine(x, y : LONGINT; VAR yCell, pos : LONGINT) : BOOLEAN;
VAR ty, tx : LONGINT;
PROCEDURE Find(startY, endY, startRow, endRow : LONGINT; VAR row, yPos : LONGINT) : BOOLEAN;
VAR ch : LONGINT;
BEGIN
row := startRow; yPos := startY;
REPEAT
ch := GetRowHeight(row);
IF ABS(yPos + ch + cellDistC - y) < PixelRange THEN RETURN TRUE END;
yPos := yPos + ch + cellDistC; INC(row);
UNTIL (row >= endRow) OR (yPos >= endY);
RETURN FALSE
END Find;
BEGIN
GetFixedPixels(tx, ty);
IF (y < ty) THEN
RETURN Find(0, y + PixelRange, 0, fixedRowsC, yCell, pos)
ELSIF (x < tx) THEN
RETURN Find(ty, y + PixelRange, tableStart.row, nofRowsC, yCell, pos)
ELSE
RETURN FALSE
END
END OnFixedYGridLine;
PROCEDURE PointerDown(x, y : LONGINT; keys : SET);
VAR col, row : LONGINT; state : SET;
BEGIN
PointerDown^(x, y, keys);
lastkeys := keys;
IF keys * {0} # {} THEN
IF allowColResize.Get() & (colWidths # NIL) & OnFixedXGridLine(x, y, dragCellSpacingNr, dragCellSpacingPos) THEN
dragCellSpacingWidth := TRUE;
ELSIF allowRowResize.Get() & (rowHeights # NIL) & OnFixedYGridLine(x, y, dragCellSpacingNr, dragCellSpacingPos) THEN
dragCellSpacingHeight := TRUE;
ELSE
FindCellXY(x, y, col, row);
state := GetCellState(col, row);
wasSelected := CellSelected IN state;
IF shiftDown & (0 IN keys) THEN
SetSelection(selA.col, selA.row, col, row);
dragPossible := FALSE; selecting := TRUE
ELSE
IF CellSelected IN state THEN selecting := FALSE; dragPossible := TRUE; downX := x; downY := y
ELSE
dragPossible := FALSE; selecting := TRUE;
selA.col := col; selA.row := row; SetFocusPos(col, row);
SetSelection(col, row, col, row)
END
END
END
END
END PointerDown;
PROCEDURE PointerLeave;
BEGIN
SetHighlight(-1, -1); pointerInside := FALSE
END PointerLeave;
PROCEDURE PointerMove(x, y : LONGINT; keys : SET);
VAR col, row : LONGINT; manager : WM.WindowManager; cell, pos : LONGINT;
BEGIN
IF dragCellSpacingWidth THEN
x := Strings.Min(x, bounds.GetWidth());
IF (colWidths # NIL) & (dragCellSpacingNr < LEN(colWidths)) THEN
colWidths[dragCellSpacingNr] := Strings.Max(x - dragCellSpacingPos, 1);
Invalidate()
END;
ELSIF dragCellSpacingHeight THEN
y := Strings.Min(y, bounds.GetHeight());
IF (rowHeights # NIL) & (dragCellSpacingNr < LEN(rowHeights)) THEN
rowHeights[dragCellSpacingNr] := Strings.Max(y - dragCellSpacingPos, 1);
Invalidate()
END;
ELSIF dragPossible THEN
IF (ABS(x - downX) > DragDist) OR (ABS(y - downY) > DragDist) THEN
dragPossible := FALSE;
drag := TRUE;
AutoStartDrag
END
ELSE
FindCellXY(x, y, col, row); pointerInside := TRUE; lastPointerX := x; lastPointerY := y;
IF allowColResize.Get() & (colWidths # NIL) & OnFixedXGridLine(x, y, cell, pos) THEN
IF ~hasOldPointer THEN
prevPointerInfo := GetPointerInfo();
hasOldPointer := TRUE;
manager := WM.GetDefaultManager();
SetPointerInfo(manager.pointerLeftRight)
END;
ELSIF allowRowResize.Get() & (rowHeights # NIL) & OnFixedYGridLine(x, y, cell, pos) THEN
IF ~hasOldPointer THEN
prevPointerInfo := GetPointerInfo();
hasOldPointer := TRUE;
manager := WM.GetDefaultManager();
SetPointerInfo(manager.pointerUpDown)
END;
ELSE
IF hasOldPointer THEN SetPointerInfo(prevPointerInfo); hasOldPointer := FALSE END;
END;
IF selecting THEN
IF 0 IN keys THEN
CASE selectionMode OF
| GridSelectSingleCell, GridSelectSingleCol, GridSelectSingleRow : SetSelection(col, row, col, row)
| GridSelectCols, GridSelectRows, GridSelectBlock, GridSelectHorizontal, GridSelectVertical:
SetSelection(selA.col, selA.row, col, row)
ELSE
END;
SetFocusPos(col, row)
END
END;
IF selectOnPointerOver THEN SetSelection(col, row, col, row) END;
SetHighlight(col, row)
END;
IF keys = {} THEN dragPossible := FALSE; selecting := FALSE END
END PointerMove;
PROCEDURE CellClicked*(col, row : LONGINT);
BEGIN
IF wasSelected & onClickSelected.HasListeners() THEN
dragPossible := FALSE;
onClickSelected.Call(GetCellData(col, row))
END;
IF onClick.HasListeners() THEN
onClick.Call(GetCellData(col, row))
END
END CellClicked;
PROCEDURE PointerUp(x, y : LONGINT; keys : SET);
VAR col, row : LONGINT; d : BOOLEAN;
BEGIN
IF 2 IN lastkeys THEN lastkeys := keys; RETURN END;
d := dragCellSpacingWidth OR dragCellSpacingHeight OR
(selecting & (selStart.row # selEnd.row) OR (selStart.col # selEnd.col));
IF ~d THEN
FindCellXY(x, y, col, row);
SetSelection(col, row, col, row); SetFocusPos(col, row);
IF ~drag THEN CellClicked(col, row) END
END;
drag := FALSE;
dragCellSpacingWidth := FALSE; dragCellSpacingHeight := FALSE;
selecting := FALSE
END PointerUp;
PROCEDURE WheelMove*(dz: LONGINT);
VAR t, l : LONGINT;
BEGIN
GetTopPosition(l, t); t := t + dz; SetTopPosition(l, t, TRUE)
END WheelMove;
END GenericGrid;
VAR
GSonSelect, GSonClick, GSonClickSelected,
GSonSelectInfo, GSonClickInfo, GSonClickSelectedInfo: String;
GSGenericGrid : String;
fixedColsProto, fixedRowsProto : WMProperties.Int32Property;
defaultColWidthProto, defaultRowHeightProto : WMProperties.Int32Property;
allowColResizeProto, allowRowResizeProto, adjustFocusPositionProto : WMProperties.BooleanProperty;
nofColsProto, nofRowsProto, cellDistProto : WMProperties.Int32Property;
showScrollXProto, showScrollYProto, alwaysShowScrollXProto, alwaysShowScrollYProto : WMProperties.BooleanProperty;
PROCEDURE Init;
BEGIN
GSonSelect := NewString("onSelect");
GSonClick := NewString("onClick");
GSonClickSelected := NewString("onClickSelected");
GSonSelectInfo := NewString("Is called when a cell is selected");
GSonClickInfo := NewString("is called on a click");
GSonClickSelectedInfo := NewString("is called when a selected cell is clicked");
GSGenericGrid := NewString("GenericGrid");
END Init;
PROCEDURE InitProto;
BEGIN
NEW(fixedColsProto, NIL, NewString("fixedCols"), NewString("number of fixed columns"));
NEW(fixedRowsProto, NIL, NewString("fixedRows"), NewString("number of fixed rows"));
NEW(defaultColWidthProto, NIL, NewString("defaultColWidth"), NewString("default width of a column"));
NEW(defaultRowHeightProto, NIL, NewString("defaultRowHeight"), NewString("default height of a row"));
defaultColWidthProto.Set(100); defaultRowHeightProto.Set(20);
NEW(allowColResizeProto, NIL, NewString("allowColResize"), NewString("can columns be resized"));
allowColResizeProto.Set(TRUE);
NEW(allowRowResizeProto, NIL, NewString("allowRowResize"), NewString("can rows be resized"));
allowRowResizeProto.Set(TRUE);
NEW(adjustFocusPositionProto, NIL, NewString("adjustFocusPosition"), NewString("focus adjusting when clicking/dragging cells"));
adjustFocusPositionProto.Set(TRUE);
NEW(nofColsProto, NIL, NewString("nofCols"), NewString("number of columns in the table"));
nofColsProto.Set(1);
NEW(nofRowsProto, NIL, NewString("nofRows"), NewString("number of rows in the table"));
nofRowsProto.Set(1);
NEW(cellDistProto, NIL, NewString("cellDist"), NewString("distance between cells"));
cellDistProto.Set(1);
NEW(showScrollXProto, NIL, NewString("showScrollX"), NewString("horizontal scrollbar is displayed if needed"));
showScrollXProto.Set(TRUE);
NEW(showScrollYProto, NIL, NewString("showScrollY"), NewString("vertical scrollbar is displayed if needed"));
showScrollYProto.Set(TRUE);
NEW(alwaysShowScrollXProto, NIL, NewString("alwaysShowScrollX"), NewString("horizontal scrollbar is always displayed"));
NEW(alwaysShowScrollYProto, NIL, NewString("alwaysShowScrollY"), NewString("vertical scrollbar is always displayed"));
END InitProto;
PROCEDURE GenGrid*() : XML.Element;
VAR grid : GenericGrid;
BEGIN
NEW(grid);
RETURN grid
END GenGrid;
PROCEDURE NewString*(CONST x : ARRAY OF CHAR) : String;
BEGIN
RETURN Strings.NewString(x)
END NewString;
BEGIN
Init;
InitProto;
END WMGrids.
SystemTools.Free WMGrids ~
History:
03.04.2006 Added AlignSubComponents in last line for GenericGrid.RecacheAllProperties