OberonCore

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    x: Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Forms2: array [0..3] of TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  Inc(x);
  Label1.Caption := IntToStr(x)
end;

end.

object Form2: TForm2
  Left = 208
  Top = 201
  Width = 205
  Height = 185
  Caption = 'Form2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Visible = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 32
    Top = 32
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  object Button1: TButton
    Left = 32
    Top = 72
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2;

{$R *.res}

var
  i: Integer;

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  i := 0;
  while i < 4 do begin
    Application.CreateForm(TForm2, Forms2[i]);
    Inc(i)
  end;
  Application.Run;
end.

MODULE TmpX;

   IMPORT Dialog;

   TYPE
      Form = RECORD
         x*: INTEGER
      END;

   VAR
      f1*, f2*, f3*, f4*: Form;
      forms*: ARRAY 4 OF Form;

   PROCEDURE Button1Click* (n: INTEGER);
   BEGIN
      INC(forms[n].x);
      Dialog.UpdateInt(forms[n].x)
   END Button1Click;

END TmpX.

MODULE TmpX;

   IMPORT Dialog;

   TYPE
      Form = RECORD
         x*: INTEGER
      END;

   VAR
      forms*: ARRAY 4 OF Form;

   PROCEDURE (VAR f: Form) Button1Click*, NEW;
   BEGIN
      INC(f.x);
      Dialog.UpdateInt(f.x)
   END Button1Click;

END TmpX.

MODULE TmpOpenForm;

   IMPORT Files, Views, FormViews, FormModels, Containers, Controls, StdDialog, Dialog, Windows, Properties, StdLog;

   (*
      1.2[3]4 -> 1.2[fix]4
      1.2(3)4 -> 1.2(fix)4
   *)
   PROCEDURE Fix (VAR s: Dialog.String; IN fix: ARRAY OF CHAR);
      VAR new: Dialog.String;
         i (* s reader *), j (* new writer *), k (* fix reader *): INTEGER;
            c: CHAR;
   BEGIN
      i := 0;
      WHILE (i < LEN(s)) & (s[i] # 0X) & (s[i] # '.') DO new[i] := s[i]; INC(i) END;
      IF (i < LEN(s)) & (s[i] = '.') THEN
         new[i] := '.'; INC(i);
         
         WHILE (i < LEN(s)) & (s[i] # 0X) & ~((s[i] = '[') OR (s[i] = '(')) DO new[i] := s[i]; INC(i) END;

         IF (i < LEN(s)) & ((s[i] = '[') OR (s[i] = '(')) THEN
            new[i] := s[i]; j := i + 1;
            IF s[i] = '[' THEN
               c := ']'
            ELSE (* '(' *)
               c := ')'
            END;
            WHILE (i < LEN(s)) & (s[i] # 0X) & (s[i] # c) DO INC(i) END;
            IF (i < LEN(s)) & (s[i] = c) THEN
               INC(i);
               
               k := 0;
               WHILE (k < LEN(fix)) & (fix[k] # 0X) DO
                  new[j] := fix[k]; (* TRAP on new[j] bound overflow OK *)
                  INC(j);
                  INC(k)
               END;
               
               new[j] := c; INC(j); (* TRAP on new[j] bound overflow OK *)
               
               WHILE (i < LEN(s)) & (s[i] # 0X) DO
                  new[j] := s[i]; (* TRAP on new[j] bound overflow OK *)
                  INC(j);
                  INC(i)
               END;
         
               new[j] := 0X; (* TRAP on new[j] bound overflow OK *)
         
               StdLog.String(s); StdLog.String(" -> ");
         
               s := new;
               
               StdLog.String(s); StdLog.Ln
            END
         END
      END
   END Fix;

   (* сделано как в UnicodeConv.ControlsControl *)
   PROCEDURE ControlsControl (src: Controls.Control; IN fix: ARRAY OF CHAR): Controls.Control;
      VAR
         res: Controls.Control;
         plist : Properties.Property;
         p : Controls.Prop;
         poll : Properties.PollMsg;
         set : Properties.SetMsg;
   BEGIN
      res := Views.CopyOf(src, Views.deep)(Controls.Control);
      Views.HandlePropMsg(src, poll);
      plist := poll.prop;
      WHILE (plist # NIL) & ~(plist IS Controls.Prop) DO
         plist := plist.next
      END;
      IF plist # NIL THEN
         p := plist(Controls.Prop);
         p.known := {Controls.link,Controls.guard,Controls.notifier};
         p.valid := {Controls.link,Controls.guard,Controls.notifier};

         Fix(p.link, fix);
         Fix(p.guard, fix);
         Fix(p.notifier, fix);

         set.old := NIL; set.prop := p;
         Views.HandlePropMsg(res, set)
      END;
      RETURN res
   END ControlsControl;

   (* сделано как в UnicodeConv.ConvertThisView *)
   PROCEDURE ConvertThisView (src: Views.View; IN fix: ARRAY OF CHAR): Views.View;
      VAR dst: Views.View;
   BEGIN
      WITH src: Controls.Control DO
         dst := ControlsControl(src, fix)
      ELSE
         dst := NIL
      END;
      RETURN dst
   END ConvertThisView;

   (* сделано как в UnicodeConv.FormViewsView *)
   PROCEDURE FormViewsView (src: FormViews.View; IN fix: ARRAY OF CHAR): FormViews.View;
      VAR
         res: FormViews.View; m: FormModels.Model; c: Containers.Controller;
         v, v1, cv: Views.View;
   BEGIN
      res := Views.CopyOf(src, Views.deep)(FormViews.View);
      m := res.ThisModel(); c := res.ThisController();
      c.GetFirstView(Containers.any, v);
      WHILE v # NIL DO
         v1 := v; c.GetNextView(Containers.any, v1);   (* след-й надо брать до замены *)
         cv := ConvertThisView(v, fix); IF cv # NIL THEN m.ReplaceView(v, cv) END;
         v := v1
      END;
      RETURN res
   END FormViewsView;

   PROCEDURE GetForm (IN masterDir, masterName: ARRAY OF CHAR; IN fix: ARRAY OF CHAR): FormViews.View;
      VAR v: FormViews.View;
   BEGIN
      v := Views.OldView(Files.dir.This(masterDir), masterName$)(FormViews.View);
      ASSERT(v # NIL);
      RETURN FormViewsView(v, fix)
   END GetForm;

   (* сделано как в StdApi.ThisMask *)
   PROCEDURE Mask (v: Views.View);
      VAR c: Containers.Controller;
   BEGIN
      IF v # NIL THEN
         WITH v: Containers.View DO
            c := v.ThisController();
            IF c # NIL THEN
               c.SetOpts(c.opts - {Containers.noFocus} + {Containers.noCaret, Containers.noSelection})
            ELSE Dialog.ShowMsg("#System:NotEditable")
            END
         ELSE Dialog.ShowMsg("#System:ContainerExpected")
         END
      END
   END Mask;

   (* сделано как в StdApi.OpenAuxDialog *)
   PROCEDURE OpenAuxDialog* (IN masterDir, masterName: ARRAY OF CHAR; IN fix: ARRAY OF CHAR; IN title: ARRAY OF CHAR);
      VAR t0: Views.Title; done: BOOLEAN;
         v: Views.View;
   BEGIN
      Dialog.MapString(title, t0);
      Windows.SelectByTitle(NIL, {Windows.isAux}, t0, done);
      IF ~done THEN
         v := GetForm(masterDir, masterName, fix);
         Mask(v);
         StdDialog.Open(v, title, NIL, "", NIL, FALSE, TRUE, TRUE, FALSE, TRUE)
      END
   END OpenAuxDialog;

   (* сделано как в StdApi.OpenToolDialog *)
   PROCEDURE OpenToolDialog* (IN masterDir, masterName: ARRAY OF CHAR; IN fix: ARRAY OF CHAR; IN title: ARRAY OF CHAR);
      VAR t0: Views.Title; done: BOOLEAN;
         v: Views.View;
   BEGIN
      Dialog.MapString(title, t0);
      Windows.SelectByTitle(NIL, {Windows.isTool}, t0, done);
      IF ~done THEN
         v := GetForm(masterDir, masterName, fix);
         Mask(v);
         IF v # NIL THEN
            StdDialog.Open(v, title, NIL, "", NIL, TRUE, FALSE, TRUE, FALSE, TRUE)
         END
      END
   END OpenToolDialog;

   PROCEDURE Test*;
   BEGIN
      OpenAuxDialog("Tmp/Rsrc", "X1", "0", "Form X1 1 aux");
      OpenAuxDialog("Tmp/Rsrc", "X1", "1", "Form X1 2 aux");
      OpenToolDialog("Tmp/Rsrc", "X1", "1", "Form X1 2 tool")
   END Test;

END TmpOpenForm.

(!)TmpOpenForm.Test