Код:
(O) TempGraphic.Open
MODULE TempGraphic;
IMPORT Views, Ports, Models, Stores, Controllers, ObxRandom, TextViews, TextModels;
CONST
bandH = 10 * Ports.mm;
TYPE
Plot = POINTER TO RECORD (Views.View)
data: POINTER TO ARRAY OF INTEGER; (* % *)
topBand: INTEGER; (* Верхний отображаемый столбец *)
blocks, focus: Context
END;
Context = POINTER TO RECORD (Models.Context)
(* Описатель контекста для внедряемых отображений *)
next: Context;
base: Plot; (* контейнер - наш график *)
view: Views.View; (* внедряемое отображение. Mожет быть не только TextView,
но и любой другой *)
l, t, r, b: INTEGER (* cached bounding box of contained view *)
END;
PROCEDURE CalcRange (t, b: INTEGER; OUT beg, end: INTEGER);
BEGIN
beg := t DIV bandH;
end := b DIV bandH + 1
END CalcRange;
PROCEDURE DrawBand(f: Views.Frame; fW, num, val: INTEGER);
BEGIN
f.DrawRect(0, num * bandH, SHORT(ENTIER(fW / 100 * val)), (num + 1) * bandH, 0, Ports.blue)
END DrawBand;
PROCEDURE (v: Plot) Restore (f: Views.Frame; l, t, r, b: INTEGER);
VAR beg, end, len, i: INTEGER;
w, h: INTEGER;
c: Context;
BEGIN
v.context.GetSize(w, h);
len := LEN(v.data);
beg := v.topBand;
end := beg + h DIV bandH + 1;
FOR i := MIN(beg, len-1) TO MIN(end, len-1) DO
DrawBand(f, w, i-beg, v.data[i])
END;
(*Создаем подкадры для всех внедренных отображений. Дальше их отрисовку обеспечит среда*)
c := v.blocks; i := 0;
WHILE c # NIL DO
(* Рисуем рамочку *)
f.DrawRect(c.l, c.t - v.topBand*bandH, c.r, c.b - v.topBand*bandH, 0, Ports.red);
Views.InstallFrame(f, c.view, c.l, c.t - v.topBand*bandH, i, c = v.focus); INC(i); c := c.next
END
END Restore;
PROCEDURE ^ NewBlock (v: Plot; l, t, r, b: INTEGER);
PROCEDURE ^ CheckBlock (v: Plot; x, y: INTEGER): Context;
PROCEDURE (v: Plot) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
VAR focus: Views.View);
VAR w, h, len, page: INTEGER;
l, t, r, b: INTEGER;
c: Context;
PROCEDURE InputRect; (* Считываем прямоугольник для нового блока *)
VAR x, y: INTEGER;
mod: SET;
isDown: BOOLEAN;
BEGIN
f.Input(x, y, mod, isDown);
l := x; t := y;
REPEAT
f.Input(x, y, mod, isDown)
UNTIL ~isDown;
IF x < l THEN
r := l; l := x
ELSE
r := x
END;
IF y < t THEN
b := t; t := y
ELSE
b := y
END
END InputRect;
BEGIN
v.context.GetSize(w, h);
page := h DIV bandH;
len := LEN(v.data);
WITH msg: Controllers.PollSectionMsg DO (* Опрос состояния прокрутки, можно возвращать
в любых единицах, главное - отношение трех величин *)
IF msg.vertical THEN (* Отрабатываем только вертикальную прокрутку *)
msg.wholeSize := len;
msg.partPos := v.topBand;
msg.partSize := page;
msg.valid := TRUE;
msg.done := TRUE
END
| msg: Controllers.ScrollMsg DO
IF msg.vertical THEN
CASE msg.op OF
| Controllers.decLine: v.topBand := MAX(0, v.topBand-1)
| Controllers.incLine: v.topBand := MIN(v.topBand+1, len-1)
| Controllers.decPage: v.topBand := MAX(0, v.topBand-page)
| Controllers.incPage: v.topBand := MIN(v.topBand+page, len-1)
| Controllers.gotoPos: v.topBand := MAX(0, MIN(msg.pos, len-1))
END;
msg.done := TRUE;
Views.Update(v, Views.rebuildFrames)
END
| msg: Controllers.TrackMsg DO
c := CheckBlock(v, msg.x, msg.y); (* Проверяем, нет ли уже в точке блока. *)
IF c = NIL THEN (* Если нет, то создаем новый *)
InputRect;
IF r - l < 30 * Ports.mm THEN r := l + 30 * Ports.mm END;
IF b - t < 20 * Ports.mm THEN b := t + 20 * Ports.mm END;
INC(t, v.topBand*bandH); INC(b, v.topBand*bandH);
NewBlock(v, l, t, r, b)
ELSE
IF c = v.focus THEN (* Если в этой точке уже фокусированный блок, то говорим среде,
что обработку сообщения надо передать ему *)
focus := c.view
ELSE
v.focus := c (* Иначе устанавливаем новый фокус *)
END
END;
Views.Update(v, Views.rebuildFrames)
| msg: Controllers.PollCursorMsg DO (* Устанавливаем форму курсора *)
c := CheckBlock(v, msg.x, msg.y);
IF c = NIL THEN (* Если блоков нет, то крестовый курсор *)
msg.cursor := Ports.graphicsCursor
ELSIF c = v.focus THEN (* Если фокусированный блок, то спросим у него самого *)
focus := v.focus.view
ELSE (* Если нефокусированный блок, то стрелка *)
msg.cursor := Ports.arrowCursor
END
ELSE
(* Если есть фокус, то передаем все остальные сообщения ему *)
IF v.focus # NIL THEN
focus := v.focus.view
END
END
END HandleCtrlMsg;
PROCEDURE CheckBlock (v: Plot; x, y: INTEGER): Context;
VAR c: Context;
BEGIN
INC(y, v.topBand*bandH);
c := v.blocks;
WHILE c # NIL DO
IF (c.l <= x) & (x < c.r) &
(c.t <= y) & (y < c.b) THEN
RETURN c
END;
c := c.next
END;
RETURN NIL
END CheckBlock;
PROCEDURE NewBlock (v: Plot; l, t, r, b: INTEGER);
VAR block: Context;
BEGIN
NEW(block);
block.view := TextViews.dir.New(TextModels.dir.NewFromString("Текстовый блок"));
block.l := l; block.t := t; block.r := r; block.b := b;
block.next := v.blocks;
v.blocks := block;
Stores.Join(v, block.view);
block.view.InitContext(block);
v.focus := block
END NewBlock;
(* Context *)
PROCEDURE (c: Context) ThisModel (): Models.Model;
BEGIN
RETURN NIL
END ThisModel;
PROCEDURE (c: Context) GetSize (OUT w, h: INTEGER);
BEGIN
w := c.r - c.l;
h := c.b - c.t
END GetSize;
PROCEDURE (c: Context) Normalize (): BOOLEAN;
BEGIN
RETURN TRUE
END Normalize;
PROCEDURE Init (v: Plot);
VAR i: INTEGER;
BEGIN
NEW(v.data, 10000);
FOR i := 0 TO LEN(v.data)-1 DO
v.data[i] := SHORT(ENTIER(ObxRandom.Uniform()* 100))
END
END Init;
PROCEDURE Open* ;
VAR v: Plot;
BEGIN
NEW(v);
Init(v);
Views.OpenAux(v, "Отчет")
END Open;
END TempGraphic.
Вход
FAQ
Поиск
Будет примерно так:
