1
0

TB2Dock.pas 185 KB

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