fltkgui.bmx 79 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152
  1. Strict
  2. Import MaxGUI.MaxGUI
  3. Import BRL.Graphics
  4. Import "fltkfonts.bmx"
  5. Import "fltksystem.bmx"
  6. Extern "C"
  7. Function bbStringToUTF8String:Byte Ptr ( str$ )
  8. EndExtern
  9. Private
  10. Include "fltkdecls.bmx"
  11. Global FLDriver:TFLTKGUIDriver = New TFLTKGuiDriver
  12. maxgui_driver = FLDriver
  13. Type TFLGuiSystemDriver Extends TFLSystemDriver
  14. Field gui:TFLTKGUIDriver
  15. Method Poll()
  16. gui.RefreshWidgets()
  17. flWait(0.0)
  18. gui.FreePointers()
  19. DispatchGuiEvents()
  20. End Method
  21. Method Wait()
  22. Poll()
  23. flWait(-1)
  24. End Method
  25. Function Create:TFLGuiSystemDriver(host:TFLTKGUIDriver)
  26. Local guisystem:TFLGuiSystemDriver = New TFLGuiSystemDriver
  27. guisystem.gui = host
  28. Return guisystem
  29. End Function
  30. End Type
  31. Public
  32. Type TFLTKGUIDriver Extends TMaxGUIDriver
  33. Global fntDefault:TFLGuiFont
  34. Field RefreshList:TList=New TList, PointerTrash:Byte Ptr[]
  35. Field fontRequester:TFLFontRequest
  36. ?Linux
  37. Function _FlushAsyncOpsProc( fd,data:Byte Ptr ) "C" nodebug
  38. bbSystemFlushAsyncOps
  39. End Function
  40. ?
  41. Method UserName$()
  42. End Method
  43. Method ComputerName$()
  44. End Method
  45. Method New()
  46. brl.System.Driver=TFLGuiSystemDriver.Create(Self)
  47. Local display
  48. ?Linux
  49. display = bbSystemDisplay()
  50. ?
  51. flReset(display,EventHandler,KeyFilter,TFLWidget.MouseHandler,TFLWidget.KeyHandler)
  52. ?Linux
  53. flAddFd( bbSystemAsyncFD(),FL_READ,_FlushAsyncOpsProc,Null )
  54. ?
  55. 'Initialize FLTK font handler after flReset() call.
  56. TFLFontFamily.Initialize()
  57. fntDefault = TFLGuiFont(LibraryFont( GUIFONT_SYSTEM, 0, FONT_NORMAL ))
  58. End Method
  59. Function EventHandler:Int(flevent) "C" nodebug
  60. Local key,state
  61. Local event:TEvent
  62. Select flevent
  63. Case FL_DND_RELEASE
  64. If TFLGadget.getDragDrop() Then flSetBelowMouse(TFLGadget.getDragDrop().WidgetHandle())
  65. Return 1
  66. Case FL_SHORTCUT
  67. key=flkeytovkey(flEventKey())
  68. state=flstatetomodifiers(flEventState())
  69. event=HotKeyEvent( key,state,flGetFocus() )
  70. If event Then
  71. event.emit()
  72. Return 1
  73. EndIf
  74. EndSelect
  75. End Function
  76. Function KeyFilter(obj:Int) "C" nodebug
  77. Local source:TFLWidget
  78. Local event:TEvent
  79. Local key,mods,text$,i
  80. source=TFLWidget(HandleToObject(obj))
  81. If flEventKey()=FL_KEY_Control_R Return 0
  82. If source And (source.eventfilter<>Null) Then
  83. key=BlitzKeyFromFlConst(flEventKey())
  84. text$=fleventtext()
  85. mods=flstatetomodifiers(flEventState())
  86. If key
  87. event=CreateEvent(EVENT_KEYDOWN,source,key,mods)
  88. If Not source.eventfilter(event,source.context) Then Return 0
  89. 'Unlike the other platforms, text isn't set by FLTK when combining tab with modifier keys
  90. If Not text And key = KEY_TAB Then text="~t"
  91. EndIf
  92. For i=0 Until text.length
  93. key=text[i]
  94. event=CreateEvent(EVENT_KEYCHAR,source,key,mods)
  95. If Not source.eventfilter(event,source.context) Then Return 0
  96. Next
  97. EndIf
  98. Return 1
  99. End Function
  100. Function BlitzKeyFromFlConst( pKey% )
  101. Select pKey
  102. Case FL_KEY_BackSpace;Return KEY_BACKSPACE
  103. Case FL_KEY_Tab;Return KEY_TAB
  104. Case FL_KEY_Enter;Return KEY_RETURN
  105. Case FL_KEY_Pause
  106. Case FL_KEY_Scroll_Lock
  107. Case FL_KEY_Escape;Return KEY_ESCAPE
  108. Case FL_KEY_Home;Return KEY_HOME
  109. Case FL_KEY_Left;Return KEY_LEFT
  110. Case FL_KEY_Up;Return KEY_UP
  111. Case FL_KEY_Right;Return KEY_RIGHT
  112. Case FL_KEY_Down;Return KEY_DOWN
  113. Case FL_KEY_Page_Up;Return KEY_PAGEUP
  114. Case FL_KEY_Page_Down;Return KEY_PAGEDOWN
  115. Case FL_KEY_End;Return KEY_END
  116. Case FL_KEY_Print;Return KEY_PRINT
  117. Case FL_KEY_Insert;Return KEY_INSERT
  118. Case FL_KEY_Menu
  119. Case FL_KEY_Help
  120. Case FL_KEY_Num_Lock
  121. Case FL_KEY_KP+0;Return KEY_NUM0
  122. Case FL_KEY_KP+1;Return KEY_NUM1
  123. Case FL_KEY_KP+2;Return KEY_NUM2
  124. Case FL_KEY_KP+3;Return KEY_NUM3
  125. Case FL_KEY_KP+4;Return KEY_NUM4
  126. Case FL_KEY_KP+5;Return KEY_NUM5
  127. Case FL_KEY_KP+6;Return KEY_NUM6
  128. Case FL_KEY_KP+7;Return KEY_NUM7
  129. Case FL_KEY_KP+8;Return KEY_NUM8
  130. Case FL_KEY_KP+9;Return KEY_NUM9
  131. Case FL_KEY_KP_Enter;Return KEY_ENTER
  132. Case FL_KEY_F+1;Return KEY_F1
  133. Case FL_KEY_F+2;Return KEY_F2
  134. Case FL_KEY_F+3;Return KEY_F3
  135. Case FL_KEY_F+4;Return KEY_F4
  136. Case FL_KEY_F+5;Return KEY_F5
  137. Case FL_KEY_F+6;Return KEY_F6
  138. Case FL_KEY_F+7;Return KEY_F7
  139. Case FL_KEY_F+8;Return KEY_F8
  140. Case FL_KEY_F+9;Return KEY_F9
  141. Case FL_KEY_F+10;Return KEY_F10
  142. Case FL_KEY_F+11;Return KEY_F11
  143. Case FL_KEY_F+12;Return KEY_F12
  144. Case FL_KEY_Shift_L;Return KEY_LSHIFT
  145. Case FL_KEY_Shift_R;Return KEY_RSHIFT
  146. Case FL_KEY_Control_L;Return KEY_LCONTROL
  147. Case FL_KEY_Control_R;Return KEY_RCONTROL
  148. Case FL_KEY_Caps_Lock
  149. Case FL_KEY_Meta_L;Return KEY_LSYS
  150. Case FL_KEY_Meta_R;Return KEY_RSYS
  151. Case FL_KEY_Alt_L;Return KEY_LALT
  152. Case FL_KEY_Alt_R;Return KEY_RALT
  153. Case FL_KEY_Delete;Return KEY_DELETE
  154. Default;Return flkeytovkey(pKey)
  155. EndSelect
  156. EndFunction
  157. Method RefreshWidget( widget:TFLWidget )
  158. RefreshList.AddLast widget
  159. End Method
  160. Method QueueFlDelete( pointer:Byte Ptr )
  161. PointerTrash:+[pointer]
  162. EndMethod
  163. Method RefreshWidgets()
  164. For Local w:TFLWidget = EachIn RefreshList
  165. w.Redraw()
  166. Next
  167. RefreshList.Clear()
  168. End Method
  169. Method FreePointers()
  170. For Local pointer:Byte Ptr = EachIn PointerTrash
  171. flDelete(pointer)
  172. Next
  173. PointerTrash = Null
  174. EndMethod
  175. Method CreateGadget:TGadget(class,name$,x,y,w,h,group:TGadget,style)
  176. Select class
  177. Case GADGET_DESKTOP
  178. Return New TFLDesktop.CreateDesktop()
  179. Case GADGET_WINDOW
  180. Return New TFLWindow.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  181. Case GADGET_PANEL
  182. Return New TFLPanel.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  183. Case GADGET_BUTTON
  184. Return New TFLButton.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  185. Case GADGET_TEXTFIELD
  186. Return New TFLTextField.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  187. Case GADGET_TEXTAREA
  188. Return New TFLTextArea.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  189. Case GADGET_COMBOBOX
  190. Return New TFLComboBox.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  191. Case GADGET_LISTBOX
  192. Return New TFLListBox.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  193. Case GADGET_TOOLBAR
  194. Return New TFLToolbar.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  195. Case GADGET_TABBER
  196. Return New TFLTabber.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  197. Case GADGET_TREEVIEW
  198. Return New TFLTreeview.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  199. Case GADGET_HTMLVIEW
  200. Return New TFLHTMLView.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  201. Case GADGET_LABEL
  202. Return New TFLLabel.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  203. Case GADGET_SLIDER
  204. Return New TFLSlider.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  205. Case GADGET_PROGBAR
  206. Return New TFLProgBar.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  207. Case GADGET_MENUITEM
  208. Return TFLMenu.CreateMenu(name,style,TFLMenu(group))
  209. Case GADGET_CANVAS
  210. Return New TFLCanvas.CreateGadget(name,x,y,w,h,TFLGadget(group),style)
  211. End Select
  212. End Method
  213. Method LoadFont:TGuiFont(name$,size,flags)
  214. Return TFLGUIFont.LoadFont(name,size,flags)
  215. End Method
  216. Method RequestColor( red,green,blue )
  217. Local r:Byte = red, g:Byte = green, b:Byte = blue
  218. If flChooseColor( "Choose Color", Varptr r, Varptr g, Varptr b )
  219. Return $ff000000 | (r Shl 16) | (g Shl 8) | b
  220. EndIf
  221. Return 0
  222. End Method
  223. Method RequestFont:TGuiFont(font:TGuiFont)
  224. If Not fontRequester Then fontRequester = New TFLFontRequest
  225. Return fontRequester.Request(TFLGUIFont(font))
  226. End Method
  227. Method SetPointer(shape)
  228. flSetCursor(shape)
  229. End Method
  230. Method ActiveGadget:TGadget()
  231. PollSystem
  232. Local handle:Int = flGetFocus()
  233. If handle Return TFLWidget(HandleToObject(flGetUser(handle)))
  234. End Method
  235. Method LoadIconStrip:TIconStrip(image:Object)
  236. Return TFLIconStrip.Create(image)
  237. End Method
  238. Method LookupColor( colorindex:Int, pRed:Byte Var, pGreen:Byte Var, pBlue:Byte Var )
  239. Select colorindex
  240. Case GUICOLOR_WINDOWBG
  241. colorindex = FL_BACKGROUND_COLOR
  242. Case GUICOLOR_GADGETBG
  243. colorindex = FL_BACKGROUND2_COLOR
  244. Case GUICOLOR_GADGETFG
  245. colorindex = FL_FOREGROUND_COLOR
  246. Case GUICOLOR_SELECTIONBG
  247. colorindex = FL_SELECTION_COLOR
  248. Default
  249. Return Super.LookupColor( colorindex, pRed, pGreen, pBlue )
  250. EndSelect
  251. Local color = flGetColor( colorindex )
  252. pRed = color Shr 24
  253. pGreen = (color Shr 16) & $FF
  254. pBlue = (color Shr 8) & $FF
  255. Return True
  256. EndMethod
  257. Method LibraryFont:TGuiFont( pFontType% = GUIFONT_SYSTEM, pFontSize:Double = 0, pFontStyle% = FONT_NORMAL )
  258. Local tmpFont:TGuiFont
  259. Local tmpFontAttrib%
  260. ?Win32
  261. If pFontSize <= 0 Then pFontSize = 10
  262. ?Not Win32
  263. If pFontSize <= 0 Then pFontSize = 12
  264. ?
  265. Select pFontType
  266. Case GUIFONT_MONOSPACED
  267. Return LoadFontWithDouble( TFLFontFamily.FriendlyNameFromID(FL_COURIER), pFontSize, pFontStyle )
  268. Case GUIFONT_SANSSERIF
  269. Return LoadFontWithDouble( TFLFontFamily.FriendlyNameFromID(FL_HELVETICA), pFontSize, pFontStyle )
  270. Case GUIFONT_SERIF
  271. Return LoadFontWithDouble( TFLFontFamily.FriendlyNameFromID(FL_TIMES), pFontSize, pFontStyle )
  272. Case GUIFONT_SCRIPT
  273. Return LoadFontWithDouble("Comic Sans MS",pFontSize,pFontStyle)
  274. Default 'GUIFONT_SYSTEM
  275. Return LoadFontWithDouble( TFLFontFamily.FriendlyNameFromID(FL_HELVETICA), pFontSize, pFontStyle )
  276. EndSelect
  277. EndMethod
  278. End Type
  279. Type TFLWidget Extends TGadget
  280. Global initText:Byte Ptr = " ".ToCString()
  281. Field fltype, flhandle, flkey, tag, tooltip:Byte Ptr
  282. Field originx, originy, client:TFLWidget, dirty, objhandle:Int = HandleFromObject(Self)
  283. Method CreateWidget:TFLWidget( fltype, text$, x, y, w, h, group:TFLWidget, alignment = -1, boxtype = -1 )
  284. Self.fltype = fltype
  285. SetRect(x,y,w,h)
  286. parent = group
  287. InitWidget()
  288. If alignment > -1 Then flSetAlign( flhandle, alignment )
  289. If boxtype > -1 Then flSetBox( flhandle, boxtype, False )
  290. If text Then SetText(text)
  291. Return Self
  292. EndMethod
  293. Method WidgetHandle()
  294. ?Debug
  295. Assert flhandle, "Attempt to access a NULL widget."
  296. ?
  297. Return flhandle
  298. EndMethod
  299. Method InitWidget()
  300. If TFLWidget(parent) Then flBegin( TFLWidget(parent).Query(QUERY_FLWIDGET_CLIENT) )
  301. flhandle = flWidget(AbsoluteX(),AbsoluteY(),width,height,initText,fltype)
  302. flSetCallback(WidgetHandle(),CallbackHandler,objhandle )
  303. If TFLWidget(parent) Then
  304. flEnd( TFLWidget(parent).Query(QUERY_FLWIDGET_CLIENT) )
  305. TFLWidget(parent).AddChild(Self)
  306. Else
  307. LockLayout()
  308. EndIf
  309. If flkey Then flSetButtonKey(WidgetHandle(),flkey)
  310. SetTooltip("")
  311. EndMethod
  312. Method Rethink()
  313. flSetArea(WidgetHandle(),AbsoluteX(),AbsoluteY(),width,height)
  314. End Method
  315. Method Redraw()
  316. If flhandle Then
  317. flRedraw(WidgetHandle())
  318. dirty = False
  319. EndIf
  320. End Method
  321. Method SetText(text$)
  322. Return flSetLabel(WidgetHandle(),text)
  323. End Method
  324. Method GetText$()
  325. Return flGetLabel(WidgetHandle())
  326. End Method
  327. Method SetToolTip(tip$)
  328. If tooltip Then MemFree tooltip
  329. tooltip = tip.ToCString()
  330. flSetToolTip(WidgetHandle(),tooltip)
  331. End Method
  332. Method GetToolTip$()
  333. If tooltip Then Return String.FromCString(tooltip)
  334. EndMethod
  335. Method SetShape(x,y,w,h)
  336. Super.SetShape x,y,w,h
  337. If parent parent.activate ACTIVATE_REDRAW
  338. End Method
  339. Method SetColor( r,g,b )
  340. flSetColor(WidgetHandle(),r,g,b)
  341. End Method
  342. Method RemoveColor()
  343. flRemoveColor(WidgetHandle())
  344. End Method
  345. Method SetTextColor( r,g,b )
  346. flSetLabelColor(WidgetHandle(),r,g,b)
  347. EndMethod
  348. Method SetShow(truefalse)
  349. flSetShow(WidgetHandle(),truefalse)
  350. End Method
  351. Method ClientWidth()
  352. Local w
  353. If client Then w=client.width Else w=width-originx
  354. Return Max(w,0)
  355. End Method
  356. Method ClientHeight()
  357. Local h
  358. If client Then h=client.height Else h=height-originy
  359. Return Max(h,0)
  360. End Method
  361. Method RemoveChild(child:TFLWidget)
  362. kids.remove child
  363. child.parent=Null
  364. If child.flhandle Then
  365. flRemoveFromGroup Query(QUERY_FLWIDGET_CLIENT),child.flhandle
  366. SetDirty()
  367. EndIf
  368. End Method
  369. Method AddChild(child:TFLWidget)
  370. If child.parent TFLWidget(child.parent).RemoveChild(child)
  371. child.parent=Self
  372. kids.addlast(child)
  373. If child.flhandle Then
  374. flAddToGroup Query(QUERY_FLWIDGET_CLIENT),child.flhandle
  375. SetDirty()
  376. EndIf
  377. child.LockLayout
  378. child.Rethink()
  379. End Method
  380. Method SetDirty()
  381. If Not dirty
  382. dirty=True
  383. FLDriver.RefreshWidget Self
  384. EndIf
  385. End Method
  386. Method Free()
  387. 'Cleanup any client gadget first.
  388. If client Then
  389. client.CleanUp()
  390. client = Null
  391. EndIf
  392. 'Then remove ourselves from our parent
  393. If TFLWidget(parent) Then TFLWidget(parent).RemoveChild(Self)
  394. 'And free our widget in the FLTK toolkit.
  395. If flhandle Then
  396. flSetCallBack( WidgetHandle(), CallbackHandler, 0 )
  397. If objhandle Then
  398. Release objhandle
  399. objhandle= 0
  400. EndIf
  401. If fltype=FL_WINDOW Then flDestroyWindow flhandle Else flFreeWidget flhandle
  402. EndIf
  403. 'Then any tooltip we may have.
  404. If tooltip Then
  405. MemFree tooltip
  406. tooltip = Null
  407. EndIf
  408. 'And clear the widget handle and parent.
  409. flhandle=0
  410. parent = Null
  411. EndMethod
  412. Method CountKids()
  413. Return kids.count()
  414. End Method
  415. Method SetOrigin(x,y)
  416. originx=x
  417. originy=y
  418. End Method
  419. Method AbsoluteX()
  420. Local p:TFLWidget = TFLWidget(parent)
  421. Local x = xpos
  422. While p
  423. x:+p.originx
  424. If p.client And Self <> p.client x:+p.client.xpos+p.client.originx
  425. If p.fltype<>FL_WINDOW x:+p.xpos Else Exit
  426. p=TFLWidget(p.parent)
  427. Wend
  428. Return x
  429. End Method
  430. Method AbsoluteY()
  431. Local p:TFLWidget = TFLWidget(parent)
  432. Local y = ypos
  433. While p
  434. y:+p.originy
  435. If p.client And Self <> p.client y:+p.client.ypos+p.client.originy
  436. If p.fltype<>FL_WINDOW y:+p.ypos Else Exit
  437. p=TFLWidget(p.parent)
  438. Wend
  439. Return y
  440. End Method
  441. Method Query(queryid)
  442. Select queryid
  443. Case QUERY_FLWIDGET
  444. Return flhandle
  445. Case QUERY_FLWIDGET_CLIENT
  446. If client Return client.flhandle Else Return flhandle
  447. End Select
  448. End Method
  449. Method OnCallback()
  450. EndMethod
  451. Method OnMouse:Int()
  452. EndMethod
  453. Method OnKey:Int()
  454. EndMethod
  455. Function CallbackHandler(flwidget,obj:Int) "C" nodebug
  456. Local widget:TFLWidget = TFLWidget(HandleToObject(obj))
  457. If widget Then widget.OnCallback()
  458. EndFunction
  459. Function MouseHandler:Int(flwidget,obj:Int) "C" nodebug
  460. Local widget:TFLWidget = TFLWidget(HandleToObject(obj))
  461. Select flEvent()
  462. Case FL_LEAVE
  463. If TFLGadget.activepanel Then
  464. TFLGadget.activepanel.OnMouseLeave()
  465. TFLGadget.activepanel = Null
  466. EndIf
  467. Case FL_RELEASE
  468. Local tmpButton:Int = flEventButton()
  469. Local tmpX:Int = flEventX(), tmpY:Int = flEventY()
  470. Local tmpDropWidget:TFLWidget = TFLWidget(HandleToObject(flUserData(flWidgetWindow(flwidget))))
  471. If tmpDropWidget Then tmpDropWidget = tmpDropWidget.FindChildAtCoords(tmpX,tmpY)
  472. If tmpDropWidget And tmpDropWidget.fltype <> FL_WINDOW Then
  473. tmpX:-tmpDropWidget.AbsoluteX()
  474. tmpY:-tmpDropWidget.AbsoluteY()
  475. EndIf
  476. If dragGadget[tmpButton-1] Then
  477. PostGuiEvent EVENT_GADGETDROP, tmpDropWidget, tmpButton, flStateToModifiers(flEventState()), tmpX, tmpY, dragGadget[tmpButton-1]
  478. dragGadget[tmpButton-1] = Null
  479. EndIf
  480. EndSelect
  481. If widget Then Return widget.OnMouse()
  482. EndFunction
  483. Function KeyHandler:Int(flwidget,obj:Int) "C" nodebug
  484. Local widget:TFLWidget = TFLWidget(HandleToObject(obj))
  485. If widget Then Return widget.OnKey()
  486. EndFunction
  487. Function XPMFromPixmap:String[](pPixmap:TPixmap)
  488. Const charRange:Int = 26
  489. Local x:Int, y:Int, i:Int, j:Int, tmpColor:Int, chrctsPerPixel:Int, tmpString$
  490. Local width:Int = PixmapWidth(pPixmap), height:Int = PixmapHeight(pPixmap)
  491. Local colormap:Int[][] = New Int[][height], colors:Int[], colorstrings:String[]
  492. For y = 0 Until height
  493. colormap[y] = New Int[width]
  494. For x = 0 Until width
  495. 'Read color from pixel
  496. tmpColor = ReadPixel(pPixmap,x,y)
  497. 'If less than 50% alpha, set a standard transparent color.
  498. If (tmpColor Shr 24) < $80 Then tmpColor = $00000000
  499. 'Find the color if it has been used before.
  500. For i = 0 Until colors.length
  501. If colors[i] = tmpColor Then Exit
  502. Next
  503. 'If it hasn't been found, add it to the end of the array.
  504. If i = colors.length Then colors:+[tmpColor]
  505. 'And finally, update the colormap with the color index.
  506. colormap[y][x] = i
  507. Next
  508. Next
  509. chrctsPerPixel = (colors.length / charRange) + 1
  510. colorstrings = New String[colors.length]
  511. Local tmpResult:String[] = [width + " " + height + " " + colors.length + " " + chrctsPerPixel]
  512. For i = 0 Until colors.length
  513. Local tmpI:Int = i
  514. For j = 0 Until chrctsPerPixel
  515. colorstrings[i]:+Chr$("a"[0]+(tmpI Mod charRange))
  516. tmpI:/charRange
  517. Next
  518. tmpString = colorstrings[i] + "~tc "
  519. If (colors[i] Shr 24) <> $FF Then tmpString:+"None" Else tmpString:+"#"+_RGBHex(colors[i]&$FFFFFF)
  520. tmpResult:+[tmpString]
  521. Next
  522. For y = 0 Until height
  523. tmpString = ""
  524. For x = 0 Until width
  525. tmpString:+colorstrings[colormap[y][x]]
  526. Next
  527. tmpResult:+[tmpString]
  528. Next
  529. Return tmpResult
  530. EndFunction
  531. Function _RGBHex$( rgb:Int )
  532. Local buf:Short[6]
  533. For Local k:Int=5 To 0 Step -1
  534. Local n:Int=(rgb&15)+Asc("0")
  535. If n>Asc("9") n=n+(Asc("A")-Asc("9")-1)
  536. buf[k]=n
  537. rgb:Shr 4
  538. Next
  539. Return String.FromShorts( buf,buf.length )
  540. End Function
  541. Method FindChildAtCoords:TFLWidget( pX, pY )
  542. If pX > 0 And pX < ClientWidth() And pY > 0 And pY < ClientHeight() Then
  543. For Local tmpChild:TFLWidget = EachIn kids
  544. tmpChild = tmpChild.FindChildAtCoords( pX - tmpChild.xpos, pY - tmpChild.ypos)
  545. If tmpChild Then Return tmpChild
  546. Next
  547. Return Self
  548. EndIf
  549. EndMethod
  550. EndType
  551. Type TFLGadget Extends TFLWidget
  552. Global activepanel:TFLGadget
  553. Global activex, activey, activekey
  554. Field menu:TFLMenu
  555. Field enabled = True, ignore
  556. Field font:TFLGUIFont
  557. Field pixmap:TPixmap, pixmapflags, image, icons:TFLIconStrip
  558. Method CreateGadget:TFLGadget(pText$, pX, pY, pW, pH, pGroup:TFLGadget, pStyle)
  559. style = pStyle
  560. SetRect(pX,pY,pW,pH)
  561. parent = pGroup
  562. InitGadget()
  563. If (LocalizationMode() & LOCALIZATION_OVERRIDE) Then
  564. LocalizeGadget(Self,pText)
  565. Else
  566. SetText(pText)
  567. EndIf
  568. SetFont(TFLTKGUIDriver.fntDefault)
  569. Return Self
  570. EndMethod
  571. Method InitGadget()
  572. EndMethod
  573. Method SetHotKey(keycode,modifier)
  574. Local flkey
  575. flkey=flkeyfromvkey(keycode)
  576. If flkey flkey:+flstatefrommodifiers(modifier)
  577. End Method
  578. Method SetEnabled(truefalse)
  579. enabled=truefalse
  580. flSetActive WidgetHandle(),truefalse
  581. End Method
  582. Method SetFont( font:TGuiFont )
  583. Self.font = TFLGUIFont(font)
  584. flSetLabelFont WidgetHandle(),Self.font.handle
  585. flSetLabelSize WidgetHandle(),Self.font.GetSizeForFL()
  586. SetText(GetText())
  587. Redraw()
  588. End Method
  589. Method SetText(text$)
  590. Super.SetText(text.Replace("@","@@"))
  591. EndMethod
  592. Method GetText$()
  593. Return Super.GetText().Replace("@@","@")
  594. EndMethod
  595. Method State()
  596. Local flags
  597. If Not enabled Then flags:|STATE_DISABLED
  598. If Not flVisible(WidgetHandle()) flags:|STATE_HIDDEN
  599. Return flags
  600. End Method
  601. Method Activate(cmd)
  602. Select cmd
  603. Case ACTIVATE_FOCUS
  604. flSetFocus(WidgetHandle())
  605. PollSystem
  606. Case ACTIVATE_REDRAW
  607. Redraw
  608. End Select
  609. End Method
  610. Method SetPixmap(pPixmap:TPixmap,flags)
  611. Local d
  612. SetFLImage 0
  613. If pixmap And image Then
  614. flFreeImage( image )
  615. image = 0
  616. EndIf
  617. pixmap = Null
  618. If pPixmap Then
  619. Select PixmapFormat(pPixmap)
  620. Case PF_RGB888, PF_BGR888, PF_I8
  621. d = 3
  622. pixmap = ConvertPixmap(pPixmap,PF_RGB888)
  623. Case PF_RGBA8888, PF_BGRA8888, PF_A8
  624. d = 4
  625. pixmap = ConvertPixmap(pPixmap,PF_RGBA8888)
  626. Default
  627. Return
  628. EndSelect
  629. If pixmap Then
  630. image = flImage(pixmap.pixels,pixmap.width,pixmap.height,d,pixmap.pitch)
  631. EndIf
  632. EndIf
  633. pixmapflags = flags
  634. SetFLImage image
  635. End Method
  636. Method SetFLImage(image)
  637. End Method
  638. Method SetIconStrip(iconstrip:TIconStrip)
  639. icons=TFLIconStrip(iconstrip)
  640. End Method
  641. Method ClearListItems()
  642. For Local i=items.length-1 To 0 Step -1
  643. RemoveListItem i
  644. Next
  645. End Method
  646. Method Free()
  647. Super.Free()
  648. pixmap = Null
  649. icons = Null
  650. If image Then flFreeImage(image);image = 0
  651. End Method
  652. Method GetMenu:TFLMenu()
  653. If Not menu Then
  654. menu = New TFLMenu
  655. menu.owner = Self
  656. EndIf
  657. Return menu
  658. End Method
  659. Method OnMouse:Int()
  660. Local x = flEventX()-AbsoluteX(), y = flEventY()-AbsoluteY()
  661. If activepanel And (activepanel<>Self) Then
  662. activepanel.OnMouseLeave()
  663. activepanel = Null
  664. EndIf
  665. If GetSensitivity() & SENSITIZE_MOUSE Then
  666. Select flevent()
  667. Case FL_DRAG, FL_MOVE
  668. Local data, state=flEventState()
  669. If state&FL_BUTTON1 data=MOUSE_LEFT
  670. If state&FL_BUTTON3 data=MOUSE_RIGHT
  671. If state&FL_BUTTON2 data=MOUSE_MIDDLE
  672. If (activepanel <> Self) Then
  673. PostGuiEvent(EVENT_MOUSEENTER,Self,data,0,x,y)
  674. activepanel=Self
  675. Else
  676. If (x <> activex) Or (y <> activey) Then
  677. PostGuiEvent(EVENT_MOUSEMOVE,Self,data,0,x,y)
  678. EndIf
  679. EndIf
  680. activex=x;activey=y
  681. Case FL_PUSH, FL_RELEASE
  682. Local data, button=flEventButton(), id = EVENT_MOUSEDOWN
  683. Select button
  684. Case FL_LEFT_MOUSE data=MOUSE_LEFT
  685. Case FL_RIGHT_MOUSE data=MOUSE_RIGHT
  686. Case FL_MIDDLE_MOUSE data=MOUSE_MIDDLE
  687. EndSelect
  688. If flEvent() = FL_RELEASE Then id = EVENT_MOUSEUP
  689. PostGuiEvent(id,Self,data,0,x,y)
  690. Case FL_MOUSEWHEEL
  691. PostGuiEvent(EVENT_MOUSEWHEEL,Self,flEventdY(),0,x,y)
  692. EndSelect
  693. Return 1
  694. EndIf
  695. EndMethod
  696. Method OnMouseLeave()
  697. If GetSensitivity() & SENSITIZE_MOUSE Then
  698. PostGuiEvent(EVENT_MOUSELEAVE,Self,0,0,activex,activey)
  699. EndIf
  700. EndMethod
  701. Method OnKey:Int()
  702. Local key, mods
  703. If GetSensitivity() & SENSITIZE_KEYS Then
  704. Select flevent()
  705. Case FL_KEYDOWN
  706. key=TFLTKGUIDriver.BlitzKeyFromFlConst(flEventKey())
  707. mods=flstatetomodifiers(flEventState())
  708. If activekey=key
  709. PostGuiEvent(EVENT_KEYREPEAT,Self,key,mods)
  710. Else
  711. PostGuiEvent(EVENT_KEYDOWN,Self,key,mods)
  712. EndIf
  713. activekey=key
  714. Case FL_KEYUP
  715. key=TFLTKGUIDriver.BlitzKeyFromFlConst(flEventKey())
  716. mods=flstatetomodifiers(flEventState())
  717. PostGuiEvent(EVENT_KEYUP,Self,key,mods)
  718. activekey=0
  719. EndSelect
  720. EndIf
  721. EndMethod
  722. 'For WINDOW_ACCEPTFILES drag n' drop event.
  723. Global _dragDrop:TFLGadget = Null
  724. Function setDragDrop( pGadget:TFLGadget )
  725. _dragDrop = pGadget
  726. EndFunction
  727. Function getDragDrop:TFLGadget()
  728. Return _dragDrop
  729. EndFunction
  730. EndType
  731. Type TFLDesktop Extends TFLGadget
  732. Method Class()
  733. Return GADGET_DESKTOP
  734. EndMethod
  735. Method InitGadget()
  736. Local x, y, w, h
  737. flDisplayRect( Varptr x, Varptr y, Varptr w, Varptr h )
  738. SetRect( x, y, w, h )
  739. EndMethod
  740. Method CreateDesktop:TFLGadget()
  741. InitGadget()
  742. Return Self
  743. EndMethod
  744. EndType
  745. Type TFLWindow Extends TFLGadget
  746. Const MENU_HEIGHT = 25, STATUSBAR_HEIGHT = 22
  747. Global lastactivewindow:TFLWindow
  748. Field menubar:TFLWidget, statustext:TFLGadget[3]
  749. Method InitGadget()
  750. Local tmpParent:TGadget = parent;parent = Null
  751. fltype = FL_WINDOW
  752. InitWidget()
  753. If Not (style&WINDOW_TITLEBAR) Then flClearBorder(WidgetHandle())
  754. CreateWindowClient()
  755. If tmpParent Then
  756. flSetNonModal(WidgetHandle())
  757. parent = tmpParent
  758. EndIf
  759. Rethink()
  760. If Not (style&WINDOW_HIDDEN) Then SetShow(True) Else SetShow(False)
  761. EndMethod
  762. Method Class()
  763. Return GADGET_WINDOW
  764. EndMethod
  765. Method SetText(text$)
  766. flSetWindowLabel(WidgetHandle(),text)
  767. End Method
  768. Method SetColor(r,g,b)
  769. Super.SetColor(r,g,b)
  770. client.SetColor(r,g,b)
  771. EndMethod
  772. Method Activate(cmd)
  773. Select cmd
  774. Case ACTIVATE_MINIMIZE
  775. flShowWindow WidgetHandle(), 2
  776. Case ACTIVATE_MAXIMIZE
  777. flShowWindow WidgetHandle(), 3
  778. LayoutKids()
  779. Case ACTIVATE_RESTORE
  780. flShowWindow WidgetHandle(), 4
  781. LayoutKids()
  782. Default
  783. Super.Activate(cmd)
  784. End Select
  785. End Method
  786. Method SetShow(truefalse)
  787. flShowWindow(WidgetHandle(),truefalse=True)
  788. End Method
  789. Method SetEnabled(truefalse)
  790. Super.SetEnabled(truefalse)
  791. If client Then flSetActive client.WidgetHandle(),truefalse
  792. If menubar Then flSetActive menubar.WidgetHandle(),truefalse
  793. End Method
  794. Method OnCallback()
  795. Select flevent()
  796. Case FL_CLOSE
  797. PostGuiEvent EVENT_WINDOWCLOSE,Self
  798. Case FL_FOCUS, FL_ACTIVATE
  799. If lastactivewindow <> Self Then
  800. lastactivewindow = Self
  801. PostGuiEvent EVENT_WINDOWACTIVATE,Self
  802. EndIf
  803. 'Drag 'n' drop events
  804. Case FL_DND_ENTER
  805. setDragDrop(Self)
  806. Case FL_DND_LEAVE
  807. setDragDrop(Null)
  808. Case FL_PASTE
  809. DropFiles()
  810. setDragDrop(Null)
  811. Default
  812. Local ax,ay,aw,ah,move,size
  813. flGetArea WidgetHandle(),Varptr ax,Varptr ay,Varptr aw,Varptr ah
  814. If (style&WINDOW_CLIENTCOORDS) Then
  815. ax:+originX;ay:+originY
  816. aw:-originX;ah:-originY
  817. If (style&WINDOW_MENU) Then
  818. ay:+MENU_HEIGHT
  819. ah:-MENU_HEIGHT
  820. EndIf
  821. If (style&WINDOW_STATUS) Then ah:-STATUSBAR_HEIGHT
  822. EndIf
  823. If ax<>xpos Or ay<>ypos move=True
  824. If aw<>width Or ah<>height size=True
  825. SetRect ax,ay,aw,ah
  826. If size RethinkWindow()
  827. If move PostGuiEvent(EVENT_WINDOWMOVE,Self,0,0,ax,ay)
  828. If size PostGuiEvent(EVENT_WINDOWSIZE,Self,0,0,aw,ah)
  829. End Select
  830. EndMethod
  831. Method CreateWindowClient()
  832. If style&WINDOW_RESIZABLE Then SetMinimumSize(64,64)
  833. If style&WINDOW_ACCEPTFILES Then flSetAcceptsFiles( WidgetHandle(), True )
  834. If style&WINDOW_MENU
  835. menubar = New TFLWidget.CreateWidget( FL_MENUBAR, "", -2, 0, width+4, MENU_HEIGHT, Self, -1, FL_THIN_UP_BOX )
  836. kids.Remove(menubar)
  837. EndIf
  838. If style&WINDOW_STATUS
  839. statustext[2] = New TFLLabel.CreateGadget("",0,height-STATUSBAR_HEIGHT,width,STATUSBAR_HEIGHT,Self,LABEL_RIGHT)
  840. statustext[1] = New TFLLabel.CreateGadget("",0,height-STATUSBAR_HEIGHT,width,STATUSBAR_HEIGHT,Self,LABEL_CENTER)
  841. statustext[0] = New TFLLabel.CreateGadget("",0,height-STATUSBAR_HEIGHT,width,STATUSBAR_HEIGHT,Self,LABEL_LEFT)
  842. For Local tmpStatusText:TFLGadget = EachIn statustext
  843. If tmpStatusText = statustext[2] Then flSetBox( tmpStatusText.WidgetHandle(), FL_EMBOSSED_BOX, False ) Else flSetBox( tmpStatusText.WidgetHandle(), FL_NO_BOX,False )
  844. flSetAlign( tmpStatusText.WidgetHandle(), flAlign(tmpStatusText.WidgetHandle())&~FL_ALIGN_WRAP );kids.Remove(tmpStatusText)
  845. Next
  846. EndIf
  847. client=New TFLPanel.CreateGadget("",0,0,1,1,Self,0)
  848. RemoveChild(client);client.parent = Self
  849. RethinkWindow()
  850. End Method
  851. Method Rethink()
  852. Local tmpX:Int = AbsoluteX(), tmpY:Int = AbsoluteY(), tmpW:Int = width, tmpH:Int = height
  853. If (style&WINDOW_CLIENTCOORDS) Then
  854. tmpX:-originX;tmpY:-originY
  855. tmpW:+originX;tmpH:+originY
  856. If (style&WINDOW_MENU) Then
  857. tmpY:-MENU_HEIGHT
  858. tmpH:+MENU_HEIGHT
  859. EndIf
  860. If (style&WINDOW_STATUS) Then tmpH:+STATUSBAR_HEIGHT
  861. EndIf
  862. flSetArea(WidgetHandle(),tmpX,tmpY,tmpW,tmpH)
  863. RethinkWindow()
  864. EndMethod
  865. Method RethinkWindow()
  866. Local x,y,w=width,h=height
  867. If menubar Then flSetArea(menubar.WidgetHandle(),-2,0,w+4,MENU_HEIGHT);h:-MENU_HEIGHT;y:+MENU_HEIGHT
  868. If statustext[0] Then
  869. If Not (style&WINDOW_CLIENTCOORDS) Then h:-STATUSBAR_HEIGHT
  870. For Local tmpStatusText:TFLWidget = EachIn statustext;flSetArea(tmpStatusText.WidgetHandle(),0,y+originY+ClientHeight(),w,STATUSBAR_HEIGHT);Next
  871. EndIf
  872. client.SetArea x,y,ClientWidth(),ClientHeight()
  873. LayoutKids()
  874. End Method
  875. Method DoLayout()
  876. 'Don't do anything!
  877. EndMethod
  878. Method GetStatusText$()
  879. If statustext[0] Then
  880. Return "~t".Join([statustext[0].GetText(), statustext[1].GetText(), statustext[2].GetText()])
  881. EndIf
  882. EndMethod
  883. Method SetStatusText(text$)
  884. If statustext[0] Then
  885. Local tmpAlignments$[] = text.Split("~t")
  886. If tmpAlignments.length > 3 Then tmpAlignments = [tmpAlignments[0], tmpAlignments[1], "~t".Join(tmpAlignments[2..])]
  887. tmpAlignments = tmpAlignments[..3]
  888. For Local i = 0 Until 3
  889. statustext[i].SetText( tmpAlignments[i] )
  890. Next
  891. EndIf
  892. End Method
  893. Method ClientWidth()
  894. If (style&WINDOW_CLIENTCOORDS) Then Return width Else Return (width-originx)
  895. EndMethod
  896. Method ClientHeight()
  897. Local h:Int = height
  898. If Not(style&WINDOW_CLIENTCOORDS) Then
  899. h:-originY
  900. If menubar Then h:-MENU_HEIGHT
  901. If statustext[0] Then h:-STATUSBAR_HEIGHT
  902. EndIf
  903. Return h
  904. EndMethod
  905. Method SetMaximumSize( w,h )
  906. flSetMaxWindowSize(WidgetHandle(),w,h)
  907. End Method
  908. Method SetMinimumSize( w,h )
  909. flSetMinWindowSize(WidgetHandle(),w,h)
  910. End Method
  911. Method UpdateMenu()
  912. Local count,flmenu Ptr
  913. If Not (menubar And menu) Return
  914. count=menu.count(-1)
  915. flmenu=flCreateMenu(count+2,CallbackHandler)
  916. menu.setflmenu(flmenu)
  917. flSetMenu(menubar.WidgetHandle(),flmenu)
  918. End Method
  919. Method PopupMenu( menu0:TGadget,extra:Object )
  920. Local menu:TFLMenu
  921. Local count,flmenu Ptr
  922. menu=TFLMenu(menu0)
  923. count=menu.count(-1)
  924. flmenu=flCreateMenu(count+2,CallbackHandler)
  925. menu.setflmenu(flmenu)
  926. menu=TFLMenu(HandleToObject(flPopupMenu(flmenu)))
  927. If menu PostGuiEvent(EVENT_MENUACTION,menu,menu.tag,0,0,0,extra)
  928. End Method
  929. Method SetPixmap(pPixmap:TPixmap, pFlags)
  930. ?Linux
  931. If (pFlags&GADGETPIXMAP_ICON) Then
  932. 'Generate the strings which represent the pixmap in XPM format.
  933. Local tmpXPM$[] = XPMFromPixmap(pPixmap)
  934. 'Create a new array of char* pointers to pass to flSetWindowIcon().
  935. '+1 is for terminating Null pointer.
  936. Local tmpStringPointers:Byte Ptr[tmpXPM.length+1]
  937. 'Store char* pointers for each section inside the array.
  938. For Local i:Int = 0 Until tmpXPM.length
  939. tmpStringPointers[i] = tmpXPM[i].ToCString()
  940. Next
  941. 'And end the array with a Null pointer.
  942. tmpStringPointers[tmpXPM.length] = Null
  943. 'Set the window icon.
  944. flSetWindowIcon( WidgetHandle(), tmpStringPointers )
  945. 'And then free all the char* pointers before we exit. We only need
  946. 'to iterate through tmpXPM.length as tmpStringPointers.length will
  947. 'include the terminating Null pointer array element.
  948. For Local i:Int = 0 Until tmpXPM.length
  949. MemFree tmpStringPointers[i]
  950. Next
  951. EndIf
  952. ?
  953. EndMethod
  954. Method DropFiles()
  955. For Local tmpUrl$ = EachIn flEventText().Replace("file://","").Replace("~r","").Split("~n")
  956. If tmpUrl[..8].ToLower() = "https://" Then Continue
  957. If tmpUrl[..7].ToLower() = "http://" Then Continue
  958. If tmpUrl[..6].ToLower() = "ftp://" Then Continue
  959. tmpURL = DecodeURL(tmpURL)
  960. If Not tmpURL Then Continue
  961. 'Creating and manipulating widgets inside an FL_PASTE event is considered dangerous.
  962. 'Therefore we should queue this event so that it's dispatched safely after a call to
  963. 'Poll/WaitSystem().
  964. QueueGuiEvent(EVENT_WINDOWACCEPT,Self,0,0,0,0,tmpURL)
  965. Next
  966. End Method
  967. 'http://www.blitzbasic.com/codearcs/codearcs.php?code=1581
  968. Function DecodeURL:String(EncStr:String)
  969. Local Pos:Int = 0
  970. Local HexVal:String
  971. Local Result:String
  972. While Pos < EncStr.length
  973. If EncStr[Pos..Pos+1] = "%" Then
  974. HexVal = EncStr[Pos+1..Pos+3]
  975. Result :+ Chr(Int("$"+HexVal))
  976. Pos:+3
  977. ElseIf EncStr[Pos..Pos+1] = "+" Then
  978. Result :+ " "
  979. Pos:+1
  980. Else
  981. Result :+ EncStr[Pos..Pos+1]
  982. Pos:+1
  983. EndIf
  984. Wend
  985. Return Result
  986. End Function
  987. EndType
  988. Type TFLLabel Extends TFLGadget
  989. Method InitGadget()
  990. fltype=FL_BOX
  991. InitWidget()
  992. Local tmpAlignment = FL_ALIGN_WRAP|FL_ALIGN_INSIDE|FL_ALIGN_CLIP
  993. Select style&24
  994. Case LABEL_LEFT tmpAlignment:|FL_ALIGN_LEFT
  995. Case LABEL_CENTER tmpAlignment:|FL_ALIGN_CENTER
  996. Case LABEL_RIGHT tmpAlignment:|FL_ALIGN_RIGHT
  997. EndSelect
  998. flSetAlign WidgetHandle(),tmpAlignment
  999. Local tmpBox
  1000. Select style&7
  1001. Case 0 tmpBox = FL_NO_BOX
  1002. Case LABEL_FRAME tmpBox = FL_BORDER_BOX
  1003. Case LABEL_SUNKENFRAME tmpBox = FL_THIN_DOWN_FRAME
  1004. Case LABEL_SEPARATOR tmpBox = FL_EMBOSSED_FRAME
  1005. End Select
  1006. flSetBox WidgetHandle(),tmpBox,False
  1007. EndMethod
  1008. Method Class()
  1009. Return GADGET_LABEL
  1010. EndMethod
  1011. Method SetColor( r, g, b )
  1012. Local tmpBox = FL_FLAT_BOX
  1013. Select style&7
  1014. Case LABEL_FRAME tmpBox = FL_BORDER_BOX
  1015. Case LABEL_SUNKENFRAME tmpBox = FL_THIN_DOWN_BOX
  1016. Case LABEL_SEPARATOR tmpBox = FL_EMBOSSED_BOX
  1017. End Select
  1018. flSetBox WidgetHandle(),tmpBox,False
  1019. Super.SetColor( r, g, b )
  1020. EndMethod
  1021. Method SetText(text$)
  1022. Super.SetText(text)
  1023. Redraw()
  1024. EndMethod
  1025. Method SetRect(x,y,w,h)
  1026. If style&LABEL_SEPARATOR = LABEL_SEPARATOR Then
  1027. If w > h Then h = 2 Else w = 2
  1028. EndIf
  1029. Super.SetRect(x,y,w,h)
  1030. EndMethod
  1031. EndType
  1032. Type TFLButton Extends TFLGadget
  1033. Method InitGadget()
  1034. Local tmpAlignment = FL_ALIGN_INSIDE|FL_ALIGN_CLIP|FL_ALIGN_WRAP|FL_ALIGN_CENTER
  1035. fltype = FL_BUTTON
  1036. Select style&7
  1037. Case 0
  1038. style = BUTTON_PUSH
  1039. Case BUTTON_CHECKBOX
  1040. If (style&BUTTON_PUSH) Then
  1041. fltype = FL_TOGGLEBUTTON
  1042. Else
  1043. fltype=FL_CHECKBUTTON
  1044. tmpAlignment:&~FL_ALIGN_CENTER
  1045. tmpAlignment:|FL_ALIGN_LEFT
  1046. EndIf
  1047. Case BUTTON_RADIO
  1048. If (style&BUTTON_PUSH) Then
  1049. fltype = FL_RADIOPUSHBUTTON
  1050. Else
  1051. fltype=FL_ROUNDBUTTON
  1052. tmpAlignment:&~FL_ALIGN_CENTER
  1053. tmpAlignment:|FL_ALIGN_LEFT
  1054. EndIf
  1055. Case BUTTON_OK
  1056. fltype=FL_RETURNBUTTON
  1057. Case BUTTON_CANCEL
  1058. flkey=FL_KEY_ESCAPE
  1059. End Select
  1060. InitWidget()
  1061. flSetAlign WidgetHandle(), tmpAlignment
  1062. flSetWhen WidgetHandle(), FL_WHEN_RELEASE
  1063. EndMethod
  1064. Method Class()
  1065. Return GADGET_BUTTON
  1066. EndMethod
  1067. Method State()
  1068. Local flags = Super.State()
  1069. If flGetButton(WidgetHandle()) Then flags:|STATE_SELECTED
  1070. Return flags
  1071. End Method
  1072. Field currentText$
  1073. Method SetText(text$)
  1074. currentText = text
  1075. If Not (pixmapflags&GADGETPIXMAP_NOTEXT) Then Super.SetText(text)
  1076. EndMethod
  1077. Method GetText$()
  1078. Return currentText
  1079. EndMethod
  1080. Method SetFLImage(image)
  1081. If Not (pixmapflags&GADGETPIXMAP_NOTEXT) Then Super.SetText(currentText)
  1082. If (pixmapflags&GADGETPIXMAP_ICON) And( (Not (style&7)) Or (style&7=BUTTON_CANCEL)) Then
  1083. If (pixmapflags&GADGETPIXMAP_NOTEXT) Then Super.SetText("")
  1084. flSetImage(WidgetHandle(),image)
  1085. EndIf
  1086. End Method
  1087. Method SetSelected(bool)
  1088. If bool And (style&7=BUTTON_RADIO) Then ExcludeOthers()
  1089. flSetButton WidgetHandle(),bool
  1090. End Method
  1091. Method SetHotKey(keycode,modifier)
  1092. Super.SetHotKey(keycode,modifier)
  1093. flSetButtonKey WidgetHandle(),flkey
  1094. EndMethod
  1095. Method OnCallback()
  1096. If (style&7=BUTTON_RADIO) Then SetButtonState(Self,STATE_SELECTED)
  1097. PostGuiEvent(EVENT_GADGETACTION,Self,State())
  1098. EndMethod
  1099. Method ExcludeOthers()
  1100. Local w:TFLWidget
  1101. For w=EachIn parent.kids
  1102. If w<>Self And (w.fltype=FL_ROUNDBUTTON Or w.fltype=FL_RADIOPUSHBUTTON)
  1103. flSetButton w.WidgetHandle(),False
  1104. EndIf
  1105. Next
  1106. End Method
  1107. EndType
  1108. Type TFLTextField Extends TFLGadget
  1109. Method InitGadget()
  1110. If (style&TEXTFIELD_PASSWORD) Then fltype=FL_PASSWORD Else fltype=FL_INPUT
  1111. InitWidget()
  1112. flSetWhen( WidgetHandle(), FL_WHEN_CHANGED|FL_WHEN_RELEASE_ALWAYS)
  1113. EndMethod
  1114. Method Class()
  1115. Return GADGET_TEXTFIELD
  1116. EndMethod
  1117. Method GetText$()
  1118. Return flGetInput(WidgetHandle())
  1119. End Method
  1120. Method SetText(text$)
  1121. flSetInput(WidgetHandle(),text)
  1122. End Method
  1123. Method SetFont(font:TGuiFont)
  1124. Super.SetFont(font)
  1125. flSetInputFont WidgetHandle(),Self.font.handle
  1126. flSetInputSize WidgetHandle(),Self.font.GetSizeForFL()
  1127. EndMethod
  1128. Method Activate(cmd)
  1129. Select cmd
  1130. Case ACTIVATE_FOCUS
  1131. Super.Activate(cmd)
  1132. flActivateInput(WidgetHandle())
  1133. Default
  1134. Super.Activate(cmd)
  1135. End Select
  1136. End Method
  1137. Method OnCallback()
  1138. If flChanged(WidgetHandle()) Then
  1139. PostGuiEvent(EVENT_GADGETACTION,Self)
  1140. flClearChanged(WidgetHandle())
  1141. EndIf
  1142. Select flevent()
  1143. Case FL_UNFOCUS
  1144. PostGuiEvent(EVENT_GADGETLOSTFOCUS,Self)
  1145. End Select
  1146. EndMethod
  1147. EndType
  1148. Type TFLTextArea Extends TFLGadget
  1149. Field textr,textg,textb
  1150. Field locked,lockedpos,lockedlen
  1151. Method InitGadget()
  1152. If (style&TEXTAREA_READONLY) Then fltype=FL_TEXTDISPLAY Else fltype=FL_TEXTEDITOR
  1153. InitWidget()
  1154. flSetBox(WidgetHandle(),FL_THIN_DOWN_BOX,False)
  1155. If (style&TEXTAREA_WORDWRAP) Then flSetWrapMode( WidgetHandle(), True, 0 )
  1156. flSetTextCallback(WidgetHandle(),EditHandler,objhandle)
  1157. EndMethod
  1158. Method Class()
  1159. Return GADGET_TEXTAREA
  1160. EndMethod
  1161. Method GetText$()
  1162. Return AreaText(0,-1,TEXTAREA_CHARS)
  1163. End Method
  1164. Method SetText(text$)
  1165. ReplaceText(0,-1,text,TEXTAREA_CHARS)
  1166. End Method
  1167. Method Activate(cmd)
  1168. Select cmd
  1169. Case ACTIVATE_FOCUS
  1170. Super.Activate(cmd)
  1171. flActivateText(WidgetHandle())
  1172. Case ACTIVATE_CUT
  1173. flCutText(WidgetHandle())
  1174. Case ACTIVATE_COPY
  1175. flCopyText(WidgetHandle())
  1176. Case ACTIVATE_PASTE
  1177. flPasteText(WidgetHandle())
  1178. Default
  1179. Super.Activate(cmd)
  1180. End Select
  1181. End Method
  1182. Method SetTabs(tabs)
  1183. ''''' flSetTextTabs( WidgetHandle(),tabs ) 'FIXME one of these days...
  1184. End Method
  1185. Method CharAt(line)
  1186. Return flLinePos(WidgetHandle(),line)
  1187. End Method
  1188. Method LineAt(index)
  1189. Return flLineCount(WidgetHandle(),index)
  1190. End Method
  1191. Method CharX(char)
  1192. Local x%, y%
  1193. flCharPosXY(WidgetHandle(),char,Varptr x,Varptr y)
  1194. If x Then Return x Else Return -1
  1195. EndMethod
  1196. Method CharY(char)
  1197. Local x%, y%
  1198. flCharPosXY(WidgetHandle(),char,Varptr x,Varptr y)
  1199. If y Then Return y Else Return -1
  1200. EndMethod
  1201. Field intLastCursorPos = -1, intLastCursorLen = -1
  1202. Method CheckCursorPos(pEmitEvent% = True,pOverridePos% = -1)
  1203. Local tmpCursorPos
  1204. If pOverridePos < 0 Then tmpCursorPos = GetCursorPos(TEXTAREA_CHARS) Else tmpCursorPos = pOverridePos
  1205. Local tmpCursorLen = GetSelectionLength(TEXTAREA_CHARS)
  1206. If intLastCursorPos <> tmpCursorPos Or intLastCursorLen <> tmpCursorLen Then
  1207. intLastCursorPos = tmpCursorPos;intLastCursorLen = tmpCursorLen
  1208. If pEmitEvent Then PostGuiEvent(EVENT_GADGETSELECT,Self)
  1209. EndIf
  1210. EndMethod
  1211. Method LockText()
  1212. locked:+1
  1213. If locked=1
  1214. lockedpos=GetCursorPos(TEXTAREA_CHARS)
  1215. lockedlen=GetSelectionLength(TEXTAREA_CHARS)
  1216. SetSelection(0,-1,TEXTAREA_CHARS)
  1217. EndIf
  1218. End Method
  1219. Method UnlockText()
  1220. If Not locked Return
  1221. If locked=1
  1222. SetSelection(lockedpos,lockedlen,TEXTAREA_CHARS)
  1223. flRedrawText WidgetHandle(),0,flTextLength(WidgetHandle())
  1224. EndIf
  1225. locked:-1
  1226. End Method
  1227. Method flstyle()
  1228. Return flGetTextStyleChar(WidgetHandle(),textr,textg,textb,font.handle,font.GetSizeForFL())
  1229. End Method
  1230. Method SetTextColor( r,g,b )
  1231. textr=r;textg=g;textb=b
  1232. flSetEditTextColor(WidgetHandle(),r,g,b)
  1233. flRedrawText WidgetHandle(),0,flTextLength(WidgetHandle())
  1234. End Method
  1235. Method SetFont( font:TGuiFont )
  1236. Self.font=TFLGUIFont(font)
  1237. LockText()
  1238. flSetTextSize WidgetHandle(),Self.font.GetSizeForFL()
  1239. flSetTextFont WidgetHandle(),Self.font.handle
  1240. UnlockText()
  1241. End Method
  1242. Method AreaText$(pos,count,units)
  1243. If units=TEXTAREA_LINES
  1244. count=flLinePos(WidgetHandle(),pos+count)
  1245. pos=flLinePos(WidgetHandle(),pos)
  1246. count:-pos
  1247. EndIf
  1248. Local tmpTextPtr:Byte Ptr = flGetText(WidgetHandle(),pos,count)
  1249. Local tmpText$ = String.FromCString(tmpTextPtr)
  1250. flFreePtr(tmpTextPtr)
  1251. Return tmpText
  1252. End Method
  1253. Method AreaLen(units)
  1254. Local count=flTextLength(WidgetHandle())
  1255. If units=TEXTAREA_LINES count=flLineCount(WidgetHandle(),count)
  1256. Return count
  1257. End Method
  1258. Method AddText(text$)
  1259. ignore:+1
  1260. Local utf8text:Byte Ptr=text.ToUTF8String()
  1261. flAddText(WidgetHandle(),utf8text)
  1262. MemFree utf8text
  1263. flSelectText WidgetHandle(),flTextLength(WidgetHandle()),0
  1264. CheckCursorPos(False)
  1265. If Not locked flShowPosition(WidgetHandle())
  1266. End Method
  1267. Method ReplaceText(pos,count,text$,units)
  1268. If units=TEXTAREA_LINES
  1269. count=flLinePos(WidgetHandle(),pos+count)
  1270. pos=flLinePos(WidgetHandle(),pos)
  1271. count:-pos
  1272. EndIf
  1273. ignore:+1
  1274. Local utf8text:Byte Ptr=text.ToUTF8String()
  1275. flReplaceText(WidgetHandle(),pos,count,utf8text)
  1276. MemFree utf8text
  1277. CheckCursorPos(False)
  1278. End Method
  1279. Method GetCursorPos(units)
  1280. Local pos=flgetcursorpos(WidgetHandle())
  1281. If units=TEXTAREA_LINES pos=flLineCount(WidgetHandle(),pos)
  1282. Return pos
  1283. End Method
  1284. Method GetSelectionLength(units)
  1285. Local n=flgetselectionlen(WidgetHandle())
  1286. If units=TEXTAREA_LINES
  1287. n=flLineCount(WidgetHandle(),flgetcursorpos(WidgetHandle())+n-1)+1-GetCursorPos(TEXTAREA_LINES)
  1288. EndIf
  1289. Return n
  1290. End Method
  1291. Method SetStyle(r,g,b,flags,pos,count,units)
  1292. Local style,stext$
  1293. LockText()
  1294. style=flGetTextStyleChar(WidgetHandle(),r,g,b,font.flfamily.GetFontID(flags),font.GetSizeForFL())
  1295. If Not style Then RuntimeError "SetStyle failed"
  1296. If units=TEXTAREA_LINES
  1297. count=flLinePos(WidgetHandle(),pos+count)
  1298. pos=flLinePos(WidgetHandle(),pos)
  1299. count:-pos
  1300. EndIf
  1301. If count<0 count=flTextLength(WidgetHandle())-pos
  1302. If count<=0 Return
  1303. stext=rept$(style,count)
  1304. flReplaceTextStyle WidgetHandle(),pos,count,stext
  1305. UnlockText()
  1306. End Method
  1307. Method SetSelection(pos,count,units)
  1308. If units=TEXTAREA_LINES
  1309. count=flLinePos(WidgetHandle(),pos+count)
  1310. pos=flLinePos(WidgetHandle(),pos)
  1311. count:-pos
  1312. If count<0 count=0
  1313. EndIf
  1314. If count<0 count=flTextLength(WidgetHandle())-pos
  1315. If count<0 Return
  1316. intLastCursorPos = pos;intLastCursorLen = count
  1317. flSelectText WidgetHandle(),pos,count
  1318. CheckCursorPos(False)
  1319. If Not locked flShowPosition(WidgetHandle())
  1320. EndMethod
  1321. Method Free()
  1322. Local textbuff:Byte Ptr = Byte Ptr(flFreeTextDisplay( WidgetHandle() ))
  1323. Super.Free()
  1324. If textbuff Then FLDriver.QueueFLDelete(textbuff)
  1325. EndMethod
  1326. Method OnCallback()
  1327. Local x = fleventx()-AbsoluteX(), y = fleventy()-AbsoluteY()
  1328. Select flevent()
  1329. Case FL_PUSH
  1330. If flEventButton()=FL_LEFT_MOUSE Or Not GetSelectionLength(TEXTAREA_CHARS) Then CheckCursorPos() 'EVENT_GADGETSELECT if cursor moved...
  1331. Case FL_RELEASE
  1332. CheckCursorPos() 'EVENT_GADGETSELECT if cursor moved...
  1333. If flEventButton()=FL_RIGHT_MOUSE PostGuiEvent(EVENT_GADGETMENU,Self,0,0,x,y) 'menu button
  1334. Case FL_KEYDOWN
  1335. If Not (style&TEXTAREA_READONLY) And flChanged(WidgetHandle()) Then
  1336. PostGuiEvent(EVENT_GADGETACTION,Self)
  1337. EndIf
  1338. CheckCursorPos()
  1339. Case FL_UNFOCUS
  1340. PostGuiEvent(EVENT_GADGETLOSTFOCUS,Self)
  1341. End Select
  1342. EndMethod
  1343. Function EditHandler(pos,inserted,deleted,restyled,ctext:Byte Ptr,obj:Int) "C"
  1344. Local text$=String.FromCString(ctext)
  1345. Local textarea:TFLTextArea = TFLTextArea(HandleToObject(obj))
  1346. If textarea Then
  1347. If deleted
  1348. flDeleteTextStyle textarea.WidgetHandle(),pos,pos+deleted
  1349. EndIf
  1350. If inserted
  1351. flInsertTextStyle textarea.WidgetHandle(),pos,rept$(textarea.flstyle(),inserted)
  1352. EndIf
  1353. If textarea.ignore Then textarea.ignore:-1;Return
  1354. If (inserted Or deleted)
  1355. textarea.CheckCursorPos(True,pos+inserted)
  1356. PostGuiEvent(EVENT_GADGETACTION,textarea)
  1357. EndIf
  1358. EndIf
  1359. End Function
  1360. Function Rept$(c,n)
  1361. Local b:Byte[n]
  1362. memset_ b,c,n
  1363. Return String.FromBytes(b,n)
  1364. End Function
  1365. EndType
  1366. Type TFLListBox Extends TFLGadget
  1367. Field Current = -1
  1368. Method InitGadget()
  1369. If (style&LISTBOX_MULTISELECT) Then fltype=FL_MULTIBROWSER Else fltype=FL_BROWSER
  1370. InitWidget()
  1371. EndMethod
  1372. Method Class()
  1373. Return GADGET_LISTBOX
  1374. EndMethod
  1375. Method SetFont(font:TGuiFont)
  1376. Self.font = TFLGUIFont(font)
  1377. flSetBrowserTextFont WidgetHandle(),Self.font.handle
  1378. flSetBrowserTextSize WidgetHandle(),Self.font.GetSizeForFL()
  1379. Local tmpItem:TGadgetItem
  1380. For Local i% = 0 Until items.length
  1381. tmpItem = TGadgetItem(items[i])
  1382. SetListItem(i,tmpItem.text,tmpItem.tip,tmpItem.icon,tmpItem.extra)
  1383. Next
  1384. EndMethod
  1385. Method InsertListItem(index,text$,tip$,icon,extra:Object)
  1386. If icons Then icon = icons.GetFLImage(icon) Else icon = 0
  1387. flInsertBrowser(WidgetHandle(),index+1,BrowserFormatString()+text,extra,icon)
  1388. End Method
  1389. Method SetListItem(index,text$,tip$,icon,extra:Object)
  1390. If icons Then icon = icons.GetFLImage(icon) Else icon = 0
  1391. flSetBrowserItem(WidgetHandle(),index+1,BrowserFormatString()+text,extra,icon)
  1392. End Method
  1393. Method RemoveListItem(index)
  1394. flRemoveBrowserItem(WidgetHandle(),index+1)
  1395. End Method
  1396. Method SetListItemState(item,state)
  1397. If Not(style&LISTBOX_MULTISELECT) Then
  1398. If state&STATE_SELECTED
  1399. Current=item
  1400. flSelectBrowser(WidgetHandle(),item+1)
  1401. Else
  1402. If Current=item Current=-1
  1403. flSelectBrowser(WidgetHandle(),0)
  1404. EndIf
  1405. Else
  1406. flMultiBrowserSelect(WidgetHandle(),item+1,(state&STATE_SELECTED<>0))
  1407. SelectionChanged()
  1408. EndIf
  1409. End Method
  1410. Method ListItemState(index)
  1411. Local state
  1412. If Not(style&LISTBOX_MULTISELECT) Then
  1413. If flBrowserValue(WidgetHandle())-1=index state:|STATE_SELECTED
  1414. Else
  1415. If flMultiBrowserSelected(WidgetHandle(),index+1) state:|STATE_SELECTED
  1416. EndIf
  1417. Return state
  1418. End Method
  1419. Method OnCallback()
  1420. Local x = fleventx()-AbsoluteX(), y = fleventy()-AbsoluteY()
  1421. Local extra:Object, i
  1422. If style&LISTBOX_MULTISELECT <> LISTBOX_MULTISELECT Then
  1423. i=SelectedItem()
  1424. If i>-1 extra=ItemExtra(i)
  1425. If i<>Current
  1426. PostGuiEvent(EVENT_GADGETSELECT,Self,i,0,0,0,extra)
  1427. Current=i
  1428. EndIf
  1429. If flEventButton()=FL_RIGHT_MOUSE
  1430. PostGuiEvent(EVENT_GADGETMENU,Self,i,0,x,y,extra)
  1431. ElseIf flEventButton()=FL_LEFT_MOUSE And flEventClicks() Mod 2
  1432. If i>-1 Then
  1433. PostGuiEvent(EVENT_GADGETACTION,Self,i,0,0,0,extra)
  1434. EndIf
  1435. EndIf
  1436. Else
  1437. i = SelectionChanged()
  1438. If i > -1 Then
  1439. extra = ItemExtra(i)
  1440. PostGuiEvent(EVENT_GADGETSELECT,Self,i,0,0,0,extra)
  1441. ElseIf flEventButton()=FL_LEFT_MOUSE And flEventClicks() Mod 2 Then
  1442. i = flBrowserValue(WidgetHandle())-1
  1443. If i > -1 Then PostGuiEvent(EVENT_GADGETACTION,Self,i,0,0,0,ItemExtra(i))
  1444. EndIf
  1445. If flEventButton()=FL_RIGHT_MOUSE Then
  1446. i = flBrowserValue(WidgetHandle())-1;extra = Null
  1447. If i > -1 Then extra = ItemExtra(i)
  1448. PostGuiEvent(EVENT_GADGETMENU,Self,i,0,x,y,extra)
  1449. EndIf
  1450. EndIf
  1451. EndMethod
  1452. Method BrowserFormatString$()
  1453. Local tmpResult$
  1454. Select fltype
  1455. Case FL_BROWSER, FL_MULTIBROWSER
  1456. If font.style&FONT_UNDERLINE Then tmpResult:+"@u"
  1457. If font.style&FONT_STRIKETHROUGH Then tmpResult:+"@-"
  1458. tmpResult:+"@."
  1459. EndSelect
  1460. Return tmpResult
  1461. EndMethod
  1462. EndType
  1463. Type TFLComboBox Extends TFLGadget
  1464. Field _lastchoice = -1
  1465. Method InitGadget()
  1466. If (style&COMBOBOX_EDITABLE) Then fltype=FL_INPUTCHOICE Else fltype=FL_CHOICE
  1467. InitWidget()
  1468. EndMethod
  1469. Method Class()
  1470. Return GADGET_COMBOBOX
  1471. EndMethod
  1472. Method GetText$()
  1473. If (style&COMBOBOX_EDITABLE) Then
  1474. Return flGetInput(flGetInputChoiceTextWidget(WidgetHandle()))
  1475. Else
  1476. If _lastchoice > -1 Then Return GadgetItemText(Self,_lastchoice)
  1477. EndIf
  1478. EndMethod
  1479. Method SetText(text$)
  1480. If style&COMBOBOX_EDITABLE Then flSetInput(flGetInputChoiceTextWidget(WidgetHandle()),text)
  1481. EndMethod
  1482. Method InsertListItem(index,text$,tip$,icon,extra:Object)
  1483. Local m:TFLMenu = New TFLMenu
  1484. GetMenu()
  1485. menu.owner=Self
  1486. m.text=text
  1487. menu.addmenu m
  1488. Local count,flmenu Ptr
  1489. count=menu.count(-1)
  1490. flmenu=flCreateMenu(count+2,CallbackHandler)
  1491. menu.setflmenu(flmenu)
  1492. If style&COMBOBOX_EDITABLE Then flSetMenu(flGetInputChoiceMenuWidget(WidgetHandle()),flmenu) Else flSetMenu(WidgetHandle(),flmenu)
  1493. End Method
  1494. Method SetListItem(index,text$,tip$,icon,extra:Object)
  1495. 'Save current selection
  1496. Local selection = SelectedGadgetItem(Self)
  1497. GetMenu()
  1498. 'Update item
  1499. Local m:TFLMenu = menu.mkids[index]
  1500. m.text=text
  1501. 'Create a new menu
  1502. Local count,flmenu Ptr
  1503. count=menu.count(-1)
  1504. flmenu=flCreateMenu(count+2,CallbackHandler)
  1505. menu.setflmenu(flmenu)
  1506. 'Apply new menu
  1507. If style&COMBOBOX_EDITABLE Then flSetMenu(flGetInputChoiceMenuWidget(WidgetHandle()),flmenu) Else flSetMenu(WidgetHandle(),flmenu)
  1508. 'Restore selection
  1509. If selection > -1 Then SelectGadgetItem(Self, selection)
  1510. End Method
  1511. Method RemoveListItem(index)
  1512. Local m:TFLMenu
  1513. GetMenu()
  1514. menu.owner=Self
  1515. menu.removemenu index
  1516. Local count,flmenu Ptr
  1517. count=menu.count(-1)
  1518. flmenu=flCreateMenu(count+2,CallbackHandler)
  1519. menu.setflmenu(flmenu)
  1520. If style&COMBOBOX_EDITABLE Then flSetMenu(flGetInputChoiceMenuWidget(WidgetHandle()),flmenu) Else flSetMenu(WidgetHandle(),flmenu)
  1521. End Method
  1522. Method SetListItemState(item,state)
  1523. If Not(style&COMBOBOX_EDITABLE) Then
  1524. If state&STATE_SELECTED Then flSetChoice(WidgetHandle(),item)
  1525. Else
  1526. If state&STATE_SELECTED Then flSetInputChoice(WidgetHandle(),item)
  1527. EndIf
  1528. End Method
  1529. Method ListItemState(index)
  1530. Local state
  1531. If Not(Style&COMBOBOX_EDITABLE) Then
  1532. If flGetChoice(WidgetHandle())=index state:|STATE_SELECTED
  1533. Else
  1534. If _lastchoice=index state:|STATE_SELECTED
  1535. EndIf
  1536. Return state
  1537. End Method
  1538. Method OnCallback()
  1539. Select flevent()
  1540. Case FL_KEYDOWN
  1541. Local text$ = fleventtext()
  1542. If text Then
  1543. _lastchoice = -1
  1544. PostGuiEvent(EVENT_GADGETACTION,Self,_lastchoice)
  1545. EndIf
  1546. Case FL_UNFOCUS
  1547. PostGuiEvent(EVENT_GADGETLOSTFOCUS,Self)
  1548. End Select
  1549. EndMethod
  1550. EndType
  1551. Type TFLTabber Extends TFLGadget
  1552. Const TABBODY_SPACING = 5
  1553. Field tabpanels:TFLWidget[]
  1554. Field selectedtab = -1
  1555. 'WARNING: TFLTabber is in a very fragile state in order to acquire the correct positioning
  1556. 'of gadgets.
  1557. Method InitGadget()
  1558. fltype = FL_TABS
  1559. InitWidget()
  1560. SetOrigin(1,20+TABBODY_SPACING)
  1561. client=New TFLPanel.CreateGadget("",0,0,ClientWidth(),ClientHeight(),Self,0)
  1562. client.SetLayout EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED
  1563. RemoveChild(client)
  1564. EndMethod
  1565. Method Class()
  1566. Return GADGET_TABBER
  1567. EndMethod
  1568. Method ClientWidth()
  1569. Return Max(width-originx,0)
  1570. EndMethod
  1571. Method ClientHeight()
  1572. Return Max(height-originy,0)
  1573. EndMethod
  1574. Method OnCallback()
  1575. Local selhandle=flGetTabPanel(WidgetHandle())
  1576. Local eventhandle=flGetTabPanelForEvent(WidgetHandle())
  1577. Local x = fleventx()-AbsoluteX(), y = fleventy()-AbsoluteY()
  1578. For Local panel:TFLWidget=EachIn tabpanels
  1579. If panel.WidgetHandle()=selhandle Then
  1580. If panel.tag<>selectedtab
  1581. SetListItemState panel.tag, STATE_SELECTED
  1582. PostGuiEvent(EVENT_GADGETACTION,Self,panel.tag,0,0,0,ItemExtra(panel.tag))
  1583. EndIf
  1584. EndIf
  1585. If panel.WidgetHandle()=eventhandle
  1586. Select flevent()
  1587. Case FL_PUSH
  1588. If flEventButton() = FL_RIGHT_MOUSE Then
  1589. PostGuiEvent(EVENT_GADGETMENU,Self,panel.tag,0,x,y,ItemExtra(panel.tag))
  1590. EndIf
  1591. EndSelect
  1592. EndIf
  1593. Next
  1594. EndMethod
  1595. Method InsertListItem(index,text$,tip$,icon,extra:Object)
  1596. Local panel:TFLWidget,x,y,w,h,client:TFLWidget = Self.client
  1597. 'Make sure that we attach the tab panel to the tabber (not the client).
  1598. Self.client = Null
  1599. panel=TFLWidget(New TFLWidget.CreateWidget(FL_GROUP,text,0,-TABBODY_SPACING,ClientWidth(),ClientHeight()+TABBODY_SPACING,Self,-1,FL_NO_BOX))
  1600. 'Make sure tab panels are resized first by LayoutKids().
  1601. 'If we don't do this, and children are added before tab panels,
  1602. 'the children don't may not drawn correctly (if at all).
  1603. kids.Remove(panel);kids.AddFirst(panel)
  1604. 'After creating the tab panel, we can restore the client area for user gadgets.
  1605. Self.client = client
  1606. 'Set the tabpanel options
  1607. If tooltip Then panel.SetTooltip tip$
  1608. panel.SetOrigin(0,TABBODY_SPACING)
  1609. panel.SetLayout EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED
  1610. panel.tag=index
  1611. 'Position the tab panel in the indexed array
  1612. tabpanels = tabpanels[..index]+[panel]+tabpanels[index..]
  1613. For Local i% = index+1 Until tabpanels.length
  1614. tabpanels[i].tag:+1
  1615. Next
  1616. 'And update the selected tab if necessary
  1617. If selectedtab < 0 Then selectedtab = index ElseIf index < selectedtab Then selectedtab:+1
  1618. Local tmpSelection% = selectedtab
  1619. 'Select new tab so that is correctly handled by Fl_Tabs
  1620. selectedtab = -1;SetListItemState index,STATE_SELECTED
  1621. 'And then restore selection to the previous tab
  1622. SetListItemState tmpSelection,STATE_SELECTED
  1623. End Method
  1624. Method SetListItemState(index,state)
  1625. If state&STATE_SELECTED Then
  1626. Local indextab:TFLWidget = tabpanels[index]
  1627. If selectedtab<>index
  1628. selectedtab=index
  1629. indextab.AddChild client
  1630. client.SetShape( 0, 0, ClientWidth(), ClientHeight() )
  1631. LayoutKids()
  1632. flSelectTab WidgetHandle(),indextab.WidgetHandle()
  1633. EndIf
  1634. EndIf
  1635. End Method
  1636. Method ListItemState(index)
  1637. Local tmpState
  1638. If index = selectedtab Then tmpState:|STATE_SELECTED
  1639. Return tmpState
  1640. End Method
  1641. Method SetListItem(index,text$,tip$,icon,extra:Object)
  1642. Local indextab:TFLWidget = tabpanels[index]
  1643. If indextab Then
  1644. indextab.SetText(text)
  1645. indextab.SetTooltip(tip)
  1646. 'If icon>0 Then
  1647. ' indextab.SetPixmap(PixmapFromIconStrip(icons,icon),GADGETPIXMAP_ICON)
  1648. 'Else
  1649. ' indextab.SetPixmap(Null,GADGETPIXMAP_ICON)
  1650. 'EndIf
  1651. SetDirty()
  1652. EndIf
  1653. End Method
  1654. Method RemoveListItem(index)
  1655. Local indextab:TFLWidget
  1656. Local panels:TFLWidget[]
  1657. Local i
  1658. indextab=tabpanels[index]
  1659. If Not indextab Then Return
  1660. If index = selectedtab Then indextab.RemoveChild client
  1661. ' free widget
  1662. indextab.free()
  1663. ' remove from array
  1664. panels=tabpanels
  1665. tabpanels=tabpanels[..tabpanels.length-1]
  1666. For i=index Until tabpanels.length
  1667. tabpanels[i]=panels[i+1]
  1668. tabpanels[i].tag=i
  1669. Next
  1670. index=Min(index,tabpanels.length-1)
  1671. If index<>-1 SetListItemState index, STATE_SELECTED
  1672. If parent RedrawGadget parent 'parent.Redraw'SetDirty
  1673. End Method
  1674. EndType
  1675. Type TFLTreeview Extends TFLGadget
  1676. Field root:TFLNode
  1677. Method InitGadget()
  1678. fltype = FLU_TREEBROWSER
  1679. InitWidget()
  1680. EndMethod
  1681. Method Class()
  1682. Return GADGET_TREEVIEW
  1683. EndMethod
  1684. Method RootNode:TFLNode()
  1685. If Not root
  1686. root=New TFLNode
  1687. root.owner=Self
  1688. root.nodehandle = fluRootNode(WidgetHandle())
  1689. kids.AddLast root
  1690. EndIf
  1691. Return root
  1692. End Method
  1693. Method SelectNode(node:TFLNode)
  1694. fluSelectNode(node.nodehandle)
  1695. End Method
  1696. Method SelectedNode:TGadget()
  1697. Local tmpNodeHandle:Int = fluSelectedNode(WidgetHandle(),1) 'Base 1 for some reason
  1698. If tmpNodeHandle Then
  1699. Local tmpNode:TFLNode = TFLNode.FromHandle(tmpNodeHandle)
  1700. If tmpNode <> RootNode() Then Return tmpNode
  1701. EndIf
  1702. End Method
  1703. Field _lastButtonPressed:Int
  1704. Method OnMouse:Int()
  1705. Local tmpButton:Int = flEventButton()
  1706. Select flEvent()
  1707. Case FL_PUSH
  1708. _lastButtonPressed = tmpButton
  1709. If tmpButton = FL_RIGHT_MOUSE Then
  1710. PostGuiEvent EVENT_GADGETMENU, Self, tmpButton-1, flStateToModifiers(flEventState()), flEventX()-AbsoluteX(), flEventY()-AbsoluteY(), SelectedNode()
  1711. EndIf
  1712. Case FL_DRAG
  1713. If (style&TREEVIEW_DRAGNDROP) And Not dragGadget[_lastButtonPressed-1] Then
  1714. dragGadget[_lastButtonPressed-1] = SelectedNode()
  1715. PostGuiEvent EVENT_GADGETDRAG, Self, _lastButtonPressed, flStateToModifiers(flEventState()), flEventX()-AbsoluteX(), flEventY()-AbsoluteY(), dragGadget[_lastButtonPressed-1]
  1716. EndIf
  1717. EndSelect
  1718. Super.OnMouse()
  1719. EndMethod
  1720. Method OnCallback()
  1721. Local intReason% = fluCallbackReason( WidgetHandle() )
  1722. Local tmpNode:TFLNode = TFLNode.FromHandle(fluCallbackNode( WidgetHandle() ))
  1723. Select intReason
  1724. Case FLU_OPENED;PostGuiEvent EVENT_GADGETOPEN, Self, 0, 0, 0, 0, tmpNode
  1725. Case FLU_CLOSED;PostGuiEvent EVENT_GADGETCLOSE, Self, 0, 0, 0, 0, tmpNode
  1726. Case FLU_SELECTED, FLU_DOUBLE_CLICK
  1727. If intReason = FLU_SELECTED Then
  1728. PostGuiEvent EVENT_GADGETSELECT, Self, 0, 0, 0, 0, tmpNode
  1729. Else
  1730. PostGuiEvent EVENT_GADGETACTION, Self, 0, 0, 0, 0, tmpNode
  1731. EndIf
  1732. EndSelect
  1733. EndMethod
  1734. EndType
  1735. Type TFLNode Extends TFLWidget
  1736. Field owner:TFLTreeview, nodehandle%
  1737. Field text$, icon = -1, textmem:Byte Ptr
  1738. Method Delete()
  1739. Free()
  1740. End Method
  1741. Method GetText$()
  1742. Return text
  1743. End Method
  1744. Method SetText(newtext$)
  1745. Local tmpIcon
  1746. If textmem Then MemFree textmem;textmem = Null
  1747. text = newtext
  1748. textmem = text.ToCString()
  1749. If icon >= 0 And owner.icons Then tmpIcon = owner.icons.images[icon] Else tmpIcon = 0
  1750. If nodehandle Then fluSetNode( nodehandle, textmem, tmpicon )
  1751. End Method
  1752. Method InsertNode:TGadget(pos,text$,icon)
  1753. Local n:TFLNode, l:TLink
  1754. If pos >= 0 And pos < kids.count()
  1755. n=TFLNode(kids.ValueAtIndex(pos))
  1756. l=kids.FindLink(n)
  1757. EndIf
  1758. n=New TFLNode
  1759. n.parent=Self
  1760. n.owner=owner
  1761. n.icon=icon
  1762. If l Then
  1763. n.nodehandle = fluInsertNode( nodehandle, pos, inittext )
  1764. fluSetNodeUserData( n.nodehandle, n.objhandle )
  1765. kids.InsertBeforeLink n,l
  1766. Else
  1767. n.nodehandle = fluAddNode( nodehandle, inittext )
  1768. fluSetNodeUserData( n.nodehandle, n.objhandle )
  1769. kids.AddLast n
  1770. EndIf
  1771. If LocalizationMode() & LOCALIZATION_OVERRIDE Then
  1772. LocalizeGadget(n,text)
  1773. Else
  1774. n.SetText(text)
  1775. EndIf
  1776. Return n
  1777. End Method
  1778. Method Free()
  1779. If Not nodehandle Then Return 'Make sure we don't free twice
  1780. Super.Free()
  1781. fluSetNodeUserData( nodehandle, 0 )
  1782. fluRemoveNode( owner.WidgetHandle(), nodehandle )
  1783. If textmem Then MemFree textmem;textmem = Null
  1784. If owner And owner.root <> Self Then 'If not TreeViewRoot()
  1785. owner = Null;nodehandle = 0
  1786. EndIf
  1787. End Method
  1788. Method ModifyNode(text$,icon)
  1789. Self.icon = icon;SetText(text)
  1790. End Method
  1791. Method Activate(cmd)
  1792. Select cmd
  1793. Case ACTIVATE_SELECT
  1794. Local tmpParent:TFLNode = TFLNode(parent)
  1795. While tmpParent
  1796. tmpParent.Activate(ACTIVATE_EXPAND)
  1797. tmpParent = TFLNode(tmpParent.parent)
  1798. Wend
  1799. fluSelectNode( nodehandle )
  1800. Case ACTIVATE_EXPAND
  1801. fluExpandNode( nodehandle, False )
  1802. Case ACTIVATE_COLLAPSE
  1803. fluExpandNode( nodehandle, True )
  1804. End Select
  1805. End Method
  1806. Method Class()
  1807. Return GADGET_NODE
  1808. EndMethod
  1809. Function FromHandle:TFLNode(nodehandle)
  1810. If nodehandle Then Return TFLNode(HandleToObject(fluNodeUserData( nodehandle )))
  1811. EndFunction
  1812. Method SetTooltip(tooltip$)
  1813. 'Do nothing - nodes don't support tooltips (yet).
  1814. EndMethod
  1815. End Type
  1816. Type TFLSlider Extends TFLGadget
  1817. 'Spinner controls
  1818. Field minimum = 1, maximum = 10
  1819. Field spinval = minimum
  1820. Field up:TFLWidget, down:TFLWidget
  1821. Method InitGadget()
  1822. If (style&SLIDER_TRACKBAR) = SLIDER_TRACKBAR Then
  1823. fltype = FL_SLIDER
  1824. ElseIf (style&SLIDER_STEPPER) = SLIDER_STEPPER Then
  1825. fltype = FL_GROUP
  1826. Else
  1827. fltype = FL_SCROLLBAR
  1828. EndIf
  1829. InitWidget()
  1830. If (style&SLIDER_STEPPER) = SLIDER_STEPPER Then
  1831. If (style&SLIDER_HORIZONTAL)
  1832. up = New TFLSpinButton.CreateWidget(FL_REPEATBUTTON,"@#>",width/2,0,width/2,height,Self)
  1833. SetGadgetLayout up,EDGE_RELATIVE,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED
  1834. down = New TFLSpinButton.CreateWidget(FL_REPEATBUTTON,"@#<",0,0,width/2,height,Self)
  1835. SetGadgetLayout down,EDGE_ALIGNED,EDGE_RELATIVE,EDGE_ALIGNED,EDGE_ALIGNED
  1836. Else
  1837. up = New TFLSpinButton.CreateWidget(FL_REPEATBUTTON,"@#2<",0,0,width,height/2,Self)
  1838. SetGadgetLayout up,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_RELATIVE
  1839. down = New TFLSpinButton.CreateWidget(FL_REPEATBUTTON,"@#2>",0,height/2,width,height/2,Self)
  1840. SetGadgetLayout down,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_RELATIVE,EDGE_ALIGNED
  1841. EndIf
  1842. Else
  1843. If (style&SLIDER_HORIZONTAL) Then flSetSliderType WidgetHandle(),FL_HOR_SLIDER
  1844. EndIf
  1845. EndMethod
  1846. Method Class()
  1847. Return GADGET_SLIDER
  1848. EndMethod
  1849. Method SetRange(small,big)
  1850. If (style&SLIDER_STEPPER) = SLIDER_STEPPER Then
  1851. minimum = small
  1852. maximum = big
  1853. SetProp(spinval)
  1854. ElseIf fltype=FL_SCROLLBAR Then
  1855. flSetScrollbarValue WidgetHandle(), GetProp(), small, 0, big
  1856. Else
  1857. flSetSliderRange WidgetHandle(),small,big
  1858. EndIf
  1859. End Method
  1860. Method SetProp(value)
  1861. If (style&SLIDER_STEPPER) = SLIDER_STEPPER Then
  1862. spinval = Min( Max( value, minimum ), maximum )
  1863. Else
  1864. flSetSliderValue WidgetHandle(),value
  1865. EndIf
  1866. End Method
  1867. Method GetProp()
  1868. If (style&SLIDER_STEPPER) = SLIDER_STEPPER Then
  1869. Return spinval
  1870. Else
  1871. Return flSliderValue(WidgetHandle())
  1872. EndIf
  1873. End Method
  1874. Method OnSpin(pSource:TFLWidget)
  1875. Local tmpNewVal = spinval
  1876. Select pSource
  1877. Case up;tmpNewVal:+1
  1878. Case down;tmpNewVal:-1
  1879. EndSelect
  1880. tmpNewVal = Min( Max( tmpNewVal, minimum ), maximum )
  1881. If tmpNewVal <> spinval Then
  1882. spinval = tmpNewVal
  1883. OnCallback()
  1884. EndIf
  1885. EndMethod
  1886. Method OnCallback()
  1887. PostGuiEvent(EVENT_GADGETACTION,Self,GetProp())
  1888. EndMethod
  1889. EndType
  1890. Type TFLSpinButton Extends TFLWidget
  1891. Method Class()
  1892. Return GADGET_SLIDER
  1893. EndMethod
  1894. Method OnCallback()
  1895. TFLSlider(parent).OnSpin(Self)
  1896. EndMethod
  1897. Const SYMBOL_WIDTH% = 13, SYMBOL_HEIGHT = 7
  1898. Method Rethink()
  1899. 'Attempts to resizes arrow heads in line with dimensions
  1900. Local scaletxt$, text$ = GetText()[2..]
  1901. 'Strip current size info from arrow label string
  1902. If text[..1] = "+" Or text[..1] = "-" Then text = text[2..]
  1903. 'Calculate the most suitable scaling
  1904. Local scale# = Min( width, height )
  1905. scale:/ Max( SYMBOL_WIDTH, SYMBOL_HEIGHT )
  1906. 'Sort out the sign of the scaling
  1907. If Int(scale) < 1 Then
  1908. scale = 1/scale
  1909. scaletxt = "-"
  1910. ElseIf Int(scale) > 1 Then
  1911. scale:-1
  1912. scaletxt = "+"
  1913. Else
  1914. scale = 0
  1915. EndIf
  1916. 'And clamp the value to a single digit
  1917. scale = Min(scale,9)
  1918. 'Then, if we need to scale, lets set the label accordingly
  1919. If Int(scale) >= 1 Then text = scaletxt + Int(scale) + text
  1920. SetText( "@#"+text )
  1921. Super.Rethink()
  1922. EndMethod
  1923. EndType
  1924. Type TFLProgBar Extends TFLGadget
  1925. Method InitGadget()
  1926. fltype=FL_PROGBAR
  1927. InitWidget()
  1928. EndMethod
  1929. Method Class()
  1930. Return GADGET_PROGBAR
  1931. EndMethod
  1932. Method SetValue(value#)
  1933. flSetProgress WidgetHandle(),value
  1934. parent.activate ACTIVATE_REDRAW
  1935. End Method
  1936. EndType
  1937. Type TFLPanel Extends TFLGadget
  1938. 'TFLCanvas, TFLToolbar and TFLToolbarItem extend TFLPanel
  1939. Method InitGadget()
  1940. fltype = FL_PANEL
  1941. InitWidget()
  1942. Select style&(PANEL_GROUP|PANEL_SUNKEN|PANEL_RAISED)
  1943. Case 0;flSetBox WidgetHandle(), FL_NO_BOX, False
  1944. Case PANEL_SUNKEN;flSetBox WidgetHandle(), FL_DOWN_FRAME, False
  1945. Case PANEL_RAISED;flSetBox WidgetHandle(), FL_UP_FRAME, False
  1946. Default;SetOrigin(4,18)
  1947. EndSelect
  1948. If (style&PANEL_ACTIVE) Then SetSensitivity(SENSITIZE_ALL)
  1949. EndMethod
  1950. Method Class()
  1951. Return GADGET_PANEL
  1952. EndMethod
  1953. Method SetEnabled(truefalse)
  1954. Super.SetEnabled(truefalse)
  1955. flSetPanelEnabled WidgetHandle(),truefalse
  1956. EndMethod
  1957. Method Rethink()
  1958. SetFLImage(image)
  1959. Super.Rethink()
  1960. EndMethod
  1961. Method SetFLImage(image)
  1962. Self.image = image
  1963. flSetPanelImage(WidgetHandle(),image,pixmapflags)
  1964. End Method
  1965. Method SetColor( r,g,b )
  1966. flSetPanelColor(WidgetHandle(),r,g,b)
  1967. Redraw()
  1968. End Method
  1969. Method SetSensitivity(pSensitivity%)
  1970. Super.SetSensitivity(pSensitivity)
  1971. flSetPanelActive WidgetHandle(), (GetSensitivity()<>0)
  1972. EndMethod
  1973. Method OnMouse()
  1974. Select flevent()
  1975. Case FL_PUSH
  1976. flSetFocus(Query(QUERY_FLWIDGET_CLIENT))
  1977. EndSelect
  1978. Super.OnMouse()
  1979. EndMethod
  1980. EndType
  1981. Type TFLCanvas Extends TFLPanel
  1982. Field driver$
  1983. Field canvas:TGraphics
  1984. Field canvasflags
  1985. Method InitGadget()
  1986. fltype=FL_CANVAS
  1987. InitWidget()
  1988. flSetCanvasMode WidgetHandle(),DefaultGraphicsFlags()
  1989. SetSensitivity(SENSITIZE_ALL)
  1990. SetShow(True)
  1991. EndMethod
  1992. Method Class()
  1993. Return GADGET_CANVAS
  1994. EndMethod
  1995. Method SetText(text$)
  1996. driver=text
  1997. EndMethod
  1998. Method GetText$()
  1999. Return driver
  2000. EndMethod
  2001. Method AttachGraphics:TGraphics( flags )
  2002. canvasflags=flags
  2003. ?MacOS
  2004. canvas=brl.Graphics.AttachGraphics( NSContentView(flCanvasWindow(WidgetHandle())),flags )
  2005. ?Not MacOS
  2006. canvas=brl.Graphics.AttachGraphics( flCanvasWindow(WidgetHandle()),flags )
  2007. ?
  2008. End Method
  2009. Method CanvasGraphics:TGraphics()
  2010. Return canvas
  2011. End Method
  2012. Method SetShow(truefalse)
  2013. flSetShow(WidgetHandle(),truefalse)
  2014. End Method
  2015. Method Free()
  2016. Super.Free()
  2017. If canvas
  2018. canvas.Close()
  2019. canvas=Null
  2020. EndIf
  2021. EndMethod
  2022. Method SetFLImage(image)
  2023. EndMethod
  2024. Method SetColor(r,g,b)
  2025. EndMethod
  2026. Method OnCallback()
  2027. Select flevent()
  2028. Case FL_ACTIVATE
  2029. ?MacOS
  2030. NSUpdateCanvas(flCanvasWindow(WidgetHandle()))
  2031. ?
  2032. PostGuiEvent EVENT_GADGETPAINT,Self
  2033. End Select
  2034. Super.OnCallback()
  2035. EndMethod
  2036. End Type
  2037. Type TFLToolbar Extends TFLGadget
  2038. Method InitGadget()
  2039. Local tmpClient:TFLWidget = TFLWidget(parent).client
  2040. TFLWidget(parent).client = Null
  2041. fltype=FL_TOOLBAR
  2042. InitWidget()
  2043. TFLWidget(parent).client = tmpClient
  2044. flSetBox(WidgetHandle(),FL_NO_BOX,False)
  2045. LayoutToolbar()
  2046. SetLayout(EDGE_ALIGNED,EDGE_CENTERED,EDGE_ALIGNED,EDGE_CENTERED)
  2047. EndMethod
  2048. Method Class()
  2049. Return GADGET_TOOLBAR
  2050. EndMethod
  2051. Method AbsoluteX()
  2052. Local tmpValue:Int = Super.AbsoluteX()
  2053. If TFLWidget(parent) Then tmpValue:-TFLWidget(parent).originx
  2054. Return tmpValue
  2055. End Method
  2056. Method AbsoluteY()
  2057. Local tmpValue:Int = Super.AbsoluteY()
  2058. If TFLWidget(parent) Then tmpValue:-TFLWidget(parent).originy
  2059. Return tmpValue
  2060. End Method
  2061. Method SetShow(truefalse)
  2062. If truefalse ~ ((State() & STATE_HIDDEN) = 0) Then
  2063. Super.SetShow(truefalse)
  2064. LayoutToolbar()
  2065. EndIf
  2066. EndMethod
  2067. Method SetLayout(Left,Right,top,bottom)
  2068. Super.SetLayout(EDGE_ALIGNED,EDGE_CENTERED,EDGE_ALIGNED,EDGE_CENTERED)
  2069. EndMethod
  2070. ' toolbar specific
  2071. Method SetListItemState(index,state)
  2072. Local item:TFLToolbarItem = ToolPanel(index)
  2073. If item Then
  2074. If state&STATE_SELECTED Then item.toggled = True Else item.toggled = False
  2075. item.SetEnabled( Not (state&STATE_DISABLED) )
  2076. item.Redraw()
  2077. EndIf
  2078. End Method
  2079. Method ListItemState(index)
  2080. Local state, item:TFLToolbarItem = ToolPanel(index)
  2081. If item
  2082. If item.State() & STATE_DISABLED Then state:|STATE_DISABLED
  2083. If item.toggled Then state:|STATE_SELECTED
  2084. EndIf
  2085. Return state
  2086. End Method
  2087. Method InsertListItem(index,text$,tip$,icon,extra:Object)
  2088. ' bump button panel indexes
  2089. For Local item:TFLToolbarItem = EachIn kids
  2090. If item.tag>=index item.tag:+1
  2091. Next
  2092. SetListItem index,text,tip,icon,extra
  2093. End Method
  2094. Method RemoveListItem(index)
  2095. Local item:TFLToolbarItem = ToolPanel(index)
  2096. If item Then
  2097. item.CleanUp()
  2098. For Local tmpToolPanel:TFLToolbarItem = EachIn kids
  2099. If tmpToolPanel.tag > index Then tmpToolPanel.tag:-1
  2100. Next
  2101. LayoutToolBar()
  2102. EndIf
  2103. EndMethod
  2104. Method GetBestHeight()
  2105. If icons Then Return icons.pixmap.height+6
  2106. EndMethod
  2107. Method SetListItem(index,text$,tip$,icon,extra:Object)
  2108. Local image, item:TFLToolbarItem = ToolPanel(index)
  2109. If icons Then image = icons.GetFLImage(icon)
  2110. If Not item Then
  2111. item=TFLToolbarItem(New TFLToolbarItem.CreateGadget("",0,0,TFLToolbarItem.DIVIDER_WIDTH,GetBestHeight(),Self,PANEL_ACTIVE))
  2112. item.SetLayout EDGE_ALIGNED,EDGE_CENTERED,EDGE_ALIGNED,EDGE_CENTERED
  2113. item.tag=index
  2114. EndIf
  2115. item.SetFLImage image
  2116. item.SetToolTip tip
  2117. If image Then item.MakeIcon() Else item.MakeDivider()
  2118. LayoutToolBar()
  2119. End Method
  2120. Method ToolPanel:TFLToolbarItem(index)
  2121. For Local panel:TFLToolbarItem=EachIn kids
  2122. If panel.tag=index Return panel
  2123. Next
  2124. End Method
  2125. Method SetIconStrip( iconstrip:TIconStrip )
  2126. Super.SetIconStrip(iconstrip)
  2127. For Local i:Int = 0 Until items.length
  2128. ModifyGadgetItem( Self, i, items[i].text, items[i].flags, items[i].icon, items[i].tip, items[i].extra )
  2129. Next
  2130. LayoutToolbar()
  2131. EndMethod
  2132. Method SetShape(x,y,w,h)
  2133. LayoutToolbar()
  2134. EndMethod
  2135. Method Free()
  2136. SetShow(False)
  2137. Super.Free()
  2138. EndMethod
  2139. Method LayoutToolBar()
  2140. Local item:TGadgetItem
  2141. Local x = 4, y= 4, w, h = GetBestHeight(), index
  2142. Local panel:TFLToolbarItem
  2143. For item=EachIn items
  2144. panel=ToolPanel(index)
  2145. If panel
  2146. w=panel.width
  2147. panel.SetShape x+1,y,w,h
  2148. x:+w+2
  2149. EndIf
  2150. index:+1
  2151. Next
  2152. If (State() & STATE_HIDDEN) Then h = 0 Else If items h:+8
  2153. If height <> h Then
  2154. TFLWidget(parent).SetOrigin(TFLWidget(parent).originx,TFLWidget(parent).originy-height+h)
  2155. parent.Rethink()
  2156. EndIf
  2157. Super.SetShape 0,0,x+60,h
  2158. End Method
  2159. EndType
  2160. Type TFLToolbarItem Extends TFLPanel
  2161. Const DIVIDER_WIDTH:Int = 2
  2162. Field toggled = False
  2163. Method AbsoluteX()
  2164. Return TFLWidget(parent).AbsoluteX() + xpos
  2165. End Method
  2166. Method AbsoluteY()
  2167. Return TFLWidget(parent).AbsoluteY() + ypos
  2168. End Method
  2169. Method Class()
  2170. Return GADGET_TOOLBAR
  2171. EndMethod
  2172. Method SetEnabled(bool)
  2173. Super.SetEnabled(bool)
  2174. If Not bool Then flSetBox( WidgetHandle(), FL_NO_BOX, False )
  2175. EndMethod
  2176. Method Free()
  2177. 'Stop Super.Free() from deleting an image that belongs to an icon-strip.
  2178. image = 0
  2179. 'Now we can safely call Super.Free()
  2180. Super.Free()
  2181. EndMethod
  2182. Method SetFLImage(image)
  2183. pixmapflags = PANELPIXMAP_CENTER
  2184. Super.SetFLImage(image)
  2185. EndMethod
  2186. Method IsDivider()
  2187. Return (width <= DIVIDER_WIDTH)
  2188. EndMethod
  2189. Method MakeDivider()
  2190. SetRect(xpos,ypos,DIVIDER_WIDTH,height)
  2191. flSetBox( WidgetHandle(), FL_EMBOSSED_FRAME, False)
  2192. EndMethod
  2193. Method MakeIcon()
  2194. SetRect(xpos,ypos,height,height)
  2195. flSetBox( WidgetHandle(), FL_NO_BOX, False)
  2196. EndMethod
  2197. Method OnMouse()
  2198. Local x = fleventx()-AbsoluteX(), y = fleventy()-AbsoluteY()
  2199. If activepanel And (activepanel<>Self) Then
  2200. activepanel.OnMouseLeave()
  2201. activepanel = Null
  2202. EndIf
  2203. If Not ((State()&STATE_DISABLED) Or IsDivider()) And flEventButton() = FL_LEFT_MOUSE Then 'Not disabled
  2204. Select flevent()
  2205. Case FL_PUSH
  2206. flSetBox( WidgetHandle(), FL_THIN_DOWN_BOX, True )
  2207. Case FL_MOVE
  2208. If activepanel <> Self Then
  2209. flSetBox( WidgetHandle(), FL_THIN_UP_BOX, True )
  2210. activePanel = Self
  2211. EndIf
  2212. Case FL_DRAG
  2213. If x < width And y < height And x > 0 And y > 0 Then
  2214. flSetBox( WidgetHandle(), FL_THIN_DOWN_BOX, True )
  2215. Else
  2216. flSetBox( WidgetHandle(), FL_NO_BOX, True )
  2217. EndIf
  2218. Case FL_RELEASE
  2219. If x < width And y < height And x > 0 And y > 0 Then
  2220. Local item=tag&$ffff, flags=parent.ItemFlags(item)
  2221. If flags&GADGETITEM_TOGGLE Then parent.SelectItem(item,2)
  2222. PostGuiEvent(EVENT_GADGETACTION,parent,item,0,0,0)
  2223. EndIf
  2224. flSetBox( WidgetHandle(), FL_THIN_UP_BOX, True )
  2225. Default
  2226. Return
  2227. EndSelect
  2228. EndIf
  2229. EndMethod
  2230. Method OnMouseLeave()
  2231. flSetBox( WidgetHandle(), FL_NO_BOX, True )
  2232. EndMethod
  2233. EndType
  2234. Type TFLHTMLView Extends TFLGadget
  2235. Field currenturl$
  2236. Field history:TList
  2237. Field historylink:TLink
  2238. Field hpos:TList
  2239. Field hposlink:TLink
  2240. Method InitGadget()
  2241. fltype=FL_HELPVIEW
  2242. InitWidget()
  2243. flSetBox( WidgetHandle(), FL_THIN_DOWN_BOX, False )
  2244. flSetStyleView( WidgetHandle(), style )
  2245. EndMethod
  2246. Method Class()
  2247. Return GADGET_HTMLVIEW
  2248. EndMethod
  2249. Method GetText$()
  2250. Return currenturl$
  2251. EndMethod
  2252. Method SetText(text$)
  2253. SetURL(text)
  2254. EndMethod
  2255. Method Activate(cmd)
  2256. Select cmd
  2257. Case ACTIVATE_FORWARD
  2258. ForwardURL()
  2259. Case ACTIVATE_BACK
  2260. BackURL()
  2261. Default
  2262. Super.Activate(cmd)
  2263. End Select
  2264. End Method
  2265. Method OnCallback()
  2266. RequestURL(flEventURL())
  2267. EndMethod
  2268. Method CleanHTML$(src$)
  2269. Return src
  2270. End Method
  2271. Method RequestURL(path$)
  2272. Local curr$, lpath$
  2273. If Not path Return
  2274. path=path.Replace("\","/")
  2275. curr="file:"+CurrentDir()
  2276. If path[..curr.length]=curr
  2277. path=ExtractDir(currenturl)+path[curr.length..]
  2278. EndIf
  2279. lpath = path.ToLower()
  2280. Select ExtractExt$(lpath)
  2281. Case "png","jpg","jpeg","gif","bmp"
  2282. flRedirectView WidgetHandle(),path
  2283. Default
  2284. PostGuiEvent(EVENT_GADGETACTION,Self,0,0,0,0,path)
  2285. If Not (style & HTMLVIEW_NONAVIGATE) ' markcw
  2286. If lpath.StartsWith("ftp:") Or lpath.StartsWith("http:")..
  2287. Or lpath.StartsWith("https:") Or lpath.StartsWith("ipp:")..
  2288. Or lpath.StartsWith("mailto:") Or lpath.StartsWith("news:")
  2289. OpenURL path
  2290. EndIf
  2291. EndIf
  2292. End Select
  2293. End Method
  2294. Method BackURL()
  2295. If historylink And historylink.PrevLink()
  2296. historylink=historylink.PrevLink()
  2297. If hposlink
  2298. hposlink._value=String(flGetLineView(flhandle))
  2299. If hposlink.PrevLink() hposlink=hposlink.PrevLink()
  2300. SetURL String(historylink.Value()),False
  2301. EndIf
  2302. EndIf
  2303. End Method
  2304. Method ForwardURL()
  2305. If historylink And historylink.NextLink()
  2306. historylink=historylink.NextLink()
  2307. If hposlink
  2308. hposlink._value=String(flGetLineView(flhandle))
  2309. If hposlink.NextLink() hposlink=hposlink.NextLink()
  2310. SetURL String(historylink.Value()),False
  2311. EndIf
  2312. EndIf
  2313. End Method
  2314. Method SetURL(path$,addhistory=True)
  2315. Local stream:TStream
  2316. Local hash,anchor$
  2317. Local html$,script=0
  2318. If addhistory
  2319. currenturl=flGetPathView(flhandle)
  2320. If Not flIsLinkView(flhandle) currenturl=path
  2321. If currenturl.find("#")<>-1 path=currenturl
  2322. If hposlink hposlink._value=String(flGetLineView(flhandle))
  2323. If currenturl.StartsWith("javascript:history.back()")
  2324. If historylink And historylink.PrevLink()
  2325. historylink=historylink.PrevLink()
  2326. hposlink=hposlink.PrevLink()
  2327. EndIf
  2328. If historylink path=String(historylink.Value())
  2329. script=1
  2330. ElseIf currenturl.StartsWith("javascript:history.forward()")
  2331. If historylink And historylink.NextLink()
  2332. historylink=historylink.NextLink()
  2333. hposlink=hposlink.NextLink()
  2334. EndIf
  2335. If historylink path=String(historylink.Value())
  2336. script=1
  2337. ElseIf currenturl.StartsWith("javascript:history.go(")
  2338. If currenturl[22..23] = "-"
  2339. If historylink And historylink.PrevLink()
  2340. historylink=historylink.PrevLink()
  2341. hposlink=hposlink.PrevLink()
  2342. EndIf
  2343. Else
  2344. If historylink And historylink.NextLink()
  2345. historylink=historylink.NextLink()
  2346. hposlink=hposlink.NextLink()
  2347. EndIf
  2348. EndIf
  2349. If historylink path=String(historylink.Value())
  2350. script=1
  2351. EndIf
  2352. If Not path Return False
  2353. EndIf
  2354. currenturl=path
  2355. flSetPathView(flhandle,currenturl)
  2356. If path[..5]="file:" path=path[5..]
  2357. hash=path.find("#")
  2358. If hash<>-1
  2359. anchor=path[hash+1..]
  2360. path=path[..hash]
  2361. EndIf
  2362. stream=ReadStream(path)
  2363. If stream
  2364. html=LoadString(stream)
  2365. CloseStream stream
  2366. html=CleanHTML(html)
  2367. EndIf
  2368. flSetView(flhandle,html)
  2369. If addhistory And (Not script)
  2370. If anchor flSeekView(flhandle,anchor)
  2371. If Not history history=New TList
  2372. While historylink And historylink.NextLink()
  2373. historylink.NextLink().Remove
  2374. Wend
  2375. historylink=history.AddLast(currenturl)
  2376. If Not hpos hpos=New TList
  2377. While hposlink And hposlink.NextLink()
  2378. hposlink.NextLink().Remove
  2379. Wend
  2380. hposlink=hpos.AddLast(String(flGetLineView(flhandle)))
  2381. Else
  2382. flSetLineView(flhandle,Int(String(hposlink.Value())))
  2383. EndIf
  2384. Return True
  2385. End Method
  2386. Function ViewHandler:Byte Ptr(flhandle,uri:Byte Ptr) "C"
  2387. Return Null
  2388. End Function
  2389. EndType
  2390. Type TFLMenu Extends TFLWidget
  2391. Field text$
  2392. Field owner:TFLGadget
  2393. Field mparent:TFLMenu
  2394. Field mkids:TFLMenu[]
  2395. Field checked,disabled,divider,check
  2396. Field index
  2397. Field flshortcut
  2398. Method Delete()
  2399. Free()
  2400. EndMethod
  2401. Method Class()
  2402. Return GADGET_MENUITEM
  2403. EndMethod
  2404. Function CreateMenu:TFLMenu( text$,tag,parent:TFLMenu )
  2405. Local m:TFLMenu = New TFLMenu
  2406. m.text=text
  2407. m.tag=tag
  2408. If parent
  2409. m.parent=parent
  2410. parent.AddMenu m
  2411. EndIf
  2412. If LocalizationMode() & LOCALIZATION_OVERRIDE Then LocalizeGadget(m,text)
  2413. Return m
  2414. End Function
  2415. Method OnCallback()
  2416. Local m:TFLMenu = Self
  2417. ' choice menu
  2418. While (m)
  2419. If TFLComboBox(m.owner)
  2420. TFLComboBox(m.owner)._lastchoice = index
  2421. m.owner.SetText(text)
  2422. PostGuiEvent(EVENT_GADGETACTION,m.owner,index)
  2423. Return
  2424. EndIf
  2425. m=m.mparent
  2426. Wend
  2427. ' window menu
  2428. If check Then checked = Not checked
  2429. PostGuiEvent(EVENT_MENUACTION,Self,tag)
  2430. End Method
  2431. Method Free()
  2432. Local k:TFLMenu = mparent
  2433. If k And k.mkids
  2434. For Local i:Int = 0 Until k.mkids.length
  2435. If k.mkids[i]=Self
  2436. k.mkids=k.mkids[..i] + k.mkids[i+1..]
  2437. Exit
  2438. EndIf
  2439. Next
  2440. EndIf
  2441. owner = Null;mkids = Null;mparent = Null;parent = Null
  2442. If objhandle Then
  2443. Release objhandle
  2444. objhandle = 0
  2445. EndIf
  2446. End Method
  2447. Method count(id) 'recursively assign unique index to each node in tree, skips number for pop
  2448. index=id
  2449. id:+1
  2450. If mkids
  2451. For Local m:TFLMenu = EachIn mkids
  2452. id=m.count(id)
  2453. Next
  2454. id:+1
  2455. EndIf
  2456. Return id
  2457. End Method
  2458. Method SetFLMenu(flmenu Ptr) 'recursively set hosts menuitem slots
  2459. Local m:TFLMenu,mm:TFLMenu
  2460. Local flags, pfnthandle, pfntsize
  2461. m=Self
  2462. While (m)
  2463. If m.owner
  2464. pfnthandle = m.owner.font.handle
  2465. pfntsize = m.owner.font.GetSizeForFL()
  2466. EndIf
  2467. m=m.mparent
  2468. Wend
  2469. If Not pfnthandle Then pfnthandle = TFLTKGUIDriver.fntDefault.handle
  2470. If Not pfntsize Then pfntsize = TFLTKGUIDriver.fntDefault.GetSizeForFL()
  2471. If mkids
  2472. If index>-1 flSetMenuItem(flmenu,index,text,flshortcut,objhandle,FL_SUBMENU,pfnthandle,pfntsize) 'message
  2473. For m=EachIn mkids
  2474. m.divider=False
  2475. If m.text="" And mm mm.divider=True
  2476. mm=m
  2477. Next
  2478. For m=EachIn mkids
  2479. m.SetFLMenu(flmenu)
  2480. Next
  2481. Else
  2482. flags=0
  2483. If text="" flags:|FL_MENU_INVISIBLE
  2484. If divider flags:|FL_MENU_DIVIDER
  2485. If check
  2486. flags:|FL_MENU_TOGGLE
  2487. If checked flags:|FL_MENU_VALUE
  2488. EndIf
  2489. If disabled flags:|FL_MENU_INACTIVE
  2490. If index>-1 flSetMenuItem(flmenu,index,text,flshortcut,objhandle,flags,pfnthandle,pfntsize) 'message
  2491. EndIf
  2492. End Method
  2493. Method SetHotKey(keycode,modifier)
  2494. Local flkey = flkeyfromvkey(keycode)
  2495. If flkey flkey:+flstatefrommodifiers(modifier)
  2496. flshortcut=flkey
  2497. End Method
  2498. Method AddMenu( child:TFLMenu )
  2499. child.mparent=Self
  2500. child.owner = owner
  2501. mkids:+[child]
  2502. End Method
  2503. Method RemoveMenu( index )
  2504. ?debug
  2505. Assert index < mkids.length, "FLTK child menu index out of range."
  2506. ?
  2507. mkids[index].Free()
  2508. End Method
  2509. Method State()
  2510. Local t
  2511. If checked t:|STATE_SELECTED
  2512. If disabled t:|STATE_DISABLED
  2513. Return t
  2514. End Method
  2515. Method SetSelected(truefalse)
  2516. check=True
  2517. checked=truefalse
  2518. End Method
  2519. Method SetEnabled(bool)
  2520. disabled=Not bool
  2521. End Method
  2522. Method SetText(label$)
  2523. text=label
  2524. End Method
  2525. Method GetText$()
  2526. Return text
  2527. End Method
  2528. Method SetTooltip(tooltip$)
  2529. 'Do nothing - menus don't support tooltips (yet).
  2530. EndMethod
  2531. End Type
  2532. Type TFLIconStrip Extends TIconStrip
  2533. Field images[]
  2534. Field iconpixmaps:TPixmap[]
  2535. Method GetFLImage:Int(index:Int)
  2536. If index>=0 And index < images.length Then Return images[index]
  2537. EndMethod
  2538. Function IsNotBlank(pixmap:TPixmap)
  2539. Local x,y
  2540. Local w=pixmap.width
  2541. Local h=pixmap.height
  2542. Local c=pixmap.ReadPixel(0,0)
  2543. For x=0 Until h*h
  2544. If pixmap.ReadPixel(x / h,x Mod h)<>c Return True
  2545. Next
  2546. End Function
  2547. Function RemoveMask(pixmap:TPixmap)
  2548. Local x,y,c
  2549. If pixmap.format<>( PF_RGBA8888 ) And pixmap.format<>( PF_BGRA8888 ) Return
  2550. Local w=pixmap.width
  2551. Local h=pixmap.height
  2552. For x=0 Until w
  2553. For y=0 Until h
  2554. c=pixmap.ReadPixel(x,y)
  2555. If c>=0 pixmap.WritePixel x,y,-1
  2556. Next
  2557. Next
  2558. End Function
  2559. Function Create:TFLIconStrip(source:Object)
  2560. Local pixmap:TPixmap,pix:TPixmap,winpix:TPixmap
  2561. Local n,d
  2562. pix=TPixmap(source)
  2563. If Not pix pix=LoadPixmap(source)
  2564. If Not pix Return
  2565. n=pix.width/pix.height
  2566. If n=0 Return
  2567. Select PixmapFormat(pix)
  2568. Case PF_RGB888, PF_BGR888, PF_I8
  2569. d = 3
  2570. pixmap = ConvertPixmap(pix,PF_RGB888)
  2571. Case PF_RGBA8888, PF_BGRA8888, PF_A8
  2572. d = 4
  2573. pixmap = ConvertPixmap(pix,PF_RGBA8888)
  2574. Default
  2575. Return Null
  2576. EndSelect
  2577. Local icons:TFLIconStrip = New TFLIconStrip
  2578. icons.pixmap=pixmap
  2579. icons.count=n
  2580. icons.images=New Int[n]
  2581. icons.iconpixmaps=New TPixmap[n]
  2582. Local w = pixmap.height, h = w
  2583. For Local x:Int = 0 Until n
  2584. winpix=pixmap.Window(x*w,0,w,pixmap.height)
  2585. If IsNotBlank(winpix) Then
  2586. icons.iconpixmaps[x]=winpix
  2587. icons.images[x]=FLImage(icons.iconpixmaps[x].pixels,w,h,d,icons.iconpixmaps[x].pitch)
  2588. EndIf
  2589. Next
  2590. Return icons
  2591. End Function
  2592. Method Delete()
  2593. For Local tmpImage:Int = EachIn images
  2594. flFreeImage(tmpImage)
  2595. Next
  2596. images = Null;iconpixmaps = Null;pixmap = Null
  2597. EndMethod
  2598. End Type
  2599. Private
  2600. Function flkeyfromvkey(k)
  2601. If k>=48 And k<58 Return k
  2602. If k>=65 And k<95 Return k+32
  2603. If k>=KEY_F1 And k<=KEY_F12 Return 65470+k-KEY_F1
  2604. Select k
  2605. Case KEY_OPENBRACKET Return 91
  2606. Case KEY_CLOSEBRACKET Return 93
  2607. Case KEY_BACKSLASH Return 92
  2608. Case KEY_TAB Return FL_KEY_Tab
  2609. Case KEY_ENTER Return FL_KEY_Enter
  2610. Case KEY_ESCAPE Return FL_KEY_Escape
  2611. Case KEY_HOME Return FL_KEY_Home
  2612. Case KEY_LEFT Return FL_KEY_Left
  2613. Case KEY_UP Return FL_KEY_Up
  2614. Case KEY_RIGHT Return FL_KEY_Right
  2615. Case KEY_DOWN Return FL_KEY_Down
  2616. Case KEY_PAGEUP Return FL_KEY_Page_Up
  2617. Case KEY_PAGEDOWN Return FL_KEY_Page_Down
  2618. Case KEY_END Return FL_KEY_End
  2619. Case KEY_PRINT Return FL_KEY_Print
  2620. Case KEY_INSERT Return FL_KEY_Insert
  2621. Case KEY_BACKSPACE Return FL_KEY_Backspace
  2622. Case KEY_DELETE Return FL_KEY_Delete
  2623. End Select
  2624. Return k
  2625. End Function
  2626. Function flstatefrommodifiers(m)
  2627. Local state
  2628. If m&MODIFIER_SHIFT state:|FL_SHIFT
  2629. If m&MODIFIER_CONTROL state:|FL_CTRL
  2630. If m&MODIFIER_OPTION state:|FL_ALT
  2631. If m&MODIFIER_SYSTEM state:|FL_META
  2632. Return state
  2633. End Function
  2634. Function flkeytovkey(k)
  2635. If k>=48 And k<58 Return k
  2636. If k>=97 And k<127 Return KEY_A+k-97
  2637. If k>=65361 And k<65365 Return KEY_LEFT+k-65361
  2638. If k>=65470 And k<65470+13 Return KEY_F1+k-65470
  2639. If k=65307 Return KEY_ESCAPE
  2640. If k=65289 Return KEY_TAB
  2641. If k=65056 Return KEY_TAB
  2642. If k=91 Return KEY_OPENBRACKET
  2643. If k=93 Return KEY_CLOSEBRACKET
  2644. If k=92 Return KEY_BACKSLASH
  2645. Return k
  2646. End Function
  2647. Function flstatetomodifiers(state)
  2648. Local m
  2649. If (state & FL_SHIFT) m:|MODIFIER_SHIFT
  2650. If (state & FL_CTRL) m:|MODIFIER_CONTROL
  2651. If (state & FL_ALT) m:|MODIFIER_OPTION
  2652. If (state & FL_META) m:|MODIFIER_SYSTEM
  2653. Return m
  2654. End Function