TB2Dock.pas 174 KB

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