Уважаемые специалисты,
Я изучаю ББ, пытаюсь написать обёртку для изменения фона документов.
Проблема такая: когда вьюшка документа обёрнута,
некоторые пункты меню, активные без обёртки, не активны.
Например, Dev -> Edit mode, Dev -> Layout mode, ...
В чём дело?
код:
Код:
MODULE MyWrapper;
IMPORT
Dialog, Stores, Models, Views, Controllers, Properties, Ports;
CONST minVersion = 0; maxVersion = 0;
TYPE
View = POINTER TO RECORD (Views.View)
inner: Views.View;
BackgroundColor:Ports.Color;
END;
FindMsg = RECORD (Controllers.Message)
v:Views.View;
END;
PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
VAR
version: INTEGER;
BEGIN
rd.ReadVersion(minVersion, maxVersion, version);
IF ~rd.cancelled THEN
Views.ReadView(rd, v.inner); (* generate Views.Alien if necessary *)
rd.ReadInt(v.BackgroundColor);
END
END Internalize;
PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
BEGIN
wr.WriteVersion(maxVersion);
Views.WriteView(wr, v.inner); (* handle Views.Alien if necessary *)
wr.WriteInt(v.BackgroundColor);
END Externalize;
PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
BEGIN
WITH source: View DO
v.BackgroundColor:=source.BackgroundColor;
IF model = NIL THEN
v.inner := Views.CopyOf(source.inner, Views.deep)
ELSE
v.inner := Views.CopyWithNewModel(source.inner, model)
END
END
END CopyFromModelView;
PROCEDURE (v: View) ThisModel (): Models.Model;
BEGIN
RETURN v.inner.ThisModel()
END ThisModel;
PROCEDURE (v: View) InitContext (context: Models.Context);
BEGIN
v.InitContext^(context);
v.inner.InitContext(context) (* wrapper and wrapped view share the same context *)
END InitContext;
PROCEDURE (v: View) Neutralize;
BEGIN
v.inner.Neutralize
END Neutralize;
PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
BEGIN
Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE);
END Restore;
PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
BEGIN
WITH msg:FindMsg DO
IF v.inner=msg.v THEN
msg.v:=v
ELSE
focus:=v.inner
END
ELSE
focus := v.inner
END;
END HandleCtrlMsg;
PROCEDURE (v: View) HandleViewMsg (f:Views.Frame; VAR msg:Views.Message);
BEGIN
WITH msg: Views.ScrollClassMsg DO
msg.allowBitmapScrolling := TRUE
ELSE
END
END HandleViewMsg;
PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
BEGIN
Views.HandlePropMsg(v.inner, msg)
END HandlePropMsg;
PROCEDURE (v: View) GetBackground (VAR color: Ports.Color);
BEGIN
color:=v.BackgroundColor
END GetBackground;
PROCEDURE WrapView(v:Views.View): View;
VAR
w:View;
replace: Controllers.ReplaceViewMsg;
BEGIN
ASSERT(v#NIL);
ASSERT(~(v IS View));
NEW(w);
w.inner := v;
Stores.Join(w, w.inner);
replace.old := v;
replace.new := w;
Controllers.Forward(replace);
RETURN w
END WrapView;
PROCEDURE UnwrapView(v:View);
VAR
replace: Controllers.ReplaceViewMsg;
BEGIN
ASSERT(v#NIL);
replace.old := v;
replace.new := v.inner;
Controllers.Forward(replace);
END UnwrapView;
PROCEDURE FindWrapper (inner:Views.View): View;
VAR
find:FindMsg;
BEGIN
find.v:=inner;
Controllers.Forward(find);
IF find.v=inner THEN
RETURN NIL
ELSE
RETURN find.v(View)
END;
END FindWrapper;
PROCEDURE GetCurrentView (): Views.View;
BEGIN
RETURN Controllers.FocusView()
END GetCurrentView;
PROCEDURE SetBackgroundColor * ();
VAR
set:BOOLEAN;
color:Ports.Color;
v:View;
FocusView:Views.View;
script: Stores.Operation;
BEGIN
FocusView:=GetCurrentView();
IF FocusView=NIL THEN
RETURN
END;
v:=FindWrapper(FocusView);
IF v#NIL THEN
color:=v.BackgroundColor
ELSE
color:=Ports.defaultColor
END;
Dialog.GetColor(color,color,set);
IF set THEN
IF v=NIL THEN
v:=WrapView(FocusView);
END;
v.BackgroundColor:=color;
Views.Update(v,FALSE)
END;
END SetBackgroundColor;
PROCEDURE SetTransparentBackground * ();
VAR
FocusView:Views.View;
v:View;
BEGIN
FocusView:=GetCurrentView();
v:=FindWrapper(FocusView);
IF v#NIL THEN
UnwrapView(v);
END;
END SetTransparentBackground;
END MyWrapper.