TB2Dock.pas 175 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230
  1. unit TB2Dock;
  2. {
  3. Toolbar2000
  4. Copyright (C) 1998-2005 by Jordan Russell
  5. All rights reserved.
  6. The contents of this file are subject to the "Toolbar2000 License"; you may
  7. not use or distribute this file except in compliance with the
  8. "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
  9. TB2k-LICENSE.txt or at:
  10. https://jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
  11. Alternatively, the contents of this file may be used under the terms of the
  12. GNU General Public License (the "GPL"), in which case the provisions of the
  13. GPL are applicable instead of those in the "Toolbar2000 License". A copy of
  14. the GPL may be found in GPL-LICENSE.txt or at:
  15. https://jrsoftware.org/files/tb2k/GPL-LICENSE.txt
  16. If you wish to allow use of your version of this file only under the terms of
  17. the GPL and not to allow others to use your version of this file under the
  18. "Toolbar2000 License", indicate your decision by deleting the provisions
  19. above and replace them with the notice and other provisions required by the
  20. GPL. If you do not delete the provisions above, a recipient may use your
  21. version of this file under either the "Toolbar2000 License" or the GPL.
  22. $jrsoftware: tb2k/Source/TB2Dock.pas,v 1.99 2005/07/15 19:35:03 jr Exp $
  23. }
  24. interface
  25. {x$DEFINE TB2Dock_DisableLock}
  26. { Remove the 'x' to enable the define. It will disable calls to
  27. LockWindowUpdate, which it calls to disable screen updates while dragging.
  28. You may want to temporarily enable the define while debugging so you are able
  29. to see your code window while stepping through the dragging routines. }
  30. {$I TB2Ver.inc}
  31. uses
  32. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
  33. type
  34. { TTBDock }
  35. TTBDockBoundLinesValues = (blTop, blBottom, blLeft, blRight);
  36. TTBDockBoundLines = set of TTBDockBoundLinesValues;
  37. TTBDockPosition = (dpTop, dpBottom, dpLeft, dpRight);
  38. TTBDockType = (dtNotDocked, dtFloating, dtTopBottom, dtLeftRight);
  39. TTBDockableTo = set of TTBDockPosition;
  40. TTBCustomDockableWindow = class;
  41. TTBInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean;
  42. Bar: TTBCustomDockableWindow) of object;
  43. TTBRequestDockEvent = procedure(Sender: TObject; Bar: TTBCustomDockableWindow;
  44. var Accept: Boolean) of object;
  45. TTBDock = class(TCustomControl)
  46. private
  47. { Property values }
  48. FPosition: TTBDockPosition;
  49. FAllowDrag: Boolean;
  50. FBoundLines: TTBDockBoundLines;
  51. FBkgOnToolbars: Boolean;
  52. FFixAlign: Boolean;
  53. FCommitNewPositions: Boolean;
  54. FLimitToOneRow: Boolean;
  55. FOnInsertRemoveBar: TTBInsertRemoveEvent;
  56. FOnRequestDock: TTBRequestDockEvent;
  57. { Internal }
  58. FDisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars }
  59. FArrangeToolbarsNeeded: Boolean;
  60. FNonClientWidth, FNonClientHeight: Integer;
  61. { Property access methods }
  62. //function GetVersion: TToolbar97Version;
  63. procedure SetAllowDrag(Value: Boolean);
  64. procedure SetBoundLines(Value: TTBDockBoundLines);
  65. procedure SetFixAlign(Value: Boolean);
  66. procedure SetPosition(Value: TTBDockPosition);
  67. //procedure SetVersion(const Value: TToolbar97Version);
  68. function GetToolbarCount: Integer;
  69. function GetToolbars(Index: Integer): TTBCustomDockableWindow;
  70. { Internal }
  71. procedure ChangeDockList(const Insert: Boolean; const Bar: TTBCustomDockableWindow);
  72. procedure CommitPositions;
  73. procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  74. const Clip: HRGN);
  75. function GetDesignModeRowOf(const XY: Integer): Integer;
  76. procedure RelayMsgToFloatingBars(var Message: TMessage);
  77. procedure ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow;
  78. const ForceRemove: Boolean);
  79. { Messages }
  80. procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  81. procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  82. procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  83. procedure WMMove(var Message: TWMMove); message WM_MOVE;
  84. procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  85. procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  86. procedure WMPrint(var Message: TMessage); message WM_PRINT;
  87. procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
  88. procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  89. protected
  90. DockList: TList; { List of the toolbars docked, and those floating and have LastDock
  91. pointing to the dock. Items are casted in TTBCustomDockableWindow's. }
  92. DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars }
  93. function Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean; virtual;
  94. procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  95. procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer);
  96. procedure DrawBackground(DC: HDC; const DrawRect: TRect); virtual;
  97. function HasVisibleToolbars: Boolean;
  98. procedure InvalidateBackgrounds;
  99. procedure Loaded; override;
  100. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  101. procedure SetParent(AParent: TWinControl); override;
  102. function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean;
  103. procedure Paint; override;
  104. function UsingBackground: Boolean; virtual;
  105. property ArrangeToolbarsNeeded: Boolean read FArrangeToolbarsNeeded write FArrangeToolbarsNeeded;
  106. property DisableArrangeToolbars: Integer read FDisableArrangeToolbars write FDisableArrangeToolbars;
  107. public
  108. constructor Create(AOwner: TComponent); override;
  109. procedure CreateParams(var Params: TCreateParams); override;
  110. destructor Destroy; override;
  111. procedure ArrangeToolbars; virtual;
  112. procedure BeginUpdate;
  113. procedure EndUpdate;
  114. function GetCurrentRowSize(const Row: Integer; var AFullSize: Boolean): Integer;
  115. function GetHighestRow(const HighestEffective: Boolean): Integer;
  116. function GetMinRowSize(const Row: Integer;
  117. const ExcludeControl: TTBCustomDockableWindow): Integer;
  118. property CommitNewPositions: Boolean read FCommitNewPositions write FCommitNewPositions;
  119. property NonClientWidth: Integer read FNonClientWidth;
  120. property NonClientHeight: Integer read FNonClientHeight;
  121. property ToolbarCount: Integer read GetToolbarCount;
  122. property Toolbars[Index: Integer]: TTBCustomDockableWindow read GetToolbars;
  123. published
  124. property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True;
  125. property BoundLines: TTBDockBoundLines read FBoundLines write SetBoundLines default [];
  126. property Color default clBtnFace;
  127. property FixAlign: Boolean read FFixAlign write SetFixAlign default False;
  128. property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False;
  129. property PopupMenu;
  130. property Position: TTBDockPosition read FPosition write SetPosition default dpTop;
  131. property Visible;
  132. property OnContextPopup;
  133. property OnInsertRemoveBar: TTBInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar;
  134. property OnMouseDown;
  135. property OnMouseMove;
  136. property OnMouseUp;
  137. property OnRequestDock: TTBRequestDockEvent read FOnRequestDock write FOnRequestDock;
  138. property OnResize;
  139. end;
  140. { TTBFloatingWindowParent - internal }
  141. TTBToolWindowNCRedrawWhatElement = (twrdBorder, twrdCaption, twrdCloseButton);
  142. TTBToolWindowNCRedrawWhat = set of TTBToolWindowNCRedrawWhatElement;
  143. TTBFloatingWindowParentClass = class of TTBFloatingWindowParent;
  144. TTBFloatingWindowParent = class(TCustomForm)
  145. private
  146. FCloseButtonDown: Boolean; { True if Close button is currently depressed }
  147. FDockableWindow: TTBCustomDockableWindow;
  148. FParentForm: TCustomForm;
  149. FShouldShow: Boolean;
  150. procedure SetCloseButtonState(Pushed: Boolean);
  151. procedure RedrawNCArea(const RedrawWhat: TTBToolWindowNCRedrawWhat);
  152. procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  153. procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  154. procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  155. procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
  156. procedure WMClose(var Message: TWMClose); message WM_CLOSE;
  157. procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  158. procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
  159. procedure WMMove(var Message: TWMMove); message WM_MOVE;
  160. procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  161. procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  162. procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
  163. procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  164. procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  165. procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP;
  166. procedure WMPrint(var Message: TMessage); message WM_PRINT;
  167. procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
  168. protected
  169. procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  170. procedure CreateParams(var Params: TCreateParams); override;
  171. procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  172. const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); dynamic;
  173. property DockableWindow: TTBCustomDockableWindow read FDockableWindow;
  174. property CloseButtonDown: Boolean read FCloseButtonDown;
  175. public
  176. property ParentForm: TCustomForm read FParentForm;
  177. constructor Create(AOwner: TComponent); override;
  178. destructor Destroy; override;
  179. end;
  180. { TTBCustomDockableWindow }
  181. TTBDockChangingEvent = procedure(Sender: TObject; Floating: Boolean;
  182. DockingTo: TTBDock) of object;
  183. TTBDragHandleStyle = (dhDouble, dhNone, dhSingle);
  184. TTBDockMode = (dmCanFloat, dmCannotFloat, dmCannotFloatOrChangeDocks);
  185. TTBFloatingMode = (fmOnTopOfParentForm, fmOnTopOfAllForms);
  186. TTBSizeHandle = (twshLeft, twshRight, twshTop, twshTopLeft,
  187. twshTopRight, twshBottom, twshBottomLeft, twshBottomRight);
  188. { ^ must be in same order as HTLEFT..HTBOTTOMRIGHT }
  189. TTBPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint;
  190. const ExtraData: Pointer): Longint;
  191. TTBPositionReadStringProc = function(const ToolbarName, Value, Default: String;
  192. const ExtraData: Pointer): String;
  193. TTBPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint;
  194. const ExtraData: Pointer);
  195. TTBPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String;
  196. const ExtraData: Pointer);
  197. TTBReadPositionData = record
  198. ReadIntProc: TTBPositionReadIntProc;
  199. ReadStringProc: TTBPositionReadStringProc;
  200. ExtraData: Pointer;
  201. end;
  202. TTBDockableWindowStyles = set of (tbdsResizeEightCorner, tbdsResizeClipCursor);
  203. TTBShrinkMode = (tbsmNone, tbsmWrap, tbsmChevron);
  204. TTBCustomDockableWindow = class(TCustomControl)
  205. private
  206. { Property variables }
  207. FAutoResize: Boolean;
  208. FDblClickUndock: Boolean;
  209. FDockPos, FDockRow, FEffectiveDockPos, FEffectiveDockRow: Integer;
  210. FDocked: Boolean;
  211. FCurrentDock, FDefaultDock, FLastDock: TTBDock;
  212. FCurrentSize: Integer;
  213. FFloating: Boolean;
  214. FOnClose, FOnDockChanged, FOnMove, FOnRecreated,
  215. FOnRecreating,
  216. FOnVisibleChanged: TNotifyEvent;
  217. FOnCloseQuery: TCloseQueryEvent;
  218. FOnDockChanging, FOnDockChangingHidden: TTBDockChangingEvent;
  219. FActivateParent, FHideWhenInactive, FCloseButton, FCloseButtonWhenDocked,
  220. FFullSize, FResizable, FShowCaption, FStretch, FUseLastDock: Boolean;
  221. FBorderStyle: TBorderStyle;
  222. FDockMode: TTBDockMode;
  223. FDragHandleStyle: TTBDragHandleStyle;
  224. FDockableTo: TTBDockableTo;
  225. FFloatingMode: TTBFloatingMode;
  226. FSmoothDrag: Boolean;
  227. FDockableWindowStyles: TTBDockableWindowStyles;
  228. FLastRowSize: Integer;
  229. FInsertRowBefore: Boolean;
  230. { Misc. }
  231. FUpdatingBounds, { Incremented while internally changing the bounds. This allows
  232. it to move the toolbar freely in design mode and prevents the
  233. SizeChanging protected method from begin called }
  234. FDisableArrange, { Incremented to disable Arrange }
  235. FDisableOnMove, { Incremented to prevent WM_MOVE handler from calling the OnMoved handler }
  236. FHidden: Integer; { Incremented while the toolbar is temporarily hidden }
  237. FArrangeNeeded, FMoved: Boolean;
  238. FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color }
  239. FFloatingPosition: TPoint;
  240. FDockForms: TList;
  241. FSavedAtRunTime: Boolean;
  242. //FNonClientWidth, FNonClientHeight: Integer;
  243. FDragMode, FDragSplitting, FDragCanSplit: Boolean;
  244. FSmoothDragging: Boolean;
  245. { When floating. These are not used in design mode }
  246. FCloseButtonDown: Boolean; { True if Close button is currently depressed }
  247. FCloseButtonHover: Boolean;
  248. FFloatParent: TTBFloatingWindowParent; { Run-time only: The actual Parent of the toolbar when it is floating }
  249. { Property access methods }
  250. //function GetVersion: TToolbar97Version;
  251. function GetNonClientWidth: Integer;
  252. function GetNonClientHeight: Integer;
  253. function IsLastDockStored: Boolean;
  254. function IsWidthAndHeightStored: Boolean;
  255. procedure SetAutoResize(Value: Boolean);
  256. procedure SetBorderStyle(Value: TBorderStyle);
  257. procedure SetCloseButton(Value: Boolean);
  258. procedure SetCloseButtonWhenDocked(Value: Boolean);
  259. procedure SetCurrentDock(Value: TTBDock);
  260. procedure SetDefaultDock(Value: TTBDock);
  261. procedure SetDockPos(Value: Integer);
  262. procedure SetDockRow(Value: Integer);
  263. procedure SetDragHandleStyle(Value: TTBDragHandleStyle);
  264. procedure SetFloating(Value: Boolean);
  265. procedure SetFloatingMode(Value: TTBFloatingMode);
  266. procedure SetFloatingPosition(Value: TPoint);
  267. procedure SetFullSize(Value: Boolean);
  268. procedure SetLastDock(Value: TTBDock);
  269. procedure SetResizable(Value: Boolean);
  270. procedure SetShowCaption(Value: Boolean);
  271. procedure SetStretch(Value: Boolean);
  272. procedure SetUseLastDock(Value: Boolean);
  273. //procedure SetVersion(const Value: TToolbar97Version);
  274. { Internal }
  275. procedure CancelNCHover;
  276. procedure DrawDraggingOutline(const DC: HDC; const NewRect, OldRect: PRect;
  277. const NewDocking, OldDocking: Boolean);
  278. procedure RedrawNCArea;
  279. procedure SetCloseButtonState(Pushed: Boolean);
  280. procedure ShowNCContextMenu(const Pos: TSmallPoint);
  281. procedure Moved;
  282. function GetShowingState: Boolean;
  283. procedure UpdateCaptionState;
  284. procedure UpdateTopmostFlag;
  285. procedure UpdateVisibility;
  286. procedure ReadSavedAtRunTime(Reader: TReader);
  287. procedure WriteSavedAtRunTime(Writer: TWriter);
  288. function GetDragHandleSize: Integer;
  289. function GetDragHandleXOffset: Integer;
  290. { Messages }
  291. procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  292. procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  293. procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  294. procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  295. procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  296. procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  297. procedure WMEnable(var Message: TWMEnable); message WM_ENABLE;
  298. procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  299. procedure WMMove(var Message: TWMMove); message WM_MOVE;
  300. procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
  301. procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  302. procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  303. procedure WMNCMouseLeave(var Message: TMessage); message $2A2 {WM_NCMOUSELEAVE};
  304. procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
  305. procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
  306. procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  307. procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  308. procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP;
  309. procedure WMPrint(var Message: TMessage); message WM_PRINT;
  310. procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
  311. procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  312. protected
  313. property ActivateParent: Boolean read FActivateParent write FActivateParent default True;
  314. property AutoResize: Boolean read FAutoResize write SetAutoResize default True;
  315. property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  316. property Color default clBtnFace;
  317. property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
  318. property CloseButtonDown: Boolean read FCloseButtonDown;
  319. property CloseButtonHover: Boolean read FCloseButtonHover;
  320. property CloseButtonWhenDocked: Boolean read FCloseButtonWhenDocked write SetCloseButtonWhenDocked default False;
  321. property DefaultDock: TTBDock read FDefaultDock write SetDefaultDock;
  322. property DockableTo: TTBDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight];
  323. property DockableWindowStyles: TTBDockableWindowStyles read FDockableWindowStyles write FDockableWindowStyles;
  324. property DockMode: TTBDockMode read FDockMode write FDockMode default dmCanFloat;
  325. property DragHandleStyle: TTBDragHandleStyle read FDragHandleStyle write SetDragHandleStyle default dhSingle;
  326. property FloatingMode: TTBFloatingMode read FFloatingMode write SetFloatingMode default fmOnTopOfParentForm;
  327. property FullSize: Boolean read FFullSize write SetFullSize default False;
  328. property InactiveCaption: Boolean read FInactiveCaption;
  329. property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True;
  330. property Resizable: Boolean read FResizable write SetResizable default True;
  331. property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
  332. property SmoothDrag: Boolean read FSmoothDrag write FSmoothDrag default True;
  333. property Stretch: Boolean read FStretch write SetStretch default False;
  334. property UseLastDock: Boolean read FUseLastDock write SetUseLastDock default True;
  335. property OnClose: TNotifyEvent read FOnClose write FOnClose;
  336. property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
  337. property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged;
  338. property OnDockChanging: TTBDockChangingEvent read FOnDockChanging write FOnDockChanging;
  339. property OnDockChangingHidden: TTBDockChangingEvent read FOnDockChangingHidden write FOnDockChangingHidden;
  340. property OnMove: TNotifyEvent read FOnMove write FOnMove;
  341. property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated;
  342. property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating;
  343. property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;
  344. { Overridden methods }
  345. procedure CreateParams(var Params: TCreateParams); override;
  346. procedure DefineProperties(Filer: TFiler); override;
  347. function GetPalette: HPALETTE; override;
  348. procedure Loaded; override;
  349. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  350. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  351. function PaletteChanged(Foreground: Boolean): Boolean; override;
  352. procedure SetParent(AParent: TWinControl); override;
  353. { Methods accessible to descendants }
  354. procedure Arrange;
  355. function CalcNCSizes: TPoint; virtual;
  356. function CanDockTo(ADock: TTBDock): Boolean; virtual;
  357. procedure ChangeSize(AWidth, AHeight: Integer);
  358. function ChildControlTransparent(Ctl: TControl): Boolean; dynamic;
  359. procedure Close;
  360. procedure ControlExistsAtPos(const P: TPoint; var ControlExists: Boolean); virtual;
  361. function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType;
  362. NewFloating: Boolean; NewDock: TTBDock): TPoint; virtual; abstract;
  363. procedure DoDockChangingHidden(NewFloating: Boolean; DockingTo: TTBDock); dynamic;
  364. procedure DoubleClick;
  365. procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  366. const Clip: HRGN); virtual;
  367. procedure GetBaseSize(var ASize: TPoint); virtual; abstract;
  368. function GetDockedCloseButtonRect(LeftRight: Boolean): TRect; virtual;
  369. function GetFloatingWindowParentClass: TTBFloatingWindowParentClass; dynamic;
  370. procedure GetMinShrinkSize(var AMinimumSize: Integer); virtual;
  371. procedure GetMinMaxSize(var AMinClientWidth, AMinClientHeight,
  372. AMaxClientWidth, AMaxClientHeight: Integer); virtual;
  373. function GetShrinkMode: TTBShrinkMode; virtual;
  374. procedure InitializeOrdering; dynamic;
  375. function IsAutoResized: Boolean;
  376. procedure ResizeBegin(SizeHandle: TTBSizeHandle); dynamic;
  377. procedure ResizeEnd; dynamic;
  378. procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); dynamic;
  379. procedure ResizeTrackAccept; dynamic;
  380. procedure SizeChanging(const AWidth, AHeight: Integer); virtual;
  381. property EffectiveDockPosAccess: Integer read FEffectiveDockPos write FEffectiveDockPos;
  382. property EffectiveDockRowAccess: Integer read FEffectiveDockRow write FEffectiveDockRow;
  383. public
  384. property DblClickUndock: Boolean read FDblClickUndock write FDblClickUndock default True;
  385. property Docked: Boolean read FDocked;
  386. property Canvas;
  387. property CurrentDock: TTBDock read FCurrentDock write SetCurrentDock stored False;
  388. property CurrentSize: Integer read FCurrentSize write FCurrentSize;
  389. property DockPos: Integer read FDockPos write SetDockPos default -1;
  390. property DockRow: Integer read FDockRow write SetDockRow default 0;
  391. property DragMode: Boolean read FDragMode;
  392. property DragSplitting: Boolean read FDragSplitting;
  393. property EffectiveDockPos: Integer read FEffectiveDockPos;
  394. property EffectiveDockRow: Integer read FEffectiveDockRow;
  395. property Floating: Boolean read FFloating write SetFloating default False;
  396. property FloatingPosition: TPoint read FFloatingPosition write SetFloatingPosition;
  397. property LastDock: TTBDock read FLastDock write SetLastDock stored IsLastDockStored;
  398. property NonClientWidth: Integer read GetNonClientWidth;
  399. property NonClientHeight: Integer read GetNonClientHeight;
  400. constructor Create(AOwner: TComponent); override;
  401. destructor Destroy; override;
  402. function GetParentComponent: TComponent; override;
  403. function HasParent: Boolean; override;
  404. procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  405. procedure AddDockForm(const Form: TCustomForm);
  406. procedure AddDockedNCAreaToSize(var S: TPoint; const LeftRight: Boolean);
  407. procedure AddFloatingNCAreaToSize(var S: TPoint);
  408. procedure BeginMoving(const InitX, InitY: Integer);
  409. procedure BeginSizing(const ASizeHandle: TTBSizeHandle);
  410. procedure BeginUpdate;
  411. procedure EndUpdate;
  412. procedure GetDockedNCArea(var TopLeft, BottomRight: TPoint;
  413. const LeftRight: Boolean);
  414. function GetFloatingBorderSize: TPoint; virtual;
  415. procedure GetFloatingNCArea(var TopLeft, BottomRight: TPoint);
  416. function IsMovable: Boolean;
  417. procedure MoveOnScreen(const OnlyIfFullyOffscreen: Boolean);
  418. procedure ReadPositionData(var S: string); dynamic;
  419. procedure RemoveDockForm(const Form: TCustomForm);
  420. function WritePositionData: string; dynamic;
  421. published
  422. property Height stored IsWidthAndHeightStored;
  423. property Width stored IsWidthAndHeightStored;
  424. end;
  425. procedure TBRegLoadPositions(const OwnerComponent: TComponent;
  426. const RootKey: DWORD; const BaseRegistryKey: String);
  427. procedure TBRegSavePositions(const OwnerComponent: TComponent;
  428. const RootKey: DWORD; const BaseRegistryKey: String);
  429. procedure TBIniLoadPositions(const OwnerComponent: TComponent;
  430. const Filename, SectionNamePrefix: String);
  431. procedure TBIniSavePositions(const OwnerComponent: TComponent;
  432. const Filename, SectionNamePrefix: String);
  433. procedure TBCustomLoadPositions(const OwnerComponent: TComponent;
  434. const ReadIntProc: TTBPositionReadIntProc;
  435. const ReadStringProc: TTBPositionReadStringProc; const ExtraData: Pointer);
  436. procedure TBCustomSavePositions(const OwnerComponent: TComponent;
  437. const WriteIntProc: TTBPositionWriteIntProc;
  438. const WriteStringProc: TTBPositionWriteStringProc; const ExtraData: Pointer);
  439. function TBGetDockTypeOf(const Control: TTBDock; const Floating: Boolean): TTBDockType;
  440. function TBGetToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow):
  441. TCustomForm;
  442. function TBValidToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow):
  443. TCustomForm;
  444. implementation
  445. uses
  446. Registry, IniFiles, Consts, Menus,
  447. TB2Common, TB2Hook, TB2Consts, Types, PasTools;
  448. type
  449. TControlAccess = class(TControl);
  450. const
  451. DockedBorderSize = 2;
  452. DockedBorderSize2 = DockedBorderSize*2;
  453. var
  454. DragHandleSizes: array[Boolean, TTBDragHandleStyle] of Integer =
  455. ((9, 0, 6), (14, 14, 14));
  456. DragHandleXOffsets: array[Boolean, TTBDragHandleStyle] of Integer =
  457. ((2, 0, 1), (3, 0, 5));
  458. const
  459. HT_TB2k_Border = 2000;
  460. HT_TB2k_Close = 2001;
  461. HT_TB2k_Caption = 2002;
  462. ForceDockAtTopRow = 0;
  463. ForceDockAtLeftPos = -8;
  464. PositionLeftOrRight = [dpLeft, dpRight];
  465. twrdAll = [Low(TTBToolWindowNCRedrawWhatElement)..High(TTBToolWindowNCRedrawWhatElement)];
  466. { Constants for TTBCustomDockableWindow registry values/data.
  467. Don't localize any of these names! }
  468. rvRev = 'Rev';
  469. rdCurrentRev = 2000;
  470. rvVisible = 'Visible';
  471. rvDockedTo = 'DockedTo';
  472. rdDockedToFloating = '+';
  473. rvLastDock = 'LastDock';
  474. rvDockRow = 'DockRow';
  475. rvDockPos = 'DockPos';
  476. rvFloatLeft = 'FloatLeft';
  477. rvFloatTop = 'FloatTop';
  478. threadvar
  479. FloatingToolWindows: TList;
  480. { Misc. functions }
  481. function GetSmallCaptionHeight(Control: TControl): Integer;
  482. { Returns height of the caption of a small window }
  483. begin
  484. Result := GetSystemMetricsForControl(Control, SM_CYSMCAPTION);
  485. end;
  486. function GetMDIParent(const Form: TCustomForm): TCustomForm;
  487. { Returns the parent of the specified MDI child form. But, if Form isn't a
  488. MDI child, it simply returns Form. }
  489. var
  490. I, J: Integer;
  491. begin
  492. Result := Form;
  493. if Form = nil then Exit;
  494. if (Form is TForm) and
  495. (TForm(Form).FormStyle = fsMDIChild) then
  496. for I := 0 to Screen.FormCount-1 do
  497. with Screen.Forms[I] do begin
  498. if FormStyle <> fsMDIForm then Continue;
  499. for J := 0 to MDIChildCount-1 do
  500. if MDIChildren[J] = Form then begin
  501. Result := Screen.Forms[I];
  502. Exit;
  503. end;
  504. end;
  505. end;
  506. function TBGetDockTypeOf(const Control: TTBDock; const Floating: Boolean): TTBDockType;
  507. begin
  508. if Floating then
  509. Result := dtFloating
  510. else
  511. if Control = nil then
  512. Result := dtNotDocked
  513. else begin
  514. if not(Control.Position in PositionLeftOrRight) then
  515. Result := dtTopBottom
  516. else
  517. Result := dtLeftRight;
  518. end;
  519. end;
  520. function TBGetToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TCustomForm;
  521. var
  522. Ctl: TWinControl;
  523. begin
  524. Result := nil;
  525. Ctl := ToolWindow;
  526. while Assigned(Ctl.Parent) do begin
  527. if Ctl.Parent is TCustomForm then
  528. Result := TCustomForm(Ctl.Parent);
  529. Ctl := Ctl.Parent;
  530. end;
  531. { ^ for compatibility with ActiveX controls, that code is used instead of
  532. GetParentForm because it returns nil unless the form is the *topmost*
  533. parent }
  534. if Result is TTBFloatingWindowParent then
  535. Result := TTBFloatingWindowParent(Result).ParentForm;
  536. end;
  537. function TBValidToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TCustomForm;
  538. begin
  539. Result := TBGetToolWindowParentForm(ToolWindow);
  540. if Result = nil then
  541. raise EInvalidOperation.CreateFmt(SParentRequired, [ToolWindow.Name]);
  542. end;
  543. procedure ToolbarHookProc(Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
  544. var
  545. I: Integer;
  546. ToolWindow: TTBCustomDockableWindow;
  547. Form: TCustomForm;
  548. begin
  549. case Code of
  550. hpSendActivate,
  551. hpSendActivateApp: begin
  552. if Assigned(FloatingToolWindows) then
  553. for I := 0 to FloatingToolWindows.Count-1 do
  554. with TTBCustomDockableWindow(FloatingToolWindows.List[I]) do
  555. { Hide or restore toolbars when a form or the application is
  556. deactivated or activated, and/or update their caption state
  557. (active/inactive) }
  558. UpdateVisibility;
  559. end;
  560. hpSendWindowPosChanged: begin
  561. if Assigned(FloatingToolWindows) then
  562. for I := 0 to FloatingToolWindows.Count-1 do begin
  563. ToolWindow := TTBCustomDockableWindow(FloatingToolWindows.List[I]);
  564. with ToolWindow do begin
  565. if (FFloatingMode = fmOnTopOfParentForm) and HandleAllocated then begin
  566. with PWindowPos(LParam)^ do
  567. { Call UpdateVisibility if parent form's visibility has
  568. changed, or if it has been minimized or restored }
  569. if ((flags and (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0) or
  570. (flags and SWP_FRAMECHANGED <> 0)) then begin
  571. Form := TBGetToolWindowParentForm(ToolWindow);
  572. if Assigned(Form) and Form.HandleAllocated and ((Wnd = Form.Handle) or IsChild(Wnd, Form.Handle)) then
  573. UpdateVisibility;
  574. end;
  575. end;
  576. end;
  577. end;
  578. end;
  579. hpPreDestroy: begin
  580. if Assigned(FloatingToolWindows) then
  581. for I := 0 to FloatingToolWindows.Count-1 do begin
  582. with TTBCustomDockableWindow(FloatingToolWindows.List[I]) do
  583. { It must remove the form window's ownership of the tool window
  584. *before* the form gets destroyed, otherwise Windows will destroy
  585. the tool window's handle. }
  586. if Assigned(Parent) and Parent.HandleAllocated and
  587. (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) = Wnd) then
  588. SetWindowLong(Parent.Handle, GWL_HWNDPARENT, Longint(Application.Handle));
  589. { ^ Restore GWL_HWNDPARENT back to Application.Handle }
  590. end;
  591. end;
  592. end;
  593. end;
  594. type
  595. PFindWindowData = ^TFindWindowData;
  596. TFindWindowData = record
  597. TaskActiveWindow, TaskFirstWindow, TaskFirstTopMost: HWND;
  598. end;
  599. function DoFindWindow(Wnd: HWND; Param: Longint): Bool; stdcall;
  600. begin
  601. with PFindWindowData(Param)^ do
  602. if (Wnd <> TaskActiveWindow) and (Wnd <> Application.Handle) and
  603. IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then begin
  604. if GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then begin
  605. if TaskFirstWindow = 0 then TaskFirstWindow := Wnd;
  606. end
  607. else begin
  608. if TaskFirstTopMost = 0 then TaskFirstTopMost := Wnd;
  609. end;
  610. end;
  611. Result := True;
  612. end;
  613. function FindTopLevelWindow(ActiveWindow: HWND): HWND;
  614. var
  615. FindData: TFindWindowData;
  616. begin
  617. with FindData do begin
  618. TaskActiveWindow := ActiveWindow;
  619. TaskFirstWindow := 0;
  620. TaskFirstTopMost := 0;
  621. EnumThreadWindows(GetCurrentThreadID, @DoFindWindow, Longint(@FindData));
  622. if TaskFirstWindow <> 0 then
  623. Result := TaskFirstWindow
  624. else
  625. Result := TaskFirstTopMost;
  626. end;
  627. end;
  628. function IsAncestorOfWindow(const ParentWnd: HWND; Wnd: HWND): Boolean;
  629. { Returns True if Wnd is a child of, is owned by, or is the same window as
  630. ParentWnd }
  631. begin
  632. while Wnd <> 0 do begin
  633. if Wnd = ParentWnd then begin
  634. Result := True;
  635. Exit;
  636. end;
  637. Wnd := GetParent(Wnd);
  638. end;
  639. Result := False;
  640. end;
  641. procedure RecalcNCArea(const Ctl: TWinControl);
  642. begin
  643. if Ctl.HandleAllocated then
  644. SetWindowPos(Ctl.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
  645. SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  646. end;
  647. procedure InvalidateAll(const Ctl: TWinControl);
  648. { Invalidate both non-client and client area, and erase. }
  649. begin
  650. if Ctl.HandleAllocated then
  651. RedrawWindow(Ctl.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
  652. RDW_ERASE or RDW_NOCHILDREN);
  653. end;
  654. type
  655. TSetCloseButtonStateProc = procedure(Pushed: Boolean) of object;
  656. function CloseButtonLoop(const Wnd: HWND; const ButtonRect: TRect;
  657. const SetCloseButtonStateProc: TSetCloseButtonStateProc): Boolean;
  658. function MouseInButton: Boolean;
  659. var
  660. P: TPoint;
  661. begin
  662. GetCursorPos(P);
  663. Result := PtInRect(ButtonRect, P);
  664. end;
  665. var
  666. Msg: TMsg;
  667. begin
  668. Result := False;
  669. SetCloseButtonStateProc(MouseInButton);
  670. SetCapture(Wnd);
  671. try
  672. while GetCapture = Wnd do begin
  673. case Integer(GetMessage(Msg, 0, 0, 0)) of
  674. -1: Break; { if GetMessage failed }
  675. 0: begin
  676. { Repost WM_QUIT messages }
  677. PostQuitMessage(Msg.WParam);
  678. Break;
  679. end;
  680. end;
  681. case Msg.Message of
  682. WM_KEYDOWN, WM_KEYUP:
  683. { Ignore all keystrokes while in a close button loop }
  684. ;
  685. WM_MOUSEMOVE: begin
  686. { Note to self: WM_MOUSEMOVE messages should never be dispatched
  687. here to ensure no hints get shown }
  688. SetCloseButtonStateProc(MouseInButton);
  689. end;
  690. WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  691. { Make sure it doesn't begin another loop }
  692. Break;
  693. WM_LBUTTONUP: begin
  694. if MouseInButton then
  695. Result := True;
  696. Break;
  697. end;
  698. WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  699. { Ignore all other mouse up/down messages }
  700. ;
  701. else
  702. TranslateMessage(Msg);
  703. DispatchMessage(Msg);
  704. end;
  705. end;
  706. finally
  707. if GetCapture = Wnd then
  708. ReleaseCapture;
  709. SetCloseButtonStateProc(False);
  710. end;
  711. end;
  712. { TTBDock - internal }
  713. constructor TTBDock.Create(AOwner: TComponent);
  714. begin
  715. inherited;
  716. ControlStyle := ControlStyle + [csAcceptsControls, csMenuEvents] -
  717. [csClickEvents, csCaptureMouse, csOpaque];
  718. FAllowDrag := True;
  719. FBkgOnToolbars := True;
  720. DockList := TList.Create;
  721. DockVisibleList := TList.Create;
  722. Color := clBtnFace;
  723. Position := dpTop;
  724. end;
  725. procedure TTBDock.CreateParams(var Params: TCreateParams);
  726. begin
  727. inherited;
  728. { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
  729. and are not necessary for this control at run time }
  730. if not(csDesigning in ComponentState) then
  731. with Params.WindowClass do
  732. Style := Style and not(CS_HREDRAW or CS_VREDRAW);
  733. end;
  734. destructor TTBDock.Destroy;
  735. begin
  736. inherited;
  737. DockVisibleList.Free;
  738. DockList.Free;
  739. end;
  740. procedure TTBDock.SetParent(AParent: TWinControl);
  741. begin
  742. if (AParent is TTBCustomDockableWindow) or (AParent is TTBDock) then
  743. raise EInvalidOperation.Create(STBDockParentNotAllowed);
  744. inherited;
  745. end;
  746. procedure TTBDock.BeginUpdate;
  747. begin
  748. Inc(FDisableArrangeToolbars);
  749. end;
  750. procedure TTBDock.EndUpdate;
  751. begin
  752. Dec(FDisableArrangeToolbars);
  753. if FArrangeToolbarsNeeded and (FDisableArrangeToolbars = 0) then
  754. ArrangeToolbars;
  755. end;
  756. function TTBDock.HasVisibleToolbars: Boolean;
  757. var
  758. I: Integer;
  759. begin
  760. Result := False;
  761. for I := 0 to DockList.Count-1 do
  762. if ToolbarVisibleOnDock(TTBCustomDockableWindow(DockList[I])) then begin
  763. Result := True;
  764. Break;
  765. end;
  766. end;
  767. function TTBDock.ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean;
  768. begin
  769. Result := (AToolbar.Parent = Self) and
  770. (AToolbar.Visible or (csDesigning in AToolbar.ComponentState));
  771. end;
  772. function TTBDock.GetCurrentRowSize(const Row: Integer;
  773. var AFullSize: Boolean): Integer;
  774. var
  775. I, J: Integer;
  776. T: TTBCustomDockableWindow;
  777. begin
  778. Result := 0;
  779. AFullSize := False;
  780. if Row < 0 then Exit;
  781. for I := 0 to DockList.Count-1 do begin
  782. T := DockList[I];
  783. if (T.FEffectiveDockRow = Row) and ToolbarVisibleOnDock(T) then begin
  784. AFullSize := T.FullSize;
  785. if not(Position in PositionLeftOrRight) then
  786. J := T.Height
  787. else
  788. J := T.Width;
  789. if J > Result then
  790. Result := J;
  791. end;
  792. end;
  793. end;
  794. function TTBDock.GetMinRowSize(const Row: Integer;
  795. const ExcludeControl: TTBCustomDockableWindow): Integer;
  796. var
  797. I, J: Integer;
  798. T: TTBCustomDockableWindow;
  799. begin
  800. Result := 0;
  801. if Row < 0 then Exit;
  802. for I := 0 to DockList.Count-1 do begin
  803. T := DockList[I];
  804. if (T <> ExcludeControl) and (T.FEffectiveDockRow = Row) and
  805. ToolbarVisibleOnDock(T) then begin
  806. J := T.FLastRowSize;
  807. if J > Result then
  808. Result := J;
  809. end;
  810. end;
  811. end;
  812. function TTBDock.GetDesignModeRowOf(const XY: Integer): Integer;
  813. { Similar to GetRowOf, but is a little different to accomidate design mode
  814. better }
  815. var
  816. HighestRowPlus1, R, CurY, CurRowSize: Integer;
  817. FullSize: Boolean;
  818. begin
  819. Result := 0;
  820. HighestRowPlus1 := GetHighestRow(True)+1;
  821. CurY := 0;
  822. for R := 0 to HighestRowPlus1 do begin
  823. Result := R;
  824. if R = HighestRowPlus1 then Break;
  825. CurRowSize := GetCurrentRowSize(R, FullSize);
  826. if CurRowSize = 0 then Continue;
  827. Inc(CurY, CurRowSize);
  828. if XY < CurY then
  829. Break;
  830. end;
  831. end;
  832. function TTBDock.GetHighestRow(const HighestEffective: Boolean): Integer;
  833. { Returns highest used row number, or -1 if no rows are used }
  834. var
  835. I, J: Integer;
  836. begin
  837. Result := -1;
  838. for I := 0 to DockList.Count-1 do
  839. with TTBCustomDockableWindow(DockList[I]) do begin
  840. if HighestEffective then
  841. J := FEffectiveDockRow
  842. else
  843. J := FDockRow;
  844. if J > Result then
  845. begin
  846. Result := J;
  847. end;
  848. end;
  849. end;
  850. procedure TTBDock.ChangeWidthHeight(const NewWidth, NewHeight: Integer);
  851. { Same as setting Width/Height directly, but does not lose Align position. }
  852. begin
  853. case Align of
  854. alNone, alTop, alLeft:
  855. SetBounds(Left, Top, NewWidth, NewHeight);
  856. alBottom:
  857. SetBounds(Left, Top-NewHeight+Height, NewWidth, NewHeight);
  858. alRight:
  859. SetBounds(Left-NewWidth+Width, Top, NewWidth, NewHeight);
  860. end;
  861. end;
  862. function TTBDock.Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean;
  863. begin
  864. Result := AllowDrag;
  865. end;
  866. procedure TTBDock.AlignControls(AControl: TControl; var Rect: TRect);
  867. begin
  868. ArrangeToolbars;
  869. end;
  870. function CompareDockRowPos(const Item1, Item2, ExtraData: Pointer): Integer; far;
  871. begin
  872. if TTBCustomDockableWindow(Item1).FDockRow <> TTBCustomDockableWindow(Item2).FDockRow then
  873. Result := TTBCustomDockableWindow(Item1).FDockRow - TTBCustomDockableWindow(Item2).FDockRow
  874. else
  875. Result := TTBCustomDockableWindow(Item1).FDockPos - TTBCustomDockableWindow(Item2).FDockPos;
  876. end;
  877. procedure TTBDock.ArrangeToolbars;
  878. { The main procedure to arrange all the toolbars docked to it }
  879. type
  880. PPosDataRec = ^TPosDataRec;
  881. TPosDataRec = record
  882. Row, ActualRow, PrecSpace, FullSize, MinimumSize, Size, Overlap, Pos: Integer;
  883. ShrinkMode: TTBShrinkMode;
  884. NeedArrange: Boolean;
  885. end;
  886. PPosDataArray = ^TPosDataArray;
  887. TPosDataArray = array[0..$7FFFFFFF div SizeOf(TPosDataRec)-1] of TPosDataRec;
  888. var
  889. NewDockList: TList;
  890. PosData: PPosDataArray;
  891. function IndexOfDraggingToolbar(const List: TList): Integer;
  892. { Returns index of toolbar in List that's currently being dragged, or -1 }
  893. var
  894. I: Integer;
  895. begin
  896. for I := 0 to List.Count-1 do
  897. if TTBCustomDockableWindow(List[I]).FDragMode then begin
  898. Result := I;
  899. Exit;
  900. end;
  901. Result := -1;
  902. end;
  903. function ShiftLeft(const Row, StartIndex, MaxSize: Integer): Integer;
  904. { Removes PrecSpace pixels from toolbars at or before StartIndex until the
  905. right edge of the toolbar at StartIndex is <= MaxSize.
  906. Returns the total number of PrecSpace pixels removed from toolbars. }
  907. var
  908. PixelsOffEdge, I, J: Integer;
  909. P: PPosDataRec;
  910. begin
  911. Result := 0;
  912. PixelsOffEdge := -MaxSize;
  913. for I := 0 to StartIndex do begin
  914. P := @PosData[I];
  915. if P.Row = Row then begin
  916. Inc(PixelsOffEdge, P.PrecSpace);
  917. Inc(PixelsOffEdge, P.Size);
  918. end;
  919. end;
  920. if PixelsOffEdge > 0 then
  921. for I := StartIndex downto 0 do begin
  922. P := @PosData[I];
  923. if P.Row = Row then begin
  924. J := PixelsOffEdge;
  925. if P.PrecSpace < J then
  926. J := P.PrecSpace;
  927. Dec(P.PrecSpace, J);
  928. Dec(PixelsOffEdge, J);
  929. Inc(Result, J);
  930. if PixelsOffEdge = 0 then
  931. Break;
  932. end;
  933. end;
  934. end;
  935. function GetNextToolbar(const GoForward: Boolean; const Row: Integer;
  936. const StartIndex: Integer): Integer;
  937. var
  938. I: Integer;
  939. begin
  940. Result := -1;
  941. I := StartIndex;
  942. while True do begin
  943. if GoForward then begin
  944. Inc(I);
  945. if I >= NewDockList.Count then
  946. Break;
  947. end
  948. else begin
  949. Dec(I);
  950. if I < 0 then
  951. Break;
  952. end;
  953. if PosData[I].Row = Row then begin
  954. Result := I;
  955. Break;
  956. end;
  957. end;
  958. end;
  959. var
  960. LeftRight: Boolean;
  961. EmptySize, HighestRow, R, CurPos, CurRowPixel, I, J, K, L, ClientW,
  962. ClientH, MaxSize, TotalSize, PixelsPastMaxSize, Offset, CurRealPos, DragIndex,
  963. MinRealPos, DragIndexPos, ToolbarsOnRow, CurRowSize: Integer;
  964. P: PPosDataRec;
  965. T: TTBCustomDockableWindow;
  966. S: TPoint;
  967. RowIsEmpty: Boolean;
  968. label FoundNextToolbar;
  969. begin
  970. if (FDisableArrangeToolbars > 0) or (csLoading in ComponentState) then begin
  971. FArrangeToolbarsNeeded := True;
  972. Exit;
  973. end;
  974. NewDockList := nil;
  975. PosData := nil;
  976. Inc(FDisableArrangeToolbars);
  977. try
  978. { Work around VCL alignment bug when docking toolbars taller or wider than
  979. the client height or width of the form. }
  980. {if not(csDesigning in ComponentState) and HandleAllocated then
  981. SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0,
  982. SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);}
  983. LeftRight := Position in PositionLeftOrRight;
  984. if not HasVisibleToolbars then begin
  985. EmptySize := Ord(FFixAlign);
  986. if csDesigning in ComponentState then
  987. EmptySize := 9;
  988. if not LeftRight then
  989. ChangeWidthHeight(Width, EmptySize)
  990. else
  991. ChangeWidthHeight(EmptySize, Height);
  992. Exit;
  993. end;
  994. { It can't read the ClientWidth and ClientHeight properties because they
  995. attempt to create a handle, which requires Parent to be set. "ClientW"
  996. and "ClientH" are calculated instead. }
  997. ClientW := Width - FNonClientWidth;
  998. if ClientW < 0 then ClientW := 0;
  999. ClientH := Height - FNonClientHeight;
  1000. if ClientH < 0 then ClientH := 0;
  1001. { Remove toolbars from DockList & DockVisibleList that are destroying, so
  1002. that no methods on these toolbars will be called.
  1003. This is needed because in certain rare cases ArrangeToolbars can be
  1004. indirectly called while a docked toolbar is being destroyed. }
  1005. for I := DockList.Count-1 downto 0 do begin
  1006. T := DockList[I];
  1007. if csDestroying in T.ComponentState then begin
  1008. DockList.Delete(I);
  1009. DockVisibleList.Remove(T);
  1010. end;
  1011. end;
  1012. { If LimitToOneRow is True, only use the first row }
  1013. if FLimitToOneRow then
  1014. for I := 0 to DockList.Count-1 do
  1015. with TTBCustomDockableWindow(DockList[I]) do
  1016. FDockRow := 0;
  1017. { Copy DockList to NewDockList, and ensure it is in correct ordering
  1018. according to DockRow/DockPos }
  1019. NewDockList := TList.Create;
  1020. NewDockList.Count := DockList.Count;
  1021. for I := 0 to NewDockList.Count-1 do
  1022. NewDockList[I] := DockList[I];
  1023. I := IndexOfDraggingToolbar(NewDockList);
  1024. ListSortEx(NewDockList, CompareDockRowPos, nil);
  1025. DragIndex := IndexOfDraggingToolbar(NewDockList);
  1026. if (I <> -1) and TTBCustomDockableWindow(NewDockList[DragIndex]).FDragSplitting then begin
  1027. { When splitting, don't allow the toolbar being dragged to change
  1028. positions in the dock list }
  1029. NewDockList.Move(DragIndex, I);
  1030. DragIndex := I;
  1031. end;
  1032. ListSortEx(DockVisibleList, CompareDockRowPos, nil);
  1033. { Find highest row number }
  1034. HighestRow := GetHighestRow(False);
  1035. { Create a temporary array that holds new position data for the toolbars }
  1036. PosData := AllocMem(NewDockList.Count * SizeOf(TPosDataRec));
  1037. for I := 0 to NewDockList.Count-1 do begin
  1038. P := @PosData[I];
  1039. T := NewDockList[I];
  1040. P.ActualRow := T.FDockRow;
  1041. if ToolbarVisibleOnDock(T) then
  1042. P.Row := T.FDockRow
  1043. else
  1044. P.Row := -1;
  1045. P.Pos := T.FDockPos;
  1046. end;
  1047. { Find FInsertRowBefore=True and FullSize=True toolbars and make sure there
  1048. aren't any other toolbars on the same row. If there are, shift them down
  1049. a row. }
  1050. for L := 0 to 1 do begin
  1051. R := 0;
  1052. while R <= HighestRow do begin
  1053. for I := 0 to NewDockList.Count-1 do begin
  1054. T := NewDockList[I];
  1055. if (PosData[I].ActualRow = R) and
  1056. (((L = 0) and T.FInsertRowBefore and not LimitToOneRow) or
  1057. ((L = 1) and T.FullSize)) then
  1058. for J := 0 to NewDockList.Count-1 do
  1059. if (J <> I) and (PosData[J].ActualRow = R) then begin
  1060. for K := 0 to NewDockList.Count-1 do begin
  1061. if K <> I then begin
  1062. P := @PosData[K];
  1063. if P.ActualRow >= R then
  1064. Inc(P.ActualRow);
  1065. if P.Row >= R then
  1066. Inc(P.Row);
  1067. end;
  1068. end;
  1069. Inc(HighestRow);
  1070. Break;
  1071. end;
  1072. end;
  1073. Inc(R);
  1074. end;
  1075. end;
  1076. { Remove blank rows.
  1077. Note that rows that contain only invisible or currently floating toolbars
  1078. are intentionally not removed, so that when the toolbars are shown again,
  1079. they stay on their own row. }
  1080. R := 0;
  1081. while R <= HighestRow do begin
  1082. RowIsEmpty := True;
  1083. for I := 0 to NewDockList.Count-1 do
  1084. if PosData[I].ActualRow = R then begin
  1085. RowIsEmpty := False;
  1086. Break;
  1087. end;
  1088. if RowIsEmpty then begin
  1089. { Shift all ones higher than R back one }
  1090. for I := 0 to NewDockList.Count-1 do begin
  1091. if PosData[I].ActualRow > R then
  1092. Dec(PosData[I].ActualRow);
  1093. if PosData[I].Row > R then
  1094. Dec(PosData[I].Row);
  1095. end;
  1096. Dec(HighestRow);
  1097. end
  1098. else
  1099. Inc(R);
  1100. end;
  1101. { Calculate positions and sizes of each row }
  1102. R := 0;
  1103. while R <= HighestRow do begin
  1104. if not LeftRight then
  1105. MaxSize := ClientW
  1106. else
  1107. MaxSize := ClientH;
  1108. { Set initial sizes }
  1109. TotalSize := 0;
  1110. ToolbarsOnRow := 0;
  1111. MinRealPos := 0;
  1112. for I := 0 to NewDockList.Count-1 do begin
  1113. P := @PosData[I];
  1114. if P.Row = R then begin
  1115. T := NewDockList[I];
  1116. T.GetBaseSize(S);
  1117. if not LeftRight then
  1118. J := S.X + T.NonClientWidth
  1119. else
  1120. J := S.Y + T.NonClientHeight;
  1121. P.FullSize := J;
  1122. P.Size := J;
  1123. P.ShrinkMode := T.GetShrinkMode;
  1124. P.MinimumSize := 0;
  1125. T.GetMinShrinkSize(P.MinimumSize);
  1126. if P.MinimumSize > P.FullSize then
  1127. { don't allow minimum shrink size to be less than full size }
  1128. P.MinimumSize := P.FullSize;
  1129. if P.ShrinkMode = tbsmChevron then
  1130. Inc(MinRealPos, P.MinimumSize)
  1131. else
  1132. Inc(MinRealPos, P.FullSize);
  1133. { If the toolbar isn't the first toolbar on the row, and the toolbar
  1134. would go off the edge even after it's shrunk, then move it onto a
  1135. row of its own }
  1136. if (ToolbarsOnRow > 0) and (MinRealPos > MaxSize) and
  1137. not LimitToOneRow then begin
  1138. for K := I to NewDockList.Count-1 do begin
  1139. P := @PosData[K];
  1140. if P.ActualRow >= R then
  1141. Inc(P.ActualRow);
  1142. if P.Row >= R then
  1143. Inc(P.Row);
  1144. end;
  1145. Inc(HighestRow);
  1146. Break;
  1147. end;
  1148. Inc(TotalSize, J);
  1149. Inc(ToolbarsOnRow);
  1150. end;
  1151. end;
  1152. PixelsPastMaxSize := TotalSize - MaxSize;
  1153. { Set initial arrangement; don't shrink toolbars yet }
  1154. DragIndexPos := 0;
  1155. CurPos := 0;
  1156. CurRealPos := 0;
  1157. MinRealPos := 0;
  1158. for I := 0 to NewDockList.Count-1 do begin
  1159. P := @PosData[I];
  1160. T := NewDockList[I];
  1161. if P.Row = R then begin
  1162. if (CurPos = 0) and (T.FullSize or T.Stretch) then
  1163. { Force to left }
  1164. J := 0
  1165. else
  1166. J := T.FDockPos;
  1167. if I = DragIndex then
  1168. DragIndexPos := J;
  1169. { Don't let this toolbar overlap preceding toolbars by more than
  1170. the sum of their minimum sizes }
  1171. if J < MinRealPos then
  1172. J := MinRealPos;
  1173. if J > CurPos then begin
  1174. { There's a gap between the left edge or previous toolbar and
  1175. this toolbar }
  1176. if PixelsPastMaxSize <= 0 then begin
  1177. P.PrecSpace := J - CurPos;
  1178. CurPos := J;
  1179. end
  1180. else
  1181. { Don't allow a gap if exceeding MaxSize }
  1182. J := CurPos;
  1183. end
  1184. else begin
  1185. if J < CurRealPos then
  1186. P.Overlap := CurRealPos - J;
  1187. end;
  1188. Inc(CurPos, P.Size);
  1189. CurRealPos := J + P.Size;
  1190. Inc(MinRealPos, P.MinimumSize);
  1191. end;
  1192. end;
  1193. { If we aren't exceeding MaxSize, allow the toolbar being dragged
  1194. to push other toolbars to the left }
  1195. if (PixelsPastMaxSize < 0) and (DragIndex <> -1) and
  1196. (PosData[DragIndex].Row = R) then begin
  1197. I := GetNextToolbar(False, R, DragIndex);
  1198. if I <> -1 then begin
  1199. J := ShiftLeft(R, I, DragIndexPos);
  1200. if J > 0 then begin
  1201. { Ensure that toolbars that follow the toolbar being dragged stay
  1202. at the same place by increasing PrecSpace on the next toolbar }
  1203. I := GetNextToolbar(True, R, DragIndex);
  1204. if I <> -1 then
  1205. Inc(PosData[I].PrecSpace, J);
  1206. end;
  1207. end;
  1208. end;
  1209. { If any toolbars are going off the edge of the dock, try to make them
  1210. at least partially visible by shifting preceding toolbars left }
  1211. I := GetNextToolbar(False, R, NewDockList.Count);
  1212. if I <> -1 then
  1213. ShiftLeft(R, I, MaxSize);
  1214. { Shrink toolbars that overlap other toolbars (Overlaps[x] > 0) }
  1215. if PixelsPastMaxSize > 0 then begin
  1216. Offset := 0;
  1217. for I := 0 to NewDockList.Count-1 do begin
  1218. if PosData[I].Row <> R then
  1219. Continue;
  1220. T := NewDockList[I];
  1221. if (ToolbarsOnRow > 1) and T.FDragMode then
  1222. T.FDragCanSplit := True;
  1223. Inc(Offset, PosData[I].Overlap);
  1224. if Offset > PixelsPastMaxSize then
  1225. Offset := PixelsPastMaxSize;
  1226. if Offset > 0 then
  1227. for J := I-1 downto 0 do begin
  1228. P := @PosData[J];
  1229. if P.Row <> R then
  1230. Continue;
  1231. { How much can we shrink this toolbar J to get toolbar I to
  1232. its preferred position? }
  1233. if P.ShrinkMode = tbsmChevron then
  1234. L := Offset
  1235. else
  1236. L := 0;
  1237. K := -(P.Size - L - P.MinimumSize); { the number of pixels that exceed the minimum size }
  1238. if K > 0 then
  1239. { Don't shrink a toolbar below its minimum allowed size }
  1240. Dec(L, K);
  1241. Dec(P.Size, L);
  1242. Dec(PixelsPastMaxSize, L);
  1243. Dec(Offset, L);
  1244. if (Offset = 0) or
  1245. { This is needed so toolbars can push other toolbars to the
  1246. right when splitting: }
  1247. (J = DragIndex) then
  1248. Break;
  1249. end;
  1250. end;
  1251. end;
  1252. { Still exceeding MaxSize? Make sure the rightmost toolbar(s) are
  1253. at least partially visible with a width of MinimumSize }
  1254. if PixelsPastMaxSize > 0 then begin
  1255. for I := NewDockList.Count-1 downto 0 do begin
  1256. P := @PosData[I];
  1257. if (P.Row <> R) or (P.ShrinkMode = tbsmNone) or
  1258. ((P.ShrinkMode = tbsmWrap) and (ToolbarsOnRow > 1)) then
  1259. Continue;
  1260. J := P.Size - P.MinimumSize;
  1261. if J > 0 then begin { can we shrink this toolbar any? }
  1262. if J > PixelsPastMaxSize then
  1263. J := PixelsPastMaxSize;
  1264. Dec(P.Size, J);
  1265. Dec(PixelsPastMaxSize, J);
  1266. end;
  1267. if PixelsPastMaxSize = 0 then
  1268. Break;
  1269. end;
  1270. end;
  1271. { Set Poses, and adjust size of FullSize & Stretch toolbars }
  1272. CurPos := 0;
  1273. for I := 0 to NewDockList.Count-1 do begin
  1274. P := @PosData[I];
  1275. T := NewDockList[I];
  1276. if P.Row = R then begin
  1277. if T.FullSize or T.Stretch then begin
  1278. { Remove any preceding space from this toolbar }
  1279. Inc(P.Size, P.PrecSpace);
  1280. P.PrecSpace := 0;
  1281. end;
  1282. Inc(CurPos, P.PrecSpace);
  1283. if T.FullSize then begin
  1284. { Claim all space }
  1285. if P.Size < MaxSize then
  1286. P.Size := MaxSize;
  1287. end
  1288. else if T.Stretch then begin
  1289. { Steal any preceding space from the next toolbar }
  1290. for J := I+1 to NewDockList.Count-1 do
  1291. if PosData[J].Row = R then begin
  1292. Inc(P.Size, PosData[J].PrecSpace);
  1293. PosData[J].PrecSpace := 0;
  1294. goto FoundNextToolbar;
  1295. end;
  1296. { or claim any remaining space }
  1297. if P.Size < MaxSize - CurPos then
  1298. P.Size := MaxSize - CurPos;
  1299. FoundNextToolbar:
  1300. { MP }
  1301. { When dock shrinks, shrink the stretched toolbars too }
  1302. if P.Size > MaxSize - CurPos then
  1303. P.Size := MaxSize - CurPos;
  1304. { /MP }
  1305. end;
  1306. P.Pos := CurPos;
  1307. Inc(CurPos, P.Size);
  1308. end;
  1309. end;
  1310. Inc(R);
  1311. end;
  1312. for I := 0 to NewDockList.Count-1 do begin
  1313. T := NewDockList[I];
  1314. T.FEffectiveDockRow := PosData[I].ActualRow;
  1315. T.FEffectiveDockPos := PosData[I].Pos;
  1316. { If FCommitNewPositions is True, update all the toolbars' DockPos and
  1317. DockRow properties to match the actual positions.
  1318. Also update the ordering of DockList to match NewDockList }
  1319. if FCommitNewPositions then begin
  1320. T.FDockRow := T.FEffectiveDockRow;
  1321. T.FDockPos := T.FEffectiveDockPos;
  1322. DockList[I] := NewDockList[I];
  1323. end;
  1324. end;
  1325. { Now actually move the toolbars }
  1326. CurRowPixel := 0;
  1327. for R := 0 to HighestRow do begin
  1328. CurRowSize := 0;
  1329. for I := 0 to NewDockList.Count-1 do begin
  1330. P := @PosData[I];
  1331. T := NewDockList[I];
  1332. if P.Row = R then begin
  1333. K := T.FCurrentSize;
  1334. T.FCurrentSize := P.Size;
  1335. if P.Size >= P.FullSize then begin
  1336. T.FCurrentSize := 0;
  1337. { Reason: so that if new items are added to a non-shrunk toolbar
  1338. at run-time (causing its width to increase), the toolbar won't
  1339. shrink unnecessarily }
  1340. end;
  1341. if (P.ShrinkMode <> tbsmNone) and (T.FCurrentSize <> K) then begin
  1342. { If Size is changing and we are to display a chevron or wrap,
  1343. call DoArrange to get an accurate row size }
  1344. S := T.DoArrange(False, TBGetDockTypeOf(Self, False), False, Self);
  1345. { Force a rearrange in case the actual size isn't changing but the
  1346. chevron visibility might have changed (which can happen if
  1347. items are added to a FullSize=True toolbar at run-time) }
  1348. P.NeedArrange := True;
  1349. end
  1350. else begin
  1351. if (P.ShrinkMode = tbsmWrap) and (P.Size < P.FullSize) then begin
  1352. { Preserve existing height (or width) on a wrapped toolbar
  1353. whose size isn't changing now }
  1354. S.X := T.Width - T.NonClientWidth;
  1355. S.Y := T.Height - T.NonClientHeight;
  1356. end
  1357. else
  1358. T.GetBaseSize(S);
  1359. end;
  1360. if not LeftRight then
  1361. K := S.Y
  1362. else
  1363. K := S.X;
  1364. T.FLastRowSize := K;
  1365. if K > CurRowSize then
  1366. CurRowSize := K;
  1367. end;
  1368. end;
  1369. if CurRowSize <> 0 then
  1370. Inc(CurRowSize, DockedBorderSize2);
  1371. for I := 0 to NewDockList.Count-1 do begin
  1372. P := @PosData[I];
  1373. T := NewDockList[I];
  1374. if P.Row = R then begin
  1375. Inc(T.FUpdatingBounds);
  1376. try
  1377. K := T.FCurrentSize;
  1378. if P.NeedArrange then
  1379. T.FArrangeNeeded := True;
  1380. if not LeftRight then
  1381. T.SetBounds(P.Pos, CurRowPixel, P.Size, CurRowSize)
  1382. else
  1383. T.SetBounds(CurRowPixel, P.Pos, CurRowSize, P.Size);
  1384. if T.FArrangeNeeded then
  1385. { ^ don't arrange again if SetBounds call already caused one }
  1386. T.Arrange;
  1387. { Restore FCurrentSize since TTBToolbarView.DoUpdatePositions
  1388. clears it }
  1389. T.FCurrentSize := K;
  1390. finally
  1391. Dec(T.FUpdatingBounds);
  1392. end;
  1393. end;
  1394. end;
  1395. Inc(CurRowPixel, CurRowSize);
  1396. end;
  1397. { Set the size of the dock }
  1398. if not LeftRight then
  1399. ChangeWidthHeight(Width, CurRowPixel + FNonClientHeight)
  1400. else
  1401. ChangeWidthHeight(CurRowPixel + FNonClientWidth, Height);
  1402. finally
  1403. Dec(FDisableArrangeToolbars);
  1404. FArrangeToolbarsNeeded := False;
  1405. FCommitNewPositions := False;
  1406. FreeMem(PosData);
  1407. NewDockList.Free;
  1408. end;
  1409. end;
  1410. procedure TTBDock.CommitPositions;
  1411. { Copies docked toolbars' EffectiveDockRow and EffectiveDockPos properties
  1412. into DockRow and DockPos respectively.
  1413. Note that this does not reorder DockList like ArrangeToolbars does when
  1414. FCommitNewPositions=True. }
  1415. var
  1416. I: Integer;
  1417. T: TTBCustomDockableWindow;
  1418. begin
  1419. for I := 0 to DockVisibleList.Count-1 do begin
  1420. T := DockVisibleList[I];
  1421. T.FDockRow := T.FEffectiveDockRow;
  1422. T.FDockPos := T.FEffectiveDockPos;
  1423. end;
  1424. end;
  1425. procedure TTBDock.ChangeDockList(const Insert: Boolean;
  1426. const Bar: TTBCustomDockableWindow);
  1427. { Inserts or removes Bar from DockList }
  1428. var
  1429. I: Integer;
  1430. begin
  1431. I := DockList.IndexOf(Bar);
  1432. if Insert then begin
  1433. if I = -1 then begin
  1434. Bar.FreeNotification(Self);
  1435. DockList.Add(Bar);
  1436. end;
  1437. end
  1438. else begin
  1439. if I <> -1 then
  1440. DockList.Delete(I);
  1441. end;
  1442. ToolbarVisibilityChanged(Bar, False);
  1443. end;
  1444. procedure TTBDock.ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow;
  1445. const ForceRemove: Boolean);
  1446. var
  1447. Modified, VisibleOnDock: Boolean;
  1448. I: Integer;
  1449. begin
  1450. Modified := False;
  1451. I := DockVisibleList.IndexOf(Bar);
  1452. VisibleOnDock := not ForceRemove and ToolbarVisibleOnDock(Bar);
  1453. if VisibleOnDock then begin
  1454. if I = -1 then begin
  1455. DockVisibleList.Add(Bar);
  1456. Modified := True;
  1457. end;
  1458. end
  1459. else begin
  1460. if I <> -1 then begin
  1461. DockVisibleList.Remove(Bar);
  1462. Modified := True;
  1463. end;
  1464. end;
  1465. if Modified then begin
  1466. ArrangeToolbars;
  1467. if Assigned(FOnInsertRemoveBar) then
  1468. FOnInsertRemoveBar(Self, VisibleOnDock, Bar);
  1469. end;
  1470. end;
  1471. procedure TTBDock.Loaded;
  1472. begin
  1473. inherited;
  1474. { Rearranging is disabled while the component is loading, so now that it's
  1475. loaded, rearrange it. }
  1476. ArrangeToolbars;
  1477. end;
  1478. procedure TTBDock.Notification(AComponent: TComponent; Operation: TOperation);
  1479. begin
  1480. inherited;
  1481. if Operation = opRemove then begin
  1482. if AComponent is TTBCustomDockableWindow then begin
  1483. DockList.Remove(AComponent);
  1484. DockVisibleList.Remove(AComponent);
  1485. end;
  1486. end;
  1487. end;
  1488. procedure TTBDock.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  1489. var
  1490. R, R2: TRect;
  1491. P1, P2: TPoint;
  1492. SaveIndex: Integer;
  1493. begin
  1494. { Draw the Background if there is one, otherwise use default erasing
  1495. behavior }
  1496. if UsingBackground then begin
  1497. R := ClientRect;
  1498. R2 := R;
  1499. { Make up for nonclient area }
  1500. P1 := ClientToScreen(Point(0, 0));
  1501. P2 := Parent.ClientToScreen(BoundsRect.TopLeft);
  1502. Dec(R2.Left, Left + (P1.X-P2.X));
  1503. Dec(R2.Top, Top + (P1.Y-P2.Y));
  1504. SaveIndex := SaveDC(Message.DC);
  1505. IntersectClipRect(Message.DC, R.Left, R.Top, R.Right, R.Bottom);
  1506. DrawBackground(Message.DC, R2);
  1507. RestoreDC(Message.DC, SaveIndex);
  1508. Message.Result := 1;
  1509. end
  1510. else
  1511. inherited;
  1512. end;
  1513. procedure TTBDock.Paint;
  1514. var
  1515. R: TRect;
  1516. begin
  1517. inherited;
  1518. { Draw dotted border in design mode }
  1519. if csDesigning in ComponentState then begin
  1520. R := ClientRect;
  1521. with Canvas do begin
  1522. Pen.Style := psDot;
  1523. Pen.Color := clBtnShadow;
  1524. Brush.Style := bsClear;
  1525. Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1526. Pen.Style := psSolid;
  1527. end;
  1528. end;
  1529. end;
  1530. procedure TTBDock.WMMove(var Message: TWMMove);
  1531. begin
  1532. inherited;
  1533. if UsingBackground then
  1534. InvalidateBackgrounds;
  1535. end;
  1536. procedure TTBDock.WMNCCalcSize(var Message: TWMNCCalcSize);
  1537. begin
  1538. inherited;
  1539. { note to self: non-client size is stored in FNonClientWidth &
  1540. FNonClientHeight }
  1541. with Message.CalcSize_Params^.rgrc[0] do begin
  1542. if blTop in BoundLines then Inc(Top);
  1543. if blBottom in BoundLines then Dec(Bottom);
  1544. if blLeft in BoundLines then Inc(Left);
  1545. if blRight in BoundLines then Dec(Right);
  1546. end;
  1547. end;
  1548. procedure TTBDock.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  1549. const Clip: HRGN);
  1550. procedure DrawLine(const DC: HDC; const X1, Y1, X2, Y2: Integer);
  1551. begin
  1552. MoveToEx(DC, X1, Y1, nil); LineTo(DC, X2, Y2);
  1553. end;
  1554. var
  1555. RW, R, R2, RC: TRect;
  1556. DC: HDC;
  1557. HighlightPen, ShadowPen, SavePen: HPEN;
  1558. FillBrush: HBRUSH;
  1559. label 1;
  1560. begin
  1561. { This works around WM_NCPAINT problem described at top of source code }
  1562. {no! R := Rect(0, 0, Width, Height);}
  1563. GetWindowRect(Handle, RW);
  1564. R := RW;
  1565. OffsetRect(R, -R.Left, -R.Top);
  1566. if not DrawToDC then
  1567. DC := GetWindowDC(Handle)
  1568. else
  1569. DC := ADC;
  1570. try
  1571. { Use update region }
  1572. if not DrawToDC then
  1573. SelectNCUpdateRgn(Handle, DC, Clip);
  1574. { Draw BoundLines }
  1575. R2 := R;
  1576. if (BoundLines <> []) and
  1577. ((csDesigning in ComponentState) or HasVisibleToolbars) then begin
  1578. HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
  1579. ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
  1580. SavePen := SelectObject(DC, ShadowPen);
  1581. if blTop in BoundLines then begin
  1582. DrawLine(DC, R.Left, R.Top, R.Right, R.Top);
  1583. Inc(R2.Top);
  1584. end;
  1585. if blLeft in BoundLines then begin
  1586. DrawLine(DC, R.Left, R.Top, R.Left, R.Bottom);
  1587. Inc(R2.Left);
  1588. end;
  1589. SelectObject(DC, HighlightPen);
  1590. if blBottom in BoundLines then begin
  1591. DrawLine(DC, R.Left, R.Bottom-1, R.Right, R.Bottom-1);
  1592. Dec(R2.Bottom);
  1593. end;
  1594. if blRight in BoundLines then begin
  1595. DrawLine(DC, R.Right-1, R.Top, R.Right-1, R.Bottom);
  1596. Dec(R2.Right);
  1597. end;
  1598. SelectObject(DC, SavePen);
  1599. DeleteObject(ShadowPen);
  1600. DeleteObject(HighlightPen);
  1601. end;
  1602. Windows.GetClientRect(Handle, RC);
  1603. if not IsRectEmpty(RC) then begin
  1604. { ^ ExcludeClipRect can't be passed rectangles that have (Bottom < Top) or
  1605. (Right < Left) since it doesn't treat them as empty }
  1606. MapWindowPoints(Handle, 0, RC, 2);
  1607. OffsetRect(RC, -RW.Left, -RW.Top);
  1608. if EqualRect(RC, R2) then
  1609. { Skip FillRect because there would be nothing left after ExcludeClipRect }
  1610. goto 1;
  1611. ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  1612. end;
  1613. FillBrush := CreateSolidBrush(ColorToRGB(Color));
  1614. FillRect(DC, R2, FillBrush);
  1615. DeleteObject(FillBrush);
  1616. 1:
  1617. finally
  1618. if not DrawToDC then
  1619. ReleaseDC(Handle, DC);
  1620. end;
  1621. end;
  1622. procedure TTBDock.WMNCPaint(var Message: TMessage);
  1623. begin
  1624. DrawNCArea(False, 0, HRGN(Message.WParam));
  1625. end;
  1626. procedure DockNCPaintProc(Control: TControl; Wnd: HWND; DC: HDC; AppData: Longint);
  1627. begin
  1628. TTBDock(AppData).DrawNCArea(True, DC, 0);
  1629. end;
  1630. procedure TTBDock.WMPrint(var Message: TMessage);
  1631. begin
  1632. HandleWMPrint(Self, Handle, Message, DockNCPaintProc, Longint(Self));
  1633. end;
  1634. procedure TTBDock.WMPrintClient(var Message: TMessage);
  1635. begin
  1636. HandleWMPrintClient(Self, Message);
  1637. end;
  1638. procedure TTBDock.RelayMsgToFloatingBars(var Message: TMessage);
  1639. var
  1640. I: Integer;
  1641. T: TTBCustomDockableWindow;
  1642. begin
  1643. for I := 0 to DockList.Count-1 do begin
  1644. T := DockList[I];
  1645. if (csMenuEvents in T.ControlStyle) and T.Floating and T.Showing and
  1646. T.Enabled then begin
  1647. Message.Result := T.Perform(Message.Msg, Message.WParam, Message.LParam);
  1648. if Message.Result <> 0 then
  1649. Exit;
  1650. end;
  1651. end;
  1652. end;
  1653. procedure TTBDock.WMSysCommand(var Message: TWMSysCommand);
  1654. begin
  1655. { Relay WM_SYSCOMMAND messages to floating toolbars which were formerly
  1656. docked. That way, items on floating menu bars can be accessed with Alt. }
  1657. RelayMsgToFloatingBars(TMessage(Message));
  1658. end;
  1659. procedure TTBDock.CMDialogKey(var Message: TCMDialogKey);
  1660. begin
  1661. RelayMsgToFloatingBars(TMessage(Message));
  1662. if Message.Result = 0 then
  1663. inherited;
  1664. end;
  1665. procedure TTBDock.CMDialogChar(var Message: TCMDialogChar);
  1666. begin
  1667. RelayMsgToFloatingBars(TMessage(Message));
  1668. if Message.Result = 0 then
  1669. inherited;
  1670. end;
  1671. { TTBDock - property access methods }
  1672. procedure TTBDock.SetAllowDrag(Value: Boolean);
  1673. var
  1674. I: Integer;
  1675. begin
  1676. if FAllowDrag <> Value then begin
  1677. FAllowDrag := Value;
  1678. for I := 0 to ControlCount-1 do
  1679. if Controls[I] is TTBCustomDockableWindow then
  1680. RecalcNCArea(TTBCustomDockableWindow(Controls[I]));
  1681. end;
  1682. end;
  1683. function TTBDock.UsingBackground: Boolean;
  1684. begin
  1685. Result := False;
  1686. end;
  1687. procedure TTBDock.DrawBackground(DC: HDC; const DrawRect: TRect);
  1688. begin
  1689. { noop }
  1690. end;
  1691. procedure TTBDock.InvalidateBackgrounds;
  1692. { Called after background is changed }
  1693. var
  1694. I: Integer;
  1695. T: TTBCustomDockableWindow;
  1696. begin
  1697. Invalidate;
  1698. { Synchronize child toolbars also }
  1699. for I := 0 to DockList.Count-1 do begin
  1700. T := TTBCustomDockableWindow(DockList[I]);
  1701. if ToolbarVisibleOnDock(T) then
  1702. { Invalidate both non-client and client area }
  1703. InvalidateAll(T);
  1704. end;
  1705. end;
  1706. procedure TTBDock.SetBoundLines(Value: TTBDockBoundLines);
  1707. var
  1708. X, Y: Integer;
  1709. B: TTBDockBoundLines;
  1710. begin
  1711. if FBoundLines <> Value then begin
  1712. FBoundLines := Value;
  1713. X := 0;
  1714. Y := 0;
  1715. B := BoundLines; { optimization }
  1716. if blTop in B then Inc(Y);
  1717. if blBottom in B then Inc(Y);
  1718. if blLeft in B then Inc(X);
  1719. if blRight in B then Inc(X);
  1720. FNonClientWidth := X;
  1721. FNonClientHeight := Y;
  1722. RecalcNCArea(Self);
  1723. end;
  1724. end;
  1725. procedure TTBDock.SetFixAlign(Value: Boolean);
  1726. begin
  1727. if FFixAlign <> Value then begin
  1728. FFixAlign := Value;
  1729. ArrangeToolbars;
  1730. end;
  1731. end;
  1732. procedure TTBDock.SetPosition(Value: TTBDockPosition);
  1733. begin
  1734. if (FPosition <> Value) and (ControlCount <> 0) then
  1735. raise EInvalidOperation.Create(STBDockCannotChangePosition);
  1736. FPosition := Value;
  1737. case Position of
  1738. dpTop: Align := alTop;
  1739. dpBottom: Align := alBottom;
  1740. dpLeft: Align := alLeft;
  1741. dpRight: Align := alRight;
  1742. end;
  1743. end;
  1744. function TTBDock.GetToolbarCount: Integer;
  1745. begin
  1746. Result := DockVisibleList.Count;
  1747. end;
  1748. function TTBDock.GetToolbars(Index: Integer): TTBCustomDockableWindow;
  1749. begin
  1750. Result := TTBCustomDockableWindow(DockVisibleList[Index]);
  1751. end;
  1752. (*function TTBDock.GetVersion: TToolbar97Version;
  1753. begin
  1754. Result := Toolbar97VersionPropText;
  1755. end;
  1756. procedure TTBDock.SetVersion(const Value: TToolbar97Version);
  1757. begin
  1758. { write method required for the property to show up in Object Inspector }
  1759. end;*)
  1760. { TTBFloatingWindowParent - Internal }
  1761. constructor TTBFloatingWindowParent.Create(AOwner: TComponent);
  1762. begin
  1763. { Don't use TForm's Create since it attempts to load a form resource, which
  1764. TTBFloatingWindowParent doesn't have. }
  1765. CreateNew(AOwner {$IFDEF VER93} , 0 {$ENDIF});
  1766. end;
  1767. destructor TTBFloatingWindowParent.Destroy;
  1768. begin
  1769. inherited;
  1770. end;
  1771. procedure TTBFloatingWindowParent.CreateParams(var Params: TCreateParams);
  1772. const
  1773. ThickFrames: array[Boolean] of DWORD = (0, WS_THICKFRAME);
  1774. begin
  1775. inherited;
  1776. { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
  1777. and are not necessary for this control at run time }
  1778. if not(csDesigning in ComponentState) then
  1779. with Params.WindowClass do
  1780. Style := Style and not(CS_HREDRAW or CS_VREDRAW);
  1781. with Params do begin
  1782. { Note: WS_THICKFRAME and WS_BORDER styles are included to ensure that
  1783. sizing grips are displayed on child controls with scrollbars. The
  1784. thick frame or border is not drawn by Windows; TCustomToolWindow97
  1785. handles all border drawing by itself. }
  1786. if not(csDesigning in ComponentState) then
  1787. Style := WS_POPUP or WS_BORDER or ThickFrames[FDockableWindow.FResizable]
  1788. else
  1789. Style := Style or WS_BORDER or ThickFrames[FDockableWindow.FResizable];
  1790. { The WS_EX_TOOLWINDOW style is needed so there isn't a taskbar button
  1791. for the toolbar when FloatingMode = fmOnTopOfAllForms. }
  1792. ExStyle := WS_EX_TOOLWINDOW;
  1793. end;
  1794. end;
  1795. procedure TTBFloatingWindowParent.AlignControls(AControl: TControl; var Rect: TRect);
  1796. begin
  1797. { ignore Align setting of the child toolbar }
  1798. end;
  1799. procedure TTBFloatingWindowParent.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
  1800. begin
  1801. inherited;
  1802. { Because the window uses the WS_THICKFRAME style (but not for the usual
  1803. purpose), it must process the WM_GETMINMAXINFO message to remove the
  1804. minimum and maximum size limits it imposes by default. }
  1805. with Message.MinMaxInfo^ do begin
  1806. with ptMinTrackSize do begin
  1807. X := 1;
  1808. Y := 1;
  1809. { Note to self: Don't put GetMinimumSize code here, since
  1810. ClientWidth/Height values are sometimes invalid during a RecreateWnd }
  1811. end;
  1812. with ptMaxTrackSize do begin
  1813. { Because of the 16-bit (signed) size limitations of Windows 95,
  1814. Smallints must be used instead of Integers or Longints }
  1815. X := High(Smallint);
  1816. Y := High(Smallint);
  1817. end;
  1818. end;
  1819. end;
  1820. procedure TTBFloatingWindowParent.CMShowingChanged(var Message: TMessage);
  1821. const
  1822. ShowFlags: array[Boolean] of UINT = (
  1823. SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
  1824. SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  1825. begin
  1826. { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the
  1827. form doesn't get activated when Visible is set to True. }
  1828. SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing and FShouldShow]);
  1829. end;
  1830. procedure TTBFloatingWindowParent.CMDialogKey(var Message: TCMDialogKey);
  1831. begin
  1832. { If Escape if pressed on a floating toolbar, return focus to the form }
  1833. if (Message.CharCode = VK_ESCAPE) and (KeyDataToShiftState(Message.KeyData) = []) and
  1834. Assigned(ParentForm) then begin
  1835. ParentForm.SetFocus;
  1836. Message.Result := 1;
  1837. end
  1838. else
  1839. inherited;
  1840. end;
  1841. procedure TTBFloatingWindowParent.CMTextChanged(var Message: TMessage);
  1842. begin
  1843. inherited;
  1844. RedrawNCArea([twrdCaption]);
  1845. end;
  1846. function GetCaptionRect(const Control: TTBFloatingWindowParent;
  1847. const AdjustForBorder, MinusCloseButton: Boolean): TRect;
  1848. begin
  1849. Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight(Control)-1);
  1850. if MinusCloseButton then
  1851. Dec(Result.Right, Result.Bottom);
  1852. if AdjustForBorder then
  1853. with Control.FDockableWindow.GetFloatingBorderSize do
  1854. OffsetRect(Result, X, Y);
  1855. end;
  1856. function GetCloseButtonRect(const Control: TTBFloatingWindowParent;
  1857. const AdjustForBorder: Boolean): TRect;
  1858. begin
  1859. Result := GetCaptionRect(Control, AdjustForBorder, False);
  1860. Result.Left := Result.Right - (GetSmallCaptionHeight(Control)-1);
  1861. end;
  1862. procedure TTBFloatingWindowParent.WMNCCalcSize(var Message: TWMNCCalcSize);
  1863. var
  1864. TL, BR: TPoint;
  1865. begin
  1866. { Doesn't call inherited since it overrides the normal NC sizes }
  1867. Message.Result := 0;
  1868. with Message.CalcSize_Params^ do begin
  1869. FDockableWindow.GetFloatingNCArea(TL, BR);
  1870. with rgrc[0] do begin
  1871. Inc(Left, TL.X);
  1872. Inc(Top, TL.Y);
  1873. Dec(Right, BR.X);
  1874. Dec(Bottom, BR.Y);
  1875. end;
  1876. end;
  1877. end;
  1878. procedure TTBFloatingWindowParent.WMNCPaint(var Message: TMessage);
  1879. begin
  1880. { Don't call inherited because it overrides the default NC painting }
  1881. DrawNCArea(False, 0, HRGN(Message.WParam), twrdAll);
  1882. end;
  1883. procedure FloatingWindowParentNCPaintProc(Control: TControl; Wnd: HWND; DC: HDC; AppData: Longint);
  1884. begin
  1885. with TTBFloatingWindowParent(AppData) do
  1886. DrawNCArea(True, DC, 0, twrdAll);
  1887. end;
  1888. procedure TTBFloatingWindowParent.WMPrint(var Message: TMessage);
  1889. begin
  1890. HandleWMPrint(Self, Handle, Message, FloatingWindowParentNCPaintProc, Longint(Self));
  1891. end;
  1892. procedure TTBFloatingWindowParent.WMPrintClient(var Message: TMessage);
  1893. begin
  1894. HandleWMPrintClient(Self, Message);
  1895. end;
  1896. procedure TTBFloatingWindowParent.WMNCHitTest(var Message: TWMNCHitTest);
  1897. var
  1898. P: TPoint;
  1899. R: TRect;
  1900. BorderSize: TPoint;
  1901. C: Integer;
  1902. begin
  1903. inherited;
  1904. with Message do begin
  1905. P := SmallPointToPoint(Pos);
  1906. GetWindowRect(Handle, R);
  1907. Dec(P.X, R.Left); Dec(P.Y, R.Top);
  1908. if Result <> HTCLIENT then begin
  1909. Result := HTNOWHERE;
  1910. if FDockableWindow.ShowCaption and PtInRect(GetCaptionRect(Self, True, False), P) then begin
  1911. if FDockableWindow.FCloseButton and PtInRect(GetCloseButtonRect(Self, True), P) then
  1912. Result := HT_TB2k_Close
  1913. else
  1914. Result := HT_TB2k_Caption;
  1915. end
  1916. else
  1917. if FDockableWindow.Resizable then begin
  1918. BorderSize := FDockableWindow.GetFloatingBorderSize;
  1919. if not(tbdsResizeEightCorner in FDockableWindow.FDockableWindowStyles) then begin
  1920. if (P.Y >= 0) and (P.Y < BorderSize.Y) then Result := HTTOP else
  1921. if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then Result := HTBOTTOM else
  1922. if (P.X >= 0) and (P.X < BorderSize.X) then Result := HTLEFT else
  1923. if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then Result := HTRIGHT;
  1924. end
  1925. else begin
  1926. C := BorderSize.X + (GetSmallCaptionHeight(Self)-1);
  1927. if (P.X >= 0) and (P.X < BorderSize.X) then begin
  1928. Result := HTLEFT;
  1929. if (P.Y < C) then Result := HTTOPLEFT else
  1930. if (P.Y >= Height-C) then Result := HTBOTTOMLEFT;
  1931. end
  1932. else
  1933. if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then begin
  1934. Result := HTRIGHT;
  1935. if (P.Y < C) then Result := HTTOPRIGHT else
  1936. if (P.Y >= Height-C) then Result := HTBOTTOMRIGHT;
  1937. end
  1938. else
  1939. if (P.Y >= 0) and (P.Y < BorderSize.Y) then begin
  1940. Result := HTTOP;
  1941. if (P.X < C) then Result := HTTOPLEFT else
  1942. if (P.X >= Width-C) then Result := HTTOPRIGHT;
  1943. end
  1944. else
  1945. if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then begin
  1946. Result := HTBOTTOM;
  1947. if (P.X < C) then Result := HTBOTTOMLEFT else
  1948. if (P.X >= Width-C) then Result := HTBOTTOMRIGHT;
  1949. end;
  1950. end;
  1951. end;
  1952. end;
  1953. end;
  1954. end;
  1955. procedure TTBFloatingWindowParent.SetCloseButtonState(Pushed: Boolean);
  1956. begin
  1957. if FCloseButtonDown <> Pushed then begin
  1958. FCloseButtonDown := Pushed;
  1959. RedrawNCArea([twrdCloseButton]);
  1960. end;
  1961. end;
  1962. procedure TTBFloatingWindowParent.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  1963. var
  1964. P: TPoint;
  1965. R, BR: TRect;
  1966. begin
  1967. case Message.HitTest of
  1968. HT_TB2k_Caption: begin
  1969. P := FDockableWindow.ScreenToClient(Point(Message.XCursor, Message.YCursor));
  1970. FDockableWindow.BeginMoving(P.X, P.Y);
  1971. end;
  1972. HTLEFT..HTBOTTOMRIGHT:
  1973. if FDockableWindow.Resizable then
  1974. FDockableWindow.BeginSizing(TTBSizeHandle(Message.HitTest - HTLEFT));
  1975. HT_TB2k_Close: begin
  1976. GetWindowRect(Handle, R);
  1977. BR := GetCloseButtonRect(Self, True);
  1978. OffsetRect(BR, R.Left, R.Top);
  1979. if CloseButtonLoop(Handle, BR, SetCloseButtonState) then
  1980. FDockableWindow.Close;
  1981. end;
  1982. else
  1983. inherited;
  1984. end;
  1985. end;
  1986. procedure TTBFloatingWindowParent.WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk);
  1987. begin
  1988. if Message.HitTest = HT_TB2k_Caption then
  1989. FDockableWindow.DoubleClick;
  1990. end;
  1991. procedure TTBFloatingWindowParent.WMNCRButtonUp(var Message: TWMNCRButtonUp);
  1992. begin
  1993. FDockableWindow.ShowNCContextMenu(TSmallPoint(TMessage(Message).LParam));
  1994. end;
  1995. procedure TTBFloatingWindowParent.WMClose(var Message: TWMClose);
  1996. var
  1997. MDIParentForm: TCustomForm;
  1998. begin
  1999. { A floating toolbar does not use WM_CLOSE messages when its close button
  2000. is clicked, but Windows still sends a WM_CLOSE message if the user
  2001. presses Alt+F4 while one of the toolbar's controls is focused. Inherited
  2002. is not called since we do not want Windows' default processing - which
  2003. destroys the window. Instead, relay the message to the parent form. }
  2004. MDIParentForm := GetMDIParent(TBGetToolWindowParentForm(FDockableWindow));
  2005. if Assigned(MDIParentForm) and MDIParentForm.HandleAllocated then
  2006. SendMessage(MDIParentForm.Handle, WM_CLOSE, 0, 0);
  2007. { Note to self: MDIParentForm is used instead of OwnerForm since MDI
  2008. childs don't process Alt+F4 as Close }
  2009. end;
  2010. procedure TTBFloatingWindowParent.WMActivate(var Message: TWMActivate);
  2011. var
  2012. ParentForm: TCustomForm;
  2013. begin
  2014. if csDesigning in ComponentState then begin
  2015. inherited;
  2016. Exit;
  2017. end;
  2018. ParentForm := GetMDIParent(TBGetToolWindowParentForm(FDockableWindow));
  2019. if Assigned(ParentForm) and ParentForm.HandleAllocated then
  2020. SendMessage(ParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
  2021. if Message.Active <> WA_INACTIVE then begin
  2022. { This works around a "gotcha" in TCustomForm.CMShowingChanged. When a form
  2023. is hidden, it uses the internal VCL function FindTopMostWindow to
  2024. find a new active window. The problem is that handles of floating
  2025. toolbars on the form being hidden can be returned by
  2026. FindTopMostWindow, so the following code is used to prevent floating
  2027. toolbars on the hidden form from being left active. }
  2028. if not IsWindowVisible(Handle) then
  2029. { ^ Calling IsWindowVisible with a floating toolbar handle will
  2030. always return False if its parent form is hidden since the
  2031. WH_CALLWNDPROC hook automatically updates the toolbars'
  2032. visibility. }
  2033. { Find and activate a window besides this toolbar }
  2034. SetActiveWindow(FindTopLevelWindow(Handle))
  2035. else
  2036. { If the toolbar is being activated and the previous active window wasn't
  2037. its parent form, the form is activated instead. This is done so that if
  2038. the application is deactivated while a floating toolbar was active and
  2039. the application is reactivated again, it returns focus to the form. }
  2040. if Assigned(ParentForm) and ParentForm.HandleAllocated and
  2041. (Message.ActiveWindow <> ParentForm.Handle) then
  2042. SetActiveWindow(ParentForm.Handle);
  2043. end;
  2044. end;
  2045. procedure TTBFloatingWindowParent.WMMouseActivate(var Message: TWMMouseActivate);
  2046. var
  2047. ParentForm, MDIParentForm: TCustomForm;
  2048. begin
  2049. if csDesigning in ComponentState then begin
  2050. inherited;
  2051. Exit;
  2052. end;
  2053. { When floating, prevent the toolbar from activating when clicked.
  2054. This is so it doesn't take the focus away from the window that had it }
  2055. Message.Result := MA_NOACTIVATE;
  2056. { Similar to calling BringWindowToTop, but doesn't activate it }
  2057. SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0,
  2058. SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  2059. { Since it is returning MA_NOACTIVATE, activate the form instead. }
  2060. ParentForm := TBGetToolWindowParentForm(FDockableWindow);
  2061. MDIParentForm := GetMDIParent(ParentForm);
  2062. if (FDockableWindow.FFloatingMode = fmOnTopOfParentForm) and
  2063. FDockableWindow.FActivateParent and
  2064. Assigned(MDIParentForm) and (GetActiveWindow <> Handle) then begin
  2065. { ^ Note to self: The GetActiveWindow check must be in there so that
  2066. double-clicks work properly on controls like Edits }
  2067. if MDIParentForm.HandleAllocated then
  2068. SetActiveWindow(MDIParentForm.Handle);
  2069. if (MDIParentForm <> ParentForm) and { if it's an MDI child form }
  2070. ParentForm.HandleAllocated then
  2071. BringWindowToTop(ParentForm.Handle);
  2072. end;
  2073. end;
  2074. procedure TTBFloatingWindowParent.WMMove(var Message: TWMMove);
  2075. begin
  2076. inherited;
  2077. FDockableWindow.Moved;
  2078. end;
  2079. procedure TTBFloatingWindowParent.DrawNCArea(const DrawToDC: Boolean;
  2080. const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat);
  2081. { Redraws all the non-client area (the border, title bar, and close button) of
  2082. the toolbar when it is floating. }
  2083. const
  2084. COLOR_GRADIENTACTIVECAPTION = 27;
  2085. COLOR_GRADIENTINACTIVECAPTION = 28;
  2086. CaptionBkColors: array[Boolean, Boolean] of Integer =
  2087. ((COLOR_ACTIVECAPTION, COLOR_INACTIVECAPTION),
  2088. (COLOR_GRADIENTACTIVECAPTION, COLOR_GRADIENTINACTIVECAPTION));
  2089. CaptionTextColors: array[Boolean] of Integer =
  2090. (COLOR_CAPTIONTEXT, COLOR_INACTIVECAPTIONTEXT);
  2091. function GradientCaptionsEnabled: Boolean;
  2092. const
  2093. SPI_GETGRADIENTCAPTIONS = $1008; { Win98/NT5 only }
  2094. var
  2095. S: BOOL;
  2096. begin
  2097. Result := SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @S, 0) and S;
  2098. end;
  2099. const
  2100. CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED);
  2101. ActiveCaptionFlags: array[Boolean] of UINT = (DC_ACTIVE, 0);
  2102. DC_GRADIENT = $20;
  2103. GradientCaptionFlags: array[Boolean] of UINT = (0, DC_GRADIENT);
  2104. var
  2105. DC: HDC;
  2106. R, R2: TRect;
  2107. Gradient: Boolean;
  2108. SavePen: HPEN;
  2109. SaveIndex: Integer;
  2110. S: TPoint;
  2111. begin
  2112. if not HandleAllocated then Exit;
  2113. if not DrawToDC then
  2114. DC := GetWindowDC(Handle)
  2115. else
  2116. DC := ADC;
  2117. try
  2118. { Use update region }
  2119. if not DrawToDC then
  2120. SelectNCUpdateRgn(Handle, DC, Clip);
  2121. { Work around an apparent NT 4.0 & 2000 bug. If the width of the DC is
  2122. greater than the width of the screen, then any call to ExcludeClipRect
  2123. inexplicably shrinks the clipping rectangle to the screen width. I've
  2124. found that calling IntersectClipRect as done below magically fixes the
  2125. problem (but I'm not sure why). }
  2126. GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top);
  2127. IntersectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  2128. Gradient := GradientCaptionsEnabled;
  2129. { Border }
  2130. if twrdBorder in RedrawWhat then begin
  2131. { This works around WM_NCPAINT problem described at top of source code }
  2132. {no! R := Rect(0, 0, Width, Height);}
  2133. GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top);
  2134. DrawEdge(DC, R, EDGE_RAISED, BF_RECT);
  2135. SaveIndex := SaveDC(DC);
  2136. S := FDockableWindow.GetFloatingBorderSize;
  2137. with R do
  2138. ExcludeClipRect(DC, Left + S.X, Top + S.Y, Right - S.X, Bottom - S.Y);
  2139. InflateRect(R, -2, -2);
  2140. FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE));
  2141. RestoreDC(DC, SaveIndex);
  2142. end;
  2143. if FDockableWindow.ShowCaption then begin
  2144. if (twrdCaption in RedrawWhat) and FDockableWindow.FCloseButton and
  2145. (twrdCloseButton in RedrawWhat) then
  2146. SaveIndex := SaveDC(DC)
  2147. else
  2148. SaveIndex := 0;
  2149. try
  2150. if SaveIndex <> 0 then
  2151. with GetCloseButtonRect(Self, True) do
  2152. { Reduces flicker }
  2153. ExcludeClipRect(DC, Left, Top, Right, Bottom);
  2154. { Caption }
  2155. if twrdCaption in RedrawWhat then begin
  2156. R := GetCaptionRect(Self, True, FDockableWindow.FCloseButton);
  2157. { Note that Delphi's Win32 help for DrawCaption is totally wrong!
  2158. I got updated info from www.microsoft.com/msdn/sdk/ }
  2159. DrawCaption(Handle, DC, R, DC_TEXT or DC_SMALLCAP or
  2160. ActiveCaptionFlags[FDockableWindow.FInactiveCaption] or
  2161. GradientCaptionFlags[Gradient]);
  2162. { Line below caption }
  2163. R := GetCaptionRect(Self, True, False);
  2164. SavePen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE)));
  2165. MoveToEx(DC, R.Left, R.Bottom, nil);
  2166. LineTo(DC, R.Right, R.Bottom);
  2167. DeleteObject(SelectObject(DC, SavePen));
  2168. end;
  2169. finally
  2170. if SaveIndex <> 0 then
  2171. RestoreDC(DC, SaveIndex);
  2172. end;
  2173. { Close button }
  2174. if FDockableWindow.FCloseButton then begin
  2175. R := GetCloseButtonRect(Self, True);
  2176. R2 := R;
  2177. InflateRect(R2, 0, -2);
  2178. Dec(R2.Right, 2);
  2179. if twrdCaption in RedrawWhat then begin
  2180. SaveIndex := SaveDC(DC);
  2181. ExcludeClipRect(DC, R2.Left, R2.Top, R2.Right, R2.Bottom);
  2182. FillRect(DC, R, GetSysColorBrush(CaptionBkColors[Gradient,
  2183. FDockableWindow.FInactiveCaption]));
  2184. RestoreDC(DC, SaveIndex);
  2185. end;
  2186. if twrdCloseButton in RedrawWhat then
  2187. DrawFrameControl(DC, R2, DFC_CAPTION, DFCS_CAPTIONCLOSE or
  2188. CloseButtonState[FCloseButtonDown]);
  2189. end;
  2190. end;
  2191. finally
  2192. if not DrawToDC then
  2193. ReleaseDC(Handle, DC);
  2194. end;
  2195. end;
  2196. procedure TTBFloatingWindowParent.RedrawNCArea(const RedrawWhat: TTBToolWindowNCRedrawWhat);
  2197. begin
  2198. { Note: IsWindowVisible is called as an optimization. There's no need to
  2199. draw on invisible windows. }
  2200. if HandleAllocated and IsWindowVisible(Handle) then
  2201. DrawNCArea(False, 0, 0, RedrawWhat);
  2202. end;
  2203. { TTBCustomDockableWindow }
  2204. constructor TTBCustomDockableWindow.Create(AOwner: TComponent);
  2205. begin
  2206. inherited;
  2207. ControlStyle := ControlStyle +
  2208. [csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] -
  2209. [csCaptureMouse{capturing is done manually}, csOpaque];
  2210. FAutoResize := True;
  2211. FActivateParent := True;
  2212. FBorderStyle := bsSingle;
  2213. FCloseButton := True;
  2214. FDblClickUndock := True;
  2215. FDockableTo := [dpTop, dpBottom, dpLeft, dpRight];
  2216. FDockableWindowStyles := [tbdsResizeEightCorner, tbdsResizeClipCursor];
  2217. FDockPos := -1;
  2218. FDragHandleStyle := dhSingle;
  2219. FEffectiveDockRow := -1;
  2220. FHideWhenInactive := True;
  2221. FResizable := True;
  2222. FShowCaption := True;
  2223. FSmoothDrag := True;
  2224. FUseLastDock := True;
  2225. Color := clBtnFace;
  2226. if not(csDesigning in ComponentState) then
  2227. InstallHookProc(Self, ToolbarHookProc, [hpSendActivate, hpSendActivateApp,
  2228. hpSendWindowPosChanged, hpPreDestroy]);
  2229. end;
  2230. destructor TTBCustomDockableWindow.Destroy;
  2231. begin
  2232. inherited;
  2233. FDockForms.Free; { must be done after 'inherited' because Notification accesses FDockForms }
  2234. FFloatParent.Free;
  2235. UninstallHookProc(Self, ToolbarHookProc);
  2236. end;
  2237. function TTBCustomDockableWindow.HasParent: Boolean;
  2238. begin
  2239. if Parent is TTBFloatingWindowParent then
  2240. Result := False
  2241. else
  2242. Result := inherited HasParent;
  2243. end;
  2244. function TTBCustomDockableWindow.GetParentComponent: TComponent;
  2245. begin
  2246. if Parent is TTBFloatingWindowParent then
  2247. Result := nil
  2248. else
  2249. Result := inherited GetParentComponent;
  2250. end;
  2251. procedure TTBCustomDockableWindow.Moved;
  2252. begin
  2253. if not(csLoading in ComponentState) and Assigned(FOnMove) and (FDisableOnMove <= 0) then
  2254. FOnMove(Self);
  2255. end;
  2256. procedure TTBCustomDockableWindow.WMMove(var Message: TWMMove);
  2257. procedure Redraw;
  2258. { Redraws the control using an off-screen bitmap to avoid flicker }
  2259. var
  2260. CR, R: TRect;
  2261. W: HWND;
  2262. DC, BmpDC: HDC;
  2263. Bmp: HBITMAP;
  2264. begin
  2265. if not HandleAllocated then Exit;
  2266. CR := ClientRect;
  2267. W := Handle;
  2268. if GetUpdateRect(W, R, False) and EqualRect(R, CR) then begin
  2269. { The client area is already completely invalid, so don't bother using
  2270. an off-screen bitmap }
  2271. InvalidateAll(Self);
  2272. Exit;
  2273. end;
  2274. BmpDC := 0;
  2275. Bmp := 0;
  2276. DC := GetDC(W);
  2277. try
  2278. BmpDC := CreateCompatibleDC(DC);
  2279. Bmp := CreateCompatibleBitmap(DC, CR.Right, CR.Bottom);
  2280. SelectObject(BmpDC, Bmp);
  2281. SendMessage(W, WM_NCPAINT, 0, 0);
  2282. SendMessage(W, WM_ERASEBKGND, WPARAM(BmpDC), 0);
  2283. SendMessage(W, WM_PAINT, WPARAM(BmpDC), 0);
  2284. BitBlt(DC, 0, 0, CR.Right, CR.Bottom, BmpDC, 0, 0, SRCCOPY);
  2285. finally
  2286. if BmpDC <> 0 then DeleteDC(BmpDC);
  2287. if Bmp <> 0 then DeleteObject(Bmp);
  2288. ReleaseDC(W, DC);
  2289. end;
  2290. ValidateRect(W, nil);
  2291. end;
  2292. begin
  2293. inherited;
  2294. FMoved := True;
  2295. if Docked and CurrentDock.UsingBackground then begin
  2296. { Needs to redraw so that the background is lined up with the dock at the
  2297. new position. }
  2298. Redraw;
  2299. end;
  2300. Moved;
  2301. end;
  2302. procedure TTBCustomDockableWindow.WMEnable(var Message: TWMEnable);
  2303. begin
  2304. inherited;
  2305. { When a modal dialog is displayed and the toolbar window gets disabled as
  2306. a result, remove its topmost flag. }
  2307. if FFloatingMode = fmOnTopOfAllForms then
  2308. UpdateTopmostFlag;
  2309. end;
  2310. procedure TTBCustomDockableWindow.UpdateCaptionState;
  2311. { Updates the caption active/inactive state of a floating tool window.
  2312. Called when the tool window is visible or is about to be shown. }
  2313. function IsPopupWindowActive: Boolean;
  2314. const
  2315. IID_ITBPopupWindow: TGUID = '{E45CBE74-1ECF-44CB-B064-6D45B1924708}';
  2316. var
  2317. Ctl: TWinControl;
  2318. begin
  2319. Ctl := FindControl(GetActiveWindow);
  2320. { Instead of using "is TTBPopupWindow", which would require linking to the
  2321. TB2Item unit, check if the control implements the ITBPopupWindow
  2322. interface. This will tell us if it's a TTBPopupWindow or descendant. }
  2323. Result := Assigned(Ctl) and Assigned(Ctl.GetInterfaceEntry(IID_ITBPopupWindow));
  2324. end;
  2325. function GetActiveFormWindow: HWND;
  2326. var
  2327. Ctl: TWinControl;
  2328. begin
  2329. Result := GetActiveWindow;
  2330. { If the active window is a TTBFloatingWindowParent (i.e. a control on a
  2331. floating toolbar is focused), return the parent form handle instead }
  2332. Ctl := FindControl(Result);
  2333. if Assigned(Ctl) and (Ctl is TTBFloatingWindowParent) then begin
  2334. Ctl := TTBFloatingWindowParent(Ctl).ParentForm;
  2335. if Assigned(Ctl) and Ctl.HandleAllocated then
  2336. Result := Ctl.Handle;
  2337. end;
  2338. end;
  2339. var
  2340. Inactive: Boolean;
  2341. ActiveWnd: HWND;
  2342. begin
  2343. { Update caption state if floating, but not if a control on a popup window
  2344. (e.g. a TTBEditItem) is currently focused; we don't want the captions on
  2345. all floating toolbars to turn gray in that case. (The caption state will
  2346. get updated when we're called the next time the active window changes,
  2347. i.e. when the user dismisses the popup window.) }
  2348. if (Parent is TTBFloatingWindowParent) and Parent.HandleAllocated and
  2349. not IsPopupWindowActive then begin
  2350. Inactive := False;
  2351. if not ApplicationIsActive then
  2352. Inactive := True
  2353. else if (FFloatingMode = fmOnTopOfParentForm) and
  2354. (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) <> Application.Handle) then begin
  2355. { Use inactive caption if the active window doesn't own the float parent
  2356. (directly or indirectly). Note: For compatibility with browser-embedded
  2357. TActiveForms, we use IsAncestorOfWindow instead of checking
  2358. TBGetToolWindowParentForm. }
  2359. ActiveWnd := GetActiveFormWindow;
  2360. if (ActiveWnd = 0) or not IsAncestorOfWindow(ActiveWnd, Parent.Handle) then
  2361. Inactive := True;
  2362. end;
  2363. if FInactiveCaption <> Inactive then begin
  2364. FInactiveCaption := Inactive;
  2365. TTBFloatingWindowParent(Parent).RedrawNCArea(twrdAll);
  2366. end;
  2367. end;
  2368. end;
  2369. function TTBCustomDockableWindow.GetShowingState: Boolean;
  2370. function IsWindowVisibleAndNotMinimized(Wnd: HWND): Boolean;
  2371. begin
  2372. Result := IsWindowVisible(Wnd);
  2373. if Result then begin
  2374. { Wnd may not be a top-level window (e.g. in the case of an MDI child
  2375. form, or an ActiveForm embedded in a web page), so go up the chain of
  2376. parent windows and see if any of them are minimized }
  2377. repeat
  2378. if IsIconic(Wnd) then begin
  2379. Result := False;
  2380. Break;
  2381. end;
  2382. { Stop if we're at a top-level window (no need to check owner windows) }
  2383. if GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD = 0 then
  2384. Break;
  2385. Wnd := GetParent(Wnd);
  2386. until Wnd = 0;
  2387. end;
  2388. end;
  2389. var
  2390. HideFloatingToolbars: Boolean;
  2391. ParentForm: TCustomForm;
  2392. begin
  2393. Result := Showing and (FHidden = 0);
  2394. if Floating and not(csDesigning in ComponentState) then begin
  2395. HideFloatingToolbars := FFloatingMode = fmOnTopOfParentForm;
  2396. if HideFloatingToolbars then begin
  2397. ParentForm := TBGetToolWindowParentForm(Self);
  2398. if Assigned(ParentForm) and ParentForm.HandleAllocated and
  2399. IsWindowVisibleAndNotMinimized(ParentForm.Handle) then
  2400. HideFloatingToolbars := False;
  2401. end;
  2402. Result := Result and not (HideFloatingToolbars or (FHideWhenInactive and not ApplicationIsActive));
  2403. end;
  2404. end;
  2405. procedure TTBCustomDockableWindow.UpdateVisibility;
  2406. { Updates the visibility of the tool window, and additionally the caption
  2407. state if floating and showing }
  2408. var
  2409. IsVisible: Boolean;
  2410. begin
  2411. if HandleAllocated then begin
  2412. IsVisible := IsWindowVisible(Handle);
  2413. if IsVisible <> GetShowingState then begin
  2414. Perform(CM_SHOWINGCHANGED, 0, 0);
  2415. { Note: CMShowingChanged will call UpdateCaptionState automatically
  2416. when floating and showing }
  2417. end
  2418. else if IsVisible and Floating then begin
  2419. { If we're floating and we didn't send the CM_SHOWINGCHANGED message
  2420. then we have to call UpdateCaptionState manually }
  2421. UpdateCaptionState;
  2422. end;
  2423. end;
  2424. end;
  2425. function IsTopmost(const Wnd: HWND): Boolean;
  2426. begin
  2427. Result := GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0;
  2428. end;
  2429. function TTBCustomDockableWindow.GetDragHandleSize: Integer;
  2430. begin
  2431. Result := ScaleByPixelsPerInch(DragHandleSizes[CloseButtonWhenDocked][DragHandleStyle], Self);
  2432. end;
  2433. function TTBCustomDockableWindow.GetDragHandleXOffset: Integer;
  2434. begin
  2435. Result := ScaleByPixelsPerInch(DragHandleXOffsets[CloseButtonWhenDocked][DragHandleStyle], Self);
  2436. end;
  2437. procedure TTBCustomDockableWindow.UpdateTopmostFlag;
  2438. const
  2439. Wnds: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
  2440. var
  2441. ShouldBeTopmost: Boolean;
  2442. begin
  2443. if HandleAllocated then begin
  2444. if FFloatingMode = fmOnTopOfAllForms then
  2445. ShouldBeTopmost := IsWindowEnabled(Handle)
  2446. else
  2447. ShouldBeTopmost := IsTopmost(HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)));
  2448. if ShouldBeTopmost <> IsTopmost(Parent.Handle) then
  2449. { ^ it must check if it already was topmost or non-topmost or else
  2450. it causes problems on Win95/98 for some reason }
  2451. SetWindowPos(Parent.Handle, Wnds[ShouldBeTopmost], 0, 0, 0, 0,
  2452. SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  2453. end;
  2454. end;
  2455. procedure TTBCustomDockableWindow.CMShowingChanged(var Message: TMessage);
  2456. function GetPrevWnd(W: HWND): HWND;
  2457. var
  2458. WasTopmost, Done: Boolean;
  2459. ParentWnd: HWND;
  2460. begin
  2461. WasTopmost := IsTopmost(Parent.Handle);
  2462. Result := W;
  2463. repeat
  2464. Done := True;
  2465. Result := GetWindow(Result, GW_HWNDPREV);
  2466. ParentWnd := Result;
  2467. while ParentWnd <> 0 do begin
  2468. if WasTopmost and not IsTopmost(ParentWnd) then begin
  2469. Done := False;
  2470. Break;
  2471. end;
  2472. ParentWnd := HWND(GetWindowLong(ParentWnd, GWL_HWNDPARENT));
  2473. if ParentWnd = W then begin
  2474. Done := False;
  2475. Break;
  2476. end;
  2477. end;
  2478. until Done;
  2479. end;
  2480. const
  2481. ShowFlags: array[Boolean] of UINT = (
  2482. SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
  2483. SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  2484. var
  2485. Show: Boolean;
  2486. Form: TCustomForm;
  2487. begin
  2488. { inherited isn't called since TTBCustomDockableWindow handles CM_SHOWINGCHANGED
  2489. itself. For reference, the original TWinControl implementation is:
  2490. const
  2491. ShowFlags: array[Boolean] of Word = (
  2492. SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW,
  2493. SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
  2494. begin
  2495. SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
  2496. end;
  2497. }
  2498. if HandleAllocated then begin
  2499. Show := GetShowingState;
  2500. if Parent is TTBFloatingWindowParent then begin
  2501. if Show then begin
  2502. { If the toolbar is floating, set its "owner window" to the parent form
  2503. so that the toolbar window always stays on top of the form }
  2504. if FFloatingMode = fmOnTopOfParentForm then begin
  2505. Form := GetMDIParent(TBGetToolWindowParentForm(Self));
  2506. if Assigned(Form) and Form.HandleAllocated and
  2507. (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) <> Form.Handle) then begin
  2508. SetWindowLong(Parent.Handle, GWL_HWNDPARENT, Longint(Form.Handle));
  2509. { Following is necessarily to make it immediately realize the
  2510. GWL_HWNDPARENT change }
  2511. SetWindowPos(Parent.Handle, GetPrevWnd(Form.Handle), 0, 0, 0, 0, SWP_NOACTIVATE or
  2512. SWP_NOMOVE or SWP_NOSIZE);
  2513. end;
  2514. end
  2515. else begin
  2516. SetWindowLong(Parent.Handle, GWL_HWNDPARENT, Longint(Application.Handle));
  2517. end;
  2518. { Initialize caption state after setting owner but before showing }
  2519. UpdateCaptionState;
  2520. end;
  2521. UpdateTopmostFlag;
  2522. { Show/hide the TTBFloatingWindowParent. The following lines had to be
  2523. added to fix a problem that was in 1.65d/e. In 1.65d/e, it always
  2524. kept TTBFloatingWindowParent visible (this change was made to improve
  2525. compatibility with D4's Actions), but this for some odd reason would
  2526. cause a Stack Overflow error if the program's main form was closed
  2527. while a floating toolwindow was focused. (This problem did not occur
  2528. on NT.) }
  2529. TTBFloatingWindowParent(Parent).FShouldShow := Show;
  2530. Parent.Perform(CM_SHOWINGCHANGED, 0, 0);
  2531. end;
  2532. SetWindowPos(Handle, 0, 0, 0, 0, 0, ShowFlags[Show]);
  2533. if not Show and (GetActiveWindow = Handle) then
  2534. { If the window is hidden but is still active, find and activate a
  2535. different window }
  2536. SetActiveWindow(FindTopLevelWindow(Handle));
  2537. end;
  2538. end;
  2539. procedure TTBCustomDockableWindow.CreateParams(var Params: TCreateParams);
  2540. begin
  2541. inherited;
  2542. { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
  2543. and are not necessary for this control at run time }
  2544. if not(csDesigning in ComponentState) then
  2545. with Params.WindowClass do
  2546. Style := Style and not(CS_HREDRAW or CS_VREDRAW);
  2547. end;
  2548. procedure TTBCustomDockableWindow.Notification(AComponent: TComponent; Operation: TOperation);
  2549. begin
  2550. inherited;
  2551. if Operation = opRemove then begin
  2552. if AComponent = FDefaultDock then
  2553. FDefaultDock := nil
  2554. else
  2555. if AComponent = FLastDock then
  2556. FLastDock := nil
  2557. else begin
  2558. RemoveFromList(FDockForms, AComponent);
  2559. if Assigned(FFloatParent) and (csDestroying in FFloatParent.ComponentState) and
  2560. (AComponent = FFloatParent.FParentForm) then begin
  2561. { ^ Note: Must check csDestroying so that we are sure that FFloatParent
  2562. is actually being destroyed and not just being removed from its
  2563. Owner's component list }
  2564. if Parent = FFloatParent then begin
  2565. if FFloatingMode = fmOnTopOfParentForm then
  2566. Parent := nil
  2567. else
  2568. FFloatParent.FParentForm := nil;
  2569. end
  2570. else begin
  2571. FFloatParent.Free;
  2572. FFloatParent := nil;
  2573. end;
  2574. end;
  2575. end;
  2576. end;
  2577. end;
  2578. procedure TTBCustomDockableWindow.MoveOnScreen(const OnlyIfFullyOffscreen: Boolean);
  2579. { Moves the (floating) toolbar so that it is fully (or at least mostly) in
  2580. view on the screen }
  2581. var
  2582. R, S, Test: TRect;
  2583. begin
  2584. if Floating then begin
  2585. R := Parent.BoundsRect;
  2586. S := GetRectOfMonitorContainingRect(R, True);
  2587. if OnlyIfFullyOffscreen and IntersectRect(Test, R, S) then
  2588. Exit;
  2589. if R.Right > S.Right then
  2590. OffsetRect(R, S.Right - R.Right, 0);
  2591. if R.Bottom > S.Bottom then
  2592. OffsetRect(R, 0, S.Bottom - R.Bottom);
  2593. if R.Left < S.Left then
  2594. OffsetRect(R, S.Left - R.Left, 0);
  2595. if R.Top < S.Top then
  2596. OffsetRect(R, 0, S.Top - R.Top);
  2597. Parent.BoundsRect := R;
  2598. end;
  2599. end;
  2600. procedure TTBCustomDockableWindow.ReadPositionData(var S: string);
  2601. begin
  2602. end;
  2603. function TTBCustomDockableWindow.WritePositionData: string;
  2604. begin
  2605. Result := '';
  2606. end;
  2607. procedure TTBCustomDockableWindow.InitializeOrdering;
  2608. begin
  2609. end;
  2610. procedure TTBCustomDockableWindow.SizeChanging(const AWidth, AHeight: Integer);
  2611. begin
  2612. end;
  2613. procedure TTBCustomDockableWindow.ReadSavedAtRunTime(Reader: TReader);
  2614. begin
  2615. FSavedAtRunTime := Reader.ReadBoolean;
  2616. end;
  2617. procedure TTBCustomDockableWindow.WriteSavedAtRunTime(Writer: TWriter);
  2618. begin
  2619. { WriteSavedAtRunTime only called when not(csDesigning in ComponentState) }
  2620. Writer.WriteBoolean(True);
  2621. end;
  2622. procedure TTBCustomDockableWindow.DefineProperties(Filer: TFiler);
  2623. begin
  2624. inherited;
  2625. Filer.DefineProperty('SavedAtRunTime', ReadSavedAtRunTime,
  2626. WriteSavedAtRunTime, not(csDesigning in ComponentState));
  2627. end;
  2628. procedure TTBCustomDockableWindow.Loaded;
  2629. var
  2630. R: TRect;
  2631. begin
  2632. inherited;
  2633. { Adjust coordinates if it was initially floating }
  2634. if not FSavedAtRunTime and not(csDesigning in ComponentState) and
  2635. (Parent is TTBFloatingWindowParent) then begin
  2636. R := BoundsRect;
  2637. MapWindowPoints(TBValidToolWindowParentForm(Self).Handle, 0, R, 2);
  2638. BoundsRect := R;
  2639. MoveOnScreen(False);
  2640. end;
  2641. InitializeOrdering;
  2642. { Arranging is disabled while component was loading, so arrange now }
  2643. Arrange;
  2644. end;
  2645. procedure TTBCustomDockableWindow.BeginUpdate;
  2646. begin
  2647. Inc(FDisableArrange);
  2648. end;
  2649. procedure TTBCustomDockableWindow.EndUpdate;
  2650. begin
  2651. Dec(FDisableArrange);
  2652. if FArrangeNeeded and (FDisableArrange = 0) then
  2653. Arrange;
  2654. end;
  2655. procedure TTBCustomDockableWindow.AddDockForm(const Form: TCustomForm);
  2656. begin
  2657. if Form = nil then Exit;
  2658. if AddToList(FDockForms, Form) then
  2659. Form.FreeNotification(Self);
  2660. end;
  2661. procedure TTBCustomDockableWindow.RemoveDockForm(const Form: TCustomForm);
  2662. begin
  2663. RemoveFromList(FDockForms, Form);
  2664. end;
  2665. function TTBCustomDockableWindow.CanDockTo(ADock: TTBDock): Boolean;
  2666. begin
  2667. Result := ADock.Position in DockableTo;
  2668. end;
  2669. function TTBCustomDockableWindow.IsAutoResized: Boolean;
  2670. begin
  2671. Result := AutoResize or Assigned(CurrentDock) or Floating;
  2672. end;
  2673. procedure TTBCustomDockableWindow.ChangeSize(AWidth, AHeight: Integer);
  2674. var
  2675. S: TPoint;
  2676. begin
  2677. if Docked then
  2678. CurrentDock.ArrangeToolbars
  2679. else begin
  2680. S := CalcNCSizes;
  2681. Inc(AWidth, S.X);
  2682. Inc(AHeight, S.Y);
  2683. { Leave the width and/or height alone if the control is Anchored
  2684. (or Aligned) }
  2685. if not Floating then begin
  2686. if (akLeft in Anchors) and (akRight in Anchors) then
  2687. AWidth := Width;
  2688. if (akTop in Anchors) and (akBottom in Anchors) then
  2689. AHeight := Height;
  2690. end;
  2691. Inc(FUpdatingBounds);
  2692. try
  2693. SetBounds(Left, Top, AWidth, AHeight);
  2694. finally
  2695. Dec(FUpdatingBounds);
  2696. end;
  2697. end;
  2698. end;
  2699. procedure TTBCustomDockableWindow.Arrange;
  2700. var
  2701. Size: TPoint;
  2702. begin
  2703. if (FDisableArrange > 0) or
  2704. { Prevent flicker while loading }
  2705. (csLoading in ComponentState) or
  2706. { Don't call DoArrangeControls when Parent is nil. The VCL sets Parent to
  2707. 'nil' during destruction of a component; we can't have an OrderControls
  2708. call after a descendant control has freed its data. }
  2709. (Parent = nil) then begin
  2710. FArrangeNeeded := True;
  2711. Exit;
  2712. end;
  2713. FArrangeNeeded := False;
  2714. Size := DoArrange(True, TBGetDockTypeOf(CurrentDock, Floating), Floating,
  2715. CurrentDock);
  2716. if IsAutoResized then
  2717. ChangeSize(Size.X, Size.Y);
  2718. end;
  2719. procedure TTBCustomDockableWindow.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  2720. begin
  2721. if not(csDesigning in ComponentState) and Floating then begin
  2722. { Force Top & Left to 0 if floating }
  2723. ALeft := 0;
  2724. ATop := 0;
  2725. if Parent is TTBFloatingWindowParent then
  2726. with Parent do
  2727. SetBounds(Left, Top, (Width-ClientWidth) + AWidth,
  2728. (Height-ClientHeight) + AHeight);
  2729. end;
  2730. if (FUpdatingBounds = 0) and ((AWidth <> Width) or (AHeight <> Height)) then
  2731. SizeChanging(AWidth, AHeight);
  2732. { This allows you to drag the toolbar around the dock at design time }
  2733. if (csDesigning in ComponentState) and not(csLoading in ComponentState) and
  2734. Docked and (FUpdatingBounds = 0) and ((ALeft <> Left) or (ATop <> Top)) then begin
  2735. if not(CurrentDock.Position in PositionLeftOrRight) then begin
  2736. FDockRow := CurrentDock.GetDesignModeRowOf(ATop+(Height div 2));
  2737. FDockPos := ALeft;
  2738. end
  2739. else begin
  2740. FDockRow := CurrentDock.GetDesignModeRowOf(ALeft+(Width div 2));
  2741. FDockPos := ATop;
  2742. end;
  2743. inherited SetBounds(Left, Top, AWidth, AHeight); { only pass any size changes }
  2744. CurrentDock.ArrangeToolbars; { let ArrangeToolbars take care of position changes }
  2745. end
  2746. else begin
  2747. inherited;
  2748. {if not(csLoading in ComponentState) and Floating and (FUpdatingBounds = 0) then
  2749. FFloatingPosition := BoundsRect.TopLeft;}
  2750. end;
  2751. end;
  2752. procedure TTBCustomDockableWindow.SetParent(AParent: TWinControl);
  2753. procedure UpdateFloatingToolWindows;
  2754. begin
  2755. if Parent is TTBFloatingWindowParent then begin
  2756. AddToList(FloatingToolWindows, Self);
  2757. Parent.SetBounds(FFloatingPosition.X, FFloatingPosition.Y,
  2758. Parent.Width, Parent.Height);
  2759. end
  2760. else
  2761. RemoveFromList(FloatingToolWindows, Self);
  2762. end;
  2763. function ParentToCurrentDock(const Ctl: TWinControl): TTBDock;
  2764. begin
  2765. if Ctl is TTBDock then
  2766. Result := TTBDock(Ctl)
  2767. else
  2768. Result := nil;
  2769. end;
  2770. var
  2771. OldCurrentDock, NewCurrentDock: TTBDock;
  2772. NewFloating: Boolean;
  2773. OldParent: TWinControl;
  2774. SaveHandle: HWND;
  2775. begin
  2776. OldCurrentDock := ParentToCurrentDock(Parent);
  2777. NewCurrentDock := ParentToCurrentDock(AParent);
  2778. NewFloating := AParent is TTBFloatingWindowParent;
  2779. if AParent = Parent then begin
  2780. { Even though AParent is the same as the current Parent, this code is
  2781. necessary because when the VCL destroys the parent of the tool window,
  2782. it calls TWinControl.Remove to set FParent instead of using SetParent.
  2783. However TControl.Destroy does call SetParent(nil), so it is
  2784. eventually notified of the change before it is destroyed. }
  2785. FCurrentDock := NewCurrentDock;
  2786. FFloating := NewFloating;
  2787. FDocked := Assigned(FCurrentDock);
  2788. UpdateFloatingToolWindows;
  2789. end
  2790. else begin
  2791. if not(csDestroying in ComponentState) and Assigned(AParent) then begin
  2792. if Assigned(FOnDockChanging) then
  2793. FOnDockChanging(Self, NewFloating, NewCurrentDock);
  2794. if Assigned(FOnRecreating) then
  2795. FOnRecreating(Self);
  2796. end;
  2797. { Before changing between docked and floating state (and vice-versa)
  2798. or between docks, increment FHidden and call UpdateVisibility to hide the
  2799. toolbar. This prevents any flashing while it's being moved }
  2800. Inc(FHidden);
  2801. Inc(FDisableOnMove);
  2802. try
  2803. UpdateVisibility;
  2804. if Assigned(OldCurrentDock) then
  2805. OldCurrentDock.BeginUpdate;
  2806. if Assigned(NewCurrentDock) then
  2807. NewCurrentDock.BeginUpdate;
  2808. Inc(FUpdatingBounds);
  2809. try
  2810. if Assigned(AParent) then
  2811. DoDockChangingHidden(NewFloating, NewCurrentDock);
  2812. BeginUpdate;
  2813. try
  2814. { FCurrentSize probably won't be valid after changing Parents, so
  2815. reset it to zero }
  2816. FCurrentSize := 0;
  2817. if Parent is TTBDock then begin
  2818. if not FUseLastDock or (FLastDock <> Parent) then
  2819. TTBDock(Parent).ChangeDockList(False, Self);
  2820. TTBDock(Parent).ToolbarVisibilityChanged(Self, True);
  2821. end;
  2822. OldParent := Parent;
  2823. SaveHandle := 0;
  2824. if Assigned(AParent) then begin
  2825. //AParent.HandleNeeded;
  2826. SaveHandle := WindowHandle;
  2827. WindowHandle := 0;
  2828. end;
  2829. { Ensure that the handle is destroyed now so that any messages in the queue
  2830. get flushed. This is neccessary since existing messages may reference
  2831. FDockedTo or FDocked, which is changed below. }
  2832. inherited SetParent(nil);
  2833. { ^ Note to self: SetParent is used instead of DestroyHandle because it does
  2834. additional processing }
  2835. FCurrentDock := NewCurrentDock;
  2836. FFloating := NewFloating;
  2837. FDocked := Assigned(FCurrentDock);
  2838. try
  2839. if SaveHandle <> 0 then begin
  2840. WindowHandle := SaveHandle;
  2841. Windows.SetParent(SaveHandle, AParent.Handle);
  2842. SetWindowPos(SaveHandle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
  2843. SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  2844. end;
  2845. inherited;
  2846. except
  2847. { Failure is rare, but just in case, restore FDockedTo and FDocked back. }
  2848. FCurrentDock := ParentToCurrentDock(Parent);
  2849. FFloating := Parent is TTBFloatingWindowParent;
  2850. FDocked := Assigned(FCurrentDock);
  2851. raise;
  2852. end;
  2853. { FEffectiveDockRow probably won't be valid on the new Parent, so
  2854. reset it to -1 so that GetMinRowSize will temporarily ignore this
  2855. toolbar }
  2856. FEffectiveDockRow := -1;
  2857. if not FSmoothDragging and (OldParent is TTBFloatingWindowParent) then begin
  2858. if FFloatParent = OldParent then FFloatParent := nil;
  2859. OldParent.Free;
  2860. end;
  2861. if Parent is TTBDock then begin
  2862. if FUseLastDock and not FSmoothDragging then begin
  2863. LastDock := TTBDock(Parent); { calls ChangeDockList if LastDock changes }
  2864. TTBDock(Parent).ToolbarVisibilityChanged(Self, False);
  2865. end
  2866. else
  2867. TTBDock(Parent).ChangeDockList(True, Self);
  2868. end;
  2869. UpdateFloatingToolWindows;
  2870. { Schedule an arrange }
  2871. Arrange;
  2872. finally
  2873. EndUpdate;
  2874. end;
  2875. finally
  2876. Dec(FUpdatingBounds);
  2877. if Assigned(NewCurrentDock) then
  2878. NewCurrentDock.EndUpdate;
  2879. if Assigned(OldCurrentDock) then
  2880. OldCurrentDock.EndUpdate;
  2881. end;
  2882. finally
  2883. Dec(FDisableOnMove);
  2884. Dec(FHidden);
  2885. UpdateVisibility;
  2886. { ^ The above UpdateVisibility call not only updates the tool window's
  2887. visibility after decrementing FHidden, it also sets the
  2888. active/inactive state of the caption. }
  2889. end;
  2890. if Assigned(Parent) then
  2891. Moved;
  2892. if not(csDestroying in ComponentState) and Assigned(AParent) then begin
  2893. if Assigned(FOnRecreated) then
  2894. FOnRecreated(Self);
  2895. if Assigned(FOnDockChanged) then
  2896. FOnDockChanged(Self);
  2897. end;
  2898. end;
  2899. end;
  2900. procedure TTBCustomDockableWindow.AddDockedNCAreaToSize(var S: TPoint;
  2901. const LeftRight: Boolean);
  2902. var
  2903. TopLeft, BottomRight: TPoint;
  2904. begin
  2905. GetDockedNCArea(TopLeft, BottomRight, LeftRight);
  2906. Inc(S.X, TopLeft.X + BottomRight.X);
  2907. Inc(S.Y, TopLeft.Y + BottomRight.Y);
  2908. end;
  2909. procedure TTBCustomDockableWindow.AddFloatingNCAreaToSize(var S: TPoint);
  2910. var
  2911. TopLeft, BottomRight: TPoint;
  2912. begin
  2913. GetFloatingNCArea(TopLeft, BottomRight);
  2914. Inc(S.X, TopLeft.X + BottomRight.X);
  2915. Inc(S.Y, TopLeft.Y + BottomRight.Y);
  2916. end;
  2917. procedure TTBCustomDockableWindow.GetDockedNCArea(var TopLeft, BottomRight: TPoint;
  2918. const LeftRight: Boolean);
  2919. var
  2920. Z: Integer;
  2921. begin
  2922. Z := DockedBorderSize; { code optimization... }
  2923. TopLeft.X := Z;
  2924. TopLeft.Y := Z;
  2925. BottomRight.X := Z;
  2926. BottomRight.Y := Z;
  2927. if not LeftRight then begin
  2928. Inc(TopLeft.X, GetDragHandleSize);
  2929. //if FShowChevron then
  2930. // Inc(BottomRight.X, tbChevronSize);
  2931. end
  2932. else begin
  2933. Inc(TopLeft.Y, GetDragHandleSize);
  2934. //if FShowChevron then
  2935. // Inc(BottomRight.Y, tbChevronSize);
  2936. end;
  2937. end;
  2938. function TTBCustomDockableWindow.GetFloatingBorderSize: TPoint;
  2939. { Returns size of a thick border. Note that, depending on the Windows version,
  2940. this may not be the same as the actual window metrics since it draws its
  2941. own border }
  2942. const
  2943. XMetrics: array[Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME);
  2944. YMetrics: array[Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME);
  2945. begin
  2946. Result.X := GetSystemMetricsForControl(Self, XMetrics[Resizable]);
  2947. Result.Y := GetSystemMetricsForControl(Self, YMetrics[Resizable]);
  2948. end;
  2949. procedure TTBCustomDockableWindow.GetFloatingNCArea(var TopLeft, BottomRight: TPoint);
  2950. begin
  2951. with GetFloatingBorderSize do begin
  2952. TopLeft.X := X;
  2953. TopLeft.Y := Y;
  2954. if ShowCaption then
  2955. Inc(TopLeft.Y, GetSmallCaptionHeight(Self));
  2956. BottomRight.X := X;
  2957. BottomRight.Y := Y;
  2958. end;
  2959. end;
  2960. function TTBCustomDockableWindow.GetDockedCloseButtonRect(LeftRight: Boolean): TRect;
  2961. var
  2962. X, Y, Z: Integer;
  2963. begin
  2964. Z := GetDragHandleSize - 3;
  2965. if not LeftRight then begin
  2966. X := DockedBorderSize+1;
  2967. Y := DockedBorderSize;
  2968. end
  2969. else begin
  2970. X := (ClientWidth + DockedBorderSize) - Z;
  2971. Y := DockedBorderSize+1;
  2972. end;
  2973. Result := Bounds(X, Y, Z, Z);
  2974. end;
  2975. function TTBCustomDockableWindow.CalcNCSizes: TPoint;
  2976. var
  2977. Z: Integer;
  2978. begin
  2979. if not Docked then begin
  2980. Result.X := 0;
  2981. Result.Y := 0;
  2982. end
  2983. else begin
  2984. Result.X := DockedBorderSize2;
  2985. Result.Y := DockedBorderSize2;
  2986. if CurrentDock.FAllowDrag then begin
  2987. Z := GetDragHandleSize;
  2988. if not(CurrentDock.Position in PositionLeftOrRight) then
  2989. Inc(Result.X, Z)
  2990. else
  2991. Inc(Result.Y, Z);
  2992. end;
  2993. end;
  2994. end;
  2995. procedure TTBCustomDockableWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
  2996. var
  2997. Z: Integer;
  2998. begin
  2999. { Doesn't call inherited since it overrides the normal NC sizes }
  3000. Message.Result := 0;
  3001. if Docked then
  3002. with Message.CalcSize_Params^ do begin
  3003. InflateRect(rgrc[0], -DockedBorderSize, -DockedBorderSize);
  3004. if CurrentDock.FAllowDrag then begin
  3005. Z := GetDragHandleSize;
  3006. if not(CurrentDock.Position in PositionLeftOrRight) then
  3007. Inc(rgrc[0].Left, Z)
  3008. else
  3009. Inc(rgrc[0].Top, Z);
  3010. end;
  3011. end;
  3012. end;
  3013. procedure TTBCustomDockableWindow.WMSetCursor(var Message: TWMSetCursor);
  3014. var
  3015. P: TPoint;
  3016. R: TRect;
  3017. I: Integer;
  3018. begin
  3019. if Docked and CurrentDock.FAllowDrag and
  3020. (Message.CursorWnd = WindowHandle) and
  3021. (Smallint(Message.HitTest) = HT_TB2k_Border) and
  3022. (DragHandleStyle <> dhNone) then begin
  3023. GetCursorPos(P);
  3024. GetWindowRect(Handle, R);
  3025. if not(CurrentDock.Position in PositionLeftOrRight) then
  3026. I := P.X - R.Left
  3027. else
  3028. I := P.Y - R.Top;
  3029. if I < DockedBorderSize + GetDragHandleSize then begin
  3030. SetCursor(LoadCursor(0, IDC_SIZEALL));
  3031. Message.Result := 1;
  3032. Exit;
  3033. end;
  3034. end;
  3035. inherited;
  3036. end;
  3037. procedure TTBCustomDockableWindow.DrawNCArea(const DrawToDC: Boolean;
  3038. const ADC: HDC; const Clip: HRGN);
  3039. { Redraws all the non-client area of the toolbar when it is docked. }
  3040. var
  3041. DC: HDC;
  3042. R: TRect;
  3043. VerticalDock: Boolean;
  3044. X, Y, Y2, Y3, YO, S, SaveIndex: Integer;
  3045. R2, R3, R4: TRect;
  3046. P1, P2: TPoint;
  3047. Brush: HBRUSH;
  3048. Clr: TColorRef;
  3049. UsingBackground, B: Boolean;
  3050. procedure DrawRaisedEdge(R: TRect; const FillInterior: Boolean);
  3051. const
  3052. FillMiddle: array[Boolean] of UINT = (0, BF_MIDDLE);
  3053. begin
  3054. DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT or FillMiddle[FillInterior]);
  3055. end;
  3056. function CreateCloseButtonBitmap: HBITMAP;
  3057. const
  3058. Pattern: array[0..15] of Byte =
  3059. (0, 0, $CC, 0, $78, 0, $30, 0, $78, 0, $CC, 0, 0, 0, 0, 0);
  3060. begin
  3061. Result := CreateBitmap(8, 8, 1, 1, @Pattern);
  3062. end;
  3063. procedure DrawButtonBitmap(const Bmp: HBITMAP);
  3064. var
  3065. TempBmp: TBitmap;
  3066. begin
  3067. TempBmp := TBitmap.Create;
  3068. try
  3069. TempBmp.Handle := Bmp;
  3070. SetTextColor(DC, clBlack);
  3071. SetBkColor(DC, clWhite);
  3072. SelectObject(DC, GetSysColorBrush(COLOR_BTNTEXT));
  3073. BitBlt(DC, R2.Left, R2.Top, R2.Right - R2.Left, R2.Bottom - R2.Top,
  3074. TempBmp.Canvas.Handle, 0, 0, $00E20746 {ROP_DSPDxax});
  3075. finally
  3076. TempBmp.Free;
  3077. end;
  3078. end;
  3079. const
  3080. CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED);
  3081. begin
  3082. if not Docked or not HandleAllocated then Exit;
  3083. if not DrawToDC then
  3084. DC := GetWindowDC(Handle)
  3085. else
  3086. DC := ADC;
  3087. try
  3088. { Use update region }
  3089. if not DrawToDC then
  3090. SelectNCUpdateRgn(Handle, DC, Clip);
  3091. { This works around WM_NCPAINT problem described at top of source code }
  3092. {no! R := Rect(0, 0, Width, Height);}
  3093. GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top);
  3094. VerticalDock := CurrentDock.Position in PositionLeftOrRight;
  3095. Brush := CreateSolidBrush(ColorToRGB(Color));
  3096. UsingBackground := CurrentDock.UsingBackground and CurrentDock.FBkgOnToolbars;
  3097. { Border }
  3098. if BorderStyle = bsSingle then
  3099. DrawRaisedEdge(R, False)
  3100. else
  3101. FrameRect(DC, R, Brush);
  3102. R2 := R;
  3103. InflateRect(R2, -1, -1);
  3104. if not UsingBackground then
  3105. FrameRect(DC, R2, Brush);
  3106. { Draw the Background }
  3107. if UsingBackground then begin
  3108. R2 := R;
  3109. P1 := CurrentDock.ClientToScreen(Point(0, 0));
  3110. P2 := CurrentDock.Parent.ClientToScreen(CurrentDock.BoundsRect.TopLeft);
  3111. Dec(R2.Left, Left + CurrentDock.Left + (P1.X-P2.X));
  3112. Dec(R2.Top, Top + CurrentDock.Top + (P1.Y-P2.Y));
  3113. InflateRect(R, -1, -1);
  3114. GetWindowRect(Handle, R4);
  3115. R3 := ClientRect;
  3116. with ClientToScreen(Point(0, 0)) do
  3117. OffsetRect(R3, X-R4.Left, Y-R4.Top);
  3118. SaveIndex := SaveDC(DC);
  3119. IntersectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  3120. ExcludeClipRect(DC, R3.Left, R3.Top, R3.Right, R3.Bottom);
  3121. CurrentDock.DrawBackground(DC, R2);
  3122. RestoreDC(DC, SaveIndex);
  3123. end;
  3124. { The drag handle at the left, or top }
  3125. if CurrentDock.FAllowDrag then begin
  3126. SaveIndex := SaveDC(DC);
  3127. if not VerticalDock then
  3128. Y2 := ClientHeight
  3129. else
  3130. Y2 := ClientWidth;
  3131. Inc(Y2, DockedBorderSize);
  3132. S := GetDragHandleSize;
  3133. if FDragHandleStyle <> dhNone then begin
  3134. Y3 := Y2;
  3135. X := DockedBorderSize + GetDragHandleXOffset;
  3136. Y := DockedBorderSize;
  3137. YO := Ord(FDragHandleStyle = dhSingle);
  3138. if FCloseButtonWhenDocked then begin
  3139. if not VerticalDock then
  3140. Inc(Y, S - 2)
  3141. else
  3142. Dec(Y3, S - 2);
  3143. end;
  3144. Clr := GetSysColor(COLOR_BTNHIGHLIGHT);
  3145. for B := False to (FDragHandleStyle = dhDouble) do begin
  3146. if not VerticalDock then
  3147. R2 := Rect(X, Y+YO, X+3, Y2-YO)
  3148. else
  3149. R2 := Rect(Y+YO, X, Y3-YO, X+3);
  3150. DrawRaisedEdge(R2, True);
  3151. if not VerticalDock then
  3152. SetPixelV(DC, X, Y2-1-YO, Clr)
  3153. else
  3154. SetPixelV(DC, Y3-1-YO, X, Clr);
  3155. ExcludeClipRect(DC, R2.Left, R2.Top, R2.Right, R2.Bottom);
  3156. Inc(X, 3);
  3157. end;
  3158. end;
  3159. if not UsingBackground then begin
  3160. if not VerticalDock then
  3161. R2 := Rect(DockedBorderSize, DockedBorderSize,
  3162. DockedBorderSize+S, Y2)
  3163. else
  3164. R2 := Rect(DockedBorderSize, DockedBorderSize,
  3165. Y2, DockedBorderSize+S);
  3166. FillRect(DC, R2, Brush);
  3167. end;
  3168. RestoreDC(DC, SaveIndex);
  3169. { Close button }
  3170. if FCloseButtonWhenDocked then begin
  3171. R2 := GetDockedCloseButtonRect(VerticalDock);
  3172. if FCloseButtonDown then
  3173. DrawEdge(DC, R2, BDR_SUNKENOUTER, BF_RECT)
  3174. else if FCloseButtonHover then
  3175. DrawRaisedEdge(R2, False);
  3176. InflateRect(R2, -2, -2);
  3177. if FCloseButtonDown then
  3178. OffsetRect(R2, 1, 1);
  3179. DrawButtonBitmap(CreateCloseButtonBitmap);
  3180. end;
  3181. end;
  3182. DeleteObject(Brush);
  3183. finally
  3184. if not DrawToDC then
  3185. ReleaseDC(Handle, DC);
  3186. end;
  3187. end;
  3188. procedure TTBCustomDockableWindow.RedrawNCArea;
  3189. begin
  3190. { Note: IsWindowVisible is called as an optimization. There's no need to
  3191. draw on invisible windows. }
  3192. if HandleAllocated and IsWindowVisible(Handle) then
  3193. DrawNCArea(False, 0, 0);
  3194. end;
  3195. procedure TTBCustomDockableWindow.WMNCPaint(var Message: TMessage);
  3196. begin
  3197. { Don't call inherited because it overrides the default NC painting }
  3198. DrawNCArea(False, 0, HRGN(Message.WParam));
  3199. end;
  3200. procedure DockableWindowNCPaintProc(Control: TControl; Wnd: HWND; DC: HDC; AppData: Longint);
  3201. begin
  3202. with TTBCustomDockableWindow(AppData) do
  3203. DrawNCArea(True, DC, 0)
  3204. end;
  3205. procedure TTBCustomDockableWindow.WMPrint(var Message: TMessage);
  3206. begin
  3207. HandleWMPrint(Self, Handle, Message, DockableWindowNCPaintProc, Longint(Self));
  3208. end;
  3209. procedure TTBCustomDockableWindow.WMPrintClient(var Message: TMessage);
  3210. begin
  3211. HandleWMPrintClient(Self, Message);
  3212. end;
  3213. procedure TTBCustomDockableWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  3214. var
  3215. R, R2, R3: TRect;
  3216. P1, P2: TPoint;
  3217. SaveIndex: Integer;
  3218. begin
  3219. if Docked and CurrentDock.UsingBackground and CurrentDock.FBkgOnToolbars then begin
  3220. R := ClientRect;
  3221. R2 := R;
  3222. P1 := CurrentDock.ClientToScreen(Point(0, 0));
  3223. P2 := CurrentDock.Parent.ClientToScreen(CurrentDock.BoundsRect.TopLeft);
  3224. Dec(R2.Left, Left + CurrentDock.Left + (P1.X-P2.X));
  3225. Dec(R2.Top, Top + CurrentDock.Top + (P1.Y-P2.Y));
  3226. GetWindowRect(Handle, R3);
  3227. with ClientToScreen(Point(0, 0)) do begin
  3228. Inc(R2.Left, R3.Left-X);
  3229. Inc(R2.Top, R3.Top-Y);
  3230. end;
  3231. SaveIndex := SaveDC(Message.DC);
  3232. IntersectClipRect(Message.DC, R.Left, R.Top, R.Right, R.Bottom);
  3233. CurrentDock.DrawBackground(Message.DC, R2);
  3234. RestoreDC(Message.DC, SaveIndex);
  3235. Message.Result := 1;
  3236. end
  3237. else
  3238. inherited;
  3239. end;
  3240. function TTBCustomDockableWindow.GetPalette: HPALETTE;
  3241. begin
  3242. if Docked then
  3243. Result := CurrentDock.GetPalette
  3244. else
  3245. Result := 0;
  3246. end;
  3247. function TTBCustomDockableWindow.PaletteChanged(Foreground: Boolean): Boolean;
  3248. begin
  3249. Result := inherited PaletteChanged(Foreground);
  3250. if Result and not Foreground then begin
  3251. { There seems to be a bug in Delphi's palette handling. When the form is
  3252. inactive and another window realizes a palette, docked TToolbar97s
  3253. weren't getting redrawn. So this workaround code was added. }
  3254. InvalidateAll(Self);
  3255. end;
  3256. end;
  3257. procedure TTBCustomDockableWindow.DrawDraggingOutline(const DC: HDC;
  3258. const NewRect, OldRect: PRect; const NewDocking, OldDocking: Boolean);
  3259. var
  3260. NewSize, OldSize: TSize;
  3261. begin
  3262. with GetFloatingBorderSize do begin
  3263. if NewDocking then NewSize.cx := 1 else NewSize.cx := X;
  3264. NewSize.cy := NewSize.cx;
  3265. if OldDocking then OldSize.cx := 1 else OldSize.cx := X;
  3266. OldSize.cy := OldSize.cx;
  3267. end;
  3268. DrawHalftoneInvertRect(DC, NewRect, OldRect, NewSize, OldSize);
  3269. end;
  3270. procedure TTBCustomDockableWindow.CMColorChanged(var Message: TMessage);
  3271. begin
  3272. { Make sure non-client area is redrawn }
  3273. InvalidateAll(Self);
  3274. inherited; { the inherited handler calls Invalidate }
  3275. end;
  3276. procedure TTBCustomDockableWindow.CMTextChanged(var Message: TMessage);
  3277. begin
  3278. inherited;
  3279. if Parent is TTBFloatingWindowParent then
  3280. TTBFloatingWindowParent(Parent).Caption := Caption;
  3281. end;
  3282. procedure TTBCustomDockableWindow.CMVisibleChanged(var Message: TMessage);
  3283. begin
  3284. if not(csDesigning in ComponentState) and Docked then
  3285. CurrentDock.ToolbarVisibilityChanged(Self, False);
  3286. inherited;
  3287. if Assigned(FOnVisibleChanged) then
  3288. FOnVisibleChanged(Self);
  3289. end;
  3290. procedure TTBCustomDockableWindow.BeginMoving(const InitX, InitY: Integer);
  3291. type
  3292. PDockedSize = ^TDockedSize;
  3293. TDockedSize = record
  3294. Dock: TTBDock;
  3295. BoundsRect: TRect;
  3296. Size: TPoint;
  3297. RowSizes: TList;
  3298. end;
  3299. const
  3300. SplitCursors: array[Boolean] of PChar = (IDC_SIZEWE, IDC_SIZENS);
  3301. var
  3302. UseSmoothDrag: Boolean;
  3303. DockList: TList;
  3304. NewDockedSizes: TList; {items are pointers to TDockedSizes}
  3305. OriginalDock, MouseOverDock: TTBDock;
  3306. MoveRect: TRect;
  3307. StartDocking, PreventDocking, PreventFloating, WatchForSplit, SplitVertical: Boolean;
  3308. ScreenDC: HDC;
  3309. OldCursor: HCURSOR;
  3310. NPoint, DPoint: TPoint;
  3311. OriginalDockRow, OriginalDockPos: Integer;
  3312. FirstPos, LastPos, CurPos: TPoint;
  3313. function FindDockedSize(const ADock: TTBDock): PDockedSize;
  3314. var
  3315. I: Integer;
  3316. begin
  3317. for I := 0 to NewDockedSizes.Count-1 do begin
  3318. Result := NewDockedSizes[I];
  3319. if Result.Dock = ADock then
  3320. Exit;
  3321. end;
  3322. Result := nil;
  3323. end;
  3324. function GetRowOf(const RowSizes: TList; const XY: Integer;
  3325. var Before: Boolean): Integer;
  3326. { Returns row number of the specified coordinate. Before is set to True if it
  3327. was in the top (or left) quarter of the row. }
  3328. var
  3329. HighestRow, R, CurY, NextY, CurRowSize, EdgeSize: Integer;
  3330. FullSizeRow: Boolean;
  3331. begin
  3332. Before := False;
  3333. HighestRow := RowSizes.Count-1;
  3334. CurY := 0;
  3335. for R := 0 to HighestRow do begin
  3336. CurRowSize := Integer(RowSizes[R]);
  3337. FullSizeRow := FullSize or (CurRowSize and $10000 <> 0);
  3338. CurRowSize := Smallint(CurRowSize);
  3339. if CurRowSize = 0 then
  3340. Continue;
  3341. NextY := CurY + CurRowSize;
  3342. if not FullSizeRow then
  3343. EdgeSize := CurRowSize div 4
  3344. else
  3345. EdgeSize := CurRowSize div 2;
  3346. if XY < CurY + EdgeSize then begin
  3347. Result := R;
  3348. Before := True;
  3349. Exit;
  3350. end;
  3351. if not FullSizeRow and (XY < NextY - EdgeSize) then begin
  3352. Result := R;
  3353. Exit;
  3354. end;
  3355. CurY := NextY;
  3356. end;
  3357. Result := HighestRow+1;
  3358. end;
  3359. procedure Dropped;
  3360. var
  3361. NewDockRow: Integer;
  3362. Before: Boolean;
  3363. MoveRectClient: TRect;
  3364. C: Integer;
  3365. DockedSize: PDockedSize;
  3366. begin
  3367. if MouseOverDock <> nil then begin
  3368. DockedSize := FindDockedSize(MouseOverDock);
  3369. MoveRectClient := MoveRect;
  3370. OffsetRect(MoveRectClient, -DockedSize.BoundsRect.Left,
  3371. -DockedSize.BoundsRect.Top);
  3372. if not FDragSplitting then begin
  3373. if not(MouseOverDock.Position in PositionLeftOrRight) then
  3374. C := (MoveRectClient.Top+MoveRectClient.Bottom) div 2
  3375. else
  3376. C := (MoveRectClient.Left+MoveRectClient.Right) div 2;
  3377. NewDockRow := GetRowOf(DockedSize.RowSizes, C, Before);
  3378. if Before then
  3379. WatchForSplit := False;
  3380. end
  3381. else begin
  3382. NewDockRow := FDockRow;
  3383. Before := False;
  3384. end;
  3385. if WatchForSplit then begin
  3386. if (MouseOverDock <> OriginalDock) or (NewDockRow <> OriginalDockRow) then
  3387. WatchForSplit := False
  3388. else begin
  3389. if not SplitVertical then
  3390. C := FirstPos.X - LastPos.X
  3391. else
  3392. C := FirstPos.Y - LastPos.Y;
  3393. if Abs(C) >= 10 then begin
  3394. WatchForSplit := False;
  3395. FDragSplitting := True;
  3396. SetCursor(LoadCursor(0, SplitCursors[SplitVertical]));
  3397. end;
  3398. end;
  3399. end;
  3400. FDockRow := NewDockRow;
  3401. if not(MouseOverDock.Position in PositionLeftOrRight) then
  3402. FDockPos := MoveRectClient.Left
  3403. else
  3404. FDockPos := MoveRectClient.Top;
  3405. Parent := MouseOverDock;
  3406. if not FSmoothDragging then
  3407. CurrentDock.CommitNewPositions := True;
  3408. FInsertRowBefore := Before;
  3409. try
  3410. CurrentDock.ArrangeToolbars;
  3411. finally
  3412. FInsertRowBefore := False;
  3413. end;
  3414. end
  3415. else begin
  3416. WatchForSplit := False;
  3417. FloatingPosition := MoveRect.TopLeft;
  3418. Floating := True;
  3419. { Make sure it doesn't go completely off the screen }
  3420. MoveOnScreen(True);
  3421. end;
  3422. { Make sure it's repainted immediately (looks better on really slow
  3423. computers when smooth dragging is enabled) }
  3424. Update;
  3425. end;
  3426. procedure MouseMoved;
  3427. var
  3428. OldMouseOverDock: TTBDock;
  3429. OldMoveRect: TRect;
  3430. Pos: TPoint;
  3431. function GetDockRect(Control: TTBDock): TRect;
  3432. var
  3433. I: Integer;
  3434. begin
  3435. for I := 0 to NewDockedSizes.Count-1 do
  3436. with PDockedSize(NewDockedSizes[I])^ do begin
  3437. if Dock <> Control then Continue;
  3438. Result := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X),
  3439. Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y),
  3440. Size.X, Size.Y);
  3441. Exit;
  3442. end;
  3443. SetRectEmpty(Result);
  3444. end;
  3445. function CheckIfCanDockTo(Control: TTBDock; R: TRect): Boolean;
  3446. const
  3447. DockSensX = 25;
  3448. DockSensY = 25;
  3449. var
  3450. S, Temp: TRect;
  3451. Sens: Integer;
  3452. begin
  3453. with Control do begin
  3454. Result := False;
  3455. InflateRect(R, 3, 3);
  3456. S := GetDockRect(Control);
  3457. { Like Office, distribute ~25 pixels of extra dock detection area
  3458. to the left side if the toolbar was grabbed at the left, both sides
  3459. if the toolbar was grabbed at the middle, or the right side if
  3460. toolbar was grabbed at the right. If outside, don't try to dock. }
  3461. Sens := MulDiv(DockSensX, NPoint.X, DPoint.X);
  3462. if (Pos.X < R.Left-(DockSensX-Sens)) or (Pos.X >= R.Right+Sens) then
  3463. Exit;
  3464. { Don't try to dock to the left or right if pointer is above or below
  3465. the boundaries of the dock }
  3466. if (Control.Position in PositionLeftOrRight) and
  3467. ((Pos.Y < R.Top) or (Pos.Y >= R.Bottom)) then
  3468. Exit;
  3469. { And also distribute ~25 pixels of extra dock detection area to
  3470. the top or bottom side }
  3471. Sens := MulDiv(DockSensY, NPoint.Y, DPoint.Y);
  3472. if (Pos.Y < R.Top-(DockSensY-Sens)) or (Pos.Y >= R.Bottom+Sens) then
  3473. Exit;
  3474. Result := IntersectRect(Temp, R, S);
  3475. end;
  3476. end;
  3477. var
  3478. R, R2: TRect;
  3479. I: Integer;
  3480. Dock: TTBDock;
  3481. Accept: Boolean;
  3482. TL, BR: TPoint;
  3483. begin
  3484. OldMouseOverDock := MouseOverDock;
  3485. OldMoveRect := MoveRect;
  3486. GetCursorPos(Pos);
  3487. if FDragSplitting then
  3488. MouseOverDock := CurrentDock
  3489. else begin
  3490. { Check if it can dock }
  3491. MouseOverDock := nil;
  3492. if StartDocking and not PreventDocking then
  3493. { MP }
  3494. { reversal of for cycle proposed by 'rl' is rejected as it suffers a bug:
  3495. { whenever toolbar is "catched", it is moved to different row }
  3496. for I := 0 to DockList.Count-1 do begin
  3497. Dock := DockList[I];
  3498. if CheckIfCanDockTo(Dock, FindDockedSize(Dock).BoundsRect) then begin
  3499. MouseOverDock := Dock;
  3500. Accept := True;
  3501. if Assigned(MouseOverDock.FOnRequestDock) then
  3502. MouseOverDock.FOnRequestDock(MouseOverDock, Self, Accept);
  3503. if Accept then
  3504. Break
  3505. else
  3506. MouseOverDock := nil;
  3507. end;
  3508. end;
  3509. end;
  3510. { If not docking, clip the point so it doesn't get dragged under the
  3511. taskbar }
  3512. if MouseOverDock = nil then begin
  3513. R := GetRectOfMonitorContainingPoint(Pos, True);
  3514. if Pos.X < R.Left then Pos.X := R.Left;
  3515. if Pos.X > R.Right then Pos.X := R.Right;
  3516. if Pos.Y < R.Top then Pos.Y := R.Top;
  3517. if Pos.Y > R.Bottom then Pos.Y := R.Bottom;
  3518. end;
  3519. MoveRect := GetDockRect(MouseOverDock);
  3520. { Make sure title bar (or at least part of the toolbar) is still accessible
  3521. if it's dragged almost completely off the screen. This prevents the
  3522. problem seen in Office 97 where you drag it offscreen so that only the
  3523. border is visible, sometimes leaving you no way to move it back short of
  3524. resetting the toolbar. }
  3525. if MouseOverDock = nil then begin
  3526. R2 := GetRectOfMonitorContainingPoint(Pos, True);
  3527. R := R2;
  3528. with GetFloatingBorderSize do
  3529. InflateRect(R, -(X+4), -(Y+4));
  3530. if MoveRect.Bottom < R.Top then
  3531. OffsetRect(MoveRect, 0, R.Top-MoveRect.Bottom);
  3532. if MoveRect.Top > R.Bottom then
  3533. OffsetRect(MoveRect, 0, R.Bottom-MoveRect.Top);
  3534. if MoveRect.Right < R.Left then
  3535. OffsetRect(MoveRect, R.Left-MoveRect.Right, 0);
  3536. if MoveRect.Left > R.Right then
  3537. OffsetRect(MoveRect, R.Right-MoveRect.Left, 0);
  3538. GetFloatingNCArea(TL, BR);
  3539. I := R2.Top + 4 - TL.Y;
  3540. if MoveRect.Top < I then
  3541. OffsetRect(MoveRect, 0, I-MoveRect.Top);
  3542. end;
  3543. { Empty MoveRect if it's wanting to float but it's not allowed to, and
  3544. set the mouse cursor accordingly. }
  3545. if PreventFloating and not Assigned(MouseOverDock) then begin
  3546. SetRectEmpty(MoveRect);
  3547. SetCursor(LoadCursor(0, IDC_NO));
  3548. end
  3549. else begin
  3550. if FDragSplitting then
  3551. SetCursor(LoadCursor(0, SplitCursors[SplitVertical]))
  3552. else
  3553. SetCursor(OldCursor);
  3554. end;
  3555. { Update the dragging outline }
  3556. if not UseSmoothDrag then
  3557. DrawDraggingOutline(ScreenDC, @MoveRect, @OldMoveRect, MouseOverDock <> nil,
  3558. OldMouseOverDock <> nil)
  3559. else
  3560. if not IsRectEmpty(MoveRect) then
  3561. Dropped;
  3562. end;
  3563. procedure BuildDockList;
  3564. procedure Recurse(const ParentCtl: TWinControl);
  3565. var
  3566. D: TTBDockPosition;
  3567. I: Integer;
  3568. begin
  3569. if ContainsControl(ParentCtl) or not ParentCtl.Showing then
  3570. Exit;
  3571. with ParentCtl do begin
  3572. for D := Low(D) to High(D) do
  3573. for I := 0 to ParentCtl.ControlCount-1 do
  3574. if (Controls[I] is TTBDock) and (TTBDock(Controls[I]).Position = D) then
  3575. Recurse(TWinControl(Controls[I]));
  3576. for I := 0 to ParentCtl.ControlCount-1 do
  3577. if (Controls[I] is TWinControl) and not(Controls[I] is TTBDock) then
  3578. Recurse(TWinControl(Controls[I]));
  3579. end;
  3580. if (ParentCtl is TTBDock) and TTBDock(ParentCtl).Accepts(Self) and CanDockTo(TTBDock(ParentCtl)) and
  3581. (DockList.IndexOf(ParentCtl) = -1) then
  3582. DockList.Add(ParentCtl);
  3583. end;
  3584. var
  3585. ParentForm: TCustomForm;
  3586. DockFormsList: TList;
  3587. I, J: Integer;
  3588. begin
  3589. { Manually add CurrentDock to the DockList first so that it gets priority
  3590. over other docks }
  3591. if Assigned(CurrentDock) and CurrentDock.Accepts(Self) and CanDockTo(CurrentDock) then
  3592. DockList.Add(CurrentDock);
  3593. ParentForm := TBGetToolWindowParentForm(Self);
  3594. DockFormsList := TList.Create;
  3595. try
  3596. if Assigned(FDockForms) then begin
  3597. for I := 0 to Screen.CustomFormCount-1 do begin
  3598. J := FDockForms.IndexOf(Screen.CustomForms[I]);
  3599. if (J <> -1) and (FDockForms[J] <> ParentForm) then
  3600. DockFormsList.Add(FDockForms[J]);
  3601. end;
  3602. end;
  3603. if Assigned(ParentForm) then
  3604. DockFormsList.Insert(0, ParentForm);
  3605. for I := 0 to DockFormsList.Count-1 do
  3606. Recurse(DockFormsList[I]);
  3607. finally
  3608. DockFormsList.Free;
  3609. end;
  3610. end;
  3611. var
  3612. Accept, FullSizeRow: Boolean;
  3613. R: TRect;
  3614. Msg: TMsg;
  3615. NewDockedSize: PDockedSize;
  3616. I, J, S: Integer;
  3617. begin
  3618. Accept := False;
  3619. SplitVertical := False;
  3620. WatchForSplit := False;
  3621. OriginalDock := CurrentDock;
  3622. OriginalDockRow := FDockRow;
  3623. OriginalDockPos := FDockPos;
  3624. try
  3625. FDragMode := True;
  3626. FDragSplitting := False;
  3627. if Docked then begin
  3628. FDragCanSplit := False;
  3629. CurrentDock.CommitNewPositions := True;
  3630. CurrentDock.ArrangeToolbars; { needed for WatchForSplit assignment below }
  3631. SplitVertical := CurrentDock.Position in PositionLeftOrRight;
  3632. WatchForSplit := FDragCanSplit;
  3633. end;
  3634. DockList := nil;
  3635. NewDockedSizes := nil;
  3636. try
  3637. UseSmoothDrag := FSmoothDrag;
  3638. FSmoothDragging := UseSmoothDrag;
  3639. NPoint := Point(InitX, InitY);
  3640. { Adjust for non-client area }
  3641. if not(Parent is TTBFloatingWindowParent) then begin
  3642. GetWindowRect(Handle, R);
  3643. R.BottomRight := ClientToScreen(Point(0, 0));
  3644. DPoint := Point(Width-1, Height-1);
  3645. end
  3646. else begin
  3647. GetWindowRect(Parent.Handle, R);
  3648. R.BottomRight := Parent.ClientToScreen(Point(0, 0));
  3649. DPoint := Point(Parent.Width-1, Parent.Height-1);
  3650. end;
  3651. Dec(NPoint.X, R.Left-R.Right);
  3652. Dec(NPoint.Y, R.Top-R.Bottom);
  3653. PreventDocking := GetKeyState(VK_CONTROL) < 0;
  3654. PreventFloating := DockMode <> dmCanFloat;
  3655. { Build list of all TTBDock's on the form }
  3656. DockList := TList.Create;
  3657. if DockMode <> dmCannotFloatOrChangeDocks then
  3658. BuildDockList
  3659. else
  3660. if Docked then
  3661. DockList.Add(CurrentDock);
  3662. { Ensure positions of each possible dock are committed }
  3663. for I := 0 to DockList.Count-1 do
  3664. TTBDock(DockList[I]).CommitPositions;
  3665. { Set up potential sizes for each dock type }
  3666. NewDockedSizes := TList.Create;
  3667. for I := -1 to DockList.Count-1 do begin
  3668. New(NewDockedSize);
  3669. NewDockedSize.RowSizes := nil;
  3670. try
  3671. with NewDockedSize^ do begin
  3672. if I = -1 then begin
  3673. { -1 adds the floating size }
  3674. Dock := nil;
  3675. SetRectEmpty(BoundsRect);
  3676. Size := DoArrange(False, TBGetDockTypeOf(CurrentDock, Floating), True, nil);
  3677. AddFloatingNCAreaToSize(Size);
  3678. end
  3679. else begin
  3680. Dock := TTBDock(DockList[I]);
  3681. GetWindowRect(Dock.Handle, BoundsRect);
  3682. if Dock <> CurrentDock then begin
  3683. Size := DoArrange(False, TBGetDockTypeOf(CurrentDock, Floating), False, Dock);
  3684. AddDockedNCAreaToSize(Size, Dock.Position in PositionLeftOrRight);
  3685. end
  3686. else
  3687. Size := Point(Width, Height);
  3688. end;
  3689. end;
  3690. if Assigned(NewDockedSize.Dock) then begin
  3691. NewDockedSize.RowSizes := TList.Create;
  3692. for J := 0 to NewDockedSize.Dock.GetHighestRow(True) do begin
  3693. S := Smallint(NewDockedSize.Dock.GetCurrentRowSize(J, FullSizeRow));
  3694. if FullSizeRow then
  3695. S := S or $10000;
  3696. NewDockedSize.RowSizes.Add(Pointer(S));
  3697. end;
  3698. end;
  3699. NewDockedSizes.Add(NewDockedSize);
  3700. except
  3701. NewDockedSize.RowSizes.Free;
  3702. Dispose(NewDockedSize);
  3703. raise;
  3704. end;
  3705. end;
  3706. { Before locking, make sure all pending paint messages are processed }
  3707. ProcessPaintMessages;
  3708. { Save the original mouse cursor }
  3709. OldCursor := GetCursor;
  3710. if not UseSmoothDrag then begin
  3711. { This uses LockWindowUpdate to suppress all window updating so the
  3712. dragging outlines doesn't sometimes get garbled. (This is safe, and in
  3713. fact, is the main purpose of the LockWindowUpdate function)
  3714. IMPORTANT! While debugging you might want to enable the 'TB2Dock_DisableLock'
  3715. conditional define (see top of the source code). }
  3716. {$IFNDEF TB2Dock_DisableLock}
  3717. LockWindowUpdate(GetDesktopWindow);
  3718. {$ENDIF}
  3719. { Get a DC of the entire screen. Works around the window update lock
  3720. by specifying DCX_LOCKWINDOWUPDATE. }
  3721. ScreenDC := GetDCEx(GetDesktopWindow, 0,
  3722. DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  3723. end
  3724. else
  3725. ScreenDC := 0;
  3726. try
  3727. SetCapture(Handle);
  3728. { Initialize }
  3729. StartDocking := Docked;
  3730. MouseOverDock := nil;
  3731. SetRectEmpty(MoveRect);
  3732. GetCursorPos(FirstPos);
  3733. LastPos := FirstPos;
  3734. MouseMoved;
  3735. StartDocking := True;
  3736. { Stay in message loop until capture is lost. Capture is removed either
  3737. by this procedure manually doing it, or by an outside influence (like
  3738. a message box or menu popping up) }
  3739. while GetCapture = Handle do begin
  3740. case Integer(GetMessage(Msg, 0, 0, 0)) of
  3741. -1: Break; { if GetMessage failed }
  3742. 0: begin
  3743. { Repost WM_QUIT messages }
  3744. PostQuitMessage(Msg.WParam);
  3745. Break;
  3746. end;
  3747. end;
  3748. case Msg.Message of
  3749. WM_KEYDOWN, WM_KEYUP:
  3750. { Ignore all keystrokes while dragging. But process Ctrl and Escape }
  3751. case Msg.WParam of
  3752. VK_CONTROL:
  3753. if PreventDocking <> (Msg.Message = WM_KEYDOWN) then begin
  3754. PreventDocking := Msg.Message = WM_KEYDOWN;
  3755. MouseMoved;
  3756. end;
  3757. VK_ESCAPE:
  3758. Break;
  3759. end;
  3760. WM_MOUSEMOVE: begin
  3761. { Note to self: WM_MOUSEMOVE messages should never be dispatched
  3762. here to ensure no hints get shown during the drag process }
  3763. CurPos := SmallPointToPoint(TSmallPoint(DWORD(GetMessagePos)));
  3764. if (LastPos.X <> CurPos.X) or (LastPos.Y <> CurPos.Y) then begin
  3765. MouseMoved;
  3766. LastPos := CurPos;
  3767. end;
  3768. end;
  3769. WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  3770. { Make sure it doesn't begin another loop }
  3771. Break;
  3772. WM_LBUTTONUP: begin
  3773. Accept := True;
  3774. Break;
  3775. end;
  3776. WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  3777. { Ignore all other mouse up/down messages }
  3778. ;
  3779. else
  3780. TranslateMessage(Msg);
  3781. DispatchMessage(Msg);
  3782. end;
  3783. end;
  3784. finally
  3785. { Since it sometimes breaks out of the loop without capture being
  3786. released }
  3787. if GetCapture = Handle then
  3788. ReleaseCapture;
  3789. if not UseSmoothDrag then begin
  3790. { Hide dragging outline. Since NT will release a window update lock if
  3791. another thread comes to the foreground, it has to release the DC
  3792. and get a new one for erasing the dragging outline. Otherwise,
  3793. the DrawDraggingOutline appears to have no effect when this happens. }
  3794. ReleaseDC(GetDesktopWindow, ScreenDC);
  3795. ScreenDC := GetDCEx(GetDesktopWindow, 0,
  3796. DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  3797. DrawDraggingOutline(ScreenDC, nil, @MoveRect, True, MouseOverDock <> nil);
  3798. ReleaseDC(GetDesktopWindow, ScreenDC);
  3799. { Release window update lock }
  3800. {$IFNDEF TB2Dock_DisableLock}
  3801. LockWindowUpdate(0);
  3802. {$ENDIF}
  3803. end;
  3804. end;
  3805. { Move to new position only if MoveRect isn't empty }
  3806. FSmoothDragging := False;
  3807. if Accept and not IsRectEmpty(MoveRect) then
  3808. { Note: Dropped must be called again after FSmoothDragging is reset to
  3809. False so that TTBDock.ArrangeToolbars makes the DockPos changes
  3810. permanent }
  3811. Dropped;
  3812. { LastDock isn't automatically updated while FSmoothDragging=True, so
  3813. update it now that it's back to False }
  3814. if FUseLastDock and Assigned(CurrentDock) then
  3815. LastDock := CurrentDock;
  3816. { Free FFloatParent if it's no longer the Parent }
  3817. if Assigned(FFloatParent) and (Parent <> FFloatParent) then begin
  3818. FFloatParent.Free;
  3819. FFloatParent := nil;
  3820. end;
  3821. finally
  3822. FSmoothDragging := False;
  3823. if not Docked then begin
  3824. { If we didn't end up docking, restore the original DockRow & DockPos
  3825. values }
  3826. FDockRow := OriginalDockRow;
  3827. FDockPos := OriginalDockPos;
  3828. end;
  3829. if Assigned(NewDockedSizes) then begin
  3830. for I := NewDockedSizes.Count-1 downto 0 do begin
  3831. NewDockedSize := NewDockedSizes[I];
  3832. NewDockedSize.RowSizes.Free;
  3833. Dispose(NewDockedSize);
  3834. end;
  3835. NewDockedSizes.Free;
  3836. end;
  3837. DockList.Free;
  3838. end;
  3839. finally
  3840. FDragMode := False;
  3841. FDragSplitting := False;
  3842. end;
  3843. end;
  3844. function TTBCustomDockableWindow.ChildControlTransparent(Ctl: TControl): Boolean;
  3845. begin
  3846. Result := False;
  3847. end;
  3848. procedure TTBCustomDockableWindow.ControlExistsAtPos(const P: TPoint;
  3849. var ControlExists: Boolean);
  3850. var
  3851. I: Integer;
  3852. begin
  3853. for I := 0 to ControlCount-1 do
  3854. if not ChildControlTransparent(Controls[I]) and Controls[I].Visible and
  3855. PtInRect(Controls[I].BoundsRect, P) then begin
  3856. ControlExists := True;
  3857. Break;
  3858. end;
  3859. end;
  3860. procedure TTBCustomDockableWindow.DoubleClick;
  3861. begin
  3862. if Docked then begin
  3863. if DblClickUndock and (DockMode = dmCanFloat) then begin
  3864. Floating := True;
  3865. MoveOnScreen(True);
  3866. end;
  3867. end
  3868. else if Floating then begin
  3869. if Assigned(LastDock) then
  3870. Parent := LastDock
  3871. else
  3872. if Assigned(DefaultDock) then begin
  3873. FDockRow := ForceDockAtTopRow;
  3874. FDockPos := ForceDockAtLeftPos;
  3875. Parent := DefaultDock;
  3876. end;
  3877. end;
  3878. end;
  3879. function TTBCustomDockableWindow.IsMovable: Boolean;
  3880. begin
  3881. Result := (Docked and CurrentDock.FAllowDrag) or Floating;
  3882. end;
  3883. procedure TTBCustomDockableWindow.MouseDown(Button: TMouseButton;
  3884. Shift: TShiftState; X, Y: Integer);
  3885. var
  3886. P: TPoint;
  3887. CtlExists: Boolean;
  3888. begin
  3889. inherited;
  3890. if (Button <> mbLeft) or not IsMovable then
  3891. Exit;
  3892. { Ignore message if user clicked on a child control }
  3893. P := Point(X, Y);
  3894. if PtInRect(ClientRect, P) then begin
  3895. CtlExists := False;
  3896. ControlExistsAtPos(P, CtlExists);
  3897. if CtlExists then
  3898. Exit;
  3899. end;
  3900. if not(ssDouble in Shift) then begin
  3901. BeginMoving(X, Y);
  3902. MouseUp(mbLeft, [], -1, -1);
  3903. end
  3904. else
  3905. { Handle double click }
  3906. DoubleClick;
  3907. end;
  3908. procedure TTBCustomDockableWindow.WMNCHitTest(var Message: TWMNCHitTest);
  3909. var
  3910. P: TPoint;
  3911. R: TRect;
  3912. begin
  3913. inherited;
  3914. if Docked then
  3915. with Message do begin
  3916. P := SmallPointToPoint(Pos);
  3917. GetWindowRect(Handle, R);
  3918. Dec(P.X, R.Left); Dec(P.Y, R.Top);
  3919. if Result <> HTCLIENT then begin
  3920. Result := HTNOWHERE;
  3921. if FCloseButtonWhenDocked and CurrentDock.FAllowDrag and
  3922. PtInRect(GetDockedCloseButtonRect(
  3923. TBGetDockTypeOf(CurrentDock, Floating) = dtLeftRight), P) then
  3924. Result := HT_TB2k_Close
  3925. else
  3926. Result := HT_TB2k_Border;
  3927. end;
  3928. end;
  3929. end;
  3930. procedure TTBCustomDockableWindow.WMNCMouseMove(var Message: TWMNCMouseMove);
  3931. var
  3932. InArea: Boolean;
  3933. begin
  3934. inherited;
  3935. { Note: TME_NONCLIENT was introduced in Windows 98 and 2000 }
  3936. CallTrackMouseEvent(Handle, TME_LEAVE or $10 {TME_NONCLIENT});
  3937. InArea := Message.HitTest = HT_TB2k_Close;
  3938. if FCloseButtonHover <> InArea then begin
  3939. FCloseButtonHover := InArea;
  3940. RedrawNCArea;
  3941. end;
  3942. end;
  3943. procedure TTBCustomDockableWindow.WMNCMouseLeave(var Message: TMessage);
  3944. begin
  3945. if not MouseCapture then
  3946. CancelNCHover;
  3947. inherited;
  3948. end;
  3949. procedure TTBCustomDockableWindow.CMMouseLeave(var Message: TMessage);
  3950. begin
  3951. inherited;
  3952. { On Windows versions that can't send a WM_NCMOUSELEAVE message, trap
  3953. CM_MOUSELEAVE to detect when the mouse moves from the non-client area to
  3954. another control. }
  3955. CancelNCHover;
  3956. end;
  3957. procedure TTBCustomDockableWindow.WMMouseMove(var Message: TMessage);
  3958. begin
  3959. { On Windows versions that can't send a WM_NCMOUSELEAVE message, trap
  3960. WM_MOUSEMOVE to detect when the mouse moves from the non-client area to
  3961. the client area.
  3962. Note: We are overriding WM_MOUSEMOVE instead of MouseMove so that our
  3963. processing always gets done first. }
  3964. CancelNCHover;
  3965. inherited;
  3966. end;
  3967. procedure TTBCustomDockableWindow.CancelNCHover;
  3968. begin
  3969. if FCloseButtonHover then begin
  3970. FCloseButtonHover := False;
  3971. RedrawNCArea;
  3972. end;
  3973. end;
  3974. procedure TTBCustomDockableWindow.Close;
  3975. var
  3976. Accept: Boolean;
  3977. begin
  3978. Accept := True;
  3979. if Assigned(FOnCloseQuery) then
  3980. FOnCloseQuery(Self, Accept);
  3981. { Did the CloseQuery event return True? }
  3982. if Accept then begin
  3983. Hide;
  3984. if Assigned(FOnClose) then
  3985. FOnClose(Self);
  3986. end;
  3987. end;
  3988. procedure TTBCustomDockableWindow.SetCloseButtonState(Pushed: Boolean);
  3989. begin
  3990. if FCloseButtonDown <> Pushed then begin
  3991. FCloseButtonDown := Pushed;
  3992. RedrawNCArea;
  3993. end;
  3994. end;
  3995. procedure TTBCustomDockableWindow.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  3996. var
  3997. R, BR: TRect;
  3998. P: TPoint;
  3999. begin
  4000. case Message.HitTest of
  4001. HT_TB2k_Close: begin
  4002. GetWindowRect(Handle, R);
  4003. BR := GetDockedCloseButtonRect(
  4004. TBGetDockTypeOf(CurrentDock, Floating) = dtLeftRight);
  4005. OffsetRect(BR, R.Left, R.Top);
  4006. if CloseButtonLoop(Handle, BR, SetCloseButtonState) then
  4007. Close;
  4008. end;
  4009. HT_TB2k_Border: begin
  4010. P := ScreenToClient(SmallPointToPoint(TSmallPoint(GetMessagePos())));
  4011. if IsMovable then
  4012. BeginMoving(P.X, P.Y);
  4013. end;
  4014. else
  4015. inherited;
  4016. end;
  4017. end;
  4018. procedure TTBCustomDockableWindow.WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk);
  4019. begin
  4020. if Message.HitTest = HT_TB2k_Border then begin
  4021. if IsMovable then
  4022. DoubleClick;
  4023. end
  4024. else
  4025. inherited;
  4026. end;
  4027. procedure TTBCustomDockableWindow.ShowNCContextMenu(const Pos: TSmallPoint);
  4028. begin
  4029. { Delphi 5 and later use the WM_CONTEXTMENU message for popup menus }
  4030. SendMessage(Handle, WM_CONTEXTMENU, 0, LPARAM(Pos));
  4031. end;
  4032. procedure TTBCustomDockableWindow.WMNCRButtonUp(var Message: TWMNCRButtonUp);
  4033. begin
  4034. ShowNCContextMenu(TSmallPoint(TMessage(Message).LParam));
  4035. end;
  4036. procedure TTBCustomDockableWindow.WMContextMenu(var Message: TWMContextMenu);
  4037. { Unfortunately TControl.WMContextMenu ignores clicks in the non-client area.
  4038. On docked toolbars, we need right clicks on the border, part of the
  4039. non-client area, to display the popup menu. The only way I see to have it do
  4040. that is to create a new version of WMContextMenu specifically for the
  4041. non-client area, and that is what this method is.
  4042. Note: This is identical to Delphi 5's TControl.WMContextMenu, except where
  4043. noted. }
  4044. var
  4045. Pt, Temp: TPoint;
  4046. Handled: Boolean;
  4047. PopupMenu: TPopupMenu;
  4048. begin
  4049. { Added 'inherited;' here }
  4050. inherited;
  4051. if Message.Result <> 0 then Exit;
  4052. if csDesigning in ComponentState then Exit;
  4053. Pt := SmallPointToPoint(Message.Pos);
  4054. if Pt.X < 0 then
  4055. Temp := Pt
  4056. else
  4057. begin
  4058. Temp := ScreenToClient(Pt);
  4059. { Changed the following. We're only interested in the non-client area }
  4060. {if not PtInRect(ClientRect, Temp) then}
  4061. if PtInRect(ClientRect, Temp) then
  4062. begin
  4063. {inherited;}
  4064. Exit;
  4065. end;
  4066. end;
  4067. Handled := False;
  4068. DoContextPopup(Temp, Handled);
  4069. Message.Result := Ord(Handled);
  4070. if Handled then Exit;
  4071. PopupMenu := GetPopupMenu;
  4072. if (PopupMenu <> nil) and PopupMenu.AutoPopup then
  4073. begin
  4074. SendCancelMode(nil);
  4075. PopupMenu.PopupComponent := Self;
  4076. if Pt.X < 0 then
  4077. Pt := ClientToScreen(Point(0,0));
  4078. PopupMenu.Popup(Pt.X, Pt.Y);
  4079. Message.Result := 1;
  4080. end;
  4081. if Message.Result = 0 then
  4082. inherited;
  4083. end;
  4084. procedure TTBCustomDockableWindow.GetMinShrinkSize(var AMinimumSize: Integer);
  4085. begin
  4086. end;
  4087. function TTBCustomDockableWindow.GetFloatingWindowParentClass: TTBFloatingWindowParentClass;
  4088. begin
  4089. Result := TTBFloatingWindowParent;
  4090. end;
  4091. procedure TTBCustomDockableWindow.GetMinMaxSize(var AMinClientWidth,
  4092. AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer);
  4093. begin
  4094. end;
  4095. function TTBCustomDockableWindow.GetShrinkMode: TTBShrinkMode;
  4096. begin
  4097. Result := tbsmNone;
  4098. end;
  4099. procedure TTBCustomDockableWindow.ResizeBegin;
  4100. begin
  4101. end;
  4102. procedure TTBCustomDockableWindow.ResizeTrack(var Rect: TRect; const OrigRect: TRect);
  4103. begin
  4104. end;
  4105. procedure TTBCustomDockableWindow.ResizeTrackAccept;
  4106. begin
  4107. end;
  4108. procedure TTBCustomDockableWindow.ResizeEnd;
  4109. begin
  4110. end;
  4111. procedure TTBCustomDockableWindow.BeginSizing(const ASizeHandle: TTBSizeHandle);
  4112. var
  4113. UseSmoothDrag, DragX, DragY, ReverseX, ReverseY: Boolean;
  4114. MinWidth, MinHeight, MaxWidth, MaxHeight: Integer;
  4115. DragRect, OrigDragRect: TRect;
  4116. ScreenDC: HDC;
  4117. OrigPos, OldPos: TPoint;
  4118. procedure DoResize;
  4119. begin
  4120. BeginUpdate;
  4121. try
  4122. ResizeTrackAccept;
  4123. Parent.BoundsRect := DragRect;
  4124. SetBounds(Left, Top, Parent.ClientWidth, Parent.ClientHeight);
  4125. finally
  4126. EndUpdate;
  4127. end;
  4128. { Make sure it doesn't go completely off the screen }
  4129. MoveOnScreen(True);
  4130. end;
  4131. procedure MouseMoved;
  4132. var
  4133. Pos: TPoint;
  4134. OldDragRect: TRect;
  4135. begin
  4136. GetCursorPos(Pos);
  4137. { It needs to check if the cursor actually moved since last time. This is
  4138. because a call to LockWindowUpdate (apparently) generates a mouse move
  4139. message even when mouse hasn't moved. }
  4140. if (Pos.X = OldPos.X) and (Pos.Y = OldPos.Y) then Exit;
  4141. OldPos := Pos;
  4142. OldDragRect := DragRect;
  4143. DragRect := OrigDragRect;
  4144. if DragX then begin
  4145. if not ReverseX then Inc(DragRect.Right, Pos.X-OrigPos.X)
  4146. else Inc(DragRect.Left, Pos.X-OrigPos.X);
  4147. end;
  4148. if DragY then begin
  4149. if not ReverseY then Inc(DragRect.Bottom, Pos.Y-OrigPos.Y)
  4150. else Inc(DragRect.Top, Pos.Y-OrigPos.Y);
  4151. end;
  4152. if DragRect.Right-DragRect.Left < MinWidth then begin
  4153. if not ReverseX then DragRect.Right := DragRect.Left + MinWidth
  4154. else DragRect.Left := DragRect.Right - MinWidth;
  4155. end;
  4156. if (MaxWidth > 0) and (DragRect.Right-DragRect.Left > MaxWidth) then begin
  4157. if not ReverseX then DragRect.Right := DragRect.Left + MaxWidth
  4158. else DragRect.Left := DragRect.Right - MaxWidth;
  4159. end;
  4160. if DragRect.Bottom-DragRect.Top < MinHeight then begin
  4161. if not ReverseY then DragRect.Bottom := DragRect.Top + MinHeight
  4162. else DragRect.Top := DragRect.Bottom - MinHeight;
  4163. end;
  4164. if (MaxHeight > 0) and (DragRect.Bottom-DragRect.Top > MaxHeight) then begin
  4165. if not ReverseY then DragRect.Bottom := DragRect.Top + MaxHeight
  4166. else DragRect.Top := DragRect.Bottom - MaxHeight;
  4167. end;
  4168. ResizeTrack(DragRect, OrigDragRect);
  4169. if not UseSmoothDrag then
  4170. DrawDraggingOutline(ScreenDC, @DragRect, @OldDragRect, False, False)
  4171. else
  4172. DoResize;
  4173. end;
  4174. var
  4175. Accept: Boolean;
  4176. Msg: TMsg;
  4177. R: TRect;
  4178. begin
  4179. if not Floating then Exit;
  4180. Accept := False;
  4181. UseSmoothDrag := FSmoothDrag;
  4182. MinWidth := 0;
  4183. MinHeight := 0;
  4184. MaxWidth := 0;
  4185. MaxHeight := 0;
  4186. GetMinMaxSize(MinWidth, MinHeight, MaxWidth, MaxHeight);
  4187. Inc(MinWidth, Parent.Width-Width);
  4188. Inc(MinHeight, Parent.Height-Height);
  4189. if MaxWidth > 0 then
  4190. Inc(MaxWidth, Parent.Width-Width);
  4191. if MaxHeight > 0 then
  4192. Inc(MaxHeight, Parent.Height-Height);
  4193. DragX := ASizeHandle in [twshLeft, twshRight, twshTopLeft, twshTopRight,
  4194. twshBottomLeft, twshBottomRight];
  4195. ReverseX := ASizeHandle in [twshLeft, twshTopLeft, twshBottomLeft];
  4196. DragY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight, twshBottom,
  4197. twshBottomLeft, twshBottomRight];
  4198. ReverseY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight];
  4199. ResizeBegin(ASizeHandle);
  4200. try
  4201. { Before locking, make sure all pending paint messages are processed }
  4202. ProcessPaintMessages;
  4203. if not UseSmoothDrag then begin
  4204. { This uses LockWindowUpdate to suppress all window updating so the
  4205. dragging outlines doesn't sometimes get garbled. (This is safe, and in
  4206. fact, is the main purpose of the LockWindowUpdate function)
  4207. IMPORTANT! While debugging you might want to enable the 'TB2Dock_DisableLock'
  4208. conditional define (see top of the source code). }
  4209. {$IFNDEF TB2Dock_DisableLock}
  4210. LockWindowUpdate(GetDesktopWindow);
  4211. {$ENDIF}
  4212. { Get a DC of the entire screen. Works around the window update lock
  4213. by specifying DCX_LOCKWINDOWUPDATE. }
  4214. ScreenDC := GetDCEx(GetDesktopWindow, 0,
  4215. DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  4216. end
  4217. else
  4218. ScreenDC := 0;
  4219. try
  4220. SetCapture(Handle);
  4221. if (tbdsResizeClipCursor in FDockableWindowStyles) and
  4222. not UsingMultipleMonitors then begin
  4223. R := GetRectOfPrimaryMonitor(False);
  4224. ClipCursor(@R);
  4225. end;
  4226. { Initialize }
  4227. OrigDragRect := Parent.BoundsRect;
  4228. DragRect := OrigDragRect;
  4229. if not UseSmoothDrag then
  4230. DrawDraggingOutline(ScreenDC, @DragRect, nil, False, False);
  4231. GetCursorPos(OrigPos);
  4232. OldPos := OrigPos;
  4233. { Stay in message loop until capture is lost. Capture is removed either
  4234. by this procedure manually doing it, or by an outside influence (like
  4235. a message box or menu popping up) }
  4236. while GetCapture = Handle do begin
  4237. case Integer(GetMessage(Msg, 0, 0, 0)) of
  4238. -1: Break; { if GetMessage failed }
  4239. 0: begin
  4240. { Repost WM_QUIT messages }
  4241. PostQuitMessage(Msg.WParam);
  4242. Break;
  4243. end;
  4244. end;
  4245. case Msg.Message of
  4246. WM_KEYDOWN, WM_KEYUP:
  4247. { Ignore all keystrokes while sizing except for Escape }
  4248. if Msg.WParam = VK_ESCAPE then
  4249. Break;
  4250. WM_MOUSEMOVE:
  4251. { Note to self: WM_MOUSEMOVE messages should never be dispatched
  4252. here to ensure no hints get shown during the drag process }
  4253. MouseMoved;
  4254. WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  4255. { Make sure it doesn't begin another loop }
  4256. Break;
  4257. WM_LBUTTONUP: begin
  4258. Accept := True;
  4259. Break;
  4260. end;
  4261. WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  4262. { Ignore all other mouse up/down messages }
  4263. ;
  4264. else
  4265. TranslateMessage(Msg);
  4266. DispatchMessage(Msg);
  4267. end;
  4268. end;
  4269. finally
  4270. { Since it sometimes breaks out of the loop without capture being
  4271. released }
  4272. if GetCapture = Handle then
  4273. ReleaseCapture;
  4274. ClipCursor(nil);
  4275. if not UseSmoothDrag then begin
  4276. { Hide dragging outline. Since NT will release a window update lock if
  4277. another thread comes to the foreground, it has to release the DC
  4278. and get a new one for erasing the dragging outline. Otherwise,
  4279. the DrawDraggingOutline appears to have no effect when this happens. }
  4280. ReleaseDC(GetDesktopWindow, ScreenDC);
  4281. ScreenDC := GetDCEx(GetDesktopWindow, 0,
  4282. DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  4283. DrawDraggingOutline(ScreenDC, nil, @DragRect, False, False);
  4284. ReleaseDC(GetDesktopWindow, ScreenDC);
  4285. { Release window update lock }
  4286. {$IFNDEF TB2Dock_DisableLock}
  4287. LockWindowUpdate(0);
  4288. {$ENDIF}
  4289. end;
  4290. end;
  4291. if not UseSmoothDrag and Accept then
  4292. DoResize;
  4293. finally
  4294. ResizeEnd;
  4295. end;
  4296. end;
  4297. procedure TTBCustomDockableWindow.DoDockChangingHidden(NewFloating: Boolean;
  4298. DockingTo: TTBDock);
  4299. begin
  4300. if not(csDestroying in ComponentState) and Assigned(FOnDockChangingHidden) then
  4301. FOnDockChangingHidden(Self, NewFloating, DockingTo);
  4302. end;
  4303. { TTBCustomDockableWindow - property access methods }
  4304. function TTBCustomDockableWindow.GetNonClientWidth: Integer;
  4305. begin
  4306. Result := CalcNCSizes.X;
  4307. end;
  4308. function TTBCustomDockableWindow.GetNonClientHeight: Integer;
  4309. begin
  4310. Result := CalcNCSizes.Y;
  4311. end;
  4312. function TTBCustomDockableWindow.IsLastDockStored: Boolean;
  4313. begin
  4314. Result := FCurrentDock = nil; {}{should this be changed to 'Floating'?}
  4315. end;
  4316. function TTBCustomDockableWindow.IsWidthAndHeightStored: Boolean;
  4317. begin
  4318. Result := (CurrentDock = nil) and not Floating;
  4319. end;
  4320. procedure TTBCustomDockableWindow.SetCloseButton(Value: Boolean);
  4321. begin
  4322. if FCloseButton <> Value then begin
  4323. FCloseButton := Value;
  4324. { Update the close button's visibility }
  4325. if Parent is TTBFloatingWindowParent then
  4326. TTBFloatingWindowParent(Parent).RedrawNCArea([twrdCaption, twrdCloseButton]);
  4327. end;
  4328. end;
  4329. procedure TTBCustomDockableWindow.SetCloseButtonWhenDocked(Value: Boolean);
  4330. begin
  4331. if FCloseButtonWhenDocked <> Value then begin
  4332. FCloseButtonWhenDocked := Value;
  4333. if Docked then
  4334. RecalcNCArea(Self);
  4335. end;
  4336. end;
  4337. procedure TTBCustomDockableWindow.SetDefaultDock(Value: TTBDock);
  4338. begin
  4339. if FDefaultDock <> Value then begin
  4340. FDefaultDock := Value;
  4341. if Assigned(Value) then
  4342. Value.FreeNotification(Self);
  4343. end;
  4344. end;
  4345. procedure TTBCustomDockableWindow.SetCurrentDock(Value: TTBDock);
  4346. begin
  4347. if not(csLoading in ComponentState) then begin
  4348. if Assigned(Value) then
  4349. Parent := Value
  4350. else
  4351. Parent := TBValidToolWindowParentForm(Self);
  4352. end;
  4353. end;
  4354. procedure TTBCustomDockableWindow.SetDockPos(Value: Integer);
  4355. begin
  4356. FDockPos := Value;
  4357. if Docked then
  4358. CurrentDock.ArrangeToolbars;
  4359. end;
  4360. procedure TTBCustomDockableWindow.SetDockRow(Value: Integer);
  4361. begin
  4362. FDockRow := Value;
  4363. if Docked then
  4364. CurrentDock.ArrangeToolbars;
  4365. end;
  4366. procedure TTBCustomDockableWindow.SetAutoResize(Value: Boolean);
  4367. begin
  4368. if FAutoResize <> Value then begin
  4369. FAutoResize := Value;
  4370. if Value then
  4371. Arrange;
  4372. end;
  4373. end;
  4374. procedure TTBCustomDockableWindow.SetBorderStyle(Value: TBorderStyle);
  4375. begin
  4376. if FBorderStyle <> Value then begin
  4377. FBorderStyle := Value;
  4378. if Docked then
  4379. RecalcNCArea(Self);
  4380. end;
  4381. end;
  4382. procedure TTBCustomDockableWindow.SetDragHandleStyle(Value: TTBDragHandleStyle);
  4383. begin
  4384. if FDragHandleStyle <> Value then begin
  4385. FDragHandleStyle := Value;
  4386. if Docked then
  4387. RecalcNCArea(Self);
  4388. end;
  4389. end;
  4390. procedure TTBCustomDockableWindow.SetFloating(Value: Boolean);
  4391. var
  4392. ParentFrm: TCustomForm;
  4393. NewFloatParent: TTBFloatingWindowParent;
  4394. begin
  4395. if FFloating <> Value then begin
  4396. if Value and not(csDesigning in ComponentState) then begin
  4397. ParentFrm := TBValidToolWindowParentForm(Self);
  4398. if (FFloatParent = nil) or (FFloatParent.FParentForm <> ParentFrm) then begin
  4399. NewFloatParent := GetFloatingWindowParentClass.Create(nil);
  4400. try
  4401. with NewFloatParent do begin
  4402. TWinControl(FParentForm) := ParentFrm;
  4403. FDockableWindow := Self;
  4404. Name := Format('NBFloatingWindowParent_%.8x', [Longint(NewFloatParent)]);
  4405. { ^ Must assign a unique name. In previous versions, reading in
  4406. components at run-time that had no name caused them to get assigned
  4407. names like "_1" because a component with no name -- the
  4408. TTBFloatingWindowParent form -- already existed. }
  4409. Caption := Self.Caption;
  4410. BorderStyle := bsToolWindow;
  4411. SetBounds(0, 0, (Width-ClientWidth) + Self.ClientWidth,
  4412. (Height-ClientHeight) + Self.ClientHeight);
  4413. ShowHint := True;
  4414. Visible := True;
  4415. end;
  4416. except
  4417. NewFloatParent.Free;
  4418. raise;
  4419. end;
  4420. FFloatParent := NewFloatParent;
  4421. end;
  4422. ParentFrm.FreeNotification(Self);
  4423. Parent := FFloatParent;
  4424. SetBounds(0, 0, Width, Height);
  4425. end
  4426. else
  4427. Parent := TBValidToolWindowParentForm(Self);
  4428. end;
  4429. end;
  4430. procedure TTBCustomDockableWindow.SetFloatingMode(Value: TTBFloatingMode);
  4431. begin
  4432. if FFloatingMode <> Value then begin
  4433. FFloatingMode := Value;
  4434. if HandleAllocated then
  4435. Perform(CM_SHOWINGCHANGED, 0, 0);
  4436. end;
  4437. end;
  4438. procedure TTBCustomDockableWindow.SetFloatingPosition(Value: TPoint);
  4439. begin
  4440. FFloatingPosition := Value;
  4441. if Floating and Assigned(Parent) then
  4442. Parent.SetBounds(Value.X, Value.Y, Parent.Width, Parent.Height);
  4443. end;
  4444. procedure TTBCustomDockableWindow.SetFullSize(Value: Boolean);
  4445. begin
  4446. if FFullSize <> Value then begin
  4447. FFullSize := Value;
  4448. if Docked then
  4449. CurrentDock.ArrangeToolbars;
  4450. end;
  4451. end;
  4452. procedure TTBCustomDockableWindow.SetLastDock(Value: TTBDock);
  4453. begin
  4454. if FUseLastDock and Assigned(FCurrentDock) then
  4455. { When docked, LastDock must be equal to DockedTo }
  4456. Value := FCurrentDock;
  4457. if FLastDock <> Value then begin
  4458. if Assigned(FLastDock) and (FLastDock <> Parent) then
  4459. FLastDock.ChangeDockList(False, Self);
  4460. FLastDock := Value;
  4461. if Assigned(Value) then begin
  4462. FUseLastDock := True;
  4463. Value.FreeNotification(Self);
  4464. Value.ChangeDockList(True, Self);
  4465. end;
  4466. end;
  4467. end;
  4468. procedure TTBCustomDockableWindow.SetResizable(Value: Boolean);
  4469. begin
  4470. if FResizable <> Value then begin
  4471. FResizable := Value;
  4472. if Floating and (Parent is TTBFloatingWindowParent) then begin
  4473. { Recreate the window handle because Resizable affects whether the
  4474. tool window is created with a WS_THICKFRAME style }
  4475. TTBFloatingWindowParent(Parent).RecreateWnd;
  4476. end;
  4477. end;
  4478. end;
  4479. procedure TTBCustomDockableWindow.SetShowCaption(Value: Boolean);
  4480. begin
  4481. if FShowCaption <> Value then begin
  4482. FShowCaption := Value;
  4483. if Floating then begin
  4484. { Recalculate FloatingWindowParent's NC area, and resize the toolbar
  4485. accordingly }
  4486. RecalcNCArea(Parent);
  4487. Arrange;
  4488. end;
  4489. end;
  4490. end;
  4491. procedure TTBCustomDockableWindow.SetStretch(Value: Boolean);
  4492. begin
  4493. if FStretch <> Value then begin
  4494. FStretch := Value;
  4495. if Docked then
  4496. CurrentDock.ArrangeToolbars;
  4497. end;
  4498. end;
  4499. procedure TTBCustomDockableWindow.SetUseLastDock(Value: Boolean);
  4500. begin
  4501. if FUseLastDock <> Value then begin
  4502. FUseLastDock := Value;
  4503. if not Value then
  4504. LastDock := nil
  4505. else
  4506. LastDock := FCurrentDock;
  4507. end;
  4508. end;
  4509. { Global procedures }
  4510. procedure TBCustomLoadPositions(const OwnerComponent: TComponent;
  4511. const ReadIntProc: TTBPositionReadIntProc;
  4512. const ReadStringProc: TTBPositionReadStringProc; const ExtraData: Pointer);
  4513. var
  4514. Rev: Integer;
  4515. function FindDock(AName: String): TTBDock;
  4516. var
  4517. I: Integer;
  4518. begin
  4519. Result := nil;
  4520. for I := 0 to OwnerComponent.ComponentCount-1 do
  4521. if (OwnerComponent.Components[I] is TTBDock) and
  4522. (CompareText(OwnerComponent.Components[I].Name, AName) = 0) then begin
  4523. Result := TTBDock(OwnerComponent.Components[I]);
  4524. Break;
  4525. end;
  4526. end;
  4527. procedure ReadValues(const Toolbar: TTBCustomDockableWindow; const NewDock: TTBDock);
  4528. var
  4529. Pos: TPoint;
  4530. Data: TTBReadPositionData;
  4531. LastDockName: String;
  4532. ADock: TTBDock;
  4533. begin
  4534. with Toolbar do begin
  4535. DockRow := ReadIntProc(Name, rvDockRow, DockRow, ExtraData);
  4536. DockPos := ReadIntProc(Name, rvDockPos, DockPos, ExtraData);
  4537. Pos.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData);
  4538. Pos.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData);
  4539. @Data.ReadIntProc := @ReadIntProc;
  4540. @Data.ReadStringProc := @ReadStringProc;
  4541. Data.ExtraData := ExtraData;
  4542. // not restoring floating width with legacy configuration
  4543. FloatingPosition := Pos;
  4544. if Assigned(NewDock) then
  4545. Parent := NewDock
  4546. else begin
  4547. //Parent := Form;
  4548. Floating := True;
  4549. MoveOnScreen(True);
  4550. if (Rev >= 3) and FUseLastDock then begin
  4551. LastDockName := ReadStringProc(Name, rvLastDock, '', ExtraData);
  4552. if LastDockName <> '' then begin
  4553. ADock := FindDock(LastDockName);
  4554. if Assigned(ADock) then
  4555. LastDock := ADock;
  4556. end;
  4557. end;
  4558. end;
  4559. Arrange;
  4560. end;
  4561. end;
  4562. var
  4563. DocksDisabled: TList;
  4564. I: Integer;
  4565. ToolWindow: TComponent;
  4566. ADock: TTBDock;
  4567. DockedToName: String;
  4568. LastDockName: String;
  4569. Pos: TPoint;
  4570. S: string;
  4571. begin
  4572. DocksDisabled := TList.Create;
  4573. try
  4574. with OwnerComponent do
  4575. for I := 0 to ComponentCount-1 do
  4576. if Components[I] is TTBDock then begin
  4577. TTBDock(Components[I]).BeginUpdate;
  4578. DocksDisabled.Add(Components[I]);
  4579. end;
  4580. for I := 0 to OwnerComponent.ComponentCount-1 do begin
  4581. ToolWindow := OwnerComponent.Components[I];
  4582. if ToolWindow is TTBCustomDockableWindow then
  4583. with TTBCustomDockableWindow(ToolWindow) do begin
  4584. {}{should skip over toolbars that are neither Docked nor Floating }
  4585. if Name = '' then
  4586. raise Exception.Create(STBToolWinNameNotSet);
  4587. S := ReadStringProc(Name, '', '', ExtraData);
  4588. if S <> '' then
  4589. begin
  4590. Visible := (StrToIntDef(CutToChar(S, ':', true), 0) <> 0);
  4591. DockedToName := CutToChar(S, ':', true);
  4592. DockRow := StrToIntDef(CutToChar(S, '+', true), DockRow);
  4593. DockPos := StrToIntDef(CutToChar(S, ':', true), DockPos);
  4594. if DockedToName <> '' then
  4595. begin
  4596. if DockedToName <> rdDockedToFloating then
  4597. begin
  4598. ADock := FindDock(DockedToName);
  4599. if (ADock <> nil) and ADock.FAllowDrag then
  4600. begin
  4601. Parent := ADock;
  4602. end;
  4603. end
  4604. else
  4605. begin
  4606. LastDockName := CutToChar(S, ':', true);
  4607. Pos.X := StrToIntDef(CutToChar(S, 'x', true), 0);
  4608. Pos.Y := StrToIntDef(CutToChar(S, ':', true), 0);
  4609. FloatingPosition := Pos;
  4610. Floating := True;
  4611. ReadPositionData(S);
  4612. MoveOnScreen(True);
  4613. if FUseLastDock then
  4614. begin
  4615. if LastDockName <> '' then
  4616. begin
  4617. ADock := FindDock(LastDockName);
  4618. if Assigned(ADock) then
  4619. LastDock := ADock;
  4620. end;
  4621. end;
  4622. end;
  4623. end;
  4624. end
  4625. else
  4626. begin
  4627. Rev := ReadIntProc(Name, rvRev, 0, ExtraData);
  4628. if Rev = 2000 then begin
  4629. Visible := ReadIntProc(Name, rvVisible, Ord(Visible), ExtraData) <> 0;
  4630. DockedToName := ReadStringProc(Name, rvDockedTo, '', ExtraData);
  4631. if DockedToName <> '' then begin
  4632. if DockedToName <> rdDockedToFloating then begin
  4633. ADock := FindDock(DockedToName);
  4634. if (ADock <> nil) and (ADock.FAllowDrag) then
  4635. ReadValues(TTBCustomDockableWindow(ToolWindow), ADock);
  4636. end
  4637. else
  4638. ReadValues(TTBCustomDockableWindow(ToolWindow), nil);
  4639. end;
  4640. end;
  4641. end;
  4642. end;
  4643. end;
  4644. finally
  4645. for I := DocksDisabled.Count-1 downto 0 do
  4646. TTBDock(DocksDisabled[I]).EndUpdate;
  4647. DocksDisabled.Free;
  4648. end;
  4649. end;
  4650. procedure TBCustomSavePositions(const OwnerComponent: TComponent;
  4651. const WriteIntProc: TTBPositionWriteIntProc;
  4652. const WriteStringProc: TTBPositionWriteStringProc; const ExtraData: Pointer);
  4653. var
  4654. I: Integer;
  4655. N, S: String;
  4656. begin
  4657. for I := 0 to OwnerComponent.ComponentCount-1 do
  4658. if OwnerComponent.Components[I] is TTBCustomDockableWindow then
  4659. with TTBCustomDockableWindow(OwnerComponent.Components[I]) do begin
  4660. if Name = '' then
  4661. raise Exception.Create(STBToolwinNameNotSet);
  4662. if Floating then
  4663. N := rdDockedToFloating
  4664. else if Docked then begin
  4665. if CurrentDock.FAllowDrag then begin
  4666. N := CurrentDock.Name;
  4667. if N = '' then
  4668. raise Exception.Create(STBToolwinDockedToNameNotSet);
  4669. end
  4670. else
  4671. N := '';
  4672. end
  4673. else
  4674. Continue; { skip if it's neither floating nor docked }
  4675. S := IntToStr(Ord(Visible));
  4676. S := S + ':' + N;
  4677. S := S + ':' + IntToStr(FDockRow);
  4678. S := S + '+' + IntToStr(FDockPos);
  4679. if Floating then
  4680. begin
  4681. S := S + ':';
  4682. if Assigned(FLastDock) then
  4683. S := S + FLastDock.Name;
  4684. S := S + ':' + IntToStr(FFloatingPosition.X);
  4685. S := S + 'x' + IntToStr(FFloatingPosition.Y);
  4686. end;
  4687. S := S + WritePositionData;
  4688. WriteStringProc(Name, '', S, ExtraData);
  4689. end;
  4690. end;
  4691. type
  4692. PIniReadWriteData = ^TIniReadWriteData;
  4693. TIniReadWriteData = record
  4694. IniFile: TIniFile;
  4695. SectionNamePrefix: String;
  4696. end;
  4697. function IniReadInt(const ToolbarName, Value: String; const Default: Longint;
  4698. const ExtraData: Pointer): Longint; far;
  4699. begin
  4700. Result := PIniReadWriteData(ExtraData).IniFile.ReadInteger(
  4701. PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default);
  4702. end;
  4703. function IniReadString(const ToolbarName, Value, Default: String;
  4704. const ExtraData: Pointer): String; far;
  4705. begin
  4706. Result := PIniReadWriteData(ExtraData).IniFile.ReadString(
  4707. PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default);
  4708. end;
  4709. procedure IniWriteInt(const ToolbarName, Value: String; const Data: Longint;
  4710. const ExtraData: Pointer); far;
  4711. begin
  4712. PIniReadWriteData(ExtraData).IniFile.WriteInteger(
  4713. PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data);
  4714. end;
  4715. procedure IniWriteString(const ToolbarName, Value, Data: String;
  4716. const ExtraData: Pointer); far;
  4717. begin
  4718. PIniReadWriteData(ExtraData).IniFile.WriteString(
  4719. PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data);
  4720. end;
  4721. procedure TBIniLoadPositions(const OwnerComponent: TComponent;
  4722. const Filename, SectionNamePrefix: String);
  4723. var
  4724. Data: TIniReadWriteData;
  4725. begin
  4726. Data.IniFile := TIniFile.Create(Filename);
  4727. try
  4728. Data.SectionNamePrefix := SectionNamePrefix;
  4729. TBCustomLoadPositions(OwnerComponent, IniReadInt, IniReadString, @Data);
  4730. finally
  4731. Data.IniFile.Free;
  4732. end;
  4733. end;
  4734. procedure TBIniSavePositions(const OwnerComponent: TComponent;
  4735. const Filename, SectionNamePrefix: String);
  4736. var
  4737. Data: TIniReadWriteData;
  4738. begin
  4739. Data.IniFile := TIniFile.Create(Filename);
  4740. try
  4741. Data.SectionNamePrefix := SectionNamePrefix;
  4742. TBCustomSavePositions(OwnerComponent, IniWriteInt, IniWriteString, @Data);
  4743. finally
  4744. Data.IniFile.Free;
  4745. end;
  4746. end;
  4747. function RegReadInt(const ToolbarName, Value: String; const Default: Longint;
  4748. const ExtraData: Pointer): Longint; far;
  4749. begin
  4750. Result := TRegIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default);
  4751. end;
  4752. function RegReadString(const ToolbarName, Value, Default: String;
  4753. const ExtraData: Pointer): String; far;
  4754. begin
  4755. Result := TRegIniFile(ExtraData).ReadString(ToolbarName, Value, Default);
  4756. end;
  4757. procedure RegWriteInt(const ToolbarName, Value: String; const Data: Longint;
  4758. const ExtraData: Pointer); far;
  4759. begin
  4760. TRegIniFile(ExtraData).WriteInteger(ToolbarName, Value, Data);
  4761. end;
  4762. procedure RegWriteString(const ToolbarName, Value, Data: String;
  4763. const ExtraData: Pointer); far;
  4764. begin
  4765. TRegIniFile(ExtraData).WriteString(ToolbarName, Value, Data);
  4766. end;
  4767. procedure TBRegLoadPositions(const OwnerComponent: TComponent;
  4768. const RootKey: DWORD; const BaseRegistryKey: String);
  4769. var
  4770. Reg: TRegIniFile;
  4771. begin
  4772. Reg := TRegIniFile.Create('');
  4773. try
  4774. Reg.RootKey := RootKey;
  4775. Reg.OpenKey(BaseRegistryKey, True); { assigning to RootKey resets the current key }
  4776. TBCustomLoadPositions(OwnerComponent, RegReadInt, RegReadString, Reg);
  4777. finally
  4778. Reg.Free;
  4779. end;
  4780. end;
  4781. procedure TBRegSavePositions(const OwnerComponent: TComponent;
  4782. const RootKey: DWORD; const BaseRegistryKey: String);
  4783. var
  4784. Reg: TRegIniFile;
  4785. begin
  4786. Reg := TRegIniFile.Create('');
  4787. try
  4788. Reg.RootKey := RootKey;
  4789. Reg.OpenKey(BaseRegistryKey, True); { assigning to RootKey resets the current key }
  4790. TBCustomSavePositions(OwnerComponent, RegWriteInt, RegWriteString, Reg);
  4791. finally
  4792. Reg.Free;
  4793. end;
  4794. end;
  4795. initialization
  4796. end.