WMPopups.Mod 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308
  1. MODULE WMPopups; (** AUTHOR "BF"; PURPOSE "Popup Windows"; *)
  2. IMPORT
  3. Strings, WMRectangles, WMGraphics, WMEvents, WMWindowManager, WMComponents, WMStandardComponents;
  4. CONST
  5. LineHeight = 20;
  6. TYPE
  7. Entry = OBJECT
  8. VAR
  9. caption : Strings.String; (* {caption # NIL} *)
  10. onClickHandler : WMEvents.EventListener; (* {onClickHandler # NIL} *)
  11. parameter : ANY;
  12. next : Entry;
  13. PROCEDURE &Init(caption : Strings.String; onClickHandler : WMEvents.EventListener; parameter : ANY);
  14. BEGIN
  15. ASSERT((caption # NIL) & (onClickHandler # NIL));
  16. SELF.caption := caption;
  17. SELF.onClickHandler := onClickHandler;
  18. SELF.parameter := parameter;
  19. next := NIL;
  20. END Init;
  21. END Entry;
  22. TYPE
  23. PopupWindow = OBJECT(WMComponents.FormWindow)
  24. VAR
  25. isClosed : BOOLEAN;
  26. PROCEDURE &New(entries : Entry);
  27. VAR vc : WMComponents.VisualComponent;
  28. BEGIN
  29. ASSERT(entries # NIL);
  30. vc := CreateForm(entries);
  31. Init(vc.bounds.GetWidth(), vc.bounds.GetHeight(), FALSE);
  32. SetContent(vc);
  33. isClosed := FALSE;
  34. END New;
  35. PROCEDURE CreateForm(entries : Entry) : WMComponents.VisualComponent;
  36. VAR
  37. panel : WMStandardComponents.Panel;
  38. button : WMStandardComponents.Button;
  39. font : WMGraphics.Font;
  40. entry : Entry;
  41. width, height, w, h : LONGINT;
  42. BEGIN
  43. NEW(panel);
  44. panel.fillColor.Set(WMGraphics.White);
  45. width := 100; height := 0;
  46. entry := entries;
  47. WHILE (entry # NIL) DO
  48. NEW(button);
  49. button.alignment.Set(WMComponents.AlignTop);
  50. button.bounds.SetExtents(width, LineHeight);
  51. button.caption.Set(entry.caption);
  52. button.onClick.Add(entry.onClickHandler);
  53. button.onClick.Add(Clicked);
  54. button.userData := entry.parameter;
  55. panel.AddInternalComponent(button);
  56. font := button.GetFont();
  57. font.GetStringSize(entry.caption^, w, h);
  58. IF (w + 10 > width) THEN
  59. width := w + 10;
  60. END;
  61. height := height + LineHeight;
  62. entry := entry.next;
  63. END;
  64. width := MIN(width, 1024);
  65. panel.bounds.SetExtents(width, height);
  66. RETURN panel;
  67. END CreateForm;
  68. PROCEDURE Clicked(sender, data : ANY);
  69. BEGIN
  70. Close;
  71. END Clicked;
  72. PROCEDURE FocusLost*;
  73. BEGIN
  74. Close;
  75. END FocusLost;
  76. PROCEDURE Close*;
  77. BEGIN
  78. BEGIN {EXCLUSIVE}
  79. IF isClosed THEN RETURN; END;
  80. isClosed := TRUE;
  81. END;
  82. Close^;
  83. END Close;
  84. PROCEDURE FocusGot*;
  85. BEGIN
  86. manager.SetFocus(SELF)
  87. END FocusGot;
  88. END PopupWindow;
  89. (* Open a Popup *)
  90. Popup* = OBJECT
  91. VAR
  92. first, last : Entry;
  93. window : PopupWindow;
  94. PROCEDURE &New*;
  95. BEGIN
  96. first := NIL; last := NIL;
  97. window := NIL;
  98. END New;
  99. PROCEDURE Add*(CONST caption : ARRAY OF CHAR; onClickHandler : WMEvents.EventListener);
  100. BEGIN
  101. AddParButton(caption, onClickHandler, NIL);
  102. END Add;
  103. PROCEDURE AddParButton*(CONST caption : ARRAY OF CHAR; onClickHandler : WMEvents.EventListener; par : ANY);
  104. VAR entry : Entry;
  105. BEGIN {EXCLUSIVE}
  106. NEW(entry, Strings.NewString(caption), onClickHandler, par);
  107. IF (first = NIL) THEN
  108. first := entry; last := entry;
  109. ELSE
  110. last.next := entry; last := entry;
  111. END;
  112. END AddParButton;
  113. PROCEDURE Close*;
  114. BEGIN {EXCLUSIVE}
  115. IF (window # NIL) THEN
  116. window.Close;
  117. window := NIL;
  118. END;
  119. END Close;
  120. PROCEDURE Popup* (x, y : LONGINT);
  121. VAR manager : WMWindowManager.WindowManager;
  122. BEGIN {EXCLUSIVE}
  123. IF (first # NIL) THEN
  124. IF (window # NIL) THEN window.Close; END;
  125. NEW(window, first);
  126. manager := WMWindowManager.GetDefaultManager();
  127. manager.Add(x, y, window, {WMWindowManager.FlagStayOnTop, WMWindowManager.FlagHidden});
  128. manager.SetFocus(window);
  129. END;
  130. END Popup;
  131. END Popup;
  132. (** Open a color swatch dialog *)
  133. ColorSwatchPopup* = OBJECT (WMComponents.FormWindow)
  134. VAR colorPanel : ColorSwatchPanel;
  135. color- : WMGraphics.Color;
  136. onColorChosen* : PROCEDURE {DELEGATE} (color : WMGraphics.Color);
  137. PROCEDURE &New*;
  138. BEGIN
  139. color := 0H;
  140. CreatePopup;
  141. Init(colorPanel.bounds.GetWidth(), colorPanel.bounds.GetHeight(), FALSE);
  142. SetContent(colorPanel);
  143. END New;
  144. PROCEDURE CreatePopup;
  145. BEGIN
  146. NEW(colorPanel);
  147. colorPanel.ChosenColorProc := SetColor;
  148. END CreatePopup;
  149. PROCEDURE Popup*(x, y : LONGINT);
  150. BEGIN
  151. manager := WMWindowManager.GetDefaultManager();
  152. manager.Add(x, y, SELF, {WMWindowManager.FlagStayOnTop, WMWindowManager.FlagHidden});
  153. manager.SetFocus(SELF);
  154. END Popup;
  155. PROCEDURE Clicked(sender, data : ANY);
  156. BEGIN
  157. manager.Remove(SELF)
  158. END Clicked;
  159. PROCEDURE FocusLost*;
  160. BEGIN
  161. manager.Remove(SELF)
  162. END FocusLost;
  163. PROCEDURE FocusGot*;
  164. BEGIN
  165. manager.SetFocus(SELF)
  166. END FocusGot;
  167. PROCEDURE SetColor(color : WMGraphics.Color);
  168. BEGIN
  169. SELF.color := color;
  170. IF onColorChosen # NIL THEN onColorChosen(color) END;
  171. manager.Remove(SELF)
  172. END SetColor;
  173. END ColorSwatchPopup;
  174. (** Color Swatch Visual Component *)
  175. ColorSwatchPanel* = OBJECT(WMComponents.VisualComponent)
  176. VAR colors : ARRAY 19 OF LONGINT;
  177. ChosenColorProc* : PROCEDURE {DELEGATE} (color: WMGraphics.Color);
  178. (* CloseProc : PROCEDURE {DELEGATE}; *)
  179. PROCEDURE &Init*;
  180. BEGIN
  181. Init^;
  182. bounds.SetExtents(190, 70);
  183. BuildPalette;
  184. END Init;
  185. PROCEDURE PointerDown*(x, y : LONGINT; keys : SET);
  186. VAR r, g, b, a, i, j: LONGINT; cColor: WMGraphics.Color;
  187. BEGIN
  188. i := y DIV 10; j := x DIV 10;
  189. IF (i>= 0) & (i<=2) THEN
  190. WMGraphics.ColorToRGBA(colors[j], r, g, b, a);
  191. r := ENTIER((i+1)/4*r); g:= ENTIER((i+1)/4*g); b:= ENTIER((i+1)/4*b);
  192. cColor := WMGraphics.RGBAToColor(r, g, b, a);
  193. ELSIF (i= 3) THEN
  194. cColor := colors[j];
  195. ELSIF (i>=4) & (i<=6) THEN
  196. i := i - 4;
  197. WMGraphics.ColorToRGBA(colors[j], r, g, b, a);
  198. r := 255-ENTIER((3-i)/4*(255-r)); g:= 255-ENTIER((3-i)/4*(255-g)); b:= 255-ENTIER((3-i)/4*(255-b));
  199. cColor := WMGraphics.RGBAToColor(r, g, b, a);
  200. ELSE
  201. END;
  202. IF (y>0) & (y<bounds.GetHeight()) & (x>0) &(x<bounds.GetWidth())THEN
  203. ChosenColorProc(cColor);
  204. END;
  205. END PointerDown;
  206. PROCEDURE DrawBackground*(canvas: WMGraphics.Canvas);
  207. VAR r, g, b, a, i, j: LONGINT; color: WMGraphics.Color;
  208. BEGIN
  209. DrawBackground^(canvas);
  210. FOR i := 0 TO 2 DO
  211. FOR j := 0 TO 18 DO
  212. WMGraphics.ColorToRGBA(colors[j], r, g, b, a);
  213. r := ENTIER((i+1)/4*r); g:= ENTIER((i+1)/4*g); b:= ENTIER((i+1)/4*b);
  214. color := WMGraphics.RGBAToColor(r, g, b, a);
  215. canvas.Fill(WMRectangles.MakeRect(10*j,10*i,10*j+10,10*i+10),color , WMGraphics.ModeCopy);
  216. END;
  217. END;
  218. FOR j := 0 TO 18 DO
  219. color := colors[j];
  220. canvas.Fill(WMRectangles.MakeRect(10*j,30,10*j+10,10+30),color , WMGraphics.ModeCopy);
  221. END;
  222. FOR i := 0 TO 2 DO
  223. FOR j := 0 TO 18 DO
  224. WMGraphics.ColorToRGBA(colors[j], r, g, b, a);
  225. r := 255-ENTIER((3-i)/4*(255-r)); g:= 255-ENTIER((3-i)/4*(255-g)); b:= 255-ENTIER((3-i)/4*(255-b));
  226. color := WMGraphics.RGBAToColor(r, g, b, a);
  227. canvas.Fill(WMRectangles.MakeRect(10*j,10*i+40,10*j+10,10*i+10+40),color , WMGraphics.ModeCopy);
  228. END;
  229. END;
  230. END DrawBackground;
  231. PROCEDURE BuildPalette;
  232. BEGIN
  233. colors[0] := LONGINT(0FF0000FFH); (* red *)
  234. colors[1] := LONGINT(0FF5500FFH);
  235. colors[2] := LONGINT(0FFAA00FFH);
  236. colors[3] := LONGINT(0FFFF00FFH); (* yellow *)
  237. colors[4] := LONGINT(0AAFF00FFH);
  238. colors[5] := LONGINT(055FF00FFH);
  239. colors[6] := 000FF00FFH; (* green *)
  240. colors[7] := 000FF55FFH;
  241. colors[8] := 000FFAAFFH;
  242. colors[9] := 000FFFFFFH; (* cyan *)
  243. colors[10] := 000AAFFFFH;
  244. colors[11] := 00055FFFFH;
  245. colors[12] := 00000FFFFH; (* blue *)
  246. colors[13] := 05500FFFFH;
  247. colors[14] :=LONGINT( 0AA00FFFFH);
  248. colors[15] :=LONGINT( 0FF00FFFFH); (* magenta *)
  249. colors[16] :=LONGINT( 0FF00AAFFH);
  250. colors[17] :=LONGINT( 0FF0055FFH);
  251. colors[18] :=LONGINT( 0888888FFH); (* grey *)
  252. END BuildPalette;
  253. END ColorSwatchPanel;
  254. END WMPopups.
  255. -----------------------------------------------------
  256. System.Free WMPopups