home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 6.8 KB | 151 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 3 Feb 95
- Syntax10b.Scn.Fnt
- ParcElems
- Alloc
- MODULE DialogIntegerSliders;
- (** Markus Knasm
- ller 31 Aug 94 -
- (* now DialogIntSliders -- 3 Feb 94 because modulename > 20 *)
- IMPORT DialogFrames, Dialogs, DialogSliders, DialogTexts, Display, Fonts, GraphicUtils, In, Oberon, TextFrames, Texts, Viewers;
- CONST backCol = DialogSliders.backCol; patternCol = backCol; W* = 70; H* = 20; MM = 1; ML = 0; MR =2;
- TYPE
- Item* = POINTER TO ItemDesc;
- ItemDesc* = RECORD (DialogSliders.ItemDesc)
- maxValue*: INTEGER (* highest possible value of sliderdY *)
- END;
- minusArrow*, plusArrow*: Display.Pattern;
- minusArrowImage, plusArrowImage: ARRAY 10 OF SET;
- fnt: Fonts.Font;
- PROCEDURE Max (x, y: INTEGER): INTEGER;
- BEGIN IF x > y THEN RETURN x ELSE RETURN y END
- END Max;
- PROCEDURE Min (x, y: INTEGER): INTEGER;
- BEGIN IF x < y THEN RETURN x ELSE RETURN y END
- END Min;
- PROCEDURE (s: Item) Init*;
- (** initialies the object, should be called after allocating the object with NEW *)
- BEGIN s.Init^; s.maxValue := MAX (INTEGER)
- END Init;
- PROCEDURE (s: Item) Copy* (VAR dup: Dialogs.Object);
- (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
- VAR x: Item;
- BEGIN IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; s.Copy^ (dup);
- END Copy;
- PROCEDURE (s: Item) MaxValue* (): INTEGER;
- (** returns the highest possible value of sliderdY *)
- BEGIN RETURN s.maxValue
- END MaxValue;
- PROCEDURE IntToChar (x0: INTEGER; VAR a: ARRAY OF CHAR);
- VAR i, j: INTEGER; b: ARRAY 11 OF CHAR;
- BEGIN
- i := 0; x0 := Max (0, x0);
- REPEAT
- b[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
- UNTIL x0 = 0;
- FOR j := 0 TO i - 1 DO
- a[j] := b[i -1 - j]
- END;
- a[i] := 0X
- END IntToChar;
- PROCEDURE (s: Item) Arrow* (down: BOOLEAN): Display.Pattern;
- BEGIN
- IF down THEN RETURN (minusArrow) ELSE RETURN (plusArrow) END
- END Arrow;
- PROCEDURE (s: Item) DrawSlider* (f: Display.Frame; pressed : BOOLEAN; x, y, w, h, mode : INTEGER);
- (** displays the slider of the item at (x, y) in frame f *)
- VAR dummy: INTEGER; arr: ARRAY 11 OF CHAR; bgPat: Display.Pattern;
- BEGIN
- Display.ReplConstC (f, backCol, x, y , w, h, Display.replace); IntToChar (s.sliderdY, arr);
- IF h > w THEN bgPat := DialogSliders.vBgPat ELSE bgPat := DialogSliders.hBgPat END;
- Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, mode);
- y := y + (h DIV 2) - (fnt.maxY DIV 2);
- GraphicUtils.DrawString (f, arr, x, y, w, fnt, mode, GraphicUtils.center, dummy)
- END DrawSlider;
- PROCEDURE (s: Item) MoveSlider* (f: Display.Frame; pressed: BOOLEAN; dY: INTEGER);
- (** changes the displayed value to dY *)
- VAR dummy, x, y, w, h: INTEGER; arr: ARRAY 11 OF CHAR; bgPat: Display.Pattern;
- BEGIN
- s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
- IF w > h THEN x := x + h; w := w - 2 * h ELSE y := y + w; h := h - 2 * w END;
- Display.ReplConstC (f, backCol, x, y , w, h, Display.replace); IntToChar (dY, arr);
- IF h > w THEN bgPat := DialogSliders.vBgPat ELSE bgPat := DialogSliders.hBgPat END;
- Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, Display.paint);
- y := y + (h DIV 2) - (fnt.maxY DIV 2);
- GraphicUtils.DrawString (f, arr, x, y, w, fnt, Display.paint, GraphicUtils.center, dummy)
- END MoveSlider;
- PROCEDURE (s: Item) PrintSlider* (x, y, w, h: INTEGER);
- (** prints the slider of the item at printer coordinates (x, y) *)
- VAR dummy: INTEGER; arr: ARRAY 11 OF CHAR;
- BEGIN
- GraphicUtils.PrintBox (x, y, w,h); IntToChar (s.sliderdY, arr);
- y := y + (h DIV 2) - (SHORT (fnt.maxY * Dialogs.dUnit DIV Dialogs.pUnit) DIV 2);
- GraphicUtils.PrintString (arr, x, y, w, fnt, GraphicUtils.center, dummy)
- END PrintSlider;
- PROCEDURE (s: Item) CheckdY* (VAR dY: INTEGER);
- (** checks whether dY is a possible value for sliderdY *)
- BEGIN dY := Max (0, dY)
- END CheckdY;
- PROCEDURE (s: Item) TrackScrollBar* (f: Display.Frame; mx, my : INTEGER; keys : SET);
- (** handles mouse events concerning the full scrollbar *)
- VAR x, y, w, h : INTEGER; t1: Texts.Text; olddY: INTEGER;
- BEGIN
- s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H; olddY:= s.sliderdY;
- IF ((keys = {MM}) OR (keys = {ML}) OR (keys = {MR})) & (Max (w, h) >= 2 * Min (w, h)) THEN
- Oberon.RemoveMarks (x, y, w, h);
- IF w > h THEN
- IF mx < x + h THEN s.TrackButton (f, x, y, h, mx, my, keys, TRUE)
- ELSIF mx >= x + w - h THEN s.TrackButton (f, x + w - h, y, h, mx, my, keys, FALSE)
- END
- ELSE
- IF my < y + w THEN s.TrackButton (f, x, y, w, mx, my, keys, TRUE)
- ELSIF my >= y + h - w THEN s.TrackButton (f, x, y + h - w, w, mx, my, keys, FALSE)
- END
- END;
- IF ((keys = {MM}) OR (keys = {ML}) OR (keys = {MR})) & (s.cmd[0] # 0X) & (olddY # s.sliderdY) THEN
- DialogTexts.GetParText (s.par, s.panel, t1);
- s.CallCmd (f, Viewers.This (x,y), t1)
- END
- END
- END TrackScrollBar;
- PROCEDURE Insert*;
- (** Insert ([name] [x y w h] | ^ ) inserts a integerslider - item in the panel containing the caret position *)
- VAR x, y, x1, y1, w, h: INTEGER; p : Dialogs.Panel; s: Item; name: ARRAY 64 OF CHAR;
- BEGIN
- NEW (s);
- DialogFrames.GetCaretPosition (p, x, y);
- IF (p # NIL) THEN
- s.Init; In.Open; In.Name (name);
- IF ~In.Done THEN COPY ("", name); In.Open END;
- s.SetName (name);
- In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
- IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H
- ELSE
- IF w < 0 THEN w := W END;
- IF h < 0 THEN h := H END
- END;
- s.SetDim (x1, y1, w, h, FALSE); p.Insert (s, FALSE)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END;
- IF Dialogs.res # 0 THEN Dialogs.Error ("DialogIntegerSliders") END;
- END Insert;
- BEGIN
- minusArrowImage[0] := {}; plusArrowImage[0] := {};
- minusArrowImage[1] := {}; plusArrowImage[1] := {3..5};
- minusArrowImage[2] := {}; plusArrowImage[2] := {3..5};
- minusArrowImage[3] := {}; plusArrowImage[3] := {3..5};
- minusArrowImage[4] := {0..8}; plusArrowImage[4] := {0..8};
- minusArrowImage[5] := {0..8}; plusArrowImage[5] := {0..8};
- minusArrowImage[6] := {0..8}; plusArrowImage[6] := {0..8};
- minusArrowImage[7] := {}; plusArrowImage[7] := {3..5};
- minusArrowImage[8] := {}; plusArrowImage[8] := {3..5};
- minusArrowImage[9] := {}; plusArrowImage[9] := {3..5};
- minusArrow := Display.NewPattern (minusArrowImage, 9, 9);
- plusArrow := Display.NewPattern (plusArrowImage, 9, 9);
- fnt := Fonts.This ("Syntax10.Scn.Fnt")
- END DialogIntegerSliders.
-