TB2Dock.pas 186 KB

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