WMStandardComponents.Mod 150 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628
  1. MODULE WMStandardComponents; (** AUTHOR "TF"; PURPOSE "Standard components"; *)
  2. IMPORT
  3. KernelLog, Kernel, Types, Models, Repositories, WMComponents, Strings, Files,
  4. WMGraphics, WMGraphicUtilities, WMRectangles,
  5. WMEvents, XML, Inputs, WMProperties, WMWindowManager,Modules;
  6. TYPE
  7. (* Local type-alias for convenience *)
  8. String = Strings.String;
  9. EventSource = WMEvents.EventSource;
  10. EventListener = WMEvents.EventListener ;
  11. EventListenerInfo = WMEvents.EventListenerInfo;
  12. Canvas = WMGraphics.Canvas;
  13. (** Timer *)
  14. Timer* = OBJECT (WMComponents.Component)
  15. VAR
  16. onTimer-: EventSource;
  17. eStart-, eStop- : EventListenerInfo;
  18. interval-, delay- : WMProperties.Int32Property;
  19. wait-: LONGINT;
  20. alive: BOOLEAN;
  21. timer: Kernel.Timer;
  22. internalEnabled : BOOLEAN;
  23. PROCEDURE &Init*;
  24. BEGIN
  25. Init^();
  26. SetGenerator("WMStandardComponents.GenTimer");
  27. NEW(timer);
  28. alive := TRUE;
  29. enabled.Set(FALSE); internalEnabled := FALSE;
  30. NEW(onTimer, SELF, GSonTimer, GSonTimerInfo, SELF.StringToCompCommand); events.Add(onTimer);
  31. NEW(interval, PrototypeInterval, NIL, NIL); properties.Add(interval);
  32. NEW(delay, PrototypeDelay, NIL, NIL); properties.Add(interval);
  33. NEW(eStart, GSStart, GSStartTimerInfo, SELF.Start); eventListeners.Add(eStart);
  34. NEW(eStop, GSStop, GSStopTimerInfo, SELF.Stop); eventListeners.Add(eStop);
  35. SetNameAsString(StrTimer)
  36. END Init;
  37. PROCEDURE PropertyChanged*(sender, property : ANY);
  38. BEGIN
  39. IF property = enabled THEN
  40. IF internalEnabled # enabled.Get() THEN
  41. IF enabled.Get() THEN Start(SELF, NIL) ELSE Stop(SELF, NIL) END
  42. END
  43. ELSE PropertyChanged^(sender, property)
  44. END;
  45. END PropertyChanged;
  46. PROCEDURE Start*(sender, par : ANY); (** Eventhandler *)
  47. BEGIN
  48. enabled.Set(TRUE); BEGIN {EXCLUSIVE} internalEnabled := TRUE;wait := delay.Get() END;
  49. END Start;
  50. PROCEDURE Stop*(sender, par : ANY); (** Eventhandler *)
  51. BEGIN
  52. enabled.Set(FALSE); BEGIN {EXCLUSIVE} internalEnabled := FALSE; END;
  53. END Stop;
  54. PROCEDURE Finalize*; (** PROTECTED *)
  55. BEGIN
  56. timer.Wakeup; internalEnabled := FALSE; BEGIN {EXCLUSIVE} alive := FALSE END; Finalize^
  57. END Finalize;
  58. BEGIN {ACTIVE}
  59. WHILE alive DO
  60. BEGIN {EXCLUSIVE} AWAIT(internalEnabled OR ~alive) END;
  61. IF alive THEN
  62. timer.Sleep(wait);
  63. BEGIN {EXCLUSIVE} wait := interval.Get() END;
  64. IF internalEnabled & (onTimer # NIL) THEN onTimer.Call(NIL) END;
  65. END
  66. END
  67. END Timer;
  68. CursorBlinkerCallback = PROCEDURE {DELEGATE} (sender, data: ANY);
  69. (** Global thread that periodically toggles the visibility of the registered component *)
  70. Blinker* = OBJECT
  71. VAR
  72. events- : WMEvents.EventSource;
  73. interval : LONGINT;
  74. visible-: BOOLEAN;
  75. alive, dead : BOOLEAN;
  76. timer : Kernel.Timer;
  77. PROCEDURE &Init;
  78. BEGIN
  79. interval := 500;
  80. visible := TRUE;
  81. alive := TRUE; dead := FALSE;
  82. NEW(timer);
  83. NEW(events, SELF, NIL, NIL,NIL);
  84. SetInterval(500);
  85. END Init;
  86. (** Set the cursor blinking interval in milliseconds. An interval of MAX(LONGINT) means don't blink *)
  87. PROCEDURE SetInterval*(ms : LONGINT);
  88. BEGIN {EXCLUSIVE}
  89. ASSERT(ms > 0);
  90. interval := ms;
  91. timer.Wakeup;
  92. IF (interval = MAX(LONGINT)) THEN
  93. visible := TRUE;
  94. events.Call(SELF);
  95. END;
  96. END SetInterval;
  97. PROCEDURE Finalize;
  98. BEGIN
  99. BEGIN {EXCLUSIVE} alive := FALSE; END;
  100. timer.Wakeup;
  101. BEGIN {EXCLUSIVE} AWAIT(dead); END;
  102. END Finalize;
  103. BEGIN {ACTIVE}
  104. WHILE alive DO
  105. BEGIN {EXCLUSIVE}
  106. AWAIT(~alive OR ((interval # MAX(LONGINT))));
  107. IF alive THEN
  108. events.Call(SELF);
  109. visible := ~visible;
  110. END;
  111. END;
  112. timer.Sleep(interval);
  113. END;
  114. BEGIN {EXCLUSIVE} dead := TRUE; END;
  115. END Blinker;
  116. TYPE
  117. (** Timer *)
  118. InternalTimer* = OBJECT
  119. VAR
  120. onTimer : WMEvents.EventListener;
  121. interval : LONGINT;
  122. timer: Kernel.Timer;
  123. alive, dead, enabled: BOOLEAN;
  124. PROCEDURE &Init*(onTimer : WMEvents.EventListener);
  125. BEGIN
  126. ASSERT(onTimer # NIL);
  127. SELF.onTimer := onTimer;
  128. interval := 100; (* ms *)
  129. NEW(timer);
  130. alive := TRUE; dead := FALSE; enabled := FALSE;
  131. END Init;
  132. PROCEDURE SetInterval*(ms : LONGINT);
  133. BEGIN {EXCLUSIVE}
  134. ASSERT(ms > 0);
  135. interval := ms;
  136. timer.Wakeup;
  137. END SetInterval;
  138. PROCEDURE Start*;
  139. BEGIN {EXCLUSIVE}
  140. enabled := TRUE;
  141. END Start;
  142. PROCEDURE Stop*;
  143. BEGIN {EXCLUSIVE}
  144. enabled := FALSE;
  145. END Stop;
  146. PROCEDURE Finalize*;
  147. BEGIN
  148. BEGIN {EXCLUSIVE} alive := FALSE; enabled := FALSE; END;
  149. timer.Wakeup;
  150. BEGIN {EXCLUSIVE} AWAIT(dead); END;
  151. END Finalize;
  152. BEGIN {ACTIVE}
  153. WHILE alive DO
  154. BEGIN {EXCLUSIVE} AWAIT(enabled OR ~alive) END;
  155. IF alive THEN
  156. timer.Sleep(interval);
  157. IF enabled THEN onTimer(SELF, NIL); END;
  158. END;
  159. END;
  160. BEGIN {EXCLUSIVE} dead := TRUE; END;
  161. END InternalTimer;
  162. (** SystemCommand executes an AosCommand string *)
  163. (** Example : <SystemCommand execute="Bunny.Insert BunnyLinear.gif 8 16" /> *)
  164. SystemCommand* = OBJECT(WMComponents.Component)
  165. VAR
  166. commandString- : WMProperties.StringProperty;
  167. eRun- : EventListenerInfo;
  168. PROCEDURE &Init*;
  169. BEGIN
  170. Init^;
  171. SetGenerator("WMStandardComponents.GenSystemCommand");
  172. NEW(commandString, PrototypeCommandString, NIL, NIL); properties.Add(commandString);
  173. NEW(eRun, GSRun, GSRunSystemCommandInfo, SELF.Run); eventListeners.Add(eRun);
  174. SetNameAsString(StrSystemCommand)
  175. END Init;
  176. PROCEDURE Run*(sender, par : ANY); (** Eventhandler *)
  177. VAR res : WORD; execute : String; msg : ARRAY 128 OF CHAR;
  178. BEGIN
  179. (* synchronize if not synchronized *)
  180. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Run, sender, par)
  181. ELSE
  182. (* actual business logic *)
  183. execute := commandString.Get();
  184. IF execute # NIL THEN
  185. WMComponents.Call(execute^, SELF, {}, res, msg);
  186. IF res # 0 THEN KernelLog.Enter; KernelLog.String(msg); KernelLog.Exit END
  187. END
  188. END
  189. END Run;
  190. END SystemCommand;
  191. (** Event executes a Component Event *)
  192. (** Example : <Event execute=%Timer1 Stop" /> *)
  193. Event* = OBJECT(WMComponents.Component)
  194. VAR
  195. commandString- : WMProperties.StringProperty;
  196. eRun- : EventListenerInfo;
  197. PROCEDURE &Init*;
  198. BEGIN
  199. Init^;
  200. SetGenerator("WMStandardComponents.GenEvent");
  201. NEW(commandString, PrototypeCommandString, NIL, NIL); properties.Add(commandString);
  202. NEW(eRun, GSRun, GSCallEventInfo, SELF.Run); eventListeners.Add(eRun);
  203. SetNameAsString(StrEvent)
  204. END Init;
  205. PROCEDURE Run*(sender, par : ANY); (** Eventhandler *)
  206. VAR execute : String; event : EventListener;
  207. BEGIN
  208. (* synchronize if not synchronized *)
  209. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Run, sender, par)
  210. ELSE
  211. (* actual business logic *)
  212. execute := commandString.Get();
  213. IF execute # NIL THEN
  214. event := StringToCompCommand(execute);
  215. IF event # NIL THEN event(sender, par) END;
  216. END
  217. END
  218. END Run;
  219. END Event;
  220. (** Visual components *)
  221. TYPE
  222. Panel* = OBJECT (WMComponents.VisualComponent)
  223. VAR
  224. blinking-: WMProperties.BooleanProperty;
  225. blink: BOOLEAN;
  226. show-: BOOLEAN; (* state for blinking *)
  227. PROCEDURE &Init*;
  228. BEGIN
  229. Init^;
  230. show := TRUE;
  231. SetGenerator("WMStandardComponents.GenPanel");
  232. SetNameAsString(StrPanel);
  233. NEW(blinking, PrototypeBlinking, NIL, NIL); properties.Add(blinking);
  234. blink := blinking.Get();
  235. END Init;
  236. PROCEDURE RecacheProperties*;
  237. BEGIN
  238. RecacheProperties^;
  239. PropertyChanged(SELF,blinking)
  240. END RecacheProperties;
  241. PROCEDURE SetBlinker(sender, data: ANY); (* quite generic => might be moved to VisualComponent *)
  242. BEGIN
  243. WITH sender: Blinker DO
  244. show := sender.visible;
  245. (*visible.Set(sender.visible)*) (* more generic *)
  246. END;
  247. Invalidate;
  248. END SetBlinker;
  249. (* currently, the Panel has no own Draw method.
  250. For this reason, blinking does not work in display of native Panels, but only on derived components
  251. which handle the "show" variable in their DrawBackground method.
  252. could be done with the 'visible' property, too.
  253. *)
  254. PROCEDURE PropertyChanged*(sender, property : ANY);
  255. VAR b: BOOLEAN; element : XML.Element;
  256. BEGIN
  257. IF property = blinking THEN
  258. b := blinking.Get();
  259. IF b # blink THEN
  260. blink := b;
  261. IF b THEN
  262. blinker.events.Add(SetBlinker);
  263. ELSE
  264. blinker.events.Remove(SetBlinker);
  265. show := TRUE;
  266. (*? visible.Set(TRUE);*)
  267. END;
  268. Invalidate;
  269. END;
  270. ELSE
  271. PropertyChanged^(sender, property)
  272. END;
  273. END PropertyChanged;
  274. (*
  275. PROCEDURE Draw*(canvas : WMGraphics.Canvas);
  276. BEGIN
  277. IF show THEN Draw^(canvas) END;
  278. END Draw;
  279. *)
  280. PROCEDURE Finalize*;
  281. BEGIN
  282. Finalize^;
  283. blinker.events.Remove(SetBlinker);
  284. END Finalize;
  285. END Panel;
  286. TYPE
  287. Decoration= POINTER TO RECORD
  288. TL, T, TR, L, M, R, BL, B, BR: WMGraphics.Image;
  289. END;
  290. (*
  291. DecoratorPanel* = OBJECT (WMComponents.VisualComponent)
  292. CONST TopLeft=0; Top=1; TopRight=2; Left=3; Right=4; BottomLeft =5; Bottom=6; BottomRight=7;Middle=8;
  293. VAR
  294. defaultImageName: WMProperties.StringProperty;
  295. defaultDecoration: Decoration;
  296. PROCEDURE &Init*;
  297. BEGIN
  298. Init^;
  299. SetGenerator("WMStandardComponents.GenDecoratorPanel");
  300. SetNameAsString(StrPanel);
  301. defaultDecoration := NIL;
  302. NEW(defaultImageName, PrototypeDecoratorName, NIL, NIL); properties.Add(defaultImageName);
  303. END Init;
  304. PROCEDURE RecacheProperties;
  305. BEGIN
  306. RecacheProperties^;
  307. Invalidate
  308. END RecacheProperties;
  309. PROCEDURE DrawBackground(canvas : WMGraphics.Canvas);
  310. VAR mode, mid, borderWidth : LONGINT;
  311. tc : WMGraphics.Color; r, rect : WMGraphics.Rectangle; down : BOOLEAN;
  312. str : String; deco: Decoration;
  313. BEGIN
  314. IF ~visible.Get() THEN RETURN END;
  315. GetDecoration(defaultImageName.Get(), defaultDecoration);
  316. deco := defaultDecoration;
  317. Acquire;
  318. rect := bounds.Get();
  319. inner := rect;
  320. IF deco.TL # NIL THEN
  321. IF inner.left < deco.
  322. END;
  323. Release;
  324. END DrawBackground;
  325. END DecoratorPanel;
  326. *)
  327. TYPE
  328. Label* = OBJECT(Panel)
  329. VAR
  330. caption- : WMProperties.StringProperty;
  331. textColor- : WMProperties.ColorProperty;
  332. alignH- : WMProperties.Int32Property;
  333. alignV- : WMProperties.Int32Property;
  334. PROCEDURE &Init*;
  335. BEGIN
  336. Init^;
  337. NEW(caption, PrototypeCaption, NIL, NIL); properties.Add(caption);
  338. NEW(textColor, PrototypeTextColor, NIL, NIL); properties.Add(textColor);
  339. NEW(alignH, PrototypeAlignH, NIL, NIL); properties.Add(alignH);
  340. NEW(alignV, PrototypeAlignV, NIL, NIL); properties.Add(alignV);
  341. SetGenerator("WMStandardComponents.GenLabel");
  342. SetNameAsString(StrLabel)
  343. END Init;
  344. PROCEDURE RecacheProperties*;
  345. BEGIN
  346. RecacheProperties^;
  347. SetFont(font.Get());
  348. END RecacheProperties;
  349. PROCEDURE PropertyChanged*(sender, property : ANY);
  350. VAR element : XML.Element;
  351. BEGIN
  352. IF (property = caption) OR (property = textColor) OR (property = alignH) OR (property = alignV) THEN
  353. Invalidate
  354. ELSIF (property = font) THEN
  355. RecacheProperties;
  356. Invalidate
  357. ELSIF property = model THEN Invalidate
  358. ELSE
  359. PropertyChanged^(sender, property)
  360. END;
  361. END PropertyChanged;
  362. PROCEDURE SetCaption*(CONST x : ARRAY OF CHAR);
  363. BEGIN
  364. caption.SetAOC(x)
  365. END SetCaption;
  366. PROCEDURE LinkChanged*(sender, data : ANY);
  367. VAR string : Types.String256; res : WORD; m: Models.Model;
  368. BEGIN
  369. IF (sender = model) & WMProperties.GetModel(model,m) THEN
  370. m.GetGeneric(string, res);
  371. IF (res = Models.Ok) THEN
  372. SetCaption(string.value);
  373. END;
  374. END;
  375. END LinkChanged;
  376. PROCEDURE DrawBackground*(canvas : Canvas);
  377. VAR str : String;
  378. BEGIN
  379. DrawBackground^(canvas); str := caption.Get();
  380. IF (str # NIL) & show THEN
  381. canvas.SetColor(textColor.Get());
  382. WMGraphics.DrawStringInRect(canvas, GetClientRect(), FALSE, alignH.Get(), alignV.Get(), str^)
  383. END;
  384. END DrawBackground;
  385. END Label;
  386. TYPE
  387. (** Button *)
  388. Button* = OBJECT (WMComponents.VisualComponent)
  389. CONST
  390. TextBorder=0;
  391. VAR
  392. caption- : WMProperties.StringProperty;
  393. isRepeating-, isToggle-, indicateToggle- : WMProperties.BooleanProperty;
  394. isInverse-: WMProperties.BooleanProperty;
  395. onClickHandler- : WMProperties.StringProperty;
  396. clDefault-, clHover-, clPressed-, clInactive-,
  397. clTextDefault-, clTextHover-, clTextPressed-, clTextInactive- : WMProperties.ColorProperty;
  398. effect3D- : WMProperties.Int32Property;
  399. (* single images *)
  400. imgDefaultName-, imgInactiveName-, imgHoverName-, imgPressedName-, imageName- : WMProperties.StringProperty;
  401. imgDefault, imgInactive, imgHover, imgPressed : WMGraphics.Image;
  402. useBgBitmaps-, isHorizontal-, repeatMiddleImg- : WMProperties.BooleanProperty;
  403. (* 3 x 3 background images for horizontal representation *)
  404. imgDefaultNameLeft-, imgDefaultNameRight-, imgDefaultNameMiddle-,
  405. imgHoverNameLeft-, imgHoverNameRight-, imgHoverNameMiddle-,
  406. imgPressedNameLeft-, imgPressedNameRight-, imgPressedNameMiddle- : WMProperties.StringProperty;
  407. imgDefaultLeft, imgDefaultRight, imgDefaultMiddle,
  408. imgHoverLeft, imgHoverRight, imgHoverMiddle,
  409. imgPressedLeft, imgPressedRight, imgPressedMiddle : WMGraphics.Image;
  410. (* 3 x 2 background images for vertical representation *)
  411. imgDefaultNameTop-, imgDefaultNameBottom-,
  412. imgHoverNameTop-, imgHoverNameBottom-,
  413. imgPressedNameTop-, imgPressedNameBottom- : WMProperties.StringProperty;
  414. imgDefaultTop, imgDefaultBottom,
  415. imgHoverTop, imgHoverBottom,
  416. imgPressedTop, imgPressedBottom : WMGraphics.Image;
  417. useDeco-: WMProperties.BooleanProperty;
  418. (* 3x9 backgound images for scalable representation *)
  419. decoDefaultName-, decoHoverName-, decoPressedName-: WMProperties.StringProperty;
  420. decoDefault-, decoHover-, decoPressed-: Decoration;
  421. onClick- : EventSource;
  422. (* foreground image *)
  423. image : WMGraphics.Image;
  424. pressed, keyboardPressed, mouseOver: BOOLEAN;
  425. handler : WMEvents.EventListener;
  426. invert3d : BOOLEAN;
  427. repeater : Timer;
  428. userData* : ANY;
  429. textAlignH- : WMProperties.Int32Property;
  430. textAlignV- : WMProperties.Int32Property;
  431. horizontalFit: WMProperties.BooleanProperty;
  432. textBorder: WMProperties.Int32Property;
  433. PROCEDURE &Init*;
  434. BEGIN
  435. Init^;
  436. SetNameAsString(StrButton);
  437. NEW(caption, PrototypeBcaption, NIL, NIL); properties.Add(caption);
  438. (* behavior *)
  439. NEW(isRepeating, PrototypeBisRepeating, NIL, NIL); properties.Add(isRepeating);
  440. NEW(isToggle, PrototypeBisToggle, NIL, NIL); properties.Add(isToggle);
  441. NEW(isInverse, PrototypeBisInverse, NIL, NIL); properties.Add(isInverse);
  442. NEW(indicateToggle, PrototypeBindicateToggle, NIL, NIL); properties.Add(indicateToggle);
  443. NEW(onClickHandler, PrototypeBonClickHandler, NIL, NIL); properties.Add(onClickHandler);
  444. (* look *)
  445. bounds.SetPrototype(PrototypeBBounds); (* override the defaults *)
  446. NEW(clDefault, PrototypeBclDefault, NIL, NIL); properties.Add(clDefault);
  447. NEW(clHover, PrototypeBclHover, NIL, NIL); properties.Add(clHover);
  448. NEW(clPressed, PrototypeBclPressed, NIL, NIL); properties.Add(clPressed);
  449. NEW(clInactive, PrototypeBclInactive, NIL, NIL); properties.Add(clInactive);
  450. NEW(clTextDefault, PrototypeBclTextDefault, NIL, NIL); properties.Add(clTextDefault);
  451. NEW(clTextHover, PrototypeBclTextHover, NIL, NIL); properties.Add(clTextHover);
  452. NEW(clTextPressed, PrototypeBclTextPressed, NIL, NIL); properties.Add(clTextPressed);
  453. NEW(clTextInactive, PrototypeBclTextInactive, NIL, NIL); properties.Add(clTextInactive);
  454. NEW(effect3D, PrototypeBEffect3D, NIL, NIL); properties.Add(effect3D);
  455. (* --- *)
  456. NEW(imgDefaultName, PrototypeBimgDefaultName, NIL, NIL); properties.Add(imgDefaultName);
  457. NEW(imgInactiveName, PrototypeBimgInactiveName, NIL, NIL); properties.Add(imgInactiveName);
  458. NEW(imgHoverName, PrototypeBimgHoverName, NIL, NIL); properties.Add(imgHoverName);
  459. NEW(imgPressedName, PrototypeBimgPressedName, NIL, NIL); properties.Add(imgPressedName);
  460. NEW(imageName, PrototypeBimageName, NIL, NIL); properties.Add(imageName);
  461. (* --- *)
  462. NEW(useBgBitmaps, PrototypeBUseBgImages, NIL, NIL); properties.Add(useBgBitmaps);
  463. NEW(isHorizontal, PrototypeBIsHorizontal, NIL, NIL); properties.Add(isHorizontal);
  464. NEW(repeatMiddleImg, PrototypeBRepeatMiddleImg, NIL, NIL); properties.Add(repeatMiddleImg);
  465. (* --- *)
  466. NEW(imgDefaultNameLeft, PrototypeImgDefaultNameLeft, NIL, NIL); properties.Add(imgDefaultNameLeft);
  467. NEW(imgDefaultNameRight, PrototypeImgDefaultNameRight, NIL, NIL); properties.Add(imgDefaultNameRight);
  468. NEW(imgDefaultNameMiddle, PrototypeImgDefaultNameMiddle, NIL, NIL); properties.Add(imgDefaultNameMiddle);
  469. NEW(imgHoverNameLeft, PrototypeImgHoverNameLeft, NIL, NIL); properties.Add(imgHoverNameLeft);
  470. NEW(imgHoverNameRight, PrototypeImgHoverNameRight, NIL, NIL); properties.Add(imgHoverNameRight);
  471. NEW(imgHoverNameMiddle, PrototypeImgHoverNameMiddle, NIL, NIL); properties.Add(imgHoverNameMiddle);
  472. NEW(imgPressedNameLeft, PrototypeImgPressedNameLeft, NIL, NIL); properties.Add(imgPressedNameLeft);
  473. NEW(imgPressedNameRight, PrototypeImgPressedNameRight, NIL, NIL); properties.Add(imgPressedNameRight);
  474. NEW(imgPressedNameMiddle, PrototypeImgPressedNameMiddle, NIL, NIL); properties.Add(imgPressedNameMiddle);
  475. (* --- *)
  476. NEW(useDeco, PrototypeUseDeco, NIL, NIL); properties.Add(useDeco);
  477. NEW(decoDefaultName, PrototypeDecoDefaultName, NIL, NIL); properties.Add(decoDefaultName);
  478. NEW(decoHoverName, PrototypeDecoHoverName, NIL, NIL); properties.Add(decoHoverName);
  479. NEW(decoPressedName, PrototypeDecoPressedName, NIL, NIL); properties.Add(decoPressedName);
  480. (* --- *)
  481. NEW(imgDefaultNameTop, PrototypeImgDefaultNameTop, NIL, NIL); properties.Add(imgDefaultNameTop);
  482. NEW(imgDefaultNameBottom, PrototypeImgDefaultNameBottom, NIL, NIL); properties.Add(imgDefaultNameBottom);
  483. NEW(imgHoverNameTop, PrototypeImgHoverNameTop, NIL, NIL); properties.Add(imgHoverNameTop);
  484. NEW(imgHoverNameBottom, PrototypeImgHoverNameBottom, NIL, NIL); properties.Add(imgHoverNameBottom);
  485. NEW(imgPressedNameTop, PrototypeImgPressedNameTop, NIL, NIL); properties.Add(imgPressedNameTop);
  486. NEW(imgPressedNameBottom, PrototypeImgPressedNameBottom, NIL, NIL); properties.Add(imgPressedNameBottom);
  487. NEW(textAlignH, PrototypeButtonAlignH, NIL, NIL); properties.Add(textAlignH);
  488. NEW(textAlignV, PrototypeButtonAlignV, NIL, NIL); properties.Add(textAlignV);
  489. NEW(horizontalFit, PrototypeHorizontalFit, NIL, NIL); properties.Add(horizontalFit);
  490. NEW(textBorder, PrototypeTextBorder, NIL, NIL); properties.Add(textBorder);
  491. (* events *)
  492. NEW(onClick, SELF, GSonClick, GSonClickButtonInfo, SELF.StringToCompCommand); events.Add(onClick);
  493. SetGenerator("WMStandardComponents.GenButton");
  494. END Init;
  495. PROCEDURE CheckClickHandler;
  496. VAR th : WMEvents.EventListener; s : String;
  497. BEGIN
  498. s := onClickHandler.Get();
  499. IF s # NIL THEN
  500. th := StringToCompCommand(s);
  501. IF (handler # NIL) THEN onClick.Remove(handler) END;
  502. IF th # NIL THEN onClick.Add(th); handler := th END
  503. END
  504. END CheckClickHandler;
  505. PROCEDURE ExecuteClickHandler;
  506. VAR s : Strings.String; res : WORD; msg : ARRAY 64 OF CHAR;
  507. BEGIN
  508. s := onClickHandler.Get();
  509. IF s # NIL THEN
  510. IF Strings.StartsWith2(Repositories.CommandPrefix, s^) THEN
  511. WMComponents.Call(s^, SELF, {}, res, msg);
  512. END;
  513. END;
  514. END ExecuteClickHandler;
  515. PROCEDURE ScaleFont*(height: LONGINT; percent: LONGINT);
  516. VAR fh,hfh,ntw,newSize,width: LONGINT; f,hf: WMGraphics.Font; str: String; tw, th: LONGINT; oldFontSize: LONGINT;
  517. BEGIN
  518. height := height - 2*textBorder.Get();
  519. IF height < 4 THEN height := 4 END;
  520. IF percent <= 0 THEN RETURN END;
  521. Acquire;
  522. oldFontSize := font.GetSize();
  523. (* vertical scaling *)
  524. f := GetFont();
  525. hf := WMGraphics.GetFont(f.name, 100, f.style); (* expensive ? *)
  526. hfh := hf.GetAscent() + hf.GetDescent();
  527. fh := height * percent DIV hfh;
  528. IF fh > 128 THEN fh := fh - fh MOD 8
  529. ELSIF fh > 64 THEN fh := fh - fh MOD 4
  530. ELSIF fh > 32 THEN fh := fh - fh MOD 2
  531. END;
  532. font.SetSize(fh);
  533. f := GetFont();
  534. IF horizontalFit.Get() THEN
  535. width := bounds.GetWidth() - 2*textBorder.Get();
  536. str := caption.Get();
  537. IF str # NIL THEN
  538. f.GetStringSize(str^, tw, th);
  539. IF tw > width THEN
  540. fh :=fh * width DIV tw;
  541. IF fh > 100 THEN fh := fh - fh MOD 8
  542. ELSIF fh > 32 THEN fh := fh - fh MOD 4
  543. ELSIF fh > 12 THEN fh := fh - fh MOD 2
  544. END;
  545. (* correction loop if scaling does not fit correctly *)
  546. REPEAT
  547. font.SetSize(fh);
  548. f := GetFont();
  549. f.GetStringSize(str^, tw, th);
  550. DEC(fh);
  551. UNTIL (fh <= 4) OR (tw <= width);
  552. END;
  553. END;
  554. END;
  555. IF font.GetSize() # oldFontSize THEN
  556. Invalidate;
  557. END;
  558. Release;
  559. END ScaleFont;
  560. PROCEDURE RecacheProperties*;
  561. VAR element : XML.Element; s : String;
  562. BEGIN
  563. RecacheProperties^;
  564. s := imageName.Get(); IF s # NIL THEN image := WMGraphics.LoadImage(s^, TRUE) END;
  565. (* --- *)
  566. IF useBgBitmaps.Get() THEN
  567. s := imgDefaultNameLeft.Get(); IF s # NIL THEN imgDefaultLeft := WMGraphics.LoadImage(s^, TRUE) END;
  568. s := imgDefaultNameRight.Get(); IF s # NIL THEN imgDefaultRight := WMGraphics.LoadImage(s^, TRUE) END;
  569. s := imgDefaultNameMiddle.Get(); IF s # NIL THEN imgDefaultMiddle := WMGraphics.LoadImage(s^, TRUE) END;
  570. s := imgHoverNameLeft.Get(); IF s # NIL THEN imgHoverLeft := WMGraphics.LoadImage(s^, TRUE) END;
  571. s := imgHoverNameRight.Get(); IF s # NIL THEN imgHoverRight := WMGraphics.LoadImage(s^, TRUE) END;
  572. s := imgHoverNameMiddle.Get(); IF s # NIL THEN imgHoverMiddle := WMGraphics.LoadImage(s^, TRUE) END;
  573. s := imgPressedNameLeft.Get(); IF s # NIL THEN imgPressedLeft := WMGraphics.LoadImage(s^, TRUE) END;
  574. s := imgPressedNameRight.Get(); IF s # NIL THEN imgPressedRight := WMGraphics.LoadImage(s^, TRUE) END;
  575. s := imgPressedNameMiddle.Get(); IF s # NIL THEN imgPressedMiddle := WMGraphics.LoadImage(s^, TRUE) END;
  576. s := imgDefaultNameTop.Get(); IF s # NIL THEN imgDefaultTop := WMGraphics.LoadImage(s^, TRUE) END;
  577. s := imgDefaultNameBottom.Get(); IF s # NIL THEN imgDefaultBottom := WMGraphics.LoadImage(s^, TRUE) END;
  578. s := imgHoverNameTop.Get(); IF s # NIL THEN imgHoverTop := WMGraphics.LoadImage(s^, TRUE) END;
  579. s := imgHoverNameBottom.Get(); IF s # NIL THEN imgHoverBottom := WMGraphics.LoadImage(s^, TRUE) END;
  580. s := imgPressedNameTop.Get(); IF s # NIL THEN imgPressedTop := WMGraphics.LoadImage(s^, TRUE) END;
  581. s := imgPressedNameBottom.Get(); IF s # NIL THEN imgPressedBottom := WMGraphics.LoadImage(s^, TRUE) END;
  582. s := imgHoverName.Get(); IF s # NIL THEN imgHover := WMGraphics.LoadImage(s^, TRUE) END;
  583. s := imgPressedName.Get(); IF s # NIL THEN imgPressed := WMGraphics.LoadImage(s^, TRUE) END;
  584. s := imgDefaultName.Get(); IF s # NIL THEN imgDefault := WMGraphics.LoadImage(s^, TRUE) END;
  585. s := imgInactiveName.Get(); IF s # NIL THEN imgInactive := WMGraphics.LoadImage(s^, TRUE) END;
  586. ELSE
  587. imgDefaultLeft := NIL; imgDefaultRight := NIL; imgDefaultMiddle := NIL;
  588. imgHoverLeft := NIL; imgHoverRight := NIL; imgHoverMiddle := NIL;
  589. imgPressedLeft := NIL; imgPressedRight := NIL; imgPressedMiddle := NIL;
  590. imgDefaultTop := NIL; imgDefaultBottom := NIL;
  591. imgHoverTop := NIL; imgHoverBottom := NIL;
  592. imgPressedTop := NIL; imgPressedBottom := NIL;
  593. imgHover := NIL;
  594. imgPressed := NIL;
  595. imgDefault := NIL;
  596. END;
  597. IF useDeco.Get() THEN
  598. GetDecoration(decoDefaultName.Get(), decoDefault);
  599. GetDecoration(decoHoverName.Get(), decoHover);
  600. GetDecoration(decoPressedName.Get(), decoPressed);
  601. ELSE
  602. decoDefault := NIL; decoHover := NIL; decoPressed := NIL;
  603. END;
  604. (*?PH drop this, as it belongs to parent type recaching ?*)SetFont(font.Get());
  605. CheckClickHandler;
  606. END RecacheProperties;
  607. PROCEDURE LinkChanged*(sender, data : ANY);
  608. VAR boolean : Types.Boolean; res : WORD; m: Models.Model;
  609. BEGIN
  610. IF (sender = model) & WMProperties.GetModel(model,m) THEN
  611. m.GetGeneric(boolean, res);
  612. IF isInverse.Get() THEN boolean.value := ~boolean.value END;
  613. IF (res = Models.Ok) & (pressed # boolean.value) THEN
  614. SetPressed(boolean.value);
  615. END;
  616. END;
  617. END LinkChanged;
  618. PROCEDURE ChangeModel(value : BOOLEAN);
  619. VAR boolean : Types.Boolean; res : WORD; m: Models.Model;
  620. BEGIN
  621. IF WMProperties.GetModel(model, m) THEN
  622. IF isInverse.Get() THEN boolean.value := ~value ELSE boolean.value := value END;
  623. m.SetGeneric(boolean, res);
  624. END;
  625. END ChangeModel;
  626. PROCEDURE PropertyChanged*(sender, data : ANY);
  627. VAR element : XML.Element;
  628. BEGIN
  629. IF (data = caption) THEN
  630. IF horizontalFit.Get() THEN ScaleFont(bounds.GetHeight(), scaleFont.Get()) END;
  631. Invalidate;
  632. ELSIF (data = textAlignH) OR (data = textAlignV) THEN Invalidate;
  633. ELSIF (data = onClickHandler) THEN CheckClickHandler
  634. ELSIF (data = clDefault) OR (data = clHover) OR (data = clPressed) OR (data = clTextInactive)
  635. OR (data = clTextDefault) OR (data = clTextHover) OR (data = clTextPressed) OR (data = clTextInactive) THEN Invalidate;
  636. (*ELSIF (data = font) THEN SetFont(font.Get()); Invalidate;*) (*? drop this, as PropertyChanged^ handles this *)
  637. ELSIF (data = isToggle) OR (data = indicateToggle) OR (data = isHorizontal) OR (data = repeatMiddleImg) OR (data = effect3D) THEN Invalidate;
  638. ELSIF (data = imageName) OR (data = useBgBitmaps)
  639. OR (data = imgDefaultNameLeft) OR (data = imgDefaultNameMiddle) OR (data = imgDefaultNameRight)
  640. OR (data = imgHoverNameLeft) OR (data = imgHoverNameMiddle) OR (data = imgHoverNameRight)
  641. OR (data = imgPressedNameLeft) OR (data = imgPressedNameMiddle) OR (data = imgPressedNameRight)
  642. OR (data = imgDefaultNameTop) OR (data = imgDefaultNameBottom)
  643. OR (data = imgHoverNameTop) OR (data = imgHoverNameBottom)
  644. OR (data = imgPressedNameTop) OR (data = imgPressedNameBottom)
  645. OR (data = imgDefaultName) OR (data = imgPressedName)
  646. OR (data = imgHoverName) OR (data = imgInactiveName) OR (data = enabled)
  647. OR (data = decoDefaultName) OR (data = decoHoverName) OR (data= decoPressedName) OR (data = useDeco) OR (data=horizontalFit) OR (data = textBorder)
  648. THEN
  649. RecacheProperties; Invalidate;
  650. ELSIF (data = model) THEN Invalidate
  651. ELSE
  652. PropertyChanged^(sender, data);
  653. END;
  654. END PropertyChanged;
  655. PROCEDURE CheckRepeating(start : BOOLEAN);
  656. BEGIN
  657. IF isRepeating.Get() THEN
  658. IF start THEN
  659. IF repeater = NIL THEN NEW(repeater); AddContent(repeater); repeater.onTimer.Add(Click) END;
  660. repeater.Start(SELF, NIL)
  661. ELSE
  662. IF repeater # NIL THEN repeater.Stop(SELF, NIL) END
  663. END
  664. END
  665. END CheckRepeating;
  666. PROCEDURE SetInvert3d*(invert : BOOLEAN);
  667. BEGIN
  668. Acquire;
  669. IF invert # invert3d THEN invert3d := invert; Invalidate END;
  670. Release
  671. END SetInvert3d;
  672. PROCEDURE SetPressed*(down : BOOLEAN);
  673. VAR changed : BOOLEAN;
  674. BEGIN
  675. Acquire;
  676. IF pressed # down THEN
  677. changed := TRUE;
  678. pressed := down;
  679. Invalidate;
  680. END;
  681. Release;
  682. IF changed THEN ChangeModel(pressed); END;
  683. END SetPressed;
  684. PROCEDURE GetPressed*() : BOOLEAN;
  685. BEGIN
  686. RETURN pressed;
  687. END GetPressed;
  688. PROCEDURE FocusReceived*;
  689. BEGIN
  690. FocusReceived^;
  691. Invalidate
  692. END FocusReceived;
  693. PROCEDURE FocusLost*;
  694. BEGIN
  695. FocusLost^;
  696. Invalidate
  697. END FocusLost;
  698. PROCEDURE Down;
  699. BEGIN
  700. IF ~isToggle.Get() THEN
  701. IF ~pressed THEN pressed := TRUE; Invalidate; CheckRepeating(TRUE) END;
  702. ChangeModel(pressed);
  703. ELSE
  704. pressed := ~pressed; Invalidate;
  705. END;
  706. END Down;
  707. PROCEDURE Up;
  708. BEGIN
  709. IF isToggle.Get() THEN
  710. ChangeModel(pressed); Click(SELF, userData);
  711. RETURN
  712. END;
  713. IF pressed & (mouseOver OR keyboardPressed) THEN
  714. CheckRepeating(FALSE);
  715. Click(SELF, userData);
  716. pressed := FALSE;
  717. Invalidate
  718. END;
  719. pressed := FALSE;
  720. ChangeModel(pressed);
  721. END Up;
  722. PROCEDURE PointerDown*(x, y: LONGINT; keys : SET); (** PROTECTED *)
  723. BEGIN
  724. IF enabled.Get() THEN Down END;
  725. PointerDown^(x, y, keys)
  726. END PointerDown;
  727. PROCEDURE PointerMove*(x, y : LONGINT; keys : SET); (** PROTECTED *)
  728. BEGIN
  729. IF enabled.Get() THEN
  730. IF IsHit(x, y) THEN
  731. IF ~mouseOver THEN mouseOver := TRUE; IF pressed THEN CheckRepeating(TRUE) END; Invalidate END
  732. ELSE
  733. IF mouseOver THEN mouseOver := FALSE; IF pressed THEN CheckRepeating(FALSE) END; Invalidate END
  734. END
  735. ELSE mouseOver := FALSE
  736. END;
  737. PointerMove^(x, y, keys)
  738. END PointerMove;
  739. PROCEDURE PointerUp*(x, y : LONGINT; keys : SET); (** PROTECTED *)
  740. BEGIN
  741. Up;
  742. PointerUp^(x, y, keys)
  743. END PointerUp;
  744. PROCEDURE PointerLeave*; (** PROTECTED *)
  745. BEGIN
  746. mouseOver := FALSE; Invalidate
  747. END PointerLeave;
  748. PROCEDURE SetCaption*(CONST x : ARRAY OF CHAR);
  749. BEGIN
  750. caption.Set(WMComponents.NewString(x))
  751. END SetCaption;
  752. PROCEDURE IsHit*(x, y: LONGINT) : BOOLEAN;
  753. VAR t : BOOLEAN;
  754. BEGIN
  755. IF ~visible.Get() THEN RETURN FALSE END;
  756. Acquire;
  757. t := WMRectangles.PointInRect(x, y, GetClientRect());
  758. IF useBgBitmaps.Get() THEN
  759. IF isHorizontal.Get() THEN
  760. t := t & IsHitHorizontal(x, y)
  761. ELSE
  762. t := t & IsHitVertical(x, y)
  763. END
  764. END;
  765. Release;
  766. RETURN t
  767. END IsHit;
  768. PROCEDURE IsHitHorizontal(x, y: LONGINT) : BOOLEAN;
  769. VAR a, b, c : WMGraphics.Image; aw, bw, cw : LONGINT;
  770. BEGIN
  771. IF imgDefault # NIL THEN
  772. RETURN WMGraphics.IsScaledBitmapHit (x,y,bounds.GetWidth(), bounds.GetHeight(), 64,imgDefault);
  773. ELSE
  774. GetHorizontalImages(a, b, c);
  775. IF a # NIL THEN aw := a.width ELSE aw := 0 END;
  776. IF c # NIL THEN cw := c.width ELSE cw := 0 END;
  777. bw := bounds.GetWidth() - aw - cw;
  778. IF x < aw THEN
  779. y := y * a.height DIV bounds.GetHeight();
  780. RETURN WMGraphics.IsBitmapHit(x, y, 64, a)
  781. ELSIF x > bounds.GetWidth() - cw THEN
  782. y := y * c.height DIV bounds.GetHeight();
  783. RETURN WMGraphics.IsBitmapHit(x-aw-bw, y, 64, c)
  784. ELSE (* middle image *)
  785. IF b = NIL THEN RETURN FALSE END; (* no image loaded, so the button cannot be hit *)
  786. y := y * b.height DIV bounds.GetHeight();
  787. IF repeatMiddleImg.Get() THEN
  788. RETURN WMGraphics.IsBitmapHit((x-aw) MOD b.width, y, 64, b)
  789. ELSE
  790. RETURN WMGraphics.IsBitmapHit((x-aw) * b.width DIV bw, y, 64, b)
  791. END
  792. END
  793. END
  794. END IsHitHorizontal;
  795. PROCEDURE IsHitVertical(x, y: LONGINT) : BOOLEAN;
  796. VAR a, b, c : WMGraphics.Image; ah, bh, ch : LONGINT;
  797. BEGIN
  798. GetVerticalImages(a, b, c);
  799. IF a # NIL THEN ah := a.height ELSE ah := 0 END;
  800. IF c # NIL THEN ch := c.height ELSE ch := 0 END;
  801. bh := bounds.GetHeight() - ah - ch;
  802. IF y < ah THEN
  803. x := x * a.width DIV bounds.GetWidth();
  804. RETURN WMGraphics.IsBitmapHit(x, y, 64, a)
  805. ELSIF y > bounds.GetHeight() - ch THEN
  806. x := x * c.width DIV bounds.GetWidth();
  807. RETURN WMGraphics.IsBitmapHit(x, y-ah-bh, 64, c)
  808. ELSE (* middle image *)
  809. IF b = NIL THEN RETURN FALSE END; (* no image loaded, so the button cannot be hit *)
  810. x := x * b.width DIV bounds.GetWidth();
  811. IF repeatMiddleImg.Get() THEN
  812. RETURN WMGraphics.IsBitmapHit(x, (y-ah) MOD b.height, 64, b)
  813. ELSE
  814. RETURN WMGraphics.IsBitmapHit(x, (y-ah) * b.height DIV bh, 64, b)
  815. END
  816. END
  817. END IsHitVertical;
  818. (* load images appropriate to the actual state of the button. a: left, b: middle, c: right *)
  819. PROCEDURE GetHorizontalImages(VAR a, b, c : WMGraphics.Image);
  820. VAR down : BOOLEAN;
  821. BEGIN
  822. down := pressed & (mouseOver OR isToggle.Get() OR keyboardPressed);
  823. IF down THEN
  824. IF imgPressedMiddle # NIL THEN
  825. a := imgPressedLeft; b := imgPressedMiddle; c := imgPressedRight; RETURN
  826. ELSIF imgHoverMiddle # NIL THEN
  827. a := imgHoverLeft; b := imgHoverMiddle; c := imgHoverRight; RETURN
  828. ELSE
  829. a := imgDefaultLeft; b := imgDefaultMiddle; c := imgDefaultRight; RETURN
  830. END
  831. ELSIF mouseOver THEN
  832. IF imgHoverMiddle # NIL THEN
  833. a := imgHoverLeft; b := imgHoverMiddle; c := imgHoverRight; RETURN
  834. ELSE
  835. a := imgDefaultLeft; b := imgDefaultMiddle; c := imgDefaultRight; RETURN
  836. END
  837. ELSE
  838. a := imgDefaultLeft; b := imgDefaultMiddle; c := imgDefaultRight; RETURN
  839. END
  840. END GetHorizontalImages;
  841. (* load images appropriate to the actual state of the button. a: top, b: middle, c: bottom *)
  842. PROCEDURE GetVerticalImages(VAR a, b, c : WMGraphics.Image);
  843. VAR down : BOOLEAN;
  844. BEGIN
  845. down := pressed & (mouseOver OR isToggle.Get() OR keyboardPressed);
  846. IF down THEN
  847. IF imgPressedMiddle # NIL THEN
  848. a := imgPressedTop; b := imgPressedMiddle; c := imgPressedBottom; RETURN
  849. ELSIF imgHoverMiddle # NIL THEN
  850. a := imgHoverTop; b := imgHoverMiddle; c := imgHoverBottom; RETURN
  851. ELSE
  852. a := imgDefaultTop; b := imgDefaultMiddle; c := imgDefaultBottom; RETURN
  853. END
  854. ELSIF mouseOver THEN
  855. IF imgHoverMiddle # NIL THEN
  856. a := imgHoverTop; b := imgHoverMiddle; c := imgHoverBottom; RETURN
  857. ELSE
  858. a := imgDefaultTop; b := imgDefaultMiddle; c := imgDefaultBottom; RETURN
  859. END
  860. ELSE
  861. a := imgDefaultTop; b := imgDefaultMiddle; c:= imgDefaultBottom; RETURN
  862. END
  863. END GetVerticalImages;
  864. PROCEDURE GetDecorationImage(name: String; CONST suffix: ARRAY OF CHAR; VAR image:WMGraphics.Image);
  865. VAR fileName, extension: Files.FileName;
  866. BEGIN
  867. IF (name = NIL) OR (name^="") THEN
  868. image := NIL;
  869. ELSE
  870. Files.SplitExtension(name^, fileName, extension);
  871. Strings.Append(fileName, suffix);
  872. Files.JoinExtension(fileName,extension, fileName);
  873. image := WMGraphics.LoadImage(fileName, TRUE);
  874. END;
  875. END GetDecorationImage;
  876. PROCEDURE GetDecoration(name: String; VAR d: Decoration);
  877. BEGIN
  878. IF (name = NIL) OR (name^ = "") THEN d := NIL; RETURN END;
  879. IF d = NIL THEN
  880. NEW(d);
  881. END;
  882. GetDecorationImage(name, "TL", d.TL);
  883. GetDecorationImage(name, "T", d.T);
  884. GetDecorationImage(name, "TR", d.TR);
  885. GetDecorationImage(name, "L", d.L);
  886. GetDecorationImage(name, "M", d.M);
  887. GetDecorationImage(name, "R", d.R);
  888. GetDecorationImage(name, "BL", d.BL);
  889. GetDecorationImage(name, "B", d.B);
  890. GetDecorationImage(name, "BR", d.BR);
  891. IF (d.M = NIL) & (d.T = NIL) & (d.TR = NIL) & (d.L = NIL) & (d.M = NIL) & (d.R= NIL) & (d.BR = NIL) & (d.B=NIL) & (d.BR = NIL) THEN
  892. d := NIL
  893. END;
  894. END GetDecoration;
  895. (* load images appropriate to the actual state of the button. a: left, b: middle, c: right *)
  896. PROCEDURE GetThisDecoration(VAR d : Decoration);
  897. VAR down : BOOLEAN;
  898. BEGIN
  899. down := pressed & (mouseOver OR isToggle.Get() OR keyboardPressed);
  900. IF down THEN
  901. IF decoPressed # NIL THEN d := decoPressed;
  902. ELSIF decoHover # NIL THEN d := decoHover
  903. ELSE d := decoDefault;
  904. END
  905. ELSIF mouseOver THEN
  906. IF decoHover # NIL THEN d := decoHover
  907. ELSE d := decoDefault
  908. END
  909. ELSE d := decoDefault
  910. END
  911. END GetThisDecoration;
  912. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  913. VAR mode, borderWidth : LONGINT; mid: WMGraphics.Color;
  914. tc : WMGraphics.Color; r, rect : WMGraphics.Rectangle; down : BOOLEAN;
  915. str : String;
  916. BEGIN
  917. IF ~visible.Get() THEN RETURN END;
  918. Acquire;
  919. down := pressed;
  920. IF ~enabled.Get() THEN mid := clInactive.Get(); tc := clTextInactive.Get()
  921. ELSIF down THEN mid := clPressed.Get(); tc := clTextPressed.Get()
  922. ELSIF mouseOver THEN mid := clHover.Get(); tc := clTextHover.Get()
  923. ELSE mid := clDefault.Get(); tc := clTextDefault.Get() END;
  924. IF useBgBitmaps.Get() THEN
  925. IF isHorizontal.Get() THEN
  926. DrawHorizontalBackground(canvas)
  927. ELSE
  928. DrawVerticalBackground(canvas)
  929. END
  930. ELSIF useDeco.Get() THEN
  931. DrawDecoBackground(canvas)
  932. ELSE
  933. IF invert3d THEN down := ~down END;
  934. rect := GetClientRect();
  935. mode := WMGraphics.ModeSrcOverDst;
  936. borderWidth := 1;
  937. IF mid # 0 THEN canvas.Fill(rect, mid, mode) END;
  938. IF SELF.effect3D.Get() > 0 THEN WMGraphicUtilities.RectGlassShade(canvas, rect, SELF.effect3D.Get(), down) END
  939. END;
  940. (* focus *)
  941. IF hasFocus THEN WMGraphicUtilities.DrawRect(canvas, WMRectangles.ResizeRect(rect, -1), LONGINT(0FF000080H), mode) END;
  942. (* foreground *)
  943. IF image # NIL THEN canvas.DrawImage(0, 0, image, WMGraphics.ModeSrcOverDst) END;
  944. str := caption.Get();
  945. IF str # NIL THEN
  946. r := GetClientRect();
  947. r := WMRectangles.MakeRect(r.l + TextBorder, r.t+TextBorder, r.r - TextBorder, r.b - TextBorder );
  948. canvas.SetColor(tc);
  949. WMGraphics.DrawStringInRect(canvas, r, FALSE, textAlignH.Get(), textAlignV.Get(), str^)
  950. END;
  951. IF isToggle.Get() & indicateToggle.Get() THEN
  952. IF pressed THEN tc := WMGraphics.Green;
  953. ELSE tc := WMGraphics.Red;
  954. END;
  955. canvas.Fill(WMRectangles.MakeRect(bounds.GetWidth()-8, 4, bounds.GetWidth()-4, 5), tc, WMGraphics.ModeSrcOverDst);
  956. WMGraphicUtilities.ExtRectGlassShade(canvas,
  957. WMRectangles.MakeRect(bounds.GetWidth()-9, 3, bounds.GetWidth()-3, 6), {},
  958. 1, TRUE);
  959. END;
  960. Release
  961. END DrawBackground;
  962. PROCEDURE DrawDecoBackground(canvas : WMGraphics.Canvas);
  963. VAR
  964. deco: Decoration;
  965. l,r,t,b: LONGINT;
  966. (* left and right boundaries *)
  967. tl, ml, bl, tr, mr, br: LONGINT;
  968. (* top and bottom boundaries *)
  969. lt, mt, rt, lb, mb, rb: LONGINT;
  970. maxBorder: LONGINT;
  971. PROCEDURE Draw(img:WMGraphics.Image; l,t,r,b: LONGINT );
  972. BEGIN
  973. IF (r>l) & (b>t) & (img # NIL) THEN
  974. canvas.ScaleImage(img, WMRectangles.MakeRect(0, 0, img.width, img.height), WMRectangles.MakeRect(l,t,r,b), WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  975. END;
  976. END Draw;
  977. PROCEDURE Scale(i: LONGINT): LONGINT;
  978. BEGIN
  979. IF i > maxBorder THEN RETURN maxBorder ELSE RETURN i END;
  980. END Scale;
  981. BEGIN
  982. GetThisDecoration(deco);
  983. l := bounds.GetLeft(); r := bounds.GetRight();
  984. t := bounds.GetTop(); b := bounds.GetBottom();
  985. (* but we are drawing relative to 0,0 : *)
  986. r := r-l; b := b-t; l := 0; t := 0;
  987. IF r > b THEN maxBorder := b DIV 5 ELSE maxBorder := r DIV 5 END;
  988. IF deco = NIL THEN RETURN END;
  989. IF deco.TL # NIL THEN tl := Scale(deco.TL.width); lt := Scale(deco.TL.height); Draw(deco.TL, l,t,l+tl,t+lt)
  990. ELSE tl := 0; lt := 0;
  991. END;
  992. IF deco.TR # NIL THEN tr := Scale(deco.TR.width); rt := Scale(deco.TR.height); Draw(deco.TR, r-tr, t, r, t+rt);
  993. ELSE tr := 0; rt := 0;
  994. END;
  995. IF deco.BL # NIL THEN bl := Scale(deco.BL.width); lb := Scale(deco.BL.height); Draw(deco.BL, l, b-lb, l + bl, b);
  996. ELSE bl := 0; lb := 0;
  997. END;
  998. IF deco.BR # NIL THEN br := Scale(deco.BR.width); rb := Scale(deco.BR.height); Draw(deco.BR, r-br, b-rb, r, b);
  999. ELSE br := 0; rb := 0;
  1000. END;
  1001. IF deco.L # NIL THEN ml := Scale(deco.L.width); Draw(deco.L, l, t+lt, l+ml, b-lb);
  1002. ELSE ml := 0;
  1003. END;
  1004. IF deco.R # NIL THEN mr := Scale(deco.R.width); Draw(deco.R, r-br, t+rt, r, b-rb);
  1005. ELSE mr := 0;
  1006. END;
  1007. IF deco.T # NIL THEN mt := Scale(deco.T.height); Draw(deco.T, l+tl, t, r-tr, t+mt);
  1008. ELSE mt := 0;
  1009. END;
  1010. IF deco.B # NIL THEN mb := Scale(deco.B.height); Draw(deco.B, l+bl, b-mb, r-br, b);
  1011. ELSE mb := 0;
  1012. END;
  1013. IF deco.M # NIL THEN Draw(deco.M, l+ml, t+mt, r-br, b-mb);
  1014. END;
  1015. END DrawDecoBackground;
  1016. PROCEDURE DrawHorizontalBackground(canvas : WMGraphics.Canvas);
  1017. VAR imgLeft, imgMiddle, imgRight, img : WMGraphics.Image;
  1018. wLeft, wRight : LONGINT;
  1019. down : BOOLEAN;
  1020. BEGIN
  1021. IF ~enabled.Get() & (imgInactive # NIL) THEN
  1022. img := imgInactive;
  1023. canvas.ScaleImage( img,
  1024. WMRectangles.MakeRect(0, 0, img.width, img.height),
  1025. WMRectangles.MakeRect(0, 0, bounds.GetWidth(), bounds.GetHeight()),
  1026. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1027. ELSIF imgDefault # NIL THEN
  1028. down := pressed & (mouseOver OR isToggle.Get() OR keyboardPressed);
  1029. IF down & (imgPressed # NIL) THEN
  1030. img := imgPressed
  1031. ELSIF mouseOver & (imgHover # NIL) THEN
  1032. img := imgHover
  1033. ELSE
  1034. img := imgDefault
  1035. END;
  1036. canvas.ScaleImage( img,
  1037. WMRectangles.MakeRect(0, 0, img.width, img.height),
  1038. WMRectangles.MakeRect(0, 0, bounds.GetWidth(), bounds.GetHeight()),
  1039. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1040. ELSE
  1041. GetHorizontalImages(imgLeft, imgMiddle, imgRight);
  1042. (* left *)
  1043. IF imgLeft # NIL THEN
  1044. wLeft := imgLeft.width;
  1045. canvas.ScaleImage( imgLeft,
  1046. WMRectangles.MakeRect(0, 0, imgLeft.width, imgLeft.height),
  1047. WMRectangles.MakeRect(0, 0, imgLeft.width, bounds.GetHeight()),
  1048. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1049. ELSE
  1050. wLeft := 0
  1051. END;
  1052. canvas.Line(wLeft, bounds.GetTop(), wLeft, bounds.GetBottom(), LONGINT(0FF0000FFH), WMGraphics.ModeSrcOverDst);
  1053. (* right *)
  1054. IF imgRight # NIL THEN
  1055. wRight := imgRight.width;
  1056. canvas.ScaleImage( imgRight,
  1057. WMRectangles.MakeRect(0, 0, imgRight.width, imgRight.height),
  1058. WMRectangles.MakeRect(bounds.GetWidth()-wRight, 0, bounds.GetWidth(), bounds.GetHeight()),
  1059. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1060. ELSE
  1061. wRight := 0
  1062. END;
  1063. (* middle *)
  1064. IF imgMiddle # NIL THEN
  1065. IF SELF.repeatMiddleImg.Get() THEN (* repeat image *)
  1066. WMGraphicUtilities.RepeatImageHorizontal(canvas, wLeft , 0, bounds.GetWidth()-wLeft-wRight, bounds.GetHeight(), imgMiddle)
  1067. ELSE (* scale image *)
  1068. canvas.ScaleImage( imgMiddle,
  1069. WMRectangles.MakeRect(0, 0, imgMiddle.width, imgMiddle.height),
  1070. WMRectangles.MakeRect(wLeft, 0, bounds.GetWidth()-wRight, bounds.GetHeight()), WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1071. END
  1072. END
  1073. END
  1074. END DrawHorizontalBackground;
  1075. PROCEDURE DrawVerticalBackground(canvas : WMGraphics.Canvas);
  1076. VAR imgMiddle, imgTop, imgBottom : WMGraphics.Image;
  1077. hTop, hBottom : LONGINT;
  1078. BEGIN
  1079. GetVerticalImages(imgTop, imgMiddle, imgBottom);
  1080. (* top*)
  1081. IF imgTop # NIL THEN
  1082. hTop := imgTop.height;
  1083. canvas.ScaleImage( imgTop,
  1084. WMRectangles.MakeRect(0, 0, imgTop.width, imgTop.height),
  1085. WMRectangles.MakeRect(0, 0, bounds.GetWidth(), imgTop.height),
  1086. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1087. ELSE
  1088. hTop := 0
  1089. END;
  1090. (* bottom*)
  1091. IF imgBottom # NIL THEN
  1092. hBottom := imgBottom.height;
  1093. canvas.ScaleImage( imgBottom,
  1094. WMRectangles.MakeRect(0, 0, imgBottom.width, imgBottom.height),
  1095. WMRectangles.MakeRect(0, bounds.GetHeight()-hBottom, bounds.GetWidth(), bounds.GetHeight()),
  1096. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1097. ELSE
  1098. hBottom := 0
  1099. END;
  1100. (* middle *)
  1101. IF imgMiddle # NIL THEN
  1102. IF SELF.repeatMiddleImg.Get() THEN (* repeat image *)
  1103. WMGraphicUtilities.RepeatImageVertical(canvas, 0, hTop, bounds.GetWidth(), bounds.GetHeight()-hTop-hBottom, imgMiddle)
  1104. ELSE (* scale image *)
  1105. canvas.ScaleImage( imgMiddle,
  1106. WMRectangles.MakeRect(0, 0, imgMiddle.width, imgMiddle.height),
  1107. WMRectangles.MakeRect(0, hTop, bounds.GetWidth(), bounds.GetHeight()-hBottom), WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear)
  1108. END
  1109. END
  1110. END DrawVerticalBackground;
  1111. PROCEDURE KeyEvent*(ucs : LONGINT; flags : SET; VAR keyCode : LONGINT);
  1112. BEGIN
  1113. IF ~ (Inputs.Release IN flags) THEN
  1114. IF keyCode = 20H THEN keyboardPressed := TRUE; Down
  1115. (* pressed := TRUE; keyboardPressed := TRUE; Invalidate *)
  1116. ELSE keyboardPressed := FALSE; Invalidate (* abort *)
  1117. END
  1118. ELSE
  1119. IF pressed THEN
  1120. Up; keyboardPressed := FALSE
  1121. END
  1122. END
  1123. END KeyEvent;
  1124. PROCEDURE Click*(sender, par : ANY); (** Eventhandler *)
  1125. VAR event : WMComponents.PointerEvent; command : Strings.String;
  1126. BEGIN
  1127. (* synchronize if not synchronized *)
  1128. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Click, sender, par)
  1129. ELSE
  1130. (* actual business logic *)
  1131. onClick.Call(par);
  1132. ExecuteClickHandler;
  1133. END;
  1134. command := GetAttributeValue("command");
  1135. IF command # NIL THEN WMComponents.HandleEvent(event, SELF, command) END;
  1136. END Click;
  1137. END Button;
  1138. CONST
  1139. None = -1;
  1140. MinusButton = 0;
  1141. MinusPage = 1;
  1142. Tracker = 2;
  1143. PlusPage = 3;
  1144. PlusButton = 4;
  1145. TYPE
  1146. Area = RECORD
  1147. rect : WMRectangles.Rectangle;
  1148. END;
  1149. (** Scrollbar *)
  1150. Scrollbar* = OBJECT (WMComponents.VisualComponent)
  1151. VAR
  1152. min-, max-, pos-, pageSize-, width- : WMProperties.Int32Property;
  1153. vertical- : WMProperties.BooleanProperty;
  1154. minTrackerSize- : WMProperties.Int32Property;
  1155. clDefault-, clHover-, clPressed- : WMProperties.ColorProperty;
  1156. clBtnDefault-, clBtnHover-, clBtnPressed- : WMProperties.ColorProperty;
  1157. effect3D- : WMProperties.Int32Property;
  1158. (* background *)
  1159. useBgBitmaps-, repeatBgBitmap- : WMProperties.BooleanProperty;
  1160. hBgDefaultName-, hBgHoverName-, hBgPressedName-,
  1161. vBgDefaultName-, vBgHoverName-, vBgPressedName- : WMProperties.StringProperty;
  1162. hBgDefault, hBgHover, hBgPressed,
  1163. vBgDefault, vBgHover, vBgPressed : WMGraphics.Image;
  1164. (* tracker images *)
  1165. useTrackerImages-, repeatMiddleBitmap- : WMProperties.BooleanProperty;
  1166. (* horizontal thumb *)
  1167. hTrackerDefaultNameLeft-, hTrackerHoverNameLeft-, hTrackerPressedNameLeft-,
  1168. hTrackerDefaultNameMiddle-, hTrackerHoverNameMiddle-, hTrackerPressedNameMiddle-,
  1169. hTrackerDefaultNameRight-, hTrackerHoverNameRight-, hTrackerPressedNameRight- : WMProperties.StringProperty;
  1170. hTrackerDefaultLeft, hTrackerHoverLeft, hTrackerPressedLeft,
  1171. hTrackerDefaultMiddle, hTrackerHoverMiddle, hTrackerPressedMiddle,
  1172. hTrackerDefaultRight, hTrackerHoverRight, hTrackerPressedRight : WMGraphics.Image;
  1173. (* vertical thumb *)
  1174. vTrackerDefaultNameTop-, vTrackerHoverNameTop-, vTrackerPressedNameTop-,
  1175. vTrackerDefaultNameMiddle-, vTrackerHoverNameMiddle-, vTrackerPressedNameMiddle-,
  1176. vTrackerDefaultNameBottom-, vTrackerHoverNameBottom-, vTrackerPressedNameBottom- : WMProperties.StringProperty;
  1177. vTrackerDefaultTop, vTrackerHoverTop, vTrackerPressedTop,
  1178. vTrackerDefaultMiddle, vTrackerHoverMiddle, vTrackerPressedMiddle,
  1179. vTrackerDefaultBottom, vTrackerHoverBottom, vTrackerPressedBottom : WMGraphics.Image;
  1180. (* arrow images *)
  1181. useArrowImages : WMProperties.BooleanProperty;
  1182. arrowLeftDefaultName-, arrowLeftHoverName-, arrowLeftPressedName-,
  1183. arrowUpDefaultName-, arrowUpHoverName-, arrowUpPressedName-,
  1184. arrowRightDefaultName-, arrowRightHoverName-, arrowRightPressedName-,
  1185. arrowDownDefaultName-, arrowDownHoverName-, arrowDownPressedName- : WMProperties.StringProperty;
  1186. arrowLeftDefault, arrowLeftHover, arrowLeftPressed,
  1187. arrowUpDefault, arrowUpHover, arrowUpPressed,
  1188. arrowRightDefault, arrowRightHover, arrowRightPressed,
  1189. arrowDownDefault, arrowDownHover, arrowDownPressed : WMGraphics.Image;
  1190. onPositionChanged- : EventSource;
  1191. (* bounds and state of logical subcomponents *)
  1192. areas : ARRAY 5 OF Area;
  1193. down, pressed, hover : SHORTINT;
  1194. timer : InternalTimer;
  1195. ts, tp, tDownX, tDownY : LONGINT;
  1196. PROCEDURE &Init*;
  1197. BEGIN
  1198. Init^;
  1199. SetGenerator("WMStandardComponents.GenScrollbar");
  1200. SetNameAsString(StrScrollbar);
  1201. NEW(min, PrototypeSmin, NIL, NIL); properties.Add(min);
  1202. NEW(max, PrototypeSmax, NIL, NIL); properties.Add(max);
  1203. NEW(pos, PrototypeSpos, NIL, NIL); properties.Add(pos);
  1204. NEW(pageSize, PrototypeSpageSize, NIL, NIL); properties.Add(pageSize);
  1205. NEW(vertical, PrototypeSvertical, NIL, NIL); properties.Add(vertical);
  1206. pos.SetBounds(min.Get(), max.Get());
  1207. NEW(width, PrototypeSWidth, NIL, NIL);
  1208. NEW(minTrackerSize, PrototypeSMinTrackerSize, NIL, NIL); properties.Add(minTrackerSize);
  1209. NEW(effect3D, PrototypeSEffect3D, NIL, NIL); properties.Add(effect3D);
  1210. (* simple representation *)
  1211. NEW(clDefault, PrototypeSClDefault, NIL, NIL); properties.Add(clDefault);
  1212. NEW(clHover, PrototypeSClHover, NIL, NIL); properties.Add(clHover);
  1213. NEW(clPressed, PrototypeSClPressed, NIL, NIL); properties.Add(clPressed);
  1214. NEW(clBtnDefault, PrototypeSClBtnDefault, NIL, NIL); properties.Add(clBtnDefault);
  1215. NEW(clBtnHover, PrototypeSClBtnHover, NIL, NIL); properties.Add(clBtnHover);
  1216. NEW(clBtnPressed, PrototypeSClBtnPressed, NIL, NIL); properties.Add(clBtnPressed);
  1217. (* --- background of scrollbar --- *)
  1218. NEW(useBgBitmaps, PrototypeSUseBgBitmaps, NIL, NIL); properties.Add(useBgBitmaps);
  1219. NEW(repeatBgBitmap, PrototypeSRepeateBgBitmap, NIL, NIL); properties.Add(repeatBgBitmap);
  1220. (* bitmap representation *)
  1221. NEW(hBgDefaultName, PrototypeShBgDefault, NIL, NIL); properties.Add(hBgDefaultName);
  1222. NEW(hBgHoverName, PrototypeShBgHover, NIL, NIL); properties.Add(hBgHoverName);
  1223. NEW(hBgPressedName, PrototypeShBgPressed, NIL, NIL); properties.Add(hBgPressedName);
  1224. NEW(vBgDefaultName, PrototypeSvBgDefault, NIL, NIL); properties.Add(vBgDefaultName);
  1225. NEW(vBgHoverName, PrototypeSvBgHover, NIL, NIL); properties.Add(vBgHoverName);
  1226. NEW(vBgPressedName, PrototypeSvBgPressed, NIL, NIL); properties.Add(vBgPressedName);
  1227. (* --- tracker --- *)
  1228. NEW(useTrackerImages, PrototypeSUseTrackerImages, NIL, NIL); properties.Add(useTrackerImages);
  1229. NEW(repeatMiddleBitmap, PrototypeSRepeatMiddleBitmap, NIL, NIL); properties.Add(repeatMiddleBitmap);
  1230. (* horizontal decoration bitmaps *)
  1231. NEW(hTrackerDefaultNameLeft, PrototypeShTrackerDefaultLeft, NIL, NIL); properties.Add(hTrackerDefaultNameLeft);
  1232. NEW(hTrackerHoverNameLeft, PrototypeShTrackerHoverLeft, NIL, NIL); properties.Add(hTrackerHoverNameLeft);
  1233. NEW(hTrackerPressedNameLeft, PrototypeShTrackerPressedLeft, NIL, NIL); properties.Add(hTrackerPressedNameLeft);
  1234. NEW(hTrackerDefaultNameMiddle, PrototypeShTrackerDefaultMiddle, NIL, NIL); properties.Add(hTrackerDefaultNameMiddle);
  1235. NEW(hTrackerHoverNameMiddle, PrototypeShTrackerHoverMiddle, NIL, NIL); properties.Add(hTrackerHoverNameMiddle);
  1236. NEW(hTrackerPressedNameMiddle, PrototypeShTrackerPressedMiddle, NIL, NIL); properties.Add(hTrackerPressedNameMiddle);
  1237. NEW(hTrackerDefaultNameRight, PrototypeShTrackerDefaultRight, NIL, NIL); properties.Add(hTrackerDefaultNameRight);
  1238. NEW(hTrackerHoverNameRight, PrototypeShTrackerHoverRight, NIL, NIL); properties.Add(hTrackerHoverNameRight);
  1239. NEW(hTrackerPressedNameRight, PrototypeShTrackerPressedRight, NIL, NIL); properties.Add(hTrackerPressedNameRight);
  1240. (* vertical decoration bitmaps *)
  1241. NEW(vTrackerDefaultNameTop, PrototypeSvTrackerDefaultTop, NIL, NIL); properties.Add(vTrackerDefaultNameTop);
  1242. NEW(vTrackerHoverNameTop, PrototypeSvTrackerHoverTop, NIL, NIL); properties.Add(vTrackerHoverNameTop);
  1243. NEW(vTrackerPressedNameTop, PrototypeSvTrackerPressedTop, NIL, NIL); properties.Add(vTrackerPressedNameTop);
  1244. NEW(vTrackerDefaultNameMiddle, PrototypeSvTrackerDefaultMiddle, NIL, NIL); properties.Add(vTrackerDefaultNameMiddle);
  1245. NEW(vTrackerHoverNameMiddle, PrototypeSvTrackerHoverMiddle, NIL, NIL); properties.Add(vTrackerHoverNameMiddle);
  1246. NEW(vTrackerPressedNameMiddle, PrototypeSvTrackerPressedMiddle, NIL, NIL); properties.Add(vTrackerPressedNameMiddle);
  1247. NEW(vTrackerDefaultNameBottom, PrototypeSvTrackerDefaultBottom, NIL, NIL); properties.Add(vTrackerDefaultNameBottom);
  1248. NEW(vTrackerHoverNameBottom, PrototypeSvTrackerHoverBottom, NIL, NIL); properties.Add(vTrackerHoverNameBottom);
  1249. NEW(vTrackerPressedNameBottom, PrototypeSvTrackerPressedBottom, NIL, NIL); properties.Add(vTrackerPressedNameBottom);
  1250. NEW(onPositionChanged, SELF, GSonPositionChanged, GSonPositionChangedInfo, SELF.StringToCompCommand);
  1251. events.Add(onPositionChanged);
  1252. (* --- arrow buttons --- *)
  1253. NEW(useArrowImages, PrototypeSUseArrowImages, NIL, NIL); properties.Add(useArrowImages);
  1254. (* left *)
  1255. NEW(arrowLeftDefaultName, PrototypeSArrowLeftDefault, NIL, NIL); properties.Add(arrowLeftDefaultName);
  1256. NEW(arrowLeftHoverName, PrototypeSArrowLeftHover, NIL, NIL); properties.Add(arrowLeftHoverName);
  1257. NEW(arrowLeftPressedName, PrototypeSArrowLeftPressed, NIL, NIL); properties.Add(arrowLeftPressedName);
  1258. (* right *)
  1259. NEW(arrowRightDefaultName, PrototypeSArrowRightDefault, NIL, NIL); properties.Add(arrowRightDefaultName);
  1260. NEW(arrowRightHoverName, PrototypeSArrowRightHover, NIL, NIL); properties.Add(arrowRightHoverName);
  1261. NEW(arrowRightPressedName, PrototypeSArrowRightPressed, NIL, NIL); properties.Add(arrowRightPressedName);
  1262. (* up *)
  1263. NEW(arrowUpDefaultName, PrototypeSArrowUpDefault, NIL, NIL); properties.Add(arrowUpDefaultName);
  1264. NEW(arrowUpHoverName, PrototypeSArrowUpHover, NIL, NIL); properties.Add(arrowUpHoverName);
  1265. NEW(arrowUpPressedName, PrototypeSArrowUpPressed, NIL, NIL); properties.Add(arrowUpPressedName);
  1266. (* down *)
  1267. NEW(arrowDownDefaultName, PrototypeSArrowDownDefault, NIL, NIL); properties.Add(arrowDownDefaultName);
  1268. NEW(arrowDownHoverName, PrototypeSArrowDownHover, NIL, NIL); properties.Add(arrowDownHoverName);
  1269. NEW(arrowDownPressedName, PrototypeSArrowDownPressed, NIL, NIL); properties.Add(arrowDownPressedName);
  1270. down := None; pressed := None; hover := None;
  1271. timer := NIL;
  1272. bounds.SetExtents(SELF.width.Get(), SELF.width.Get());
  1273. takesFocus.Set(FALSE);
  1274. RecacheImages;
  1275. END Init;
  1276. PROCEDURE Resized*;
  1277. BEGIN
  1278. Resized^;
  1279. UpdateLayout;
  1280. Invalidate;
  1281. END Resized;
  1282. PROCEDURE LinkChanged*(sender, data : ANY);
  1283. VAR integer : Types.Integer; res : WORD; m: Models.Model;
  1284. BEGIN
  1285. IF (sender = model) & WMProperties.GetModel(model,m) THEN
  1286. m.GetGeneric(integer, res);
  1287. IF (res = Models.Ok) & (pos.Get() # integer.value) THEN
  1288. pos.Set(integer.value);
  1289. END;
  1290. END;
  1291. END LinkChanged;
  1292. PROCEDURE ChangeModel(value : LONGINT);
  1293. VAR integer : Types.Integer; res : WORD; m: Models.Model;
  1294. BEGIN
  1295. IF WMProperties.GetModel(model, m) THEN
  1296. integer.value := value;
  1297. m.SetGeneric(integer, res);
  1298. END;
  1299. END ChangeModel;
  1300. PROCEDURE TimerCallback(sender, data : ANY);
  1301. BEGIN
  1302. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.TimerCallback, sender, data);
  1303. ELSE
  1304. Down(pressed);
  1305. END;
  1306. END TimerCallback;
  1307. PROCEDURE CheckRepeating(start : BOOLEAN);
  1308. BEGIN
  1309. IF start THEN
  1310. IF (timer = NIL) THEN NEW(timer, TimerCallback); END;
  1311. timer.Start;
  1312. ELSE
  1313. IF (timer # NIL) THEN
  1314. timer.Finalize; timer := NIL;
  1315. END;
  1316. END;
  1317. END CheckRepeating;
  1318. PROCEDURE Down(area : SHORTINT);
  1319. BEGIN
  1320. IF (area = MinusButton) THEN DecPos(NIL, NIL);
  1321. ELSIF (area = MinusPage) THEN PageUp(NIL, NIL);
  1322. ELSIF (area = PlusPage) THEN PageDown(NIL, NIL);
  1323. ELSIF (area = PlusButton) THEN IncPos(NIL, NIL);
  1324. END;
  1325. END Down;
  1326. PROCEDURE PointerDown*(x, y : LONGINT; keys : SET);
  1327. BEGIN
  1328. PointerDown^(x, y, keys);
  1329. IF (0 IN keys) THEN
  1330. down := FindArea(x, y);
  1331. IF (down # None) THEN
  1332. Down(down);
  1333. CheckRepeating(TRUE);
  1334. pressed := down;
  1335. InvalidateRect(areas[pressed].rect);
  1336. END;
  1337. tDownX := x - tp ; tDownY := y - tp;
  1338. ELSIF (1 IN keys) THEN
  1339. TrackerMove(x, y, keys);
  1340. pressed := Tracker;
  1341. down := pressed;
  1342. InvalidateRect(areas[pressed].rect);
  1343. END;
  1344. END PointerDown;
  1345. PROCEDURE PointerMove*(x, y : LONGINT; keys : SET);
  1346. VAR oldHover, oldPressed, area : SHORTINT;
  1347. BEGIN
  1348. PointerMove^(x, y, keys);
  1349. area := FindArea(x, y);
  1350. IF (down = None) THEN
  1351. IF (hover # area) THEN
  1352. oldHover := hover;
  1353. hover := area;
  1354. IF (oldHover # None) THEN InvalidateRect(areas[oldHover].rect); END;
  1355. IF (hover # None) THEN InvalidateRect(areas[hover].rect); END;
  1356. END;
  1357. ELSE
  1358. IF (hover # None) THEN oldHover := hover; hover := None; InvalidateRect(areas[oldHover].rect); END;
  1359. IF (down # Tracker) THEN
  1360. IF (area = None) OR (area # down) THEN
  1361. IF (pressed # None) THEN oldPressed := pressed; pressed := None; InvalidateRect(areas[oldPressed].rect); END;
  1362. ELSIF (area = down) THEN
  1363. pressed := down; InvalidateRect(areas[pressed].rect);
  1364. END;
  1365. ELSE
  1366. TrackerMove(x, y, keys);
  1367. END;
  1368. END;
  1369. END PointerMove;
  1370. PROCEDURE PointerUp*(x, y : LONGINT; keys : SET);
  1371. VAR oldPressed : SHORTINT;
  1372. BEGIN
  1373. PointerUp^(x, y, keys);
  1374. IF ~(0 IN keys) THEN
  1375. down := None;
  1376. IF (pressed # None) THEN
  1377. CheckRepeating(FALSE);
  1378. oldPressed := pressed;
  1379. pressed := None;
  1380. InvalidateRect(areas[oldPressed].rect);
  1381. END;
  1382. END;
  1383. END PointerUp;
  1384. PROCEDURE PointerLeave*;
  1385. VAR oldHover : SHORTINT;
  1386. BEGIN
  1387. PointerLeave^;
  1388. IF (hover # None) THEN
  1389. oldHover := hover;
  1390. hover := None;
  1391. InvalidateRect(areas[oldHover].rect);
  1392. END;
  1393. END PointerLeave;
  1394. PROCEDURE FindArea(x, y : LONGINT) : SHORTINT;
  1395. VAR result : SHORTINT;
  1396. BEGIN
  1397. result := 0;
  1398. WHILE (result < LEN(areas)) & ~WMRectangles.PointInRect(x, y, areas[result].rect) DO INC(result); END;
  1399. IF (result >= LEN(areas)) THEN result := None; END;
  1400. RETURN result;
  1401. END FindArea;
  1402. PROCEDURE TrackerMove(x, y : LONGINT; keys : SET);
  1403. VAR newPosition, value, d, dy, dp, dx : LONGINT; f : REAL; tmax, tmin, a, b : LONGINT;
  1404. BEGIN
  1405. tmin := min.Get(); tmax := max.Get();
  1406. IF 1 IN keys THEN
  1407. IF vertical.Get() THEN
  1408. a := bounds.GetWidth() + (ts DIV 2);
  1409. b := bounds.GetHeight() - a;
  1410. d := (b - a);
  1411. value := y - a;
  1412. ELSE
  1413. a := bounds.GetHeight() + (ts DIV 2);
  1414. b := bounds.GetWidth() - a;
  1415. d := (b - a);
  1416. value := x - a;
  1417. END;
  1418. IF (d > 0) THEN
  1419. IF (value < 0) THEN value := 0; ELSIF (value > b) THEN value := b; END;
  1420. f := tmax - tmin;
  1421. f := f * (value / d); newPosition := ENTIER(f);
  1422. IF (pos.Get() # newPosition) THEN pos.Set(newPosition); onPositionChanged.Call(pos); END;
  1423. END;
  1424. ELSIF 0 IN keys THEN
  1425. IF vertical.Get() THEN
  1426. d := (bounds.GetHeight() - 2 * bounds.GetWidth());
  1427. IF d > 0 THEN
  1428. dy := (y - tp) - tDownY;
  1429. f := tmax - tmin; f := f * dy / d; dp := ENTIER(f);
  1430. ELSE
  1431. dp := 0;
  1432. END;
  1433. ELSE
  1434. d := (bounds.GetWidth() - 2 * bounds.GetHeight());
  1435. IF d > 0 THEN
  1436. dx := (x - tp) - tDownX;
  1437. f := tmax - tmin; f := f * dx / d; dp := ENTIER(f);
  1438. ELSE
  1439. dp := 0;
  1440. END;
  1441. END;
  1442. IF dp # 0 THEN pos.Set(pos.Get() + dp); onPositionChanged.Call(pos); END;
  1443. END;
  1444. END TrackerMove;
  1445. PROCEDURE RecacheImages;
  1446. PROCEDURE GetImage(string : WMProperties.StringProperty) : WMGraphics.Image;
  1447. VAR s : Strings.String; image : WMGraphics.Image;
  1448. BEGIN
  1449. s := string.Get(); IF (s # NIL) THEN image := WMGraphics.LoadImage(s^, TRUE); ELSE image := NIL; END;
  1450. RETURN image;
  1451. END GetImage;
  1452. BEGIN
  1453. hBgDefault := GetImage(hBgDefaultName); hBgHover := GetImage(hBgHoverName); hBgPressed := GetImage(hBgPressedName);
  1454. vBgDefault := GetImage(vBgDefaultName); vBgHover := GetImage(vBgHoverName); vBgPressed := GetImage(vBgPressedName);
  1455. hTrackerDefaultLeft := GetImage(hTrackerDefaultNameLeft);
  1456. hTrackerHoverLeft := GetImage(hTrackerHoverNameLeft);
  1457. hTrackerPressedLeft := GetImage(hTrackerPressedNameLeft);
  1458. hTrackerDefaultMiddle := GetImage(hTrackerDefaultNameMiddle);
  1459. hTrackerHoverMiddle := GetImage(hTrackerHoverNameMiddle);
  1460. hTrackerPressedMiddle := GetImage(hTrackerPressedNameMiddle);
  1461. hTrackerDefaultRight := GetImage(hTrackerDefaultNameRight);
  1462. hTrackerHoverRight := GetImage(hTrackerHoverNameRight);
  1463. hTrackerPressedRight := GetImage(hTrackerPressedNameRight);
  1464. vTrackerDefaultTop := GetImage(vTrackerDefaultNameTop);
  1465. vTrackerHoverTop := GetImage(vTrackerHoverNameTop);
  1466. vTrackerPressedTop := GetImage(vTrackerPressedNameTop);
  1467. vTrackerDefaultMiddle := GetImage(vTrackerDefaultNameMiddle);
  1468. vTrackerHoverMiddle := GetImage(vTrackerHoverNameMiddle);
  1469. vTrackerPressedMiddle := GetImage(vTrackerPressedNameMiddle);
  1470. vTrackerDefaultBottom := GetImage(vTrackerDefaultNameBottom);
  1471. vTrackerHoverBottom := GetImage(vTrackerHoverNameBottom);
  1472. vTrackerPressedBottom := GetImage(vTrackerPressedNameBottom);
  1473. arrowLeftDefault := GetImage(arrowLeftDefaultName);
  1474. arrowLeftHover := GetImage(arrowLeftHoverName);
  1475. arrowLeftPressed := GetImage(arrowLeftPressedName);
  1476. arrowUpDefault := GetImage(arrowUpDefaultName);
  1477. arrowUpHover := GetImage(arrowUpHoverName);
  1478. arrowUpPressed := GetImage(arrowUpPressedName);
  1479. arrowRightDefault := GetImage(arrowRightDefaultName);
  1480. arrowRightHover := GetImage(arrowRightHoverName);
  1481. arrowRightPressed := GetImage(arrowRightPressedName);
  1482. arrowDownDefault := GetImage(arrowDownDefaultName);
  1483. arrowDownHover := GetImage(arrowDownHoverName);
  1484. arrowDownPressed := GetImage( arrowDownPressedName);
  1485. END RecacheImages;
  1486. PROCEDURE RecacheProperties*;
  1487. VAR element : XML.Element;
  1488. BEGIN
  1489. RecacheProperties^;
  1490. RecacheImages;
  1491. pos.SetBounds(min.Get(), max.Get());
  1492. IF SELF.vertical.Get() THEN
  1493. bounds.SetWidth(SELF.width.Get())
  1494. ELSE
  1495. bounds.SetHeight(SELF.width.Get())
  1496. END;
  1497. Resized; (*?implies Invalidate -> redundant*)
  1498. END RecacheProperties;
  1499. PROCEDURE PropertyChanged*(sender, property : ANY);
  1500. BEGIN
  1501. IF (property = pos) THEN
  1502. UpdateLayout; ChangeModel(pos.Get()); Invalidate;
  1503. ELSIF (property = model) THEN Invalidate;
  1504. ELSIF (property = vertical) THEN
  1505. IF SELF.vertical.Get() THEN
  1506. bounds.SetWidth(SELF.width.Get())
  1507. ELSE
  1508. bounds.SetHeight(SELF.width.Get())
  1509. END;
  1510. Resized; (*implies Invalidate*)
  1511. ELSIF (property = minTrackerSize) THEN UpdateLayout; Invalidate;
  1512. ELSIF (property = min) OR (property = max) OR (property = pageSize) THEN
  1513. pos.SetBounds(min.Get(), max.Get());
  1514. UpdateLayout;
  1515. Invalidate;
  1516. ELSE PropertyChanged^(sender, property)
  1517. END;
  1518. END PropertyChanged;
  1519. PROCEDURE DecPos*(sender, par : ANY);
  1520. BEGIN
  1521. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.DecPos, sender, par);
  1522. ELSE pos.Set(pos.Get() - 1); onPositionChanged.Call(pos);
  1523. END;
  1524. END DecPos;
  1525. PROCEDURE IncPos*(sender, par : ANY);
  1526. BEGIN
  1527. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.IncPos, sender, par);
  1528. ELSE pos.Set(pos.Get() + 1); onPositionChanged.Call(pos);
  1529. END;
  1530. END IncPos;
  1531. PROCEDURE PageUp*(sender, par : ANY);
  1532. BEGIN
  1533. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.PageUp, sender, par);
  1534. ELSE pos.Set(pos.Get() - pageSize.Get()); onPositionChanged.Call(pos);
  1535. END;
  1536. END PageUp;
  1537. PROCEDURE PageDown*(sender, par : ANY);
  1538. BEGIN
  1539. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.PageDown, sender, par);
  1540. ELSE pos.Set(pos.Get() + pageSize.Get()); onPositionChanged.Call(pos);
  1541. END;
  1542. END PageDown;
  1543. PROCEDURE UpdateLayout;
  1544. VAR h, w, ps, tmin, tmax : LONGINT; f : REAL; width, height : LONGINT;
  1545. BEGIN
  1546. width := bounds.GetWidth(); height := bounds.GetHeight();
  1547. tmin := min.Get(); tmax := max.Get();
  1548. ps := MIN(tmax - tmin, pageSize.Get());
  1549. IF vertical.Get() THEN
  1550. IF tmax > tmin THEN
  1551. h := (height - 2 * width);
  1552. f := ps / (tmax - tmin);
  1553. ts := MIN(h, MAX(ENTIER(f * h), SELF.minTrackerSize.Get()));
  1554. tp := (pos.Get() - tmin) * (h - ts) DIV (tmax - tmin);
  1555. ELSE
  1556. ts := (height - 2 * width); tp := 0;
  1557. END;
  1558. areas[MinusButton].rect := WMRectangles.MakeRect(0, 0, width, width);
  1559. areas[MinusPage].rect := WMRectangles.MakeRect(0, width, width, width + tp);
  1560. areas[Tracker].rect := WMRectangles.MakeRect(0, width + tp, width, width + tp + ts);
  1561. areas[PlusPage].rect := WMRectangles.MakeRect(0, width + tp + ts, width, width + h);
  1562. areas[PlusButton].rect := WMRectangles.MakeRect(0, height - width, width, height);
  1563. ELSE
  1564. IF tmax > tmin THEN
  1565. w := (width - 2 * height);
  1566. f := ps / (tmax - tmin);
  1567. ts := MIN(w, MAX(ENTIER(f * w), SELF.minTrackerSize.Get()));
  1568. tp := (pos.Get() - tmin) * (w - ts) DIV (tmax - tmin);
  1569. ELSE
  1570. ts := (width - 2 * height); tp := 0;
  1571. END;
  1572. areas[MinusButton].rect := WMRectangles.MakeRect(0, 0, height, height);
  1573. areas[MinusPage].rect := WMRectangles.MakeRect(height, 0, height + tp, height);
  1574. areas[Tracker].rect := WMRectangles.MakeRect(height + tp, 0, height + tp + ts, height);
  1575. areas[PlusPage].rect := WMRectangles.MakeRect(height + tp + ts, 0, width - height, height);
  1576. areas[PlusButton].rect := WMRectangles.MakeRect(width - height, 0, width, height);
  1577. END;
  1578. END UpdateLayout;
  1579. PROCEDURE GetButtonColor(area : SHORTINT) : WMGraphics.Color;
  1580. VAR color : WMGraphics.Color;
  1581. BEGIN
  1582. IF (area = pressed) THEN color := clBtnPressed.Get();
  1583. ELSIF (area = hover) THEN color := clBtnHover.Get();
  1584. ELSE color := clBtnDefault.Get();
  1585. END;
  1586. RETURN color;
  1587. END GetButtonColor;
  1588. PROCEDURE GetPageColor(area : SHORTINT) : WMGraphics.Color;
  1589. VAR color : WMGraphics.Color;
  1590. BEGIN
  1591. IF (area = pressed) THEN color := clPressed.Get();
  1592. ELSIF (area = hover) THEN color := clHover.Get();
  1593. ELSE color := clDefault.Get();
  1594. END;
  1595. RETURN color;
  1596. END GetPageColor;
  1597. PROCEDURE GetMinusButtonImage(vertical : BOOLEAN; area : SHORTINT; VAR image : WMGraphics.Image);
  1598. BEGIN
  1599. IF vertical THEN
  1600. IF (area = pressed) THEN image := arrowUpPressed;
  1601. ELSIF (area = hover) THEN image := arrowUpHover;
  1602. ELSE image := arrowUpDefault;
  1603. END;
  1604. ELSE
  1605. IF (area = pressed) THEN image := arrowLeftPressed;
  1606. ELSIF (area = hover) THEN image := arrowLeftHover;
  1607. ELSE image := arrowLeftDefault;
  1608. END;
  1609. END;
  1610. END GetMinusButtonImage;
  1611. PROCEDURE GetPlusButtonImage(vertical : BOOLEAN; area : SHORTINT; VAR image : WMGraphics.Image);
  1612. BEGIN
  1613. IF vertical THEN
  1614. IF (area = pressed) THEN image := arrowDownPressed;
  1615. ELSIF (area = hover) THEN image := arrowDownHover;
  1616. ELSE image := arrowDownDefault;
  1617. END;
  1618. ELSE
  1619. IF (area = pressed) THEN image := arrowRightPressed;
  1620. ELSIF (area = hover) THEN image := arrowRightHover;
  1621. ELSE image := arrowRightDefault;
  1622. END;
  1623. END;
  1624. END GetPlusButtonImage;
  1625. PROCEDURE GetTrackerImages( vertical : BOOLEAN; area : SHORTINT; VAR a, b, c : WMGraphics.Image);
  1626. BEGIN
  1627. IF vertical THEN
  1628. IF (area = pressed) THEN a := vTrackerPressedTop; b := vTrackerPressedMiddle; c := vTrackerPressedBottom;
  1629. ELSIF (area = hover) THEN a := vTrackerHoverTop; b := vTrackerHoverMiddle; c := vTrackerHoverBottom;
  1630. ELSE a := vTrackerDefaultTop; b := vTrackerDefaultMiddle; c := vTrackerDefaultBottom;
  1631. END;
  1632. ELSE
  1633. IF (area = pressed) THEN a := hTrackerPressedLeft; b := hTrackerPressedMiddle; c := hTrackerPressedRight;
  1634. ELSIF (area = hover) THEN a := hTrackerHoverLeft; b := hTrackerHoverMiddle; c := hTrackerHoverRight;
  1635. ELSE a := hTrackerDefaultLeft; b := hTrackerDefaultMiddle; c := hTrackerDefaultRight;
  1636. END;
  1637. END;
  1638. END GetTrackerImages;
  1639. PROCEDURE GetBgImage(vertical : BOOLEAN; area : SHORTINT; VAR image : WMGraphics.Image);
  1640. BEGIN
  1641. IF vertical THEN
  1642. IF (area = pressed) THEN image := vBgPressed;
  1643. ELSIF (area = hover) THEN image := vBgHover;
  1644. ELSE image := vBgDefault;
  1645. END;
  1646. ELSE
  1647. IF (area = pressed) THEN image := hBgPressed;
  1648. ELSIF (area = hover) THEN image := hBgHover;
  1649. ELSE image := hBgDefault;
  1650. END;
  1651. END;
  1652. END GetBgImage;
  1653. PROCEDURE DrawHorizontalBackground(canvas : WMGraphics.Canvas; rect : WMRectangles.Rectangle; image, imgLeft, imgMiddle, imgRight : WMGraphics.Image);
  1654. VAR wLeft, wRight : LONGINT;
  1655. BEGIN
  1656. IF image # NIL THEN
  1657. canvas.ScaleImage(image,
  1658. WMRectangles.MakeRect(0, 0, image.width, image.height), rect,
  1659. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1660. ELSE
  1661. IF imgLeft # NIL THEN
  1662. wLeft := imgLeft.width;
  1663. canvas.ScaleImage( imgLeft,
  1664. WMRectangles.MakeRect(0, 0, imgLeft.width, imgLeft.height),
  1665. WMRectangles.MakeRect(rect.l, rect.t, rect.l + imgLeft.width, rect.b),
  1666. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1667. ELSE
  1668. wLeft := 0;
  1669. END;
  1670. IF imgRight # NIL THEN
  1671. wRight := imgRight.width;
  1672. canvas.ScaleImage( imgRight,
  1673. WMRectangles.MakeRect(0, 0, imgRight.width, imgRight.height),
  1674. WMRectangles.MakeRect(rect.r - wRight, rect.t, rect.r, rect.b),
  1675. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1676. ELSE
  1677. wRight := 0;
  1678. END;
  1679. IF imgMiddle # NIL THEN
  1680. IF SELF.repeatMiddleBitmap.Get() THEN
  1681. WMGraphicUtilities.RepeatImageHorizontal(canvas, rect.l + wLeft , rect.t, (rect.r - rect.l) - wLeft - wRight, rect.b, imgMiddle);
  1682. ELSE
  1683. canvas.ScaleImage(imgMiddle,
  1684. WMRectangles.MakeRect(0, 0, imgMiddle.width, imgMiddle.height),
  1685. WMRectangles.MakeRect(rect.l + wLeft, rect.t, rect.r - wRight, rect.b), WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1686. END;
  1687. END;
  1688. END;
  1689. END DrawHorizontalBackground;
  1690. PROCEDURE DrawVerticalBackground(canvas : WMGraphics.Canvas; rect : WMRectangles.Rectangle; image, imgTop, imgMiddle, imgBottom : WMGraphics.Image);
  1691. VAR hTop, hBottom : LONGINT;
  1692. BEGIN
  1693. IF image # NIL THEN
  1694. canvas.ScaleImage(image,
  1695. WMRectangles.MakeRect(0, 0, image.width, image.height), rect,
  1696. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1697. ELSE
  1698. IF imgTop # NIL THEN
  1699. hTop := imgTop.height;
  1700. canvas.ScaleImage( imgTop,
  1701. WMRectangles.MakeRect(0, 0, imgTop.width, imgTop.height),
  1702. WMRectangles.MakeRect(rect.l, rect.t, rect.r, rect.t + imgTop.height),
  1703. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1704. ELSE
  1705. hTop := 0;
  1706. END;
  1707. IF imgBottom # NIL THEN
  1708. hBottom := imgBottom.height;
  1709. canvas.ScaleImage( imgBottom,
  1710. WMRectangles.MakeRect(0, 0, imgBottom.width, imgBottom.height),
  1711. WMRectangles.MakeRect(rect.l, rect.b - hBottom, rect.r, rect.b),
  1712. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1713. ELSE
  1714. hBottom := 0;
  1715. END;
  1716. IF imgMiddle # NIL THEN
  1717. IF SELF.repeatMiddleBitmap.Get() THEN (* repeat image *)
  1718. WMGraphicUtilities.RepeatImageVertical(canvas, rect.l, rect.t + hTop, rect.r, (rect.b - rect.t) - hTop - hBottom, imgMiddle);
  1719. ELSE (* scale image *)
  1720. canvas.ScaleImage( imgMiddle,
  1721. WMRectangles.MakeRect(0, 0, imgMiddle.width, imgMiddle.height),
  1722. WMRectangles.MakeRect(rect.l, rect.t + hTop, rect.r, rect.b-hBottom), WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1723. END;
  1724. END;
  1725. END;
  1726. END DrawVerticalBackground;
  1727. PROCEDURE DrawSimpleRepresentation(canvas : WMGraphics.Canvas; area : LONGINT; rect : WMRectangles.Rectangle; color: WMGraphics.Color; effect3D : LONGINT);
  1728. BEGIN
  1729. IF (color # 0) THEN canvas.Fill(rect, color, WMGraphics.ModeSrcOverDst) END;
  1730. IF (effect3D > 0) THEN WMGraphicUtilities.RectGlassShade(canvas, rect, effect3D, area = pressed) END
  1731. END DrawSimpleRepresentation;
  1732. PROCEDURE DrawImage(canvas : WMGraphics.Canvas; rect : WMRectangles.Rectangle; image : WMGraphics.Image; repeat, vertical : BOOLEAN);
  1733. BEGIN
  1734. IF (image # NIL) THEN
  1735. IF repeat THEN
  1736. IF vertical THEN
  1737. WMGraphicUtilities.RepeatImageVertical(canvas, rect.l, rect.t, rect.r, rect.b, image);
  1738. ELSE
  1739. WMGraphicUtilities.RepeatImageHorizontal(canvas, rect.l, rect.t, rect.r, rect.b, image);
  1740. END;
  1741. ELSE
  1742. canvas.ScaleImage(image,
  1743. WMRectangles.MakeRect(0, 0, image.width, image.height), rect,
  1744. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  1745. END;
  1746. END;
  1747. END DrawImage;
  1748. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  1749. VAR image, a, b, c : WMGraphics.Image; vertical : BOOLEAN;
  1750. BEGIN
  1751. IF ~visible.Get() THEN RETURN END;
  1752. Acquire;
  1753. vertical := SELF.vertical.Get();
  1754. IF useBgBitmaps.Get() THEN
  1755. GetBgImage(vertical, MinusPage, image);
  1756. DrawImage(canvas, areas[MinusPage].rect, image, repeatBgBitmap.Get(), vertical);
  1757. GetBgImage(vertical, PlusPage, image);
  1758. DrawImage(canvas, areas[PlusPage].rect, image, repeatBgBitmap.Get(), vertical);
  1759. ELSE
  1760. DrawSimpleRepresentation(canvas, MinusPage, areas[MinusPage].rect, GetPageColor(MinusPage), 0);
  1761. DrawSimpleRepresentation(canvas, PlusPage, areas[PlusPage].rect, GetPageColor(PlusPage), 0);
  1762. END;
  1763. IF useArrowImages.Get() THEN
  1764. GetMinusButtonImage(vertical, MinusButton, image);
  1765. DrawImage(canvas, areas[MinusButton].rect, image, FALSE, vertical);
  1766. GetPlusButtonImage(vertical, PlusButton, image);
  1767. DrawImage(canvas, areas[PlusButton].rect, image, FALSE, vertical);
  1768. ELSE
  1769. DrawSimpleRepresentation(canvas, MinusButton, areas[MinusButton].rect, GetButtonColor(MinusButton), effect3D.Get());
  1770. DrawSimpleRepresentation(canvas, PlusButton, areas[PlusButton].rect, GetButtonColor(PlusButton), effect3D.Get());
  1771. END;
  1772. IF useTrackerImages.Get() THEN
  1773. GetTrackerImages(vertical, Tracker, a, b, c);
  1774. IF vertical THEN
  1775. DrawVerticalBackground(canvas, areas[Tracker].rect, NIL, a, b, c);
  1776. ELSE
  1777. DrawHorizontalBackground(canvas, areas[Tracker].rect, NIL, a, b, c);
  1778. END;
  1779. ELSE
  1780. DrawSimpleRepresentation(canvas, Tracker, areas[Tracker].rect, GetButtonColor(Tracker), effect3D.Get());
  1781. END;
  1782. Release
  1783. END DrawBackground;
  1784. END Scrollbar;
  1785. TYPE
  1786. Slider* = OBJECT (WMComponents.VisualComponent)
  1787. VAR
  1788. min-, max-, pos-, pageSize-, trackerSize- : WMProperties.Int32Property;
  1789. vertical- : WMProperties.BooleanProperty;
  1790. clDefault-, clHover-, clPressed-, clBar : WMProperties.ColorProperty;
  1791. (* background *)
  1792. useBgBitmaps-, repeatBgBitmap- : WMProperties.BooleanProperty;
  1793. hBgDefaultName-, hBgHoverName-, hBgPressedName-,
  1794. vBgDefaultName-, vBgHoverName-, vBgPressedName- : WMProperties.StringProperty;
  1795. useTrackerImages- : WMProperties.BooleanProperty;
  1796. hTrackerDefaultName-, hTrackerHoverName-, hTrackerPressedName-,
  1797. vTrackerDefaultName-, vTrackerHoverName-, vTrackerPressedName- : WMProperties.StringProperty;
  1798. onPositionChanged- : WMEvents.EventSource;
  1799. minusPage, plusPage, tracker : Button;
  1800. ts, tp, lx, ly : LONGINT;
  1801. PROCEDURE &Init*;
  1802. BEGIN
  1803. Init^;
  1804. SetGenerator("WMStandardComponents.GenSlider");
  1805. SetNameAsString(NewString("Slider"));
  1806. NEW(min, PrototypeSmin, NIL, NIL); properties.Add(min);
  1807. NEW(max, PrototypeSmax, NIL, NIL); properties.Add(max);
  1808. NEW(pos, PrototypeSpos, NIL, NIL); properties.Add(pos);
  1809. NEW(pageSize, PrototypeSpageSize, NIL, NIL); properties.Add(pageSize);
  1810. NEW(trackerSize, PrototypeTrackerSize, NIL, NIL); properties.Add(trackerSize);
  1811. trackerSize.Set(10);
  1812. NEW(vertical, PrototypeSvertical, NIL, NIL); properties.Add(vertical);
  1813. pos.SetBounds(min.Get(), max.Get());
  1814. (* --- tracker --- *)
  1815. (* simple representation *)
  1816. NEW(clDefault, PrototypeSlClDefault, NIL, NIL); properties.Add(clDefault);
  1817. NEW(clHover, PrototypeSlClHover, NIL, NIL); properties.Add(clHover);
  1818. NEW(clPressed, PrototypeSlClPressed, NIL, NIL); properties.Add(clPressed);
  1819. NEW(clBar, PrototypeSlClBar, NIL, NIL); properties.Add(clBar);
  1820. NEW(useTrackerImages, PrototypeSlUseTrackerImages, NIL, NIL); properties.Add(useTrackerImages);
  1821. NEW(tracker); tracker.takesFocus.Set(FALSE);
  1822. tracker.alignment.Set(WMComponents.AlignClient);
  1823. NEW(hTrackerDefaultName, PrototypeSlhTrackerDefault, NIL, NIL); properties.Add(hTrackerDefaultName);
  1824. NEW(hTrackerHoverName, PrototypeSlhTrackerHover, NIL, NIL); properties.Add(hTrackerHoverName);
  1825. NEW(hTrackerPressedName, PrototypeSlhTrackerPressed, NIL, NIL); properties.Add(hTrackerPressedName);
  1826. NEW(vTrackerDefaultName, PrototypeSlvTrackerDefault, NIL, NIL); properties.Add(vTrackerDefaultName);
  1827. NEW(vTrackerHoverName, PrototypeSlvTrackerHover, NIL, NIL); properties.Add(vTrackerHoverName);
  1828. NEW(vTrackerPressedName, PrototypeSlvTrackerPressed, NIL, NIL); properties.Add(vTrackerPressedName);
  1829. (* --- background of scrollbar --- *)
  1830. NEW(useBgBitmaps, PrototypeSlUseBgBitmaps, NIL, NIL); properties.Add(useBgBitmaps);
  1831. NEW(repeatBgBitmap, PrototypeSlRepeatBgBitmap, NIL, NIL); properties.Add(repeatBgBitmap);
  1832. (* bitmap representation *)
  1833. NEW(hBgDefaultName, PrototypeSlhBgDefault, NIL, NIL); properties.Add(hBgDefaultName);
  1834. NEW(hBgHoverName, PrototypelShBgHover, NIL, NIL); properties.Add(hBgHoverName);
  1835. NEW(hBgPressedName, PrototypeSlhBgPressed, NIL, NIL); properties.Add(hBgPressedName);
  1836. NEW(vBgDefaultName, PrototypeSlvBgDefault, NIL, NIL); properties.Add(vBgDefaultName);
  1837. NEW(vBgHoverName, PrototypeSlvBgHover, NIL, NIL); properties.Add(vBgHoverName);
  1838. NEW(vBgPressedName, PrototypeSlvBgPressed, NIL, NIL); properties.Add(vBgPressedName);
  1839. NEW(onPositionChanged, SELF, NIL, NIL, SELF.StringToCompCommand);
  1840. events.Add(onPositionChanged);
  1841. (* minus page *)
  1842. NEW(minusPage); minusPage.takesFocus.Set(FALSE); minusPage.onClick.Add(PageUp); minusPage.isRepeating.Set(TRUE);
  1843. (* simple representation *)
  1844. minusPage.effect3D.Set(0);
  1845. (* plus page *)
  1846. NEW(plusPage); plusPage.takesFocus.Set(FALSE); plusPage.onClick.Add(PageDown); plusPage.isRepeating.Set(TRUE);
  1847. (* simple representation *)
  1848. plusPage.effect3D.Set(0);
  1849. SetDirection;
  1850. AddInternalComponent(minusPage);
  1851. AddInternalComponent(plusPage);
  1852. AddInternalComponent(tracker);
  1853. tracker.SetExtPointerUpHandler(TrackerPointerUp);
  1854. tracker.SetExtPointerDownHandler(TrackerPointerDown);
  1855. tracker.SetExtPointerMoveHandler(TrackerPointerMove);
  1856. takesFocus.Set(FALSE)
  1857. END Init;
  1858. PROCEDURE LinkChanged*(sender, link: ANY);
  1859. VAR m: Models.Model; integer: LONGINT;
  1860. BEGIN
  1861. IF sender = model THEN
  1862. IF WMProperties.GetModel(model,m) THEN
  1863. IF Models.GetInteger(m, integer) THEN
  1864. pos.Set(integer);
  1865. END;
  1866. END;
  1867. ELSE
  1868. LinkChanged^(sender, link)
  1869. END;
  1870. END LinkChanged;
  1871. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  1872. CONST BarWidth = 8;
  1873. VAR rect : WMRectangles.Rectangle; width, height : LONGINT;
  1874. BEGIN
  1875. DrawBackground^(canvas);
  1876. IF ~useBgBitmaps.Get() & (clBar.Get() # 0) THEN
  1877. width := bounds.GetWidth();
  1878. height := bounds.GetHeight();
  1879. IF vertical.Get() THEN
  1880. IF (width > BarWidth) THEN
  1881. rect := WMRectangles.MakeRect((width - BarWidth) DIV 2, 0, width - ((width - BarWidth) DIV 2), height);
  1882. ELSE
  1883. rect := WMRectangles.MakeRect(0, 0, width, height);
  1884. END;
  1885. ELSE
  1886. IF (height > BarWidth) THEN
  1887. rect := WMRectangles.MakeRect(0, (height - BarWidth) DIV 2, width, height - ((height - BarWidth) DIV 2));
  1888. ELSE
  1889. rect := WMRectangles.MakeRect(0, 0, width, height);
  1890. END;
  1891. END;
  1892. rect := WMRectangles.ResizeRect(rect, -1);
  1893. canvas.Fill(rect, clBar.Get(), WMGraphics.ModeSrcOverDst);
  1894. WMGraphicUtilities.RectGlassShade(canvas, rect, 1, TRUE);
  1895. END;
  1896. END DrawBackground;
  1897. PROCEDURE TrackerPointerDown(x, y : LONGINT; keys : SET; VAR handled : BOOLEAN);
  1898. BEGIN
  1899. lx := x; ly := y; handled := FALSE
  1900. END TrackerPointerDown;
  1901. PROCEDURE TrackerPointerUp(x, y : LONGINT; keys : SET; VAR handled : BOOLEAN);
  1902. BEGIN
  1903. ChangeModel
  1904. END TrackerPointerUp;
  1905. PROCEDURE ChangeModel;
  1906. VAR m: Models.Model; real: Types.Integer; res : WORD;
  1907. BEGIN
  1908. IF WMProperties.GetModel(model,m) THEN
  1909. real.value := pos.Get();
  1910. m.SetGeneric(real,res)
  1911. END;
  1912. END ChangeModel;
  1913. PROCEDURE TrackerPointerMove(x, y : LONGINT; keys : SET; VAR handled : BOOLEAN);
  1914. VAR dx, dy, dp, d : LONGINT; f : REAL; tmax, tmin : LONGINT;
  1915. BEGIN
  1916. tmax := max.Get();
  1917. tmin := min.Get();
  1918. IF 0 IN keys THEN
  1919. dy := y - ly;
  1920. IF vertical.Get() THEN
  1921. d := bounds.GetHeight();
  1922. IF d > 0 THEN
  1923. f := tmax; f := (f - tmin); f := f * dy / d; dp := ENTIER(f);
  1924. ELSE dp := 0
  1925. END;
  1926. ELSE
  1927. dx := x - lx;
  1928. d := bounds.GetWidth();
  1929. IF d > 0 THEN
  1930. f := tmax; f := (f - tmin); f := f * dx / d; dp := ENTIER(f);
  1931. ELSE dp := 0
  1932. END;
  1933. END;
  1934. IF dp # 0 THEN pos.Set(pos.Get() + dp); onPositionChanged.Call(pos) END;
  1935. END;
  1936. handled := FALSE
  1937. END TrackerPointerMove;
  1938. PROCEDURE RecacheProperties*;
  1939. BEGIN
  1940. RecacheProperties^;
  1941. tracker.useBgBitmaps.Set(useTrackerImages.Get());
  1942. minusPage.useBgBitmaps.Set(useBgBitmaps.Get());
  1943. minusPage.clDefault.Set(clDefault.Get());
  1944. minusPage.clHover.Set(clHover.Get());
  1945. minusPage.clPressed.Set(clPressed.Get());
  1946. minusPage.repeatMiddleImg.Set(repeatBgBitmap.Get());
  1947. plusPage.useBgBitmaps.Set(useBgBitmaps.Get());
  1948. plusPage.clDefault.Set(clDefault.Get());
  1949. plusPage.clHover.Set(clHover.Get());
  1950. plusPage.clPressed.Set(clPressed.Get());
  1951. plusPage.repeatMiddleImg.Set(repeatBgBitmap.Get());
  1952. pos.SetBounds(min.Get(), max.Get());
  1953. SetDirection;
  1954. AlignSubComponents;
  1955. END RecacheProperties;
  1956. PROCEDURE PropertyChanged*(sender, property : ANY);
  1957. BEGIN
  1958. IF (property = pos) THEN
  1959. AlignSubComponents; Invalidate;
  1960. ELSIF (property = vertical) THEN
  1961. SetDirection
  1962. ELSIF (property = min) OR (property = max) OR (property = pageSize) THEN
  1963. AlignSubComponents;
  1964. pos.SetBounds(min.Get(), max.Get());
  1965. Invalidate
  1966. ELSIF (property = useTrackerImages) OR (property = useBgBitmaps) OR
  1967. (property = clDefault) OR (property = clHover) OR (property = clPressed) THEN
  1968. RecacheProperties;
  1969. Invalidate;
  1970. ELSE PropertyChanged^(sender, property)
  1971. END;
  1972. END PropertyChanged;
  1973. PROCEDURE DecPos*(sender, par : ANY);
  1974. BEGIN
  1975. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.DecPos, sender, par)
  1976. ELSE pos.Set(pos.Get() - 1); onPositionChanged.Call(pos)
  1977. END
  1978. END DecPos;
  1979. PROCEDURE IncPos*(sender, par : ANY);
  1980. BEGIN
  1981. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.IncPos, sender, par)
  1982. ELSE pos.Set(pos.Get() + 1); onPositionChanged.Call(pos)
  1983. END
  1984. END IncPos;
  1985. PROCEDURE PageUp*(sender, par : ANY);
  1986. BEGIN
  1987. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.PageUp, sender, par)
  1988. ELSE pos.Set(pos.Get() - pageSize.Get()); onPositionChanged.Call(pos)
  1989. END
  1990. END PageUp;
  1991. PROCEDURE PageDown*(sender, par : ANY);
  1992. BEGIN
  1993. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.PageDown, sender, par)
  1994. ELSE pos.Set(pos.Get() + pageSize.Get()); onPositionChanged.Call(pos)
  1995. END
  1996. END PageDown;
  1997. PROCEDURE AlignSubComponents*;
  1998. VAR h, w, ps, tmin, tmax : LONGINT;
  1999. BEGIN
  2000. Acquire; DisableUpdate;
  2001. (* break a possible endless realignment *)
  2002. IF aligning THEN EnableUpdate; Release; RETURN END;
  2003. aligning := TRUE;
  2004. tmin := min.Get(); tmax := max.Get();
  2005. ps := MIN(tmax - tmin, pageSize.Get());
  2006. IF vertical.Get() THEN
  2007. IF tmax > tmin THEN
  2008. h := bounds.GetHeight();
  2009. ts := trackerSize.Get();
  2010. tp := (pos.Get() - tmin) * (h - ts) DIV (tmax - tmin);
  2011. ELSE ts := 0; tp := 0;
  2012. END;
  2013. minusPage.bounds.SetHeight(tp);
  2014. plusPage.bounds.SetHeight(h - tp - ts);
  2015. ELSE
  2016. IF tmax > tmin THEN
  2017. w := bounds.GetWidth();
  2018. ts := trackerSize.Get();
  2019. tp := (pos.Get() - tmin) * (w - ts) DIV (tmax - tmin);
  2020. ELSE ts := 0; tp := 0;
  2021. END;
  2022. minusPage.bounds.SetWidth(tp);
  2023. plusPage.bounds.SetWidth(w - tp - ts);
  2024. END;
  2025. aligning := FALSE; (* must set to false before super call *)
  2026. AlignSubComponents^;
  2027. EnableUpdate;
  2028. Release
  2029. END AlignSubComponents;
  2030. PROCEDURE SetDirection;
  2031. BEGIN
  2032. Acquire;
  2033. properties.AcquireWrite;
  2034. SetBackgroundDirection();
  2035. SetTrackerDirection();
  2036. properties.ReleaseWrite;
  2037. Release
  2038. END SetDirection;
  2039. (* set direction of tracker (thumb) *)
  2040. PROCEDURE SetTrackerDirection;
  2041. BEGIN
  2042. tracker.isHorizontal.Set(~SELF.vertical.Get());
  2043. IF vertical.Get() THEN
  2044. tracker.imgDefaultName.Set(vTrackerDefaultName.Get());
  2045. tracker.imgHoverName.Set(vTrackerHoverName.Get());
  2046. tracker.imgPressedName.Set(vTrackerPressedName.Get());
  2047. ELSE
  2048. tracker.imgDefaultName.Set(hTrackerDefaultName.Get());
  2049. tracker.imgHoverName.Set(hTrackerHoverName.Get());
  2050. tracker.imgPressedName.Set(hTrackerPressedName.Get());
  2051. END
  2052. END SetTrackerDirection;
  2053. (* set direction of background (minusPage, plusPage *)
  2054. PROCEDURE SetBackgroundDirection;
  2055. BEGIN
  2056. minusPage.isHorizontal.Set(~SELF.vertical.Get());
  2057. plusPage.isHorizontal.Set(~SELF.vertical.Get());
  2058. IF vertical.Get() THEN
  2059. minusPage.alignment.Set(WMComponents.AlignTop);
  2060. minusPage.imgDefaultNameMiddle.Set(vBgDefaultName.Get());
  2061. minusPage.imgHoverNameMiddle.Set(vBgHoverName.Get());
  2062. minusPage.imgPressedNameMiddle.Set(vBgPressedName.Get());
  2063. plusPage.alignment.Set(WMComponents.AlignBottom);
  2064. plusPage.imgDefaultNameMiddle.Set(vBgDefaultName.Get());
  2065. plusPage.imgHoverNameMiddle.Set(vBgHoverName.Get());
  2066. plusPage.imgPressedNameMiddle.Set(vBgPressedName.Get())
  2067. ELSE
  2068. minusPage.alignment.Set(WMComponents.AlignLeft);
  2069. minusPage.imgDefaultNameMiddle.Set(hBgDefaultName.Get());
  2070. minusPage.imgHoverNameMiddle.Set(hBgHoverName.Get());
  2071. minusPage.imgPressedNameMiddle.Set(hBgPressedName.Get());
  2072. plusPage.alignment.Set(WMComponents.AlignRight);
  2073. plusPage.imgDefaultNameMiddle.Set(hBgDefaultName.Get());
  2074. plusPage.imgHoverNameMiddle.Set(hBgHoverName.Get());
  2075. plusPage.imgPressedNameMiddle.Set(hBgPressedName.Get())
  2076. END
  2077. END SetBackgroundDirection;
  2078. END Slider;
  2079. TYPE
  2080. Resizer* = OBJECT(WMComponents.VisualComponent)
  2081. VAR
  2082. clDefault- : WMProperties.ColorProperty;
  2083. isFlat- : WMProperties.BooleanProperty;
  2084. dnx, dny : LONGINT;
  2085. PROCEDURE &Init*;
  2086. BEGIN
  2087. Init^;
  2088. SetGenerator("WMStandardComponents.GenResizer");
  2089. SetNameAsString(StrResizer);
  2090. NEW(clDefault, PrototypeRclDefault, NIL, NIL); properties.Add(clDefault);
  2091. NEW(isFlat, PrototypeRisFlat, NIL, NIL); properties.Add(isFlat);
  2092. bounds.SetPrototype(PrototypeRBounds)
  2093. END Init;
  2094. PROCEDURE RecacheProperties*;
  2095. VAR align: LONGINT;
  2096. BEGIN
  2097. RecacheProperties^;
  2098. align := alignment.Get();
  2099. IF (align = WMComponents.AlignRight) OR (align = WMComponents.AlignLeft) THEN
  2100. SetPointerInfo(manager.pointerLeftRight)
  2101. ELSIF (align = WMComponents.AlignBottom) OR (align = WMComponents.AlignTop) THEN
  2102. SetPointerInfo(manager.pointerUpDown)
  2103. END;
  2104. END RecacheProperties;
  2105. PROCEDURE PropertyChanged*(sender, data : ANY);
  2106. BEGIN
  2107. IF (data = properties) OR (data = alignment) THEN RecacheProperties; (*? PH added *) Invalidate;
  2108. ELSIF (data = clDefault) OR (data = isFlat) THEN Invalidate;
  2109. ELSE PropertyChanged^(sender, data)
  2110. END;
  2111. END PropertyChanged;
  2112. PROCEDURE PointerDown*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  2113. BEGIN
  2114. dnx := x; dny := y
  2115. END PointerDown;
  2116. PROCEDURE PointerMove*(x, y: LONGINT; keys: SET); (** PROTECTED *)
  2117. VAR dx, dy, align, myWidth, myHeight, newL, newR, newT, newB: LONGINT;
  2118. p, pp : WMComponents.VisualComponent;
  2119. parent : XML.Element;
  2120. pRect, ppRect: WMRectangles.Rectangle;
  2121. BEGIN
  2122. RecacheProperties;
  2123. IF 0 IN keys THEN
  2124. dx := x - dnx; dy := y - dny;
  2125. parent := GetParent();
  2126. IF (parent # NIL) & (parent IS WMComponents.VisualComponent) THEN
  2127. p := parent(WMComponents.VisualComponent);
  2128. parent := p.GetParent();
  2129. IF (parent # NIL) & (parent IS WMComponents.VisualComponent) THEN
  2130. pp := parent(WMComponents.VisualComponent);
  2131. align := alignment.Get();
  2132. pRect := p.bounds.Get();
  2133. ppRect := pp.bounds.Get();
  2134. myWidth := bounds.GetWidth();
  2135. myHeight := bounds.GetHeight();
  2136. IF align = WMComponents.AlignRight THEN
  2137. newR := pRect.r + dx;
  2138. IF newR > ppRect.r - myWidth THEN
  2139. newR := ppRect.r - myWidth;
  2140. ELSIF newR < pRect.l + myWidth + 1 THEN
  2141. newR := pRect.l + myWidth + 1;
  2142. END;
  2143. pRect.r := newR;
  2144. ELSIF align = WMComponents.AlignLeft THEN
  2145. newL := pRect.l + dx;
  2146. IF newL < ppRect.l + myWidth THEN
  2147. newL := ppRect.l + myWidth;
  2148. ELSIF newL > pRect.r - myWidth THEN
  2149. newL := pRect.r - myWidth;
  2150. END;
  2151. pRect.l := newL;
  2152. ELSIF align = WMComponents.AlignBottom THEN
  2153. newB := pRect.b + dy;
  2154. IF newB > ppRect.b - myHeight THEN
  2155. newB := ppRect.b - myHeight
  2156. ELSIF newB < pRect.t + myHeight THEN
  2157. newB := pRect.t + myHeight
  2158. END;
  2159. pRect.b := newB;
  2160. ELSIF align = WMComponents.AlignTop THEN
  2161. newT := pRect.t + dy;
  2162. IF newT > pRect.b - myHeight THEN
  2163. newT := pRect.b - myHeight
  2164. ELSIF newT < ppRect.t + myHeight THEN
  2165. newT := ppRect.t + myHeight
  2166. END;
  2167. pRect.t := newT;
  2168. END;
  2169. p.bounds.Set(pRect);
  2170. END
  2171. END
  2172. END
  2173. END PointerMove;
  2174. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  2175. BEGIN
  2176. DrawBackground^(canvas);
  2177. canvas.Fill(GetClientRect(), SELF.clDefault.Get(), WMGraphics.ModeSrcOverDst);
  2178. IF ~SELF.isFlat.Get() THEN WMGraphicUtilities.RectGlassShade(canvas, GetClientRect(), 2, FALSE) END
  2179. END DrawBackground;
  2180. END Resizer;
  2181. (* Group Panel *)
  2182. GroupPanel* = OBJECT(Panel)
  2183. VAR
  2184. caption-: WMProperties.StringProperty;
  2185. textColor- : WMProperties.ColorProperty;
  2186. border : WMRectangles.Rectangle;
  2187. captionFont : WMGraphics.Font;
  2188. PROCEDURE &Init*;
  2189. BEGIN
  2190. Init^;
  2191. SetGenerator("WMStandardComponents.GenGroupPanel");
  2192. SetNameAsString(StrGroupPanel);
  2193. NEW(caption, ProtGPCaption, NIL, NIL); properties.Add(caption);
  2194. NEW(textColor, ProtGPTextColor, NIL, NIL); properties.Add(textColor);
  2195. border := WMRectangles.MakeRect(10,14,10,10);
  2196. captionFont := WMGraphics.GetFont("Oberon", 8, {});
  2197. END Init;
  2198. PROCEDURE PropertyChanged*(sender, property : ANY);
  2199. BEGIN
  2200. IF (property = caption) OR (property = textColor) THEN Invalidate
  2201. ELSE PropertyChanged^(sender, property)
  2202. END;
  2203. END PropertyChanged;
  2204. PROCEDURE DrawBackground*(canvas: WMGraphics.Canvas);
  2205. VAR rect: WMRectangles.Rectangle;
  2206. highlight, shadow, w, h : LONGINT;
  2207. tempString : Strings.String;
  2208. BEGIN
  2209. DrawBackground^(canvas);
  2210. highlight := LONGINT(0FFFFFF80H);
  2211. shadow := 000000080H;
  2212. rect := GetClientRect();
  2213. tempString := caption.Get();
  2214. (* group line *)
  2215. IF (tempString = NIL) OR (tempString^ = "") THEN
  2216. canvas.Line(rect.l+3, rect.t+5, rect.r-4, rect.t+5, shadow, WMGraphics.ModeSrcOverDst);
  2217. canvas.Line(rect.l+4, rect.t+6, rect.r-5, rect.t+6, highlight, WMGraphics.ModeSrcOverDst);
  2218. ELSE
  2219. captionFont.GetStringSize(tempString^, w, h);
  2220. canvas.Line(rect.l+3, rect.t+5, rect.l+12, rect.t+5, shadow, WMGraphics.ModeSrcOverDst);
  2221. canvas.Line(rect.l+4, rect.t+6, rect.l+12, rect.t+6, highlight, WMGraphics.ModeSrcOverDst);
  2222. canvas.Line(rect.l+w+17, rect.t+5, rect.r-4, rect.t+5, shadow, WMGraphics.ModeSrcOverDst);
  2223. canvas.Line(rect.l+w+17, rect.t+6, rect.r-5, rect.t+6, highlight, WMGraphics.ModeSrcOverDst);
  2224. END;
  2225. canvas.Line(rect.l+3, rect.b-4, rect.r-4, rect.b-4, shadow, WMGraphics.ModeSrcOverDst);
  2226. canvas.Line(rect.l+3, rect.t+5, rect.l+3, rect.b-4, shadow, WMGraphics.ModeSrcOverDst);
  2227. canvas.Line(rect.r-4, rect.t+5, rect.r-4, rect.b-4, shadow, WMGraphics.ModeSrcOverDst);
  2228. canvas.Line(rect.l+3, rect.b-3, rect.r-3, rect.b-3, highlight, WMGraphics.ModeSrcOverDst);
  2229. canvas.Line(rect.l+4, rect.t+6, rect.l+4, rect.b-5, highlight, WMGraphics.ModeSrcOverDst);
  2230. canvas.Line(rect.r-3, rect.t+5, rect.r-3, rect.b-3, highlight, WMGraphics.ModeSrcOverDst);
  2231. (* caption *)
  2232. IF (tempString # NIL) & (tempString^ # "") THEN
  2233. canvas.SetColor(textColor.Get());
  2234. captionFont.RenderString(canvas, rect.l+15, rect.t+9, tempString^);
  2235. END;
  2236. END DrawBackground;
  2237. PROCEDURE AlignSubComponents*; (** override *)
  2238. VAR c : XML.Content; vc : WMComponents.VisualComponent;
  2239. r, b : WMRectangles.Rectangle;
  2240. BEGIN
  2241. Acquire;
  2242. IF aligning THEN Release; RETURN END;
  2243. aligning := TRUE;
  2244. r := GetClientRect();
  2245. r.l := r.l + border.l; r.t := r.t + border.t; r.r := r.r - border.r; r.b := r.b - border.b;
  2246. c := GetFirst();
  2247. WHILE (c # NIL) DO
  2248. IF c IS WMComponents.VisualComponent THEN
  2249. vc := c(WMComponents.VisualComponent);
  2250. IF vc.visible.Get() THEN
  2251. b := vc.bearing.Get();
  2252. CASE vc.alignment.Get() OF
  2253. | WMComponents.AlignTop : vc.bounds.Set(WMRectangles.MakeRect(r.l + b.l , r.t + b.t, r.r - b.r, r.t + b.t + vc.bounds.GetHeight())); INC(r.t, vc.bounds.GetHeight() + b.t + b.b)
  2254. | WMComponents.AlignLeft : vc.bounds.Set(WMRectangles.MakeRect(r.l + b.l, r.t + b.t, r.l + b.l + vc.bounds.GetWidth(), r.b - b.b)); INC(r.l, vc.bounds.GetWidth() + b.l + b.r)
  2255. | WMComponents.AlignBottom : vc.bounds.Set(WMRectangles.MakeRect(r.l + b.l, r.b - vc.bounds.GetHeight() - b.b, r.r - b.r, r.b - b.b)); DEC(r.b, vc.bounds.GetHeight() + b.t + b.b)
  2256. |WMComponents.AlignRight : vc.bounds.Set(WMRectangles.MakeRect(r.r - vc.bounds.GetWidth() - b.r , r.t + b.t, r.r - b.r, r.b - b.b)); DEC(r.r, vc.bounds.GetWidth() + b.l + b.r);
  2257. | WMComponents.AlignClient : IF ~WMRectangles.RectEmpty(r) THEN vc.bounds.Set(WMRectangles.MakeRect(r.l + b.l , r.t + b.t, r.r - b.r, r.b - b.b)) END
  2258. ELSE (* nothing *)
  2259. END;
  2260. END;
  2261. END;
  2262. c := GetNext(c);
  2263. END;
  2264. aligning := FALSE;
  2265. Release;
  2266. END AlignSubComponents;
  2267. END GroupPanel;
  2268. CONST
  2269. (** checkbox states *)
  2270. Default* = -1;
  2271. Unchecked* = 0;
  2272. Checked* = 1;
  2273. (** checkbox caption position *)
  2274. Left* = 0;
  2275. Right* = 1;
  2276. TYPE
  2277. (** Checkbox component *)
  2278. Checkbox* = OBJECT(WMComponents.VisualComponent)
  2279. VAR
  2280. caption- , onClickHandler-: WMProperties.StringProperty;
  2281. hasThreeStates-, useImages-, scaleImages- : WMProperties.BooleanProperty;
  2282. state- : WMProperties.Int32Property; (* 0 = unchecked, 1 = checked, -1 = use default *)
  2283. clBack-, clCheck-, clDefault-, clInactive- : WMProperties.ColorProperty;
  2284. imgCheckedName-, imgUncheckedName-, imgDefaultName-, imgCheckedInactiveName-, imgUncheckedInactiveName-, imgDefaultInactiveName-: WMProperties.StringProperty;
  2285. imgChecked, imgUnchecked, imgDefault, imgCheckedInactive, imgUncheckedInactive, imgDefaultInactive: WMGraphics.Image;
  2286. mouseOver: BOOLEAN;
  2287. onClick- : EventSource;
  2288. handler : WMEvents.EventListener;
  2289. PROCEDURE &Init*;
  2290. BEGIN
  2291. Init^;
  2292. SetGenerator("WMStandardComponents.GenCheckbox");
  2293. NEW(caption, ProtCBCaption, NIL, NIL); properties.Add(caption);
  2294. NEW(hasThreeStates, ProtCBHasThreeStates, NIL, NIL); properties.Add(hasThreeStates);
  2295. NEW(state, ProtCBState, NIL, NIL); properties.Add(state);
  2296. NEW(onClickHandler, PrototypeCBonClickHandler, NIL, NIL); properties.Add(onClickHandler);
  2297. bounds.SetPrototype(ProtCBBounds); (* override the defaults *)
  2298. (* colors *)
  2299. NEW(clBack, ProtCBclBack, NIL, NIL); properties.Add(clBack);
  2300. NEW(clCheck, ProtCBclCheck, NIL, NIL); properties.Add(clCheck);
  2301. NEW(clDefault, ProtCBclDefault, NIL, NIL); properties.Add(clDefault);
  2302. NEW(clInactive, ProtCBclInactive, NIL, NIL); properties.Add(clInactive);
  2303. (* images *)
  2304. NEW(useImages, ProtCBUseImages, NIL, NIL); properties.Add(useImages);
  2305. NEW(scaleImages, ProtCBScaleImages, NIL, NIL); properties.Add(scaleImages);
  2306. NEW(imgCheckedName, ProtCBImgCheckedN, NIL, NIL); properties.Add(imgCheckedName);
  2307. NEW(imgUncheckedName, ProtCBImgUncheckedN, NIL, NIL); properties.Add(imgUncheckedName);
  2308. NEW(imgDefaultName, ProtCBImgDefaultN, NIL, NIL); properties.Add(imgDefaultName);
  2309. NEW(imgCheckedInactiveName, ProtCBImgCheckedInactiveN, NIL, NIL); properties.Add(imgCheckedInactiveName);
  2310. NEW(imgUncheckedInactiveName, ProtCBImgUncheckedInactiveN, NIL, NIL); properties.Add(imgUncheckedInactiveName);
  2311. NEW(imgDefaultInactiveName, ProtCBImgDefaultInactiveN, NIL, NIL); properties.Add(imgDefaultInactiveName);
  2312. (* events *)
  2313. NEW(onClick, SELF, GSonClick, GSonClickCheckboxInfo, SELF.StringToCompCommand); events.Add(onClick);
  2314. SetNameAsString(StrCheckbox);
  2315. END Init;
  2316. PROCEDURE CheckClickHandler;
  2317. VAR th : WMEvents.EventListener; s : String;
  2318. BEGIN
  2319. s := onClickHandler.Get();
  2320. IF s # NIL THEN
  2321. th := StringToCompCommand(s);
  2322. IF (handler # NIL) THEN onClick.Remove(handler) END;
  2323. IF th # NIL THEN onClick.Add(th); handler := th END
  2324. END
  2325. END CheckClickHandler;
  2326. PROCEDURE PropertyChanged*(sender, data : ANY);
  2327. BEGIN
  2328. IF (data = caption) THEN Invalidate
  2329. ELSIF (data = onClickHandler) THEN CheckClickHandler;
  2330. ELSIF (data = scaleImages) THEN Invalidate;
  2331. ELSIF (data = state) THEN Invalidate;
  2332. ELSIF (data = clBack) OR (data = clCheck) OR (data = clDefault) OR (data = clInactive) THEN Invalidate;
  2333. ELSIF (data = useImages)
  2334. OR (data = imgCheckedName) OR (data = imgUncheckedName) OR (data = imgDefaultName)
  2335. OR (data = imgCheckedInactiveName) OR (data = imgUncheckedInactiveName) OR (data = imgDefaultInactiveName) THEN
  2336. RecacheProperties; Invalidate
  2337. ELSE PropertyChanged^(sender, data)
  2338. END;
  2339. END PropertyChanged;
  2340. PROCEDURE RecacheProperties*;
  2341. VAR s : String;
  2342. BEGIN
  2343. RecacheProperties^;
  2344. IF useImages.Get() THEN
  2345. s := imgCheckedName.Get(); IF s # NIL THEN imgChecked := WMGraphics.LoadImage(s^, TRUE) END;
  2346. s := imgUncheckedName.Get(); IF s # NIL THEN imgUnchecked := WMGraphics.LoadImage(s^, TRUE) END;
  2347. s := imgDefaultName.Get(); IF s # NIL THEN imgDefault := WMGraphics.LoadImage(s^, TRUE) END;
  2348. s := imgCheckedInactiveName.Get(); IF s # NIL THEN imgCheckedInactive := WMGraphics.LoadImage(s^, TRUE) END;
  2349. s := imgUncheckedInactiveName.Get(); IF s # NIL THEN imgUncheckedInactive := WMGraphics.LoadImage(s^, TRUE) END;
  2350. s := imgDefaultInactiveName.Get(); IF s # NIL THEN imgDefaultInactive := WMGraphics.LoadImage(s^, TRUE) END;
  2351. ELSE
  2352. imgChecked := NIL; imgUnchecked := NIL;
  2353. imgDefault := NIL;
  2354. imgCheckedInactive := NIL; imgUncheckedInactive := NIL;
  2355. imgDefaultInactive := NIL;
  2356. END;
  2357. CheckClickHandler;
  2358. END RecacheProperties;
  2359. PROCEDURE FocusReceived*;
  2360. BEGIN
  2361. FocusReceived^;
  2362. Invalidate
  2363. END FocusReceived;
  2364. PROCEDURE FocusLost*;
  2365. BEGIN
  2366. FocusLost^;
  2367. Invalidate
  2368. END FocusLost;
  2369. PROCEDURE PointerDown*(x, y: LONGINT; keys: SET);
  2370. VAR value : LONGINT;
  2371. BEGIN
  2372. IF enabled.Get() THEN
  2373. value := state.Get();
  2374. IF value = -1 THEN state.Set(0);
  2375. ELSIF value = 0 THEN state.Set(1);
  2376. ELSIF (value = 1) THEN
  2377. IF hasThreeStates.Get() THEN
  2378. state.Set(-1);
  2379. ELSE
  2380. state.Set(0);
  2381. END;
  2382. END;
  2383. Click(SELF, NIL);
  2384. END;
  2385. Invalidate;
  2386. PointerDown^(x, y, keys)
  2387. END PointerDown;
  2388. PROCEDURE PointerMove*(x, y : LONGINT; keys : SET); (** PROTECTED *)
  2389. BEGIN
  2390. IF IsHit(x, y) THEN
  2391. IF ~mouseOver THEN mouseOver := TRUE; Invalidate END
  2392. ELSE
  2393. IF mouseOver THEN mouseOver := FALSE; Invalidate END
  2394. END;
  2395. PointerMove^(x, y, keys)
  2396. END PointerMove;
  2397. PROCEDURE PointerLeave*; (** PROTECTED *)
  2398. BEGIN
  2399. mouseOver := FALSE; Invalidate
  2400. END PointerLeave;
  2401. PROCEDURE Click*(sender, par : ANY); (** Eventhandler *)
  2402. BEGIN
  2403. (* synchronize if not synchronized *)
  2404. IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Click, sender, par)
  2405. ELSE
  2406. (* actual business logic *)
  2407. onClick.Call(par)
  2408. END
  2409. END Click;
  2410. PROCEDURE DrawBackground*(canvas: WMGraphics.Canvas);
  2411. VAR
  2412. rect: WMRectangles.Rectangle;
  2413. string : Strings.String;
  2414. font : WMGraphics.Font;
  2415. img : WMGraphics.Image;
  2416. BEGIN
  2417. IF ~visible.Get() THEN RETURN END;
  2418. Acquire;
  2419. rect := GetClientRect();
  2420. font := GetFont();
  2421. DrawBackground^(canvas);
  2422. (* checkbox *)
  2423. IF ~SELF.useImages.Get() THEN
  2424. IF enabled.Get() THEN
  2425. canvas.Fill(WMRectangles.MakeRect(0, 0, rect.r-rect.l, rect.b-rect.t), clBack.Get(), WMGraphics.ModeSrcOverDst);
  2426. ELSE
  2427. canvas.Fill(WMRectangles.MakeRect(0, 0, rect.r-rect.l, rect.b-rect.t), clInactive.Get(), WMGraphics.ModeSrcOverDst);
  2428. END;
  2429. WMGraphicUtilities.RectGlassShade(canvas, WMRectangles.MakeRect(0, 0, rect.r-rect.l, rect.b-rect.t), 2, TRUE);
  2430. IF state.Get() = 1 THEN
  2431. canvas.Line(0, 0, rect.r-rect.l-1, rect.b-rect.t-1, clCheck.Get(), WMGraphics.ModeSrcOverDst);
  2432. canvas.Line(0, rect.b-rect.t-1, rect.r-rect.l-1, 0, clCheck.Get(), WMGraphics.ModeSrcOverDst);
  2433. ELSIF state.Get() = -1 THEN
  2434. canvas.Line(0, 0, rect.r-rect.l-1, rect.b-rect.t-1, clDefault.Get(), WMGraphics.ModeSrcOverDst);
  2435. canvas.Line(0, rect.b-rect.t-1, rect.r-rect.l-1, 0, clDefault.Get(), WMGraphics.ModeSrcOverDst);
  2436. END;
  2437. ELSE (* the checkbox is decorated by images *)
  2438. IF enabled.Get() THEN
  2439. IF state.Get() = -1 THEN
  2440. img := imgDefault;
  2441. ELSIF state.Get() = 0 THEN
  2442. img := imgUnchecked;
  2443. ELSIF state.Get() = 1 THEN
  2444. img := imgChecked;
  2445. END;
  2446. ELSE
  2447. IF state.Get() = -1 THEN
  2448. img := imgDefaultInactive;
  2449. ELSIF state.Get() = 0 THEN
  2450. img := imgUncheckedInactive;
  2451. ELSIF state.Get() = 1 THEN
  2452. img := imgCheckedInactive;
  2453. END;
  2454. END;
  2455. IF img # NIL THEN
  2456. IF scaleImages.Get() THEN
  2457. canvas.ScaleImage( img,
  2458. WMRectangles.MakeRect(0, 0, img.width, img.height),
  2459. WMRectangles.MakeRect(0, 0, ENTIER(bounds.GetHeight()/img.height*img.width), bounds.GetHeight()),
  2460. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  2461. ELSE
  2462. canvas.DrawImage(0, ((rect.b-rect.t)-img.height) DIV 2, img, WMGraphics.ModeSrcOverDst);
  2463. END;
  2464. END;
  2465. END;
  2466. (* checkbox hover *)
  2467. IF mouseOver THEN
  2468. IF useImages.Get() THEN
  2469. IF scaleImages.Get() THEN
  2470. canvas.Fill(WMRectangles.MakeRect(0, 0, ENTIER(bounds.GetHeight()/img.height*img.width), bounds.GetHeight()), LONGINT(0FFFF0040H), WMGraphics.ModeSrcOverDst)
  2471. ELSE
  2472. canvas.Fill(WMRectangles.MakeRect(0, ((rect.b-rect.t)-img.height) DIV 2, img.width, img.height), LONGINT(0FFFF0040H), WMGraphics.ModeSrcOverDst)
  2473. END
  2474. ELSE
  2475. canvas.Fill(WMRectangles.MakeRect(0, 0, rect.r-rect.l, rect.b-rect.t), LONGINT(0FFFF0040H), WMGraphics.ModeSrcOverDst)
  2476. END
  2477. END;
  2478. (* caption *)
  2479. string := caption.Get();
  2480. canvas.DrawString(rect.r-rect.l+5, (((rect.b-rect.t)- font.GetHeight()) DIV 2) + font.ascent+1, string^);
  2481. Release
  2482. END DrawBackground;
  2483. END Checkbox;
  2484. TYPE
  2485. Image* = OBJECT(Panel)
  2486. VAR
  2487. imageName- : WMProperties.StringProperty;
  2488. image- : WMGraphics.Image;
  2489. scaleImage- : WMProperties.BooleanProperty;
  2490. scaleImageI : BOOLEAN;
  2491. PROCEDURE &Init*;
  2492. BEGIN
  2493. Init^;
  2494. SetGenerator("WMStandardComponents.GenImage");
  2495. SetNameAsString(StrImage);
  2496. NEW(imageName, PrototypeImageName, NIL, NIL); properties.Add(imageName);
  2497. image := NIL;
  2498. NEW(scaleImage, PrototypeScaleImage, NIL, NIL); properties.Add(scaleImage);
  2499. scaleImageI := scaleImage.Get();
  2500. END Init;
  2501. PROCEDURE PropertyChanged*(sender, property : ANY);
  2502. BEGIN
  2503. IF (property = imageName) THEN
  2504. RecacheProperties; (*? PH*) Invalidate;
  2505. ELSIF (property = scaleImage) THEN
  2506. scaleImageI := scaleImage.Get();
  2507. Invalidate;
  2508. ELSE
  2509. PropertyChanged^(sender, property)
  2510. END
  2511. END PropertyChanged;
  2512. PROCEDURE RecacheProperties*;
  2513. VAR s : String;
  2514. BEGIN
  2515. RecacheProperties^;
  2516. scaleImageI := scaleImage.Get();
  2517. s := imageName.Get();
  2518. IF (s # NIL) THEN
  2519. image := WMGraphics.LoadImage(s^, TRUE);
  2520. ELSE
  2521. image := NIL;
  2522. END;
  2523. END RecacheProperties;
  2524. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  2525. VAR width, height : LONGINT;
  2526. BEGIN
  2527. DrawBackground^(canvas);
  2528. IF (image # NIL) & show THEN
  2529. IF scaleImageI THEN
  2530. width := bounds.GetWidth();
  2531. height := bounds.GetHeight();
  2532. IF (image.width # width) OR (image.height # height) THEN
  2533. canvas.ScaleImage(image,
  2534. WMRectangles.MakeRect(0, 0, image.width, image.height),
  2535. WMRectangles.MakeRect(0, 0, width, height),
  2536. WMGraphics.ModeSrcOverDst, WMGraphics.ScaleBilinear);
  2537. ELSE
  2538. canvas.DrawImage(0, 0, image, WMGraphics.ModeSrcOverDst);
  2539. END;
  2540. ELSE
  2541. canvas.DrawImage(0, 0, image, WMGraphics.ModeSrcOverDst);
  2542. END;
  2543. END
  2544. END DrawBackground;
  2545. END Image;
  2546. TYPE
  2547. (** just shows an image, showing scrollbars if necessairy *)
  2548. ImagePanel* = OBJECT(Panel)
  2549. VAR
  2550. imgName- : WMProperties.StringProperty;
  2551. img- : WMGraphics.Image;
  2552. vScrollbar, hScrollbar : Scrollbar;
  2553. dx, dy : LONGINT;
  2554. PROCEDURE & Init*;
  2555. BEGIN
  2556. Init^;
  2557. SetGenerator("WMStandardComponents.GenImagePanel");
  2558. (* properties *)
  2559. NEW(imgName, ProtoIpImgName, NIL, NIL); properties.Add(imgName);
  2560. (* scrollbars *)
  2561. NEW(vScrollbar);
  2562. vScrollbar.alignment.Set(WMComponents.AlignRight); AddInternalComponent(vScrollbar);
  2563. vScrollbar.onPositionChanged.Add(ScrollbarsChanged); vScrollbar.visible.Set(FALSE);
  2564. NEW(hScrollbar);
  2565. hScrollbar.alignment.Set(WMComponents.AlignBottom); AddInternalComponent(hScrollbar);
  2566. hScrollbar.vertical.Set(FALSE); hScrollbar.onPositionChanged.Add(ScrollbarsChanged);
  2567. hScrollbar.visible.Set(FALSE);
  2568. SetNameAsString(StrImagePanel);
  2569. dx := 0; dy := 0
  2570. END Init;
  2571. PROCEDURE Resized*;
  2572. BEGIN
  2573. Resized^;
  2574. IF img=NIL THEN
  2575. RETURN;
  2576. END;
  2577. IF img.width > bounds.GetWidth() THEN
  2578. dx := img.width - bounds.GetWidth();
  2579. hScrollbar.visible.Set(TRUE)
  2580. ELSE
  2581. dx := 0;
  2582. hScrollbar.visible.Set(FALSE)
  2583. END;
  2584. IF img.height > bounds.GetHeight() THEN
  2585. dy := img.height - bounds.GetHeight();
  2586. vScrollbar.visible.Set(TRUE)
  2587. ELSE
  2588. dy := 0;
  2589. vScrollbar.visible.Set(FALSE)
  2590. END;
  2591. END Resized;
  2592. PROCEDURE GetOffsets*(VAR x,y: LONGINT); (*returns offset caused by scrollbars*)
  2593. BEGIN
  2594. x :=-( dx * hScrollbar.pos.Get() DIV 100);
  2595. y :=-(dy * vScrollbar.pos.Get() DIV 100);
  2596. END GetOffsets;
  2597. PROCEDURE PropertyChanged*(sender, property : ANY);
  2598. BEGIN
  2599. IF property = imgName THEN
  2600. RecacheProperties; Invalidate;(*? invalidate also called in RecacheProperties->SetImage()*)
  2601. ELSE
  2602. PropertyChanged^(sender, property)
  2603. END
  2604. END PropertyChanged;
  2605. PROCEDURE RecacheProperties*;
  2606. VAR s : String;
  2607. BEGIN
  2608. s := imgName.Get();
  2609. IF s # NIL THEN SetImage(SELF, WMGraphics.LoadImage(s^, TRUE)) END (*?implicit invalidate IFF changed*)
  2610. END RecacheProperties;
  2611. PROCEDURE ScrollbarsChanged(sender, data : ANY);
  2612. BEGIN
  2613. Invalidate
  2614. END ScrollbarsChanged;
  2615. (** Iff data IS WMGraphics.Image, it is set as background. Else the background is set to white. bounds may need to be adapted by caller. *)
  2616. (* Note: Only use for anonymous Images without a specific Name *)
  2617. PROCEDURE SetImage*(sender, data : ANY); (*? PH is Invalidate always handled in PropertyChanged here, or does this exporte procedure occur in other contexts ?*)
  2618. BEGIN
  2619. IF (data # NIL) & (data IS WMGraphics.Image) THEN
  2620. img := data(WMGraphics.Image);
  2621. IF bounds.GetWidth() * bounds.GetHeight() = 0 THEN bounds.SetExtents(img.width, img.height) END;
  2622. IF img.width > bounds.GetWidth() THEN
  2623. dx := img.width - bounds.GetWidth();
  2624. hScrollbar.visible.Set(TRUE)
  2625. ELSE
  2626. dx := 0;
  2627. hScrollbar.visible.Set(FALSE)
  2628. END;
  2629. IF img.height > bounds.GetHeight() THEN
  2630. dy := img.height - bounds.GetHeight();
  2631. vScrollbar.visible.Set(TRUE)
  2632. ELSE
  2633. dy := 0;
  2634. vScrollbar.visible.Set(FALSE)
  2635. END;
  2636. Invalidate
  2637. ELSE
  2638. img := NIL; Invalidate
  2639. END
  2640. END SetImage;
  2641. PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
  2642. VAR x, y : LONGINT;
  2643. BEGIN
  2644. IF show THEN
  2645. DrawBackground^(canvas);
  2646. IF img # NIL THEN
  2647. GetOffsets(x,y);
  2648. canvas.DrawImage(x, y, img, WMGraphics.ModeSrcOverDst)
  2649. END
  2650. END;
  2651. END DrawBackground;
  2652. END ImagePanel;
  2653. VAR
  2654. manager : WMWindowManager.WindowManager;
  2655. blinker-: Blinker;
  2656. (* global strings *)
  2657. GSonTimer, GSonTimerInfo, GSStart, GSStartTimerInfo, GSStop, GSStopTimerInfo : String;
  2658. GSRun, GSRunSystemCommandInfo, GSCallEventInfo : String;
  2659. GSonClick, GSonClickButtonInfo, GSonClickCheckboxInfo : String;
  2660. GSonPositionChanged, GSonPositionChangedInfo : String;
  2661. PrototypeDelay*, PrototypeInterval* : WMProperties.Int32Property;
  2662. PrototypeCommandString*, PrototypeCaption* : WMProperties.StringProperty;
  2663. PrototypeFont- : WMProperties.FontProperty;
  2664. PrototypeTextColor*: WMProperties.ColorProperty;
  2665. PrototypeAlignH*, PrototypeButtonAlignH*: WMProperties.Int32Property;
  2666. PrototypeAlignV*, PrototypeButtonAlignV*: WMProperties.Int32Property;
  2667. (* temporary prototype-prototypes *)
  2668. ColorPrototype : WMProperties.ColorProperty;
  2669. BooleanPrototype : WMProperties.BooleanProperty;
  2670. StringPrototype : WMProperties.StringProperty;
  2671. Int32Prototype : WMProperties.Int32Property;
  2672. RectanglePrototype : WMProperties.RectangleProperty;
  2673. PrototypeBlinking*: WMProperties.BooleanProperty;
  2674. (* Button prototypes *)
  2675. PrototypeBBounds* : WMProperties.RectangleProperty;
  2676. PrototypeBUseBgImages* : WMProperties.BooleanProperty;
  2677. PrototypeBclDefault*, PrototypeBclHover*, PrototypeBclPressed*, PrototypeBclInactive*,
  2678. PrototypeBclTextDefault*, PrototypeBclTextHover*, PrototypeBclTextPressed* , PrototypeBclTextInactive*: WMProperties.ColorProperty;
  2679. PrototypeBRepeatMiddleImg*, PrototypeBisRepeating*, PrototypeBisToggle*, PrototypeBisInverse*, PrototypeBindicateToggle*, PrototypeBIsHorizontal* : WMProperties.BooleanProperty;
  2680. PrototypeBcaption*, PrototypeBonClickHandler* : WMProperties.StringProperty;
  2681. PrototypeBimgDefaultName*, PrototypeBimgInactiveName*, PrototypeBimgHoverName*, PrototypeBimgPressedName*, PrototypeBimageName* : WMProperties.StringProperty;
  2682. PrototypeImgDefaultNameLeft*, PrototypeImgDefaultNameRight*, PrototypeImgDefaultNameMiddle*,
  2683. PrototypeImgDefaultNameTop*, PrototypeImgDefaultNameBottom*,
  2684. PrototypeImgHoverNameLeft*, PrototypeImgHoverNameRight*, PrototypeImgHoverNameMiddle*,
  2685. PrototypeImgHoverNameTop*, PrototypeImgHoverNameBottom*,
  2686. PrototypeImgPressedNameLeft*, PrototypeImgPressedNameRight*, PrototypeImgPressedNameMiddle*,
  2687. PrototypeImgPressedNameTop*, PrototypeImgPressedNameBottom* : WMProperties.StringProperty;
  2688. PrototypeBEffect3D : WMProperties.Int32Property;
  2689. PrototypeUseDeco*: WMProperties.BooleanProperty;
  2690. PrototypeDecoDefaultName*, PrototypeDecoHoverName*, PrototypeDecoPressedName*: WMProperties.StringProperty;
  2691. (* Scrollbar prototypes *)
  2692. PrototypeSvertical* : WMProperties.BooleanProperty;
  2693. PrototypeSmin*, PrototypeSmax*, PrototypeSpos*, PrototypeSpageSize*, PrototypeTrackerSize*, PrototypeSWidth*,
  2694. PrototypeSMinTrackerSize* : WMProperties.Int32Property;
  2695. (* presentation : colors / images *)
  2696. PrototypeSUseArrowImages*, PrototypeSUseTrackerImages*, PrototypeSRepeatMiddleBitmap* : WMProperties.BooleanProperty;
  2697. (* background *)
  2698. PrototypeSUseBgBitmaps*, PrototypeSRepeateBgBitmap* : WMProperties.BooleanProperty;
  2699. PrototypeSClDefault*, PrototypeSClHover*, PrototypeSClPressed*,
  2700. PrototypeSClBtnDefault*, PrototypeSClBtnHover*, PrototypeSClBtnPressed* : WMProperties.ColorProperty;
  2701. PrototypeSEffect3D* : WMProperties.Int32Property;
  2702. PrototypeSvBgDefault*, PrototypeSvBgHover*, PrototypeSvBgPressed*,
  2703. PrototypeShBgDefault*, PrototypeShBgHover*, PrototypeShBgPressed* : WMProperties.StringProperty;
  2704. (* arrow images *)
  2705. PrototypeSArrowLeftDefault*, PrototypeSArrowLeftHover*, PrototypeSArrowLeftPressed*,
  2706. PrototypeSArrowUpDefault*, PrototypeSArrowUpHover*, PrototypeSArrowUpPressed*,
  2707. PrototypeSArrowRightDefault*, PrototypeSArrowRightHover*, PrototypeSArrowRightPressed*,
  2708. PrototypeSArrowDownDefault*, PrototypeSArrowDownHover*, PrototypeSArrowDownPressed* : WMProperties.StringProperty;
  2709. (* horizontal tracker *)
  2710. PrototypeShTrackerDefaultLeft*, PrototypeShTrackerHoverLeft*, PrototypeShTrackerPressedLeft*,
  2711. PrototypeShTrackerDefaultMiddle*, PrototypeShTrackerHoverMiddle*, PrototypeShTrackerPressedMiddle*,
  2712. PrototypeShTrackerDefaultRight*, PrototypeShTrackerHoverRight*, PrototypeShTrackerPressedRight*,
  2713. (* vertical tracker *)
  2714. PrototypeSvTrackerDefaultTop*, PrototypeSvTrackerHoverTop*, PrototypeSvTrackerPressedTop*,
  2715. PrototypeSvTrackerDefaultMiddle*, PrototypeSvTrackerHoverMiddle*, PrototypeSvTrackerPressedMiddle*,
  2716. PrototypeSvTrackerDefaultBottom*, PrototypeSvTrackerHoverBottom*, PrototypeSvTrackerPressedBottom* : WMProperties.StringProperty;
  2717. (* Slider prototypes *)
  2718. PrototypeSlhTrackerDefault*, PrototypeSlhTrackerHover*, PrototypeSlhTrackerPressed*,
  2719. PrototypeSlvTrackerDefault*, PrototypeSlvTrackerHover*, PrototypeSlvTrackerPressed*,
  2720. PrototypeSlhBgDefault*, PrototypelShBgHover*, PrototypeSlhBgPressed*,
  2721. PrototypeSlvBgDefault*, PrototypeSlvBgHover*, PrototypeSlvBgPressed* : WMProperties.StringProperty;
  2722. PrototypeSlUseTrackerImages*, PrototypeSlUseBgBitmaps*, PrototypeSlRepeatBgBitmap* : WMProperties.BooleanProperty;
  2723. PrototypeSlClDefault*, PrototypeSlClHover*, PrototypeSlClPressed*, PrototypeSlClBar* : WMProperties.ColorProperty;
  2724. PrototypeSlvertical* : WMProperties.BooleanProperty;
  2725. PrototypeSlmin*, PrototypeSlmax*, PrototypeSlpos*, PrototypeSlpageSize*,
  2726. PrototypeSlMinTrackerSize* : WMProperties.Int32Property;
  2727. (* Resizer prototypes *)
  2728. PrototypeRclDefault* : WMProperties.ColorProperty;
  2729. PrototypeRisFlat* : WMProperties.BooleanProperty;
  2730. PrototypeRBounds* : WMProperties.RectangleProperty;
  2731. (* Checkbox Prototypes *)
  2732. ProtCBBounds* : WMProperties.RectangleProperty;
  2733. ProtCBCaption*, PrototypeCBonClickHandler* : WMProperties.StringProperty;
  2734. ProtCBCaptionPos* : WMProperties.Int32Property;
  2735. ProtCBHasThreeStates* : WMProperties.BooleanProperty;
  2736. ProtCBState* : WMProperties.Int32Property;
  2737. ProtCBclBack*, ProtCBclCheck*, ProtCBclDefault*, ProtCBclInactive* : WMProperties.ColorProperty;
  2738. ProtCBUseImages* : WMProperties.BooleanProperty;
  2739. ProtCBScaleImages* : WMProperties.BooleanProperty;
  2740. ProtCBImgCheckedN*, ProtCBImgUncheckedN*, ProtCBImgDefaultN*,
  2741. ProtCBImgCheckedInactiveN*, ProtCBImgUncheckedInactiveN*, ProtCBImgDefaultInactiveN* : WMProperties.StringProperty;
  2742. (* Group Panel *)
  2743. ProtGPCaption* : WMProperties.StringProperty;
  2744. ProtGPTextColor* : WMProperties.ColorProperty;
  2745. (* Image *)
  2746. PrototypeImageName- : WMProperties.StringProperty;
  2747. PrototypeScaleImage : WMProperties.BooleanProperty;
  2748. (* Image Panel *)
  2749. ProtoIpImgName* : WMProperties.StringProperty;
  2750. PrototypeHorizontalFit : WMProperties.BooleanProperty;
  2751. PrototypeTextBorder : WMProperties.Int32Property;
  2752. StrTimer*, StrSystemCommand*, StrEvent*, StrPanel*, StrDecoratorPanel*, StrLabel*, StrButton*, StrScrollbar*, StrResizer* ,
  2753. StrCheckbox, StrGroupPanel, StrImagePanel, StrModel, StrModelInfo, StrImage : String;
  2754. PROCEDURE InitStrings;
  2755. BEGIN
  2756. GSonTimer := NewString("onTimer"); GSonTimerInfo := NewString("generates an event if the timer runs out");
  2757. GSStart := NewString("Start"); GSStartTimerInfo := NewString("start the timer");
  2758. GSStop := NewString("Stop"); GSStopTimerInfo := NewString("stop the timer");
  2759. GSRun := NewString("Run");
  2760. GSRunSystemCommandInfo := NewString("run the system command specified in commandString");
  2761. GSCallEventInfo := NewString("call the event listener specified in commandString");
  2762. GSonClick := NewString("onClick"); GSonClickButtonInfo := NewString("generates an event if the button is clicked");
  2763. GSonClickCheckboxInfo := NewString("generates an event if the checkbox is clicked");
  2764. GSonPositionChanged := NewString("onPositionChanged");
  2765. GSonPositionChangedInfo := NewString("generates an event if the position is changed");
  2766. StrTimer := NewString("Timer");
  2767. StrSystemCommand := NewString("SystemCommand");
  2768. StrEvent := NewString("Event");
  2769. StrPanel := NewString("Panel");
  2770. StrDecoratorPanel := NewString("DecoratorPanel");
  2771. StrLabel := NewString("Label");
  2772. StrButton := NewString("Button");
  2773. StrScrollbar := NewString("Scrollbar");
  2774. StrResizer := NewString("Resizer");
  2775. StrCheckbox := NewString("Checkbox");
  2776. StrGroupPanel := NewString("GroupPanel");
  2777. StrImage := NewString("Image");
  2778. StrImagePanel := NewString("ImagePanel");
  2779. StrModel := NewString("Model");
  2780. StrModelInfo := NewString("Model used by component");
  2781. END InitStrings;
  2782. PROCEDURE InitPrototypes;
  2783. VAR
  2784. plTimer, plLabel, plButton, plDecorator, plScrollbar, plSlider, plResizer, plCheckbox, plGroupPanel, plImagePanel : WMProperties.PropertyList;
  2785. BEGIN
  2786. (* Timer properties *)
  2787. NEW(plTimer);
  2788. NEW(PrototypeInterval, NIL, NewString("Interval"), NewString("time between two timer ticks in ms"));
  2789. PrototypeInterval.Set(100);
  2790. plTimer.Add(PrototypeInterval);
  2791. NEW(PrototypeDelay, NIL, NewString("Delay"), NewString("delay before timer ticks run"));
  2792. PrototypeDelay.Set(1000);
  2793. plTimer.Add(PrototypeDelay);
  2794. WMComponents.propertyListList.Add("Timer", plTimer);
  2795. (* SystemCommand properties *)
  2796. NEW(PrototypeCommandString, NIL, NewString("CommandString"), NewString("command to be executed uppon call to Run"));
  2797. (* Label properties *)
  2798. NEW(plLabel); WMComponents.propertyListList.Add("Label", plLabel);
  2799. NEW(PrototypeCaption, NIL, NewString("Caption"), NewString("caption text"));
  2800. NEW(PrototypeFont, NIL, NewString("Font"), NewString("Font"));
  2801. PrototypeFont.Set(WMGraphics.GetDefaultFont());
  2802. NEW(PrototypeTextColor, NIL, NewString("TextColor"), NewString("text color")); plLabel.Add(PrototypeTextColor);
  2803. PrototypeTextColor.Set(0FFH);
  2804. NEW(PrototypeAlignH, NIL, NewString("AlignH"), NewString("horizontal alignment")); plLabel.Add(PrototypeAlignH);
  2805. PrototypeAlignH.Set(WMGraphics.AlignLeft);
  2806. NEW(PrototypeAlignV, NIL, NewString("AlignV"), NewString("vertical alignment")); plLabel.Add(PrototypeAlignV);
  2807. PrototypeAlignV.Set(WMGraphics.AlignCenter);
  2808. (*
  2809. NEW(plDecorator); WMComponents.propertyListList.Add("Decorator", plDecorator);
  2810. NEW(PrototypeTopLeftName, NIL, NewString("TopLeft"), NewString("Default Top Left Decorator Bitmap")); PrototypeTopLeftName.Set(NewString("")); plDecorator.Add(PrototypeTopLeftName);
  2811. NEW(PrototypeTopName, NIL, NewString("Top"), NewString("Default Top Decorator Bitmap")); PrototypeLeftName.Set(NewString("")); plDecorator.Add(PrototypeTopName);
  2812. NEW(PrototypeTopRightName, NIL, NewString("TopRight"), NewString("Default Top Right Decorator Bitmap")); PrototypeRightName.Set(NewString("")); plDecorator.Add(PrototypeTopRightName);
  2813. NEW(PrototypeBottomLeftName, NIL, NewString("BottomLeft"), NewString("Default Bottom Left Decorator Bitmap")); PrototypeBottomLeftName.Set(NewString("")); plDecorator.Add(PrototypeBottomLeftName);
  2814. NEW(PrototypeBottomName, NIL, NewString("Bottom"), NewString("Default Bottom Decorator Bitmap")); PrototypeBottomName.Set(NewString("")); plDecorator.Add(PrototypeBottomName);
  2815. NEW(PrototypeBottomRightName, NIL, NewString("BottomRight"), NewString("Default Bottom Right Decorator Bitmap")); PrototypeBottomRightName.Set(NewString("")); plDecorator.Add(PrototypeBottomRightName);
  2816. NEW(PrototypeLeftName, NIL, NewString("Left"), NewString("Default Left Decorator Bitmap")); PrototypeLeftName.Set(NewString("")); plDecorator.Add(PrototypeLeftName);
  2817. NEW(PrototypeRightName, NIL, NewString("Right"), NewString("Default Right Decorator Bitmap")); PrototypeRightName.Set(NewString("")); plDecorator.Add(PrototypeRightName);
  2818. *)
  2819. (* Button properties *)
  2820. NEW(plButton); WMComponents.propertyListList.Add("Button", plButton);
  2821. (* caption *)
  2822. NEW(PrototypeBcaption, NIL, NewString("Caption"), NewString("defines the button text"));
  2823. (* font size *)
  2824. NEW(Int32Prototype, NIL, NewString("FontHeight"), NewString("height of the button text")); Int32Prototype.Set(12);
  2825. NEW(PrototypeBisRepeating, NIL, NewString("IsRepeating"), NewString("defines if the button repeats sending click events while being pressed down"));
  2826. NEW(PrototypeBisToggle, NIL, NewString("IsToggle"), NewString("defines if the button is a toggle button"));
  2827. NEW(PrototypeBisInverse, NIL, NewString("IsInverse"), NewString("defines if the button is the inverse of the model"));
  2828. NEW(PrototypeBindicateToggle, NIL, NewString("IndicateToggle"), NewString("Display small LED in toggle buttons"));
  2829. PrototypeBindicateToggle.Set(TRUE);
  2830. (* behaviour *)
  2831. NEW(PrototypeBonClickHandler, NIL, NewString("OnClickHandler"), NewString("handler"));
  2832. (* single images *)
  2833. NEW(StringPrototype, NIL, NewString("BgDefault"), NewString("Default background bitmap")); StringPrototype.Set(NewString(""));
  2834. NEW(PrototypeBimgDefaultName, StringPrototype, NIL, NIL); plButton.Add(PrototypeBimgDefaultName);
  2835. NEW(StringPrototype, NIL, NewString("BgInactive"), NewString("Default disabled background bitmap")); StringPrototype.Set(NewString(""));
  2836. NEW(PrototypeBimgInactiveName, StringPrototype, NIL, NIL); plButton.Add(PrototypeBimgInactiveName);
  2837. NEW(StringPrototype, NIL, NewString("BgHover"), NewString("Mouseover background bitmap")); StringPrototype.Set(NewString(""));
  2838. NEW(PrototypeBimgHoverName, StringPrototype, NIL, NIL); plButton.Add(PrototypeBimgHoverName);
  2839. NEW(StringPrototype, NIL, NewString("BgPressed"), NewString("Pressed background bitmap")); StringPrototype.Set(NewString(""));
  2840. NEW(PrototypeBimgPressedName, StringPrototype, NIL, NIL); plButton.Add(PrototypeBimgPressedName);
  2841. NEW(StringPrototype, NIL, NewString("BgImage"), NewString("background bitmap")); StringPrototype.Set(NewString(""));
  2842. NEW(PrototypeBimageName, StringPrototype, NIL, NIL); plButton.Add(PrototypeBimageName);
  2843. (* presentation *)
  2844. NEW(BooleanPrototype, NIL, NewString("UseBgBitmaps"), NewString("Is the button decorated by bitmaps or simple colors?")); BooleanPrototype.Set(FALSE);
  2845. NEW(PrototypeBUseBgImages, BooleanPrototype, NIL, NIL); plButton.Add(PrototypeBUseBgImages);
  2846. NEW(PrototypeBIsHorizontal, NIL, NewString("IsHorizontal"), NewString("Specifies if the button is horizontal or vertical")); PrototypeBIsHorizontal.Set(TRUE);
  2847. NEW(BooleanPrototype, NIL, NewString("RepeatMiddleImage"), NewString("If TRUE, the middle image of the button representation will be repeated, scaled if FALSE"));
  2848. BooleanPrototype.Set(FALSE);
  2849. NEW(PrototypeBRepeatMiddleImg, BooleanPrototype, NIL, NIL); plButton.Add(PrototypeBRepeatMiddleImg);
  2850. (* button size *)
  2851. NEW(RectanglePrototype, WMComponents.PrototypeBounds, NewString("Bounds"), NIL); RectanglePrototype.Set(WMRectangles.MakeRect(0, 0, 50, 20));
  2852. NEW(PrototypeBBounds, RectanglePrototype, NewString("Bounds"), NIL); plButton.Add(PrototypeBBounds);
  2853. (* background color *)
  2854. NEW(ColorPrototype, NIL, NewString("ClDefault"), NewString("Default background color")); ColorPrototype.Set(1010C080H);
  2855. NEW(PrototypeBclDefault, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclDefault);
  2856. NEW(ColorPrototype, NIL, NewString("ClHover"), NewString("Mouseover background color")); ColorPrototype.Set(LONGINT(0EEEE00FFH));
  2857. NEW(PrototypeBclHover, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclHover);
  2858. NEW(ColorPrototype, NIL, NewString("ClPressed"), NewString("Pressed background color")); ColorPrototype.Set(LONGINT(0EEEE00FFH));
  2859. NEW(PrototypeBclPressed, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclPressed);
  2860. NEW(ColorPrototype, NIL, NewString("ClInactive"), NewString("Inactive background color")); ColorPrototype.Set(LONGINT(80808080H));
  2861. NEW(PrototypeBclInactive, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclInactive);
  2862. (* font color *)
  2863. NEW(ColorPrototype, NIL, NewString("ClTextDefault"), NewString("Default text color")); ColorPrototype.Set(LONGINT(0FFFF00FFH));
  2864. NEW(PrototypeBclTextDefault, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclTextDefault);
  2865. NEW(ColorPrototype, NIL, NewString("ClTextHover"), NewString("Mouseover text color")); ColorPrototype.Set(00000FFFFH);
  2866. NEW(PrototypeBclTextHover, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclTextHover);
  2867. NEW(ColorPrototype, NIL, NewString("ClTextPressed"), NewString("Pressed text color")); ColorPrototype.Set(00000FFFFH);
  2868. NEW(PrototypeBclTextPressed, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclTextPressed);
  2869. NEW(ColorPrototype, NIL, NewString("ClTextInactive"), NewString("Inactive text color")); ColorPrototype.Set(0FFFFFF80H);
  2870. NEW(PrototypeBclTextInactive, ColorPrototype, NIL, NIL); plButton.Add(PrototypeBclTextInactive);
  2871. (* effect3D *)
  2872. NEW(Int32Prototype, NIL, NewString("Effect3D"), NewString("Degree of 3d-effect. Zero for flat presentation")); Int32Prototype.Set(2);
  2873. NEW(PrototypeBEffect3D, Int32Prototype, NIL, NIL); plButton.Add(PrototypeBEffect3D);
  2874. (* 3 x 5 background images *)
  2875. NEW(StringPrototype, NIL, NewString("BgLeftDefault"), NewString("Default background bitmap left")); StringPrototype.Set(NewString(""));
  2876. NEW(PrototypeImgDefaultNameLeft, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgDefaultNameLeft);
  2877. NEW(StringPrototype, NIL, NewString("BgRightDefault"), NewString("Default background bitmap right")); StringPrototype.Set(NewString(""));
  2878. NEW(PrototypeImgDefaultNameRight, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgDefaultNameRight);
  2879. NEW(StringPrototype, NIL, NewString("BgMiddleDefault"), NewString("Default background bitmap middle")); StringPrototype.Set(NewString(""));
  2880. NEW(PrototypeImgDefaultNameMiddle, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgDefaultNameMiddle);
  2881. NEW(StringPrototype, NIL, NewString("BgTopDefault"), NewString("Default background bitmap top")); StringPrototype.Set(NewString(""));
  2882. NEW(PrototypeImgDefaultNameTop, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgDefaultNameTop);
  2883. NEW(StringPrototype, NIL, NewString("BgBottomDefault"), NewString("Default background bitmap bottom")); StringPrototype.Set(NewString(""));
  2884. NEW(PrototypeImgDefaultNameBottom, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgDefaultNameBottom);
  2885. NEW(BooleanPrototype, NIL, NewString("UseDeco"), NewString("Is the button decorated by decoration?")); BooleanPrototype.Set(FALSE);
  2886. NEW(PrototypeUseDeco, BooleanPrototype, NIL, NIL); plButton.Add(PrototypeUseDeco);
  2887. NEW(StringPrototype, NIL, NewString("DecoDefault"), NewString("Default background decoration name")); StringPrototype.Set(NewString(""));
  2888. NEW(PrototypeDecoDefaultName, StringPrototype, NIL, NIL); plButton.Add(PrototypeDecoDefaultName);
  2889. NEW(StringPrototype, NIL, NewString("DecoHover"), NewString("Hover background decoration name")); StringPrototype.Set(NewString(""));
  2890. NEW(PrototypeDecoHoverName, StringPrototype, NIL, NIL); plButton.Add(PrototypeDecoHoverName);
  2891. NEW(StringPrototype, NIL, NewString("DecoPressed"), NewString("Pressed background decoration name")); StringPrototype.Set(NewString(""));
  2892. NEW(PrototypeDecoPressedName, StringPrototype, NIL, NIL); plButton.Add(PrototypeDecoPressedName);
  2893. NEW(StringPrototype, NIL, NewString("BgLeftHover"), NewString("Mouseover background bitmap left")); StringPrototype.Set(NewString(""));
  2894. NEW(PrototypeImgHoverNameLeft, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgHoverNameLeft);
  2895. NEW(StringPrototype, NIL, NewString("BgRightHover"), NewString("Mouseover background bitmap right")); StringPrototype.Set(NewString(""));
  2896. NEW(PrototypeImgHoverNameRight, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgHoverNameRight);
  2897. NEW(StringPrototype, NIL, NewString("BgMiddleHover"), NewString("Mouseover background bitmap middle")); StringPrototype.Set(NewString(""));
  2898. NEW(PrototypeImgHoverNameMiddle, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgHoverNameMiddle);
  2899. NEW(StringPrototype, NIL, NewString("BgTopHover"), NewString("Mouseover background bitmap top")); StringPrototype.Set(NewString(""));
  2900. NEW(PrototypeImgHoverNameTop, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgHoverNameTop);
  2901. NEW(StringPrototype, NIL, NewString("BgBottomHover"), NewString("Mouseover background bitmap bottom")); StringPrototype.Set(NewString(""));
  2902. NEW(PrototypeImgHoverNameBottom, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgHoverNameBottom);
  2903. NEW(StringPrototype, NIL, NewString("BgLeftPressed"), NewString("Pressed background bitmap left")); StringPrototype.Set(NewString(""));
  2904. NEW(PrototypeImgPressedNameLeft, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgPressedNameLeft);
  2905. NEW(StringPrototype, NIL, NewString("BgRightPressed"), NewString("Pressed background bitmap right")); StringPrototype.Set(NewString(""));
  2906. NEW(PrototypeImgPressedNameRight, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgPressedNameRight);
  2907. NEW(StringPrototype, NIL, NewString("BgMiddlePressed"), NewString("Pressed background bitmap middle")); StringPrototype.Set(NewString(""));
  2908. NEW(PrototypeImgPressedNameMiddle, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgPressedNameMiddle);
  2909. NEW(StringPrototype, NIL, NewString("BgTopPressed"), NewString("Pressed background bitmap top")); StringPrototype.Set(NewString(""));
  2910. NEW(PrototypeImgPressedNameTop, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgPressedNameTop);
  2911. NEW(StringPrototype, NIL, NewString("BgBottomPressed"), NewString("Pressed background bitmap bottom")); StringPrototype.Set(NewString(""));
  2912. NEW(PrototypeImgPressedNameBottom, StringPrototype, NIL, NIL); plButton.Add(PrototypeImgPressedNameBottom);
  2913. NEW(PrototypeButtonAlignH, NIL, NewString("TextAlignH"), NewString("horizontal text alignment")); plButton.Add(PrototypeAlignH);
  2914. PrototypeButtonAlignH.Set(WMGraphics.AlignCenter);
  2915. NEW(PrototypeButtonAlignV, NIL, NewString("TextAlignV"), NewString("vertical text alignment")); plButton.Add(PrototypeAlignV);
  2916. PrototypeButtonAlignV.Set(WMGraphics.AlignCenter);
  2917. (* Scrollbar prototypes *)
  2918. NEW(plScrollbar); WMComponents.propertyListList.Add("Scrollbar", plScrollbar);
  2919. NEW(PrototypeSmin, NIL, NewString("Min"), NewString("defines the scrollbar min position"));
  2920. NEW(PrototypeSmax, NIL, NewString("Max"), NewString("defines the scrollbar max position"));
  2921. PrototypeSmax.Set(100);
  2922. NEW(PrototypeSpos, NIL, NewString("Pos"), NewString("defines the scrollbar position"));
  2923. NEW(PrototypeSpageSize, NIL, NewString("PageSize"), NewString("defines the scrollbar page size"));
  2924. PrototypeSpageSize.Set(20);
  2925. NEW(PrototypeTrackerSize, NIL, NewString("TrackerSize"), NewString("defines the tracker size"));
  2926. PrototypeTrackerSize.Set(20);
  2927. (* scrollbar width *)
  2928. NEW(Int32Prototype, NIL, NewString("Width"), NewString("defines the scrollbar width")); Int32Prototype.Set(14);
  2929. NEW(PrototypeSWidth, Int32Prototype, NIL, NIL); plScrollbar.Add(PrototypeSWidth);
  2930. NEW(PrototypeSvertical, NIL, NewString("Vertical"), NewString("defines if the scrollbar is vertical"));
  2931. PrototypeSvertical.Set(TRUE);
  2932. NEW(Int32Prototype, NIL, NewString("MinTrackerSize"), NewString("")); Int32Prototype.Set(5);
  2933. NEW(PrototypeSMinTrackerSize, Int32Prototype, NIL, NIL); plScrollbar.Add(PrototypeSMinTrackerSize);
  2934. (* color *)
  2935. NEW(ColorPrototype, NIL, NewString("ClDefault"), NewString("Default background color")); ColorPrototype.Set(000000077H);
  2936. NEW(PrototypeSClDefault, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClDefault);
  2937. NEW(ColorPrototype, NIL, NewString("ClHover"), NewString("Mouseover background color")); ColorPrototype.Set(WMGraphics.Yellow);
  2938. NEW(PrototypeSClHover, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClHover);
  2939. NEW(ColorPrototype, NIL, NewString("ClPressed"), NewString("Pressed background color")); ColorPrototype.Set(WMGraphics.Yellow);
  2940. NEW(PrototypeSClPressed, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClPressed);
  2941. NEW(ColorPrototype, NIL, NewString("ClBtnDefault"), NewString("Default background color")); ColorPrototype.Set(1010C080H);
  2942. NEW(PrototypeSClBtnDefault, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClBtnDefault);
  2943. NEW(ColorPrototype, NIL, NewString("ClBtnHover"), NewString("Mouseover background color")); ColorPrototype.Set(LONGINT(0EEEE00FFH));
  2944. NEW(PrototypeSClBtnHover, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClBtnHover);
  2945. NEW(ColorPrototype, NIL, NewString("ClBtnPressed"), NewString("Pressed background color")); ColorPrototype.Set(LONGINT(0EEEE00FFH));
  2946. NEW(PrototypeSClBtnPressed, ColorPrototype, NIL, NIL); plScrollbar.Add(PrototypeSClBtnPressed);
  2947. NEW(PrototypeSEffect3D, NIL, NewString("Effect3D"), NewString("Degree of 3d-effect. Zero for flat presentation")); PrototypeSEffect3D.Set(2);
  2948. (* background *)
  2949. NEW(BooleanPrototype, NIL, NewString("UseBackgroundBitmaps"), NewString("Should background be decorated by bitmaps or simple color?")); BooleanPrototype.Set(FALSE);
  2950. NEW(PrototypeSUseBgBitmaps, BooleanPrototype, NIL, NIL); plScrollbar.Add(PrototypeSUseBgBitmaps);
  2951. NEW(BooleanPrototype, NIL, NewString("RepeatBgBitmaps"), NewString("Should background bitmap be repeated or streched?")); BooleanPrototype.Set(TRUE);
  2952. NEW(PrototypeSRepeateBgBitmap, BooleanPrototype, NIL, NIL); plScrollbar.Add(PrototypeSRepeateBgBitmap);
  2953. (* bitmaps *)
  2954. NEW(StringPrototype, NIL, NewString("HorizontalBgDefault"), NewString("Default background bitmap for the horizontal scrollbar")); StringPrototype.Set(NewString(""));
  2955. NEW(PrototypeShBgDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShBgDefault);
  2956. NEW(StringPrototype, NIL, NewString("HorizontalBgHover"), NewString("Hover background bitmap for the horizontal scrollbar")); StringPrototype.Set(NewString(""));
  2957. NEW(PrototypeShBgHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShBgHover);
  2958. NEW(StringPrototype, NIL, NewString("HorizontalBgPressed"), NewString("Pressed background bitmap for the horizontal scrollbar")); StringPrototype.Set(NewString(""));
  2959. NEW(PrototypeShBgPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShBgPressed);
  2960. NEW(StringPrototype, NIL, NewString("VerticalBgDefault"), NewString("Default background bitmap for the vertical scrollbar")); StringPrototype.Set(NewString(""));
  2961. NEW(PrototypeSvBgDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvBgDefault);
  2962. NEW(StringPrototype, NIL, NewString("VerticalBgHover"), NewString("Hover background bitmap for the vertical scrollbar")); StringPrototype.Set(NewString(""));
  2963. NEW(PrototypeSvBgHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvBgHover);
  2964. NEW(StringPrototype, NIL, NewString("VerticalBgPressed"), NewString("Pressed background bitmap for the vertical scrollbar")); StringPrototype.Set(NewString(""));
  2965. NEW(PrototypeSvBgPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvBgPressed);
  2966. (* trackers *)
  2967. NEW(BooleanPrototype, NIL, NewString("UseTrackerBitmaps"), NewString("Should thumbs be decorated by bitmaps or simple color?")); BooleanPrototype.Set(FALSE);
  2968. NEW(PrototypeSUseTrackerImages, BooleanPrototype, NIL, NIL); plScrollbar.Add(PrototypeSUseTrackerImages);
  2969. NEW(BooleanPrototype, NIL, NewString("RepeatMiddleBitmaps"), NewString("Has the middle thumb bitmap to be repeated or streched?")); BooleanPrototype.Set(TRUE);
  2970. NEW(PrototypeSRepeatMiddleBitmap, BooleanPrototype, NIL, NIL); plScrollbar.Add(PrototypeSRepeatMiddleBitmap);
  2971. (* horizontal*)
  2972. NEW(StringPrototype, NIL, NewString("HorizontalTrackerDefaultLeft"), NewString("Default background bitmap left of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2973. NEW(PrototypeShTrackerDefaultLeft, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerDefaultLeft);
  2974. NEW(StringPrototype, NIL, NewString("HorizontalTrackerHoverLeft"), NewString("Mouseover background bitmap left of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2975. NEW(PrototypeShTrackerHoverLeft, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerHoverLeft);
  2976. NEW(StringPrototype, NIL, NewString("HorizontalTrackerPressedLeft"), NewString("Pressed background bitmap left of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2977. NEW(PrototypeShTrackerPressedLeft, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerPressedLeft);
  2978. NEW(StringPrototype, NIL, NewString("HorizontalTrackerDefaultMiddle"), NewString("Default background bitmap middle of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2979. NEW(PrototypeShTrackerDefaultMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerDefaultMiddle);
  2980. NEW(StringPrototype, NIL, NewString("HorizontalTrackerHoverMiddle"), NewString("Mouseover background bitmap middle of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2981. NEW(PrototypeShTrackerHoverMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerHoverMiddle);
  2982. NEW(StringPrototype, NIL, NewString("HorizontalTrackerPressedMiddle"), NewString("Pressed background bitmap middle of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2983. NEW(PrototypeShTrackerPressedMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerPressedMiddle);
  2984. NEW(StringPrototype, NIL, NewString("HorizontalTrackerDefaultRight"), NewString("Default background bitmap right of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2985. NEW(PrototypeShTrackerDefaultRight, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerDefaultRight);
  2986. NEW(StringPrototype, NIL, NewString("HorizontalTrackerHoverRight"), NewString("Mouseover background bitmap right of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2987. NEW(PrototypeShTrackerHoverRight, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerHoverRight);
  2988. NEW(StringPrototype, NIL, NewString("HorizontalTrackerPressedRight"), NewString("Pressed background bitmap right of the horizontal thumb")); StringPrototype.Set(NewString(""));
  2989. NEW(PrototypeShTrackerPressedRight, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeShTrackerPressedRight);
  2990. (* vertical *)
  2991. NEW(StringPrototype, NIL, NewString("VerticalTrackerDefaultTop"), NewString("Default background bitmap top of the vertical thumb")); StringPrototype.Set(NewString(""));
  2992. NEW(PrototypeSvTrackerDefaultTop, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerDefaultTop);
  2993. NEW(StringPrototype, NIL, NewString("VerticalTrackerHoverTop"), NewString("Mouseover background bitmap top of the vertical thumb")); StringPrototype.Set(NewString(""));
  2994. NEW(PrototypeSvTrackerHoverTop, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerHoverTop);
  2995. NEW(StringPrototype, NIL, NewString("VerticalTrackerPressedTop"), NewString("Pressed background bitmap top of the vertical thumb")); StringPrototype.Set(NewString(""));
  2996. NEW(PrototypeSvTrackerPressedTop, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerPressedTop);
  2997. NEW(StringPrototype, NIL, NewString("VerticalTrackerDefaultMiddle"), NewString("Default background bitmap middle of the vertical thumb")); StringPrototype.Set(NewString(""));
  2998. NEW(PrototypeSvTrackerDefaultMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerDefaultMiddle);
  2999. NEW(StringPrototype, NIL, NewString("VerticalTrackerHoverMiddle"), NewString("Mouseover background bitmap middle of the vertical thumb")); StringPrototype.Set(NewString(""));
  3000. NEW(PrototypeSvTrackerHoverMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerHoverMiddle);
  3001. NEW(StringPrototype, NIL, NewString("VerticalTrackerPressedMiddle"), NewString("Pressed background bitmap middle of the vertical thumb")); StringPrototype.Set(NewString(""));
  3002. NEW(PrototypeSvTrackerPressedMiddle, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerPressedMiddle);
  3003. NEW(StringPrototype, NIL, NewString("VerticalTrackerDefaultBottom"), NewString("Default background bitmap bottom of the vertical thumb")); StringPrototype.Set(NewString(""));
  3004. NEW(PrototypeSvTrackerDefaultBottom, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerDefaultBottom);
  3005. NEW(StringPrototype, NIL, NewString("VerticalTrackerHoverBottom"), NewString("Mouseover background bitmap bottom of the vertical thumb")); StringPrototype.Set(NewString(""));
  3006. NEW(PrototypeSvTrackerHoverBottom, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerHoverBottom);
  3007. NEW(StringPrototype, NIL, NewString("VerticalTrackerPressedBottom"), NewString("Pressed background bitmap bottom of the vertical thumb")); StringPrototype.Set(NewString(""));
  3008. NEW(PrototypeSvTrackerPressedBottom, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSvTrackerPressedBottom);
  3009. (* arrows *)
  3010. NEW(BooleanPrototype, NIL, NewString("UseArrowBitmaps"), NewString("Have the arrow-buttons to be decorated by bitmaps or simple colors")); BooleanPrototype.Set(FALSE);
  3011. NEW(PrototypeSUseArrowImages, BooleanPrototype, NIL, NIL); plScrollbar.Add(PrototypeSUseArrowImages);
  3012. (* left *)
  3013. NEW(StringPrototype, NIL, NewString("ArrowLeftDefault"), NewString("Default bitmap for the left-arrow")); StringPrototype.Set(NewString(""));
  3014. NEW(PrototypeSArrowLeftDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowLeftDefault);
  3015. NEW(StringPrototype, NIL, NewString("ArrowLeftHover"), NewString("Mouseover bitmap for the left-arrow")); StringPrototype.Set(NewString(""));
  3016. NEW(PrototypeSArrowLeftHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowLeftHover);
  3017. NEW(StringPrototype, NIL, NewString("ArrowLeftPressed"), NewString("Pressed bitmap for the left-arrow")); StringPrototype.Set(NewString(""));
  3018. NEW(PrototypeSArrowLeftPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowLeftPressed);
  3019. (* right *)
  3020. NEW(StringPrototype, NIL, NewString("ArrowRightDefault"), NewString("Default bitmap for the right-arrow")); StringPrototype.Set(NewString(""));
  3021. NEW(PrototypeSArrowRightDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowRightDefault);
  3022. NEW(StringPrototype, NIL, NewString("ArrowRightHover"), NewString("Mouseover bitmap for the right-arrow")); StringPrototype.Set(NewString(""));
  3023. NEW(PrototypeSArrowRightHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowRightHover);
  3024. NEW(StringPrototype, NIL, NewString("ArrowRightPressed"), NewString("Pressed bitmap for the right-arrow")); StringPrototype.Set(NewString(""));
  3025. NEW(PrototypeSArrowRightPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowRightPressed);
  3026. (* up *)
  3027. NEW(StringPrototype, NIL, NewString("ArrowUpDefault"), NewString("Default bitmap for the up-arrow"));StringPrototype.Set(NewString(""));
  3028. NEW(PrototypeSArrowUpDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowUpDefault);
  3029. NEW(StringPrototype, NIL, NewString("ArrowUpHover"), NewString("Mouseover bitmap for the up-arrow")); StringPrototype.Set(NewString(""));
  3030. NEW(PrototypeSArrowUpHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowUpHover);
  3031. NEW(StringPrototype, NIL, NewString("ArrowUpPressed"), NewString("Pressed bitmap for the up-arrow")); StringPrototype.Set(NewString(""));
  3032. NEW(PrototypeSArrowUpPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowUpPressed);
  3033. (* down *)
  3034. NEW(StringPrototype, NIL, NewString("ArrowDownDefault"), NewString("Default bitmap for the down-arrow"));StringPrototype.Set(NewString(""));
  3035. NEW(PrototypeSArrowDownDefault, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowDownDefault);
  3036. NEW(StringPrototype, NIL, NewString("ArrowDownHover"), NewString("Mouseover bitmap for the down-arrow")); StringPrototype.Set(NewString(""));
  3037. NEW(PrototypeSArrowDownHover, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowDownHover);
  3038. NEW(StringPrototype, NIL, NewString("ArrowDownPressed"), NewString("Pressed bitmap for the down-arrow")); StringPrototype.Set(NewString(""));
  3039. NEW(PrototypeSArrowDownPressed, StringPrototype, NIL, NIL); plScrollbar.Add(PrototypeSArrowDownPressed);
  3040. (* Slider prototypes *)
  3041. NEW(plSlider); WMComponents.propertyListList.Add("Slider", plSlider);
  3042. NEW(PrototypeSlhTrackerDefault, NIL, NewString("HTrackerDefaultName"), NewString("Default tracker image for the horizontal slider"));
  3043. NEW(PrototypeSlhTrackerHover, NIL, NewString("HTrackerHoverName"), NewString("Hover tracker image for the horizontal slider"));
  3044. NEW(PrototypeSlhTrackerPressed, NIL, NewString("HTrackerPressedName"), NewString("Pressed tracker image for the horizontal slider"));
  3045. NEW(PrototypeSlvTrackerDefault, NIL, NewString("VTrackerDefaultName"), NewString("Default tracker image for the vertical slider"));
  3046. NEW(PrototypeSlvTrackerHover, NIL, NewString("VTrackerHoverName"), NewString("Hover tracker image for the vertical slider"));
  3047. NEW(PrototypeSlvTrackerPressed, NIL, NewString("VTrackerPressedName"), NewString("Pressed tracker image for the vertical slider"));
  3048. NEW(PrototypeSlhBgDefault, NIL, NewString("HBgDefaultName"), NewString("Default background image for the horizontal slider"));
  3049. NEW(PrototypelShBgHover, NIL, NewString("HBgHoverName"), NewString("Hover background image for the horizontal slider"));
  3050. NEW(PrototypeSlhBgPressed, NIL, NewString("HBgPressedName"), NewString("Pressed background image for the horizontal slider"));
  3051. NEW(PrototypeSlvBgDefault, NIL, NewString("VBgDefaultName"), NewString("Default background image for the vertical slider"));
  3052. NEW(PrototypeSlvBgHover, NIL, NewString("VBgHoverName"), NewString("Hover background image for the vertical slider"));
  3053. NEW(PrototypeSlvBgPressed, NIL, NewString("VBgPressedName"), NewString("Pressed background image for the vertical slider"));
  3054. NEW(PrototypeSlUseTrackerImages, NIL, NewString("UseTrackerImages"), NewString("Use images for the tracker of the slider?"));
  3055. NEW(PrototypeSlUseBgBitmaps, NIL, NewString("UseBgBitmaps"), NewString("Use backgroun images for slider?"));
  3056. NEW(PrototypeSlRepeatBgBitmap, NIL, NewString("RepeatBgBitamp"), NewString("Repeat middle bitmap of background image?"));
  3057. NEW(PrototypeSlClDefault, NIL, NewString("ClDefault"), NewString("Default color of slider"));
  3058. PrototypeSlClDefault.Set(0);
  3059. NEW(PrototypeSlClHover, NIL, NewString("ClHover"), NewString("Hover color of slider"));
  3060. PrototypeSlClHover.Set(0);
  3061. NEW(PrototypeSlClPressed, NIL, NewString("ClPressed"), NewString("Pressed color of slider"));
  3062. PrototypeSlClPressed.Set(0);
  3063. NEW(PrototypeSlClBar, NIL, NewString("ClBar"), NewString("Color of slider bar"));
  3064. PrototypeSlClBar.Set(0CCCCCCCCH);
  3065. NEW(PrototypeSlvertical, NIL, NewString("Vertical"),NewString("defines if the slider is vertical"));
  3066. PrototypeSlvertical.Set(TRUE);
  3067. NEW(PrototypeSlmin, NIL, NewString("Min"), NewString("defines the slider min position"));
  3068. PrototypeSlmin.Set(0);
  3069. NEW(PrototypeSlmax, NIL, NewString("Max"), NewString("defines the slider max position"));
  3070. PrototypeSlmax.Set(100);
  3071. NEW(PrototypeSlpos, NIL, NewString("Pos"), NewString("defines the slider position"));
  3072. NEW(PrototypeSlpageSize, NIL, NewString("PageSize"),NewString("defines the slider page size"));
  3073. PrototypeSlpageSize.Set(20);
  3074. (* Resizer *)
  3075. NEW(plResizer); WMComponents.propertyListList.Add("Resizer", plResizer);
  3076. NEW(ColorPrototype, NIL, NewString("ClDefault"), NewString("Default Color")); ColorPrototype.Set(WMGraphics.White);
  3077. NEW(PrototypeRclDefault, ColorPrototype, NIL, NIL); plResizer.Add(PrototypeRclDefault);
  3078. NEW(BooleanPrototype, NIL, NewString("IsFlat"), NewString("Is the resizer flat or 3d?")); BooleanPrototype.Set(FALSE);
  3079. NEW(PrototypeRisFlat, BooleanPrototype, NIL, NIL); plResizer.Add(PrototypeRisFlat);
  3080. NEW(RectanglePrototype, NIL, NewString("Bounds"), NewString("Default width and height")); RectanglePrototype.SetWidth(5); RectanglePrototype.SetHeight(5);
  3081. NEW(PrototypeRBounds, RectanglePrototype, NIL, NIL); plResizer.Add(PrototypeRBounds);
  3082. (* Checkbox *)
  3083. NEW(plCheckbox); WMComponents.propertyListList.Add("Checkbox", plCheckbox);
  3084. NEW(ProtCBCaption, NIL, NewString("Caption"), NewString("caption text")); plCheckbox.Add(ProtCBCaption);
  3085. ProtCBCaption.SetAOC("");
  3086. NEW(ProtCBCaptionPos, NIL, NewString("CaptionPos"), NewString("caption position")); plCheckbox.Add(ProtCBCaptionPos);
  3087. ProtCBCaptionPos.Set(Right);
  3088. (* Checkbox size *)
  3089. NEW(RectanglePrototype, WMComponents.PrototypeBounds, NewString("Bounds"), NIL); RectanglePrototype.Set(WMRectangles.MakeRect(0, 0, 100, 20));
  3090. NEW(ProtCBBounds, RectanglePrototype, NewString("Bounds"), NIL); plCheckbox.Add(ProtCBBounds);
  3091. (* Checkbox state *)
  3092. NEW(ProtCBHasThreeStates, NIL, NewString("HasThreeStates"), NewString("enables three state checkbox")); plCheckbox.Add(ProtCBHasThreeStates);
  3093. ProtCBHasThreeStates.Set(FALSE);
  3094. NEW(ProtCBState, NIL, NewString("State"), NewString("current state")); plCheckbox.Add(ProtCBState);
  3095. ProtCBState.Set(Unchecked);
  3096. NEW(PrototypeCBonClickHandler, NIL, NewString("onClickHandler"), NewString("onClickHandler")); plCheckbox.Add(PrototypeCBonClickHandler);
  3097. (* background color *)
  3098. NEW(ColorPrototype, NIL, NewString("ClBack"), NewString("Checkbox Background Color")); ColorPrototype.Set(LONGINT(0FFFFFF80H));
  3099. NEW(ProtCBclBack, ColorPrototype, NIL, NIL); plCheckbox.Add(ProtCBclBack);
  3100. NEW(ColorPrototype, NIL, NewString("ClCheck"), NewString("Checkbox Check Color")); ColorPrototype.Set(0000000FFH);
  3101. NEW(ProtCBclCheck, ColorPrototype, NIL, NIL); plCheckbox.Add(ProtCBclCheck);
  3102. NEW(ColorPrototype, NIL, NewString("ClDefault"), NewString("Checkbox 3rd state Check Color")); ColorPrototype.Set(0555555FFH);
  3103. NEW(ProtCBclDefault, ColorPrototype, NIL, NIL); plCheckbox.Add(ProtCBclDefault);
  3104. NEW(ColorPrototype, NIL, NewString("ClInactive"), NewString("Checkbox Inactive Color")); ColorPrototype.Set(LONGINT(088888880H));
  3105. NEW(ProtCBclInactive, ColorPrototype, NIL, NIL); plCheckbox.Add(ProtCBclInactive);
  3106. (* presentation *)
  3107. NEW(BooleanPrototype, NIL, NewString("UseBitmaps"), NewString("Have the Checkbox decorated by Images")); BooleanPrototype.Set(FALSE);
  3108. NEW(ProtCBUseImages, BooleanPrototype, NIL, NIL); plCheckbox.Add(ProtCBUseImages);
  3109. NEW(BooleanPrototype, NIL, NewString("ScaleBitmaps"), NewString("Have the Images scaled with the component siye")); BooleanPrototype.Set(FALSE);
  3110. NEW(ProtCBScaleImages, BooleanPrototype, NIL, NIL); plCheckbox.Add(ProtCBScaleImages);
  3111. (* Checkbox images *)
  3112. NEW(StringPrototype, NIL, NewString("ImgUnchecked"), NewString("Unchecked Image")); StringPrototype.SetAOC("");
  3113. NEW(ProtCBImgUncheckedN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgUncheckedN);
  3114. NEW(StringPrototype, NIL, NewString("ImgChecked"), NewString("Checked Image")); StringPrototype.SetAOC("");
  3115. NEW(ProtCBImgCheckedN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgCheckedN);
  3116. NEW(StringPrototype, NIL, NewString("ImgDefault"), NewString("3rd state Image")); StringPrototype.SetAOC("");
  3117. NEW(ProtCBImgDefaultN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgDefaultN);
  3118. NEW(StringPrototype, NIL, NewString("ImgUncheckedInactive"), NewString("Unchecked Inactive Image")); StringPrototype.SetAOC("");
  3119. NEW(ProtCBImgUncheckedInactiveN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgUncheckedInactiveN);
  3120. NEW(StringPrototype, NIL, NewString("ImgCheckedInactive"), NewString("Checked Inactive Image")); StringPrototype.SetAOC("");
  3121. NEW(ProtCBImgCheckedInactiveN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgCheckedInactiveN);
  3122. NEW(StringPrototype, NIL, NewString("ImgDefaultInactive"), NewString("3rd state Inactive Image")); StringPrototype.SetAOC("");
  3123. NEW(ProtCBImgDefaultInactiveN, StringPrototype, NIL, NIL); plCheckbox.Add(ProtCBImgDefaultInactiveN);
  3124. (* Group Panel *)
  3125. NEW(plGroupPanel); WMComponents.propertyListList.Add("GroupPanel", plGroupPanel);
  3126. NEW(ProtGPCaption, NIL, NewString("Caption"), NewString("caption text")); plGroupPanel.Add(ProtGPCaption);
  3127. NEW(ProtGPTextColor, NIL, NewString("TextColor"), NewString("Text color of group panel caption")); plGroupPanel.Add(ProtGPTextColor);
  3128. (* Image *)
  3129. NEW(PrototypeImageName, NIL, NewString("ImageName"), NewString("Name of image to be displayed"));
  3130. PrototypeImageName.Set(NIL);
  3131. NEW(PrototypeScaleImage, NIL, NewString("ScaleImage"), NewString("Scale image to fit size of component?"));
  3132. PrototypeScaleImage.Set(TRUE);
  3133. (* Image Panel *)
  3134. NEW(plImagePanel); WMComponents.propertyListList.Add("ImagePanel", plImagePanel);
  3135. NEW(ProtoIpImgName, NIL, NewString("Image"), NewString("Name of image to be displayed")); plImagePanel.Add(ProtoIpImgName);
  3136. NEW(PrototypeBlinking, NIL, NewString("Blinking"), NewString("Toggle Display of Component")); PrototypeBlinking.Set(FALSE);
  3137. NEW(PrototypeHorizontalFit, NIL, Strings.NewString("HorFit"), Strings.NewString("horiztonal fit")); PrototypeHorizontalFit.Set(TRUE);
  3138. NEW(PrototypeTextBorder, NIL, Strings.NewString("TextBorder"), Strings.NewString("inner text border")); PrototypeTextBorder.Set(1);
  3139. WMComponents.propertyListList.UpdateStyle
  3140. END InitPrototypes;
  3141. (** Generators *********************************************************************************)
  3142. PROCEDURE GenTimer*() : XML.Element;
  3143. VAR timer : Timer;
  3144. BEGIN NEW(timer); RETURN timer
  3145. END GenTimer;
  3146. PROCEDURE GenSystemCommand*() : XML.Element;
  3147. VAR systemCommand : SystemCommand;
  3148. BEGIN NEW(systemCommand); RETURN systemCommand
  3149. END GenSystemCommand;
  3150. PROCEDURE GenEvent*() : XML.Element;
  3151. VAR event : Event;
  3152. BEGIN NEW(event); RETURN event
  3153. END GenEvent;
  3154. PROCEDURE GenPanel*() : XML.Element;
  3155. VAR panel : Panel;
  3156. BEGIN NEW(panel); RETURN panel
  3157. END GenPanel;
  3158. (*
  3159. PROCEDURE GenDecoratorPanel*() : XML.Element;
  3160. VAR panel : DecoratorPanel;
  3161. BEGIN NEW(panel); RETURN panel
  3162. END GenDecoratorPanel;
  3163. *)
  3164. PROCEDURE GenLabel*() : XML.Element;
  3165. VAR label : Label;
  3166. BEGIN NEW(label); RETURN label
  3167. END GenLabel;
  3168. PROCEDURE GenButton*() : XML.Element;
  3169. VAR button : Button;
  3170. BEGIN NEW(button); RETURN button
  3171. END GenButton;
  3172. PROCEDURE GenScrollbar*() : XML.Element;
  3173. VAR scrollbar : Scrollbar;
  3174. BEGIN NEW(scrollbar); RETURN scrollbar
  3175. END GenScrollbar;
  3176. PROCEDURE GenSlider*() : XML.Element;
  3177. VAR slider : Slider;
  3178. BEGIN NEW(slider); RETURN slider;
  3179. END GenSlider;
  3180. PROCEDURE GenResizer*() : XML.Element;
  3181. VAR resizer : Resizer;
  3182. BEGIN NEW(resizer); RETURN resizer
  3183. END GenResizer;
  3184. PROCEDURE GenCheckbox*() : XML.Element;
  3185. VAR checkbox : Checkbox;
  3186. BEGIN NEW(checkbox); RETURN checkbox
  3187. END GenCheckbox;
  3188. PROCEDURE GenGroupPanel*() : XML.Element;
  3189. VAR groupPanel : GroupPanel;
  3190. BEGIN NEW(groupPanel); RETURN groupPanel
  3191. END GenGroupPanel;
  3192. PROCEDURE GenImage*() : XML.Element;
  3193. VAR image : Image;
  3194. BEGIN
  3195. NEW(image); RETURN image;
  3196. END GenImage;
  3197. PROCEDURE GenImagePanel*() : XML.Element;
  3198. VAR ip : ImagePanel;
  3199. BEGIN NEW(ip); RETURN ip
  3200. END GenImagePanel;
  3201. (**********************************************************************************************)
  3202. PROCEDURE FindLabel*(CONST uid : ARRAY OF CHAR; component : WMComponents.Component) : Label;
  3203. VAR c : WMComponents.Component;
  3204. BEGIN
  3205. ASSERT(component # NIL);
  3206. c := component.FindByUID(uid);
  3207. IF (c # NIL) & (c IS Label) THEN
  3208. RETURN c (Label);
  3209. ELSE
  3210. RETURN NIL;
  3211. END;
  3212. END FindLabel;
  3213. PROCEDURE FindButton*(CONST uid : ARRAY OF CHAR; component : WMComponents.Component) : Button;
  3214. VAR c : WMComponents.Component;
  3215. BEGIN
  3216. ASSERT(component # NIL);
  3217. c := component.FindByUID(uid);
  3218. IF (c # NIL) & (c IS Button) THEN
  3219. RETURN c (Button);
  3220. ELSE
  3221. RETURN NIL;
  3222. END;
  3223. END FindButton;
  3224. PROCEDURE FindCheckbox*(CONST uid : ARRAY OF CHAR; component : WMComponents.Component) : Checkbox;
  3225. VAR c : WMComponents.Component;
  3226. BEGIN
  3227. ASSERT(component # NIL);
  3228. c := component.FindByUID(uid);
  3229. IF (c # NIL) & (c IS Checkbox) THEN
  3230. RETURN c (Checkbox);
  3231. ELSE
  3232. RETURN NIL;
  3233. END;
  3234. END FindCheckbox;
  3235. PROCEDURE NewString*(CONST x : ARRAY OF CHAR) : String;
  3236. VAR t : String;
  3237. BEGIN
  3238. NEW(t, LEN(x)); COPY(x, t^); RETURN t
  3239. END NewString;
  3240. PROCEDURE Cleanup;
  3241. BEGIN
  3242. blinker.Finalize;
  3243. END Cleanup;
  3244. BEGIN
  3245. NEW(blinker);
  3246. Modules.InstallTermHandler(Cleanup);
  3247. manager := WMWindowManager.GetDefaultManager();
  3248. InitStrings;
  3249. InitPrototypes;
  3250. END WMStandardComponents.
  3251. Release.Rebuild WinAos WMStandardComponents.Mod ~