1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107 |
- unit IDE.MainForm;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Compiler form
- }
- {x$DEFINE STATICCOMPILER}
- { For debugging purposes, remove the 'x' to have it link the compiler code into
- this program and not depend on ISCmplr.dll. You will also need to add the
- ..\Components and Src folders to the Delphi Compiler Search path in the project
- options. Also see ISCC's STATICCOMPILER and Compiler.Compile's STATICPREPROC. }
- {$IFDEF STATICCOMPILER}
- {$R ..\Res\ISCmplr.images.res}
- {$ENDIF}
- interface
- uses
- Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, CommDlg,
- Generics.Collections, UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl,
- ScintInt, ScintEdit, IDE.ScintStylerInnoSetup, NewTabSet, ModernColors, IDE.IDEScintEdit,
- Shared.DebugStruct, Shared.CompilerInt.Struct, NewUxTheme, ImageList, ImgList, ToolWin, IDE.HelperFunc,
- VirtualImageList, BaseImageCollection;
- const
- WM_StartCommandLineCompile = WM_USER + $1000;
- WM_StartCommandLineWizard = WM_USER + $1001;
- WM_StartNormally = WM_USER + $1002;
- type
- PDebugEntryArray = ^TDebugEntryArray;
- TDebugEntryArray = array[0..0] of TDebugEntry;
- PVariableDebugEntryArray = ^TVariableDebugEntryArray;
- TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry;
- TStepMode = (smRun, smStepInto, smStepOver, smStepOut, smRunToCursor);
- TDebugTarget = (dtSetup, dtUninstall);
- const
- DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall');
- type
- TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
- TIncludedFile = class
- Filename: String;
- CompilerFileIndex: Integer;
- LastWriteTime: TFileTime;
- HasLastWriteTime: Boolean;
- Memo: TIDEScintFileEdit;
- end;
- TIncludedFiles = TObjectList<TIncludedFile>;
- TFindResult = class
- Filename: String;
- Line, LineStartPos: Integer;
- Range: TScintRange;
- PrefixStringLength: Integer;
- end;
- TFindResults = TObjectList<TFindResult>;
- TMenuBitmaps = TDictionary<TMenuItem, HBITMAP>;
- TKeyMappedMenus = TDictionary<TShortCut, TToolButton>;
- TCallTipState = record
- StartCallTipWord: Integer;
- FunctionDefinition: AnsiString;
- BraceCount: Integer;
- LastPosCallTip: Integer;
- ClassOrRecordMember: Boolean;
- CurrentCallTipWord: String;
- CurrentCallTip: Integer;
- MaxCallTips: Integer;
- end;
- TUpdatePanelMessage = class
- Msg, ConfigIdent: String;
- ConfigValue: Integer;
- Color: TColor;
- HasLink: Boolean;
- constructor Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
- end;
- TUpdatePanelMessages = TObjectList<TUpdatePanelMessage>;
- TMainForm = class(TUIStateForm)
- MainMenu1: TMainMenu;
- FMenu: TMenuItem;
- FNewMainFile: TMenuItem;
- FOpenMainFile: TMenuItem;
- FSave: TMenuItem;
- FSaveMainFileAs: TMenuItem;
- N1: TMenuItem;
- BCompile: TMenuItem;
- N2: TMenuItem;
- FExit: TMenuItem;
- EMenu: TMenuItem;
- EUndo: TMenuItem;
- N3: TMenuItem;
- ECut: TMenuItem;
- ECopy: TMenuItem;
- EPaste: TMenuItem;
- EDelete: TMenuItem;
- N4: TMenuItem;
- ESelectAll: TMenuItem;
- VMenu: TMenuItem;
- EFind: TMenuItem;
- EFindNext: TMenuItem;
- EReplace: TMenuItem;
- HMenu: TMenuItem;
- HDoc: TMenuItem;
- HAbout: TMenuItem;
- FRecent: TMenuItem;
- FClearRecent: TMenuItem;
- N6: TMenuItem;
- VCompilerOutput: TMenuItem;
- FindDialog: TFindDialog;
- ReplaceDialog: TReplaceDialog;
- StatusPanel: TPanel;
- CompilerOutputList: TListBox;
- SplitPanel: TPanel;
- HWebsite: TMenuItem;
- VToolbar: TMenuItem;
- N7: TMenuItem;
- TOptions: TMenuItem;
- HFaq: TMenuItem;
- StatusBar: TStatusBar;
- BodyPanel: TPanel;
- VStatusBar: TMenuItem;
- ERedo: TMenuItem;
- RMenu: TMenuItem;
- RStepInto: TMenuItem;
- RStepOver: TMenuItem;
- N5: TMenuItem;
- RRun: TMenuItem;
- RRunToCursor: TMenuItem;
- N10: TMenuItem;
- REvaluate: TMenuItem;
- CheckIfRunningTimer: TTimer;
- RPause: TMenuItem;
- RParameters: TMenuItem;
- OutputListPopupMenu: TMenuItem;
- POutputListCopy: TMenuItem;
- HISPPSep: TMenuItem;
- N12: TMenuItem;
- BStopCompile: TMenuItem;
- HISPPDoc: TMenuItem;
- N13: TMenuItem;
- EGoto: TMenuItem;
- RTerminate: TMenuItem;
- BMenu: TMenuItem;
- BLowPriority: TMenuItem;
- HDonate: TMenuItem;
- N14: TMenuItem;
- N15: TMenuItem;
- RTargetSetup: TMenuItem;
- RTargetUninstall: TMenuItem;
- OutputTabSet: TNewTabSet;
- DebugOutputList: TListBox;
- VDebugOutput: TMenuItem;
- VHide: TMenuItem;
- N11: TMenuItem;
- TMenu: TMenuItem;
- TAddRemovePrograms: TMenuItem;
- RToggleBreakPoint: TMenuItem;
- RDeleteBreakPoints: TMenuItem;
- HWhatsNew: TMenuItem;
- TGenerateGUID: TMenuItem;
- TSignTools: TMenuItem;
- N16: TMenuItem;
- HExamples: TMenuItem;
- N17: TMenuItem;
- BOpenOutputFolder: TMenuItem;
- N8: TMenuItem;
- VZoom: TMenuItem;
- VZoomIn: TMenuItem;
- VZoomOut: TMenuItem;
- N9: TMenuItem;
- VZoomReset: TMenuItem;
- N18: TMenuItem;
- N19: TMenuItem;
- FSaveEncoding: TMenuItem;
- FSaveEncodingAuto: TMenuItem;
- FSaveEncodingUTF8WithBOM: TMenuItem;
- ToolBar: TToolBar;
- BackNavButton: TToolButton;
- ForwardNavButton: TToolButton;
- ToolButton1: TToolButton;
- NewMainFileButton: TToolButton;
- OpenMainFileButton: TToolButton;
- SaveButton: TToolButton;
- ToolButton2: TToolButton;
- CompileButton: TToolButton;
- StopCompileButton: TToolButton;
- ToolButton3: TToolButton;
- RunButton: TToolButton;
- PauseButton: TToolButton;
- ToolButton4: TToolButton;
- TargetSetupButton: TToolButton;
- TargetUninstallButton: TToolButton;
- ToolButton5: TToolButton;
- HelpButton: TToolButton;
- Bevel1: TBevel;
- TerminateButton: TToolButton;
- ThemedToolbarVirtualImageList: TVirtualImageList;
- LightToolbarVirtualImageList: TVirtualImageList;
- POutputListSelectAll: TMenuItem;
- DebugCallStackList: TListBox;
- VDebugCallStack: TMenuItem;
- TMsgBoxDesigner: TMenuItem;
- TRegistryDesigner: TMenuItem;
- ToolBarPanel: TPanel;
- HMailingList: TMenuItem;
- MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo }
- FSaveAll: TMenuItem;
- RStepOut: TMenuItem;
- VNextTab: TMenuItem;
- VPreviousTab: TMenuItem;
- N20: TMenuItem;
- HShortcutsDoc: TMenuItem;
- HRegExDoc: TMenuItem;
- N21: TMenuItem;
- EFindPrevious: TMenuItem;
- FindResultsList: TListBox;
- VFindResults: TMenuItem;
- EFindInFiles: TMenuItem;
- FindInFilesDialog: TFindDialog;
- FPrint: TMenuItem;
- N22: TMenuItem;
- PrintDialog: TPrintDialog;
- FSaveEncodingUTF8WithoutBOM: TMenuItem;
- TFilesDesigner: TMenuItem;
- VCloseCurrentTab: TMenuItem;
- VReopenTab: TMenuItem;
- VReopenTabs: TMenuItem;
- MemosTabSetPopupMenu: TMenuItem;
- VCloseCurrentTab2: TMenuItem;
- VReopenTab2: TMenuItem;
- VReopenTabs2: TMenuItem;
- NavPopupMenu: TMenuItem;
- N23: TMenuItem;
- ThemedMarkersAndACVirtualImageList: TVirtualImageList;
- ESelectNextOccurrence: TMenuItem;
- ESelectAllOccurrences: TMenuItem;
- BreakPointsPopupMenu: TMenuItem;
- RToggleBreakPoint2: TMenuItem;
- RDeleteBreakPoints2: TMenuItem;
- N24: TMenuItem;
- VWordWrap: TMenuItem;
- N25: TMenuItem;
- ESelectAllFindMatches: TMenuItem;
- EToggleLinesComment: TMenuItem;
- EBraceMatch: TMenuItem;
- EFoldLine: TMenuItem;
- EUnfoldLine: TMenuItem;
- EFindRegEx: TMenuItem;
- UpdatePanel: TPanel;
- UpdateLinkLabel: TLinkLabel;
- UpdatePanelClosePaintBox: TPaintBox;
- UpdatePanelDonateImage: TImage;
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure FExitClick(Sender: TObject);
- procedure FOpenMainFileClick(Sender: TObject);
- procedure EUndoClick(Sender: TObject);
- procedure EMenuClick(Sender: TObject);
- procedure ECutClick(Sender: TObject);
- procedure ECopyClick(Sender: TObject);
- procedure EPasteClick(Sender: TObject);
- procedure EDeleteClick(Sender: TObject);
- procedure FSaveClick(Sender: TObject);
- procedure ESelectAllClick(Sender: TObject);
- procedure FNewMainFileClick(Sender: TObject);
- procedure FNewMainFileUserWizardClick(Sender: TObject);
- procedure HDocClick(Sender: TObject);
- procedure BCompileClick(Sender: TObject);
- procedure FMenuClick(Sender: TObject);
- procedure FMRUClick(Sender: TObject);
- procedure VCompilerOutputClick(Sender: TObject);
- procedure HAboutClick(Sender: TObject);
- procedure EFindClick(Sender: TObject);
- procedure FindDialogFind(Sender: TObject);
- procedure EReplaceClick(Sender: TObject);
- procedure ReplaceDialogReplace(Sender: TObject);
- procedure EFindNextOrPreviousClick(Sender: TObject);
- procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure VMenuClick(Sender: TObject);
- procedure HWebsiteClick(Sender: TObject);
- procedure VToolbarClick(Sender: TObject);
- procedure TOptionsClick(Sender: TObject);
- procedure HFaqClick(Sender: TObject);
- procedure HISPPDocClick(Sender: TObject);
- procedure VStatusBarClick(Sender: TObject);
- procedure ERedoClick(Sender: TObject);
- procedure StatusBarResize(Sender: TObject);
- procedure RStepIntoClick(Sender: TObject);
- procedure RStepOverClick(Sender: TObject);
- procedure RRunToCursorClick(Sender: TObject);
- procedure RRunClick(Sender: TObject);
- procedure REvaluateClick(Sender: TObject);
- procedure CheckIfRunningTimerTimer(Sender: TObject);
- procedure RPauseClick(Sender: TObject);
- procedure RParametersClick(Sender: TObject);
- procedure POutputListCopyClick(Sender: TObject);
- procedure BStopCompileClick(Sender: TObject);
- procedure EGotoClick(Sender: TObject);
- procedure RTerminateClick(Sender: TObject);
- procedure BMenuClick(Sender: TObject);
- procedure BLowPriorityClick(Sender: TObject);
- procedure StatusBarDrawPanel(StatusBar: TStatusBar;
- Panel: TStatusPanel; const Rect: TRect);
- procedure HDonateClick(Sender: TObject);
- procedure RTargetClick(Sender: TObject);
- procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState);
- procedure OutputTabSetClick(Sender: TObject);
- procedure VHideClick(Sender: TObject);
- procedure VDebugOutputClick(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure TAddRemoveProgramsClick(Sender: TObject);
- procedure RToggleBreakPointClick(Sender: TObject);
- procedure RDeleteBreakPointsClick(Sender: TObject);
- procedure HWhatsNewClick(Sender: TObject);
- procedure TGenerateGUIDClick(Sender: TObject);
- procedure TSignToolsClick(Sender: TObject);
- procedure HExamplesClick(Sender: TObject);
- procedure BOpenOutputFolderClick(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure VZoomInClick(Sender: TObject);
- procedure VZoomOutClick(Sender: TObject);
- procedure VZoomResetClick(Sender: TObject);
- procedure FSaveEncodingItemClick(Sender: TObject);
- procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState);
- procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
- NewDPI: Integer);
- procedure POutputListSelectAllClick(Sender: TObject);
- procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- procedure VDebugCallStackClick(Sender: TObject);
- procedure HMailingListClick(Sender: TObject);
- procedure TMsgBoxDesignerClick(Sender: TObject);
- procedure TRegistryDesignerClick(Sender: TObject);
- procedure MemosTabSetClick(Sender: TObject);
- procedure FSaveAllClick(Sender: TObject);
- procedure RStepOutClick(Sender: TObject);
- procedure TMenuClick(Sender: TObject);
- procedure VNextTabClick(Sender: TObject);
- procedure VPreviousTabClick(Sender: TObject);
- procedure HShortcutsDocClick(Sender: TObject);
- procedure HRegExDocClick(Sender: TObject);
- procedure VFindResultsClick(Sender: TObject);
- procedure EFindInFilesClick(Sender: TObject);
- procedure FindInFilesDialogFind(Sender: TObject);
- procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- procedure FindResultsListDblClick(Sender: TObject);
- procedure FPrintClick(Sender: TObject);
- procedure TFilesDesignerClick(Sender: TObject);
- procedure VCloseCurrentTabClick(Sender: TObject);
- procedure VReopenTabsClick(Sender: TObject);
- procedure MemosTabSetPopupMenuClick(Sender: TObject);
- procedure MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
- procedure StatusBarClick(Sender: TObject);
- procedure SimpleMenuClick(Sender: TObject);
- procedure OutputListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure RMenuClick(Sender: TObject);
- procedure BackNavButtonClick(Sender: TObject);
- procedure ForwardNavButtonClick(Sender: TObject);
- procedure NavPopupMenuClick(Sender: TObject);
- procedure ESelectNextOccurrenceClick(Sender: TObject);
- procedure ESelectAllOccurrencesClick(Sender: TObject);
- procedure BreakPointsPopupMenuClick(Sender: TObject);
- procedure FClearRecentClick(Sender: TObject);
- procedure VWordWrapClick(Sender: TObject);
- procedure ESelectAllFindMatchesClick(Sender: TObject);
- procedure EToggleLinesCommentClick(Sender: TObject);
- procedure EBraceMatchClick(Sender: TObject);
- procedure EFoldOrUnfoldLineClick(Sender: TObject);
- procedure EFindRegExClick(Sender: TObject);
- procedure UpdateLinkLabelLinkClick(Sender: TObject; const Link: string;
- LinkType: TSysLinkType);
- procedure UpdatePanelClosePaintBoxPaint(Sender: TObject);
- procedure UpdatePanelClosePaintBoxClick(Sender: TObject);
- procedure UpdatePanelDonateImageClick(Sender: TObject);
- private
- { Private declarations }
- FMemos: TList<TIDEScintEdit>; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above }
- FMainMemo: TIDEScintFileEdit; { Doesn't change }
- FPreprocessorOutputMemo: TIDEScintEdit; { Doesn't change and is the only memo which isnt a TIDEScint*File*Edit}
- FFileMemos: TList<TIDEScintFileEdit>; { All memos except FPreprocessorOutputMemo, including those without a tab }
- FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab }
- FActiveMemo: TIDEScintEdit; { Changes depending on user input }
- FErrorMemo, FStepMemo: TIDEScintFileEdit; { These change depending on user input }
- FMemosStyler: TInnoSetupStyler; { Single styler for all memos }
- FCompilerVersion: PCompilerVersionInfo;
- FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
- FMRUMainFilesList: TStringList;
- FMRUParametersList: TStringList;
- FOptions: record
- ShowStartupForm: Boolean;
- UseWizard: Boolean;
- Autosave: Boolean;
- MakeBackups: Boolean;
- FullPathInTitleBar: Boolean;
- UndoAfterSave: Boolean;
- PauseOnDebuggerExceptions: Boolean;
- RunAsDifferentUser: Boolean;
- AutoAutoComplete: Boolean;
- AutoCallTips: Boolean;
- UseSyntaxHighlighting: Boolean;
- ColorizeCompilerOutput: Boolean;
- UnderlineErrors: Boolean;
- HighlightWordAtCursorOccurrences: Boolean;
- HighlightSelTextOccurrences: Boolean;
- CursorPastEOL: Boolean;
- TabWidth: Integer;
- UseTabCharacter: Boolean;
- ShowWhiteSpace: Boolean;
- UseFolding: Boolean;
- FindRegEx: Boolean;
- WordWrap: Boolean;
- AutoIndent: Boolean;
- IndentationGuides: Boolean;
- LowPriorityDuringCompile: Boolean;
- GutterLineNumbers: Boolean;
- KeyMappingType: TKeyMappingType;
- MemoKeyMappingType: TIDEScintKeyMappingType;
- ThemeType: TThemeType;
- ShowPreprocessorOutput: Boolean;
- OpenIncludedFiles: Boolean;
- ShowCaretPosition: Boolean;
- end;
- FOptionsLoaded: Boolean;
- FTheme: TTheme;
- FSignTools: TStringList;
- FFindResults: TFindResults;
- FCompiling: Boolean;
- FCompileWantAbort: Boolean;
- FBecameIdle: Boolean;
- FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean;
- FDebugEntries: PDebugEntryArray;
- FDebugEntriesCount: Integer;
- FVariableDebugEntries: PVariableDebugEntryArray;
- FVariableDebugEntriesCount: Integer;
- FCompiledCodeText: AnsiString;
- FCompiledCodeDebugInfo: AnsiString;
- FDebugClientWnd: HWND;
- FProcessHandle, FDebugClientProcessHandle: THandle;
- FDebugTarget: TDebugTarget;
- FCompiledExe, FUninstExe, FTempDir: String;
- FPreprocessorOutput: String;
- FIncludedFiles: TIncludedFiles;
- FDebugging: Boolean;
- FStepMode: TStepMode;
- FPaused, FPausedAtCodeLine: Boolean;
- FRunToCursorPoint: TDebugEntry;
- FReplyString: String;
- FDebuggerException: String;
- FRunParameters: String;
- FLastFindOptions: TFindOptions;
- FLastFindRegEx: Boolean;
- FLastFindText: String;
- FLastReplaceText: String;
- FLastEvaluateConstantText: String;
- FSavePriorityClass: DWORD;
- FBuildAnimationFrame: Cardinal;
- FLastAnimationTick: DWORD;
- FProgress, FProgressMax: Cardinal;
- FTaskbarProgressValue: Cardinal;
- FProgressThemeData: HTHEME;
- FMenuThemeData: HTHEME;
- FToolbarThemeData: HTHEME;
- FStatusBarThemeData: HTHEME;
- FMenuDarkBackgroundBrush: TBrush;
- FMenuDarkHotOrSelectedBrush: TBrush;
- FDebugLogListTimestampsWidth: Integer;
- FOnPendingSquiggly: Boolean;
- FPendingSquigglyCaretPos: Integer;
- FCallStackCount: Cardinal;
- FDevMode, FDevNames: HGLOBAL;
- FMenuImageList: TVirtualImageList;
- FMenuBitmaps: TMenuBitmaps;
- FMenuBitmapsSize: TSize;
- FMenuBitmapsSourceImageCollection: TCustomImageCollection;
- FSynchingZoom: Boolean;
- FNavStacks: TIDEScintEditNavStacks;
- FCurrentNavItem: TIDEScintEditNavItem;
- FKeyMappedMenus: TKeyMappedMenus;
- FBackNavButtonShortCut, FForwardNavButtonShortCut: TShortCut;
- FBackNavButtonShortCut2, FForwardNavButtonShortCut2: TShortCut;
- FIgnoreTabSetClick: Boolean;
- FFirstTabSelectShortCut, FLastTabSelectShortCut: TShortCut;
- FCompileShortCut2: TShortCut;
- FCallTipState: TCallTipState;
- FUpdatePanelMessages: TUpdatePanelMessages;
- FBuildImageList: TImageList;
- FHighContrastActive: Boolean;
- function AnyMemoHasBreakPoint: Boolean;
- class procedure AppOnException(Sender: TObject; E: Exception);
- procedure AppOnActivate(Sender: TObject);
- class procedure AppOnGetActiveFormHandle(var AHandle: HWND);
- procedure AppOnIdle(Sender: TObject; var Done: Boolean);
- function AskToDetachDebugger: Boolean;
- procedure BringToForeground;
- procedure BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
- procedure BuildAndSaveKnownIncludedAndHiddenFiles;
- procedure CheckIfTerminated;
- procedure ClearMRUMainFilesList;
- procedure CloseTab(const TabIndex: Integer);
- procedure CompileFile(AFilename: String; const ReadFromFile: Boolean);
- procedure CompileIfNecessary;
- function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
- procedure DebuggingStopped(const WaitForTermination: Boolean);
- procedure DebugLogMessage(const S: String);
- procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
- function DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
- procedure DestroyDebugInfo;
- procedure DetachDebugger;
- function EvaluateConstant(const S: String; out Output: String): Integer;
- function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
- out Output: String): Integer;
- procedure FindNext(const ReverseDirection: Boolean);
- function FindSetupDirectiveValue(const DirectiveName,
- DefaultValue: String): String; overload;
- function FindSetupDirectiveValue(const DirectiveName: String;
- DefaultValue: Boolean): Boolean; overload;
- function FromCurrentPPI(const XY: Integer): Integer;
- function GetBorderStyle: TFormBorderStyle;
- procedure Go(AStepMode: TStepMode);
- procedure HideError;
- procedure InitializeFindText(Dlg: TFindDialog);
- function InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- function InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- function InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- function InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- function InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit;
- const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean;
- procedure InitiateAutoComplete(const Key: AnsiChar);
- procedure UpdateCallTipFunctionDefinition(const Pos: Integer = -1);
- procedure InitiateCallTip(const Key: AnsiChar);
- procedure ContinueCallTip;
- procedure InvalidateStatusPanel(const Index: Integer);
- procedure LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
- procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
- procedure MemoCallTipArrowClick(Sender: TObject; const Up: Boolean);
- procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
- procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar);
- procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
- procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
- procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure MemoKeyPress(Sender: TObject; var Key: Char);
- procedure MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count, FirstAffectedLine: Integer);
- procedure MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
- procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- procedure MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- procedure MemoModifiedChange(Sender: TObject);
- function MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
- procedure MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
- procedure MemoZoom(Sender: TObject);
- function MultipleSelectionPasteFromClipboard(const AMemo: TIDESCintEdit): Boolean;
- procedure UpdateReopenTabMenu(const Menu: TMenuItem);
- procedure ModifyMRUMainFilesList(const AFilename: String; const AddNewItem: Boolean);
- procedure ModifyMRUParametersList(const AParameter: String; const AddNewItem: Boolean);
- procedure MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
- const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean;
- const IsPosition: Boolean = False; const PositionVirtualSpace: Integer = 0);
- procedure NavItemClick(Sender: TObject);
- procedure NewMainFile;
- procedure NewMainFileUsingWizard;
- procedure OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean);
- procedure OpenMRUMainFile(const AFilename: String);
- procedure ParseDebugInfo(DebugInfo: Pointer);
- procedure ReadMRUMainFilesList;
- procedure ReadMRUParametersList;
- procedure RemoveMemoFromNav(const AMemo: TIDEScintEdit);
- procedure RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit);
- procedure ReopenTabClick(Sender: TObject);
- procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean);
- procedure ResetAllMemosLineState;
- procedure StartProcess;
- function SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
- procedure SetBorderStyle(Value: TFormBorderStyle);
- procedure SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
- procedure SetStatusPanelVisible(const AVisible: Boolean);
- procedure SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
- procedure ShowOpenMainFileDialog(const Examples: Boolean);
- procedure StatusBarCanvasDrawPanel(Canvas: TCanvas;
- Panel: TStatusPanel; const Rect: TRect);
- procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
- function StoreAndTestLastFindOptions(Sender: TObject): Boolean;
- function TestLastFindOptions: Boolean;
- procedure SyncEditorOptions;
- function TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
- function ToCurrentPPI(const XY: Integer): Integer;
- procedure ToggleBreakPoint(Line: Integer);
- procedure UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
- procedure UpdateAllMemosLineMarkers;
- procedure UpdateBevel1Visibility;
- procedure UpdateCaption;
- procedure UpdateCaretPosPanelAndBackNavStack;
- procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal;
- const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal);
- procedure UpdateEditModePanel;
- procedure UpdateFindRegExUI;
- procedure UpdateFindResult(const FindResult: TFindResult; const ItemIndex: Integer;
- const NewLine, NewLineStartPos: Integer);
- procedure UpdatePreprocMemos;
- procedure UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
- procedure UpdateImages;
- procedure UpdateMarginsAndAutoCompleteIcons;
- procedure UpdateMarginsAndSquigglyAndCaretWidths;
- procedure UpdateMemosTabSetVisibility;
- procedure UpdateMenuBitmapsIfNeeded;
- procedure UpdateModifiedPanel;
- procedure UpdateNavButtons;
- procedure UpdateNewMainFileButtons;
- procedure UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
- procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- procedure UpdateRunMenu;
- procedure UpdateSaveMenuItemAndButton;
- procedure UpdateTargetMenu;
- procedure UpdateUpdatePanel;
- procedure UpdateKeyMapping;
- procedure UpdateTheme;
- procedure UpdateThemeData(const Open: Boolean);
- procedure ApplyMenuBitmaps(const ParentMenuItem: TMenuItem);
- procedure UpdateStatusPanelHeight(H: Integer);
- procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND;
- procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
- procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
- procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
- procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion;
- procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit;
- var DebugEntry: PDebugEntry);
- procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
- procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
- procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
- procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
- procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
- procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
- procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
- procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
- procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
- procedure WMDPIChanged(var Message: TMessage); message WM_DPICHANGED;
- procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
- procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
- procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
- procedure WMUAHDrawMenu(var Message: TMessage); message WM_UAHDRAWMENU;
- procedure WMUAHDrawMenuItem(var Message: TMessage); message WM_UAHDRAWMENUITEM;
- procedure UAHDrawMenuBottomLine;
- procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
- procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
- protected
- procedure WndProc(var Message: TMessage); override;
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function IsShortCut(var Message: TWMKey): Boolean; override;
- published
- property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle;
- end;
- var
- MainForm: TMainForm;
- CommandLineFilename, CommandLineWizardName: String;
- CommandLineCompile: Boolean;
- CommandLineWizard: Boolean;
- implementation
- uses
- ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Themes,
- Math, StrUtils, WideStrUtils, TypInfo,
- PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, IDE.Messages, NewUxTheme.TmSchema, BrowseFunc,
- IDE.HtmlHelpFunc, TaskbarProgressFunc, IDE.ImagesModule,
- {$IFDEF STATICCOMPILER} Compiler.Compile, {$ENDIF}
- IDE.OptionsForm, IDE.StartupForm, IDE.Wizard.WizardForm, IDE.SignToolsForm,
- Shared.ConfigIniFile, Shared.SignToolsFunc, IDE.InputQueryComboForm, IDE.MsgBoxDesignerForm,
- IDE.FilesDesignerForm, IDE.RegistryDesignerForm, IDE.Wizard.WizardFormRegistryHelper,
- Shared.CompilerInt;
- {$R *.DFM}
- const
- { Memos }
- MaxMemos = 22; { Includes the main and preprocessor output memos }
- FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos }
- { Status bar panel indexes }
- spCaretPos = 0;
- spModified = 1;
- spEditMode = 2;
- spFindRegEx = 3;
- spHiddenFilesCount = 4;
- spCompileIcon = 5;
- spCompileProgress = 6;
- spExtraStatus = 7;
- { Output tab set indexes }
- tiCompilerOutput = 0;
- tiDebugOutput = 1;
- tiDebugCallStack = 2;
- tiFindResults = 3;
- LineStateGrowAmount = 4000;
- { TUpdatePanelMessage }
- constructor TUpdatePanelMessage.Create(const AMsg, AConfigIdent: String;
- const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
- begin
- Msg := AMsg;
- ConfigIdent := AConfigIdent;
- ConfigValue := AConfigValue;
- Color := AColor;
- HasLink := AHasLink;
- end;
- { TMainFormPopupMenu }
- type
- TMainFormPopupMenu = class(TPopupMenu)
- private
- FParentMenuItem: TMenuItem;
- public
- constructor Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); reintroduce; virtual;
- procedure Popup(X, Y: Integer); override;
- end;
- constructor TMainFormPopupMenu.Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem);
- begin
- inherited Create(AOwner);
- FParentMenuItem := ParentMenuItem;
- end;
- procedure TMainFormPopupMenu.Popup(X, Y: Integer);
- var
- Form: TMainForm;
- begin
- { Show the existing main menu's submenu }
- Form := Owner as TMainForm;
- var OldVisible := FParentMenuItem.Visible; { See ApplyMenuBitmaps }
- FParentMenuItem.Visible := True;
- try
- TrackPopupMenu(FParentMenuItem.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil);
- finally
- FParentMenuItem.Visible := OldVisible;
- end;
- end;
- { TMainForm }
- function TMainForm.InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- begin
- Memo.Align := alClient;
- Memo.Font.Name := GetPreferredMemoFont; { Default font only, see ReadConfig }
- Memo.Font.Size := 10;
- Memo.ShowHint := True;
- Memo.Styler := FMemosStyler;
- Memo.PopupMenu := PopupMenu;
- Memo.OnCallTipArrowClick := MemoCallTipArrowClick;
- Memo.OnChange := MemoChange;
- Memo.OnCharAdded := MemoCharAdded;
- Memo.OnHintShow := MemoHintShow;
- Memo.OnKeyDown := MemoKeyDown;
- Memo.OnKeyPress := MemoKeyPress;
- Memo.OnMarginClick := MemoMarginClick;
- Memo.OnMarginRightClick := MemoMarginRightClick;
- Memo.OnModifiedChange := MemoModifiedChange;
- Memo.OnUpdateUI := MemoUpdateUI;
- Memo.OnZoom := MemoZoom;
- Memo.Parent := BodyPanel;
- Memo.SetAutoCompleteSeparators(InnoSetupStylerWordListSeparator, InnoSetupStylerWordListTypeSeparator);
- Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]');
- Memo.Theme := FTheme;
- Memo.StyleName := 'Windows';
- Memo.Visible := False;
- Result := Memo;
- end;
- function TMainForm.InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- begin
- InitializeMemoBase(Memo, PopupMenu);
- Memo.ChangeHistory := schMarkers;
- Memo.CompilerFileIndex := UnknownCompilerFileIndex;
- Memo.ErrorLine := -1;
- Memo.StepLine := -1;
- Result := Memo;
- end;
- function TMainForm.InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- begin
- InitializeFileMemo(Memo, PopupMenu);
- Memo.AcceptDroppedFiles := True;
- Memo.CompilerFileIndex := -1;
- Memo.OnDropFiles := MainMemoDropFiles;
- Memo.Used := True;
- Result := Memo;
- end;
- function TMainForm.InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- begin
- InitializeMemoBase(Memo, PopupMenu);
- Memo.ReadOnly := True;
- Result := Memo;
- end;
- constructor TMainForm.Create(AOwner: TComponent);
- procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
- const ConfigValueDefault, ConfigValueMinimum: Integer; const Msg: String; const Color: TColor;
- const AHasLink: Boolean);
- begin
- var ConfigValue := Ini.ReadInteger('UpdatePanel', ConfigIdent, ConfigValueDefault);
- if ConfigValue < ConfigValueMinimum then
- FUpdatePanelMessages.Add(TUpdatePanelMessage.Create(Msg, ConfigIdent, ConfigValueMinimum, Color,
- AHasLink));
- end;
- procedure ReadConfig;
- var
- Ini: TConfigIniFile;
- WindowPlacement: TWindowPlacement;
- I: Integer;
- Memo: TIDEScintEdit;
- begin
- Ini := TConfigIniFile.Create;
- try
- { Menu check boxes state }
- ToolbarPanel.Visible := Ini.ReadBool('Options', 'ShowToolbar', True);
- StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True);
- FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False);
- { Configuration options }
- FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True);
- FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True);
- FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False);
- FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False);
- FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False);
- FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True);
- FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True);
- FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False);
- FOptions.AutoAutoComplete := Ini.ReadBool('Options', 'AutoComplete', True);
- FOptions.AutoCallTips := Ini.ReadBool('Options', 'AutoCallTips', True);
- FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True);
- FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True);
- FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True);
- FOptions.HighlightWordAtCursorOccurrences := Ini.ReadBool('Options', 'HighlightWordAtCursorOccurrences', False);
- FOptions.HighlightSelTextOccurrences := Ini.ReadBool('Options', 'HighlightSelTextOccurrences', True);
- FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', False);
- FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2);
- FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False);
- FOptions.ShowWhiteSpace := Ini.ReadBool('Options', 'ShowWhiteSpace', False);
- FOptions.UseFolding := Ini.ReadBool('Options', 'UseFolding', True);
- FOptions.FindRegEx := Ini.ReadBool('Options', 'FindRegEx', False);
- FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False);
- FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True);
- FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True);
- FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False);
- FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True);
- FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True);
- I := Ini.ReadInteger('Options', 'KeyMappingType', Ord(GetDefaultKeyMappingType));
- if (I >= 0) and (I <= Ord(High(TKeyMappingType))) then
- FOptions.KeyMappingType := TKeyMappingType(I);
- I := Ini.ReadInteger('Options', 'MemoKeyMappingType', Ord(GetDefaultMemoKeyMappingType));
- if (I >= 0) and (I <= Ord(High(TIDEScintKeyMappingType))) then
- FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(I);
- I := Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType));
- if (I >= 0) and (I <= Ord(High(TThemeType))) then
- FOptions.ThemeType := TThemeType(I);
- FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name);
- FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', 10);
- FMainMemo.Font.Charset := Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
- FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0); { MemoZoom will zoom the other memos }
- for Memo in FMemos do
- if Memo <> FMainMemo then
- Memo.Font := FMainMemo.Font;
- { UpdatePanel visibility }
- CheckUpdatePanelMessage(Ini, 'KnownVersion', 0, Integer(FCompilerVersion.BinVersion),
- 'Your version of Inno Setup has been updated! <a id="hwhatsnew">See what''s new</a>.',
- $ABE3AB, True); //MGreen with HSL lightness changed from 40% to 78%
- CheckUpdatePanelMessage(Ini, 'VSCodeMemoKeyMap', 0, 1,
- 'VS Code-style editor shortcuts added! Use the <a id="toptions-vscode">Editor Keys option</a> in Options dialog.',
- $FFD399, True); //MBlue with HSL lightness changed from 42% to 80%
- UpdateUpdatePanel;
- { Debug options }
- FOptions.ShowCaretPosition := Ini.ReadBool('Options', 'ShowCaretPosition', False);
- if FOptions.ShowCaretPosition then begin
- StatusBar.Panels[spCaretPos].Width := MulDiv(StatusBar.Panels[spCaretPos].Width, 7, 2);
- StatusBar.Panels[spCaretPos].Alignment := taLeftJustify;
- end;
- SyncEditorOptions;
- UpdateNewMainFileButtons;
- UpdateKeyMapping;
- UpdateTheme;
- UpdateFindRegExUI;
- { Window state }
- WindowPlacement.length := SizeOf(WindowPlacement);
- GetWindowPlacement(Handle, @WindowPlacement);
- WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet }
- WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State',
- 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
- WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State',
- 'WindowTop', WindowPlacement.rcNormalPosition.Top);
- WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State',
- 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width);
- WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State',
- 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height);
- SetWindowPlacement(Handle, @WindowPlacement);
- { Note: Must set WindowState *after* calling SetWindowPlacement, since
- TCustomForm.WMSize resets WindowState }
- if Ini.ReadBool('State', 'WindowMaximized', False) then
- WindowState := wsMaximized;
- { Note: Don't call UpdateStatusPanelHeight here since it clips to the
- current form height, which hasn't been finalized yet }
- { StatusPanel height }
- StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight',
- (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height)));
- finally
- Ini.Free;
- end;
- FOptionsLoaded := True;
- end;
- var
- I: Integer;
- NewItem: TMenuItem;
- PopupMenu: TPopupMenu;
- Memo: TIDEScintEdit;
- begin
- inherited;
- {$IFNDEF STATICCOMPILER}
- FCompilerVersion := ISDllGetVersion;
- {$ELSE}
- FCompilerVersion := ISGetVersion;
- {$ENDIF}
- FModifiedAnySinceLastCompile := True;
- InitFormFont(Self);
- FHighContrastActive := HighContrastActive; { Just checking once at startup }
- if FHighContrastActive then begin
- { If UseVisualStyle is False (LWS_USEVISUALSTYLE is off) the regular text of the label does not
- follow any high contrast theme but stays black instead, which is likely to be invisible.
- Setting it to True makes all text (regular and link) to get the COLOR_HOTLIGHT color. }
- UpdateLinkLabel.UseVisualStyle := True;
- { COLOR_WINDOW is documented as the associated background color of COLOR_HOTLIGHT }
- UpdatePanel.Color := GetSysColor(COLOR_WINDOW);
- end;
- { For some reason, if AutoScroll=False is set on the form Delphi ignores the
- 'poDefault' Position setting }
- AutoScroll := False;
- { Append the shortcut key text to the Edit items. Don't actually set the
- ShortCut property because we don't want the key combinations having an
- effect when Memo doesn't have the focus. }
- SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]);
- SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]);
- SetFakeShortCut(ECut, Ord('X'), [ssCtrl]);
- SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]);
- SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]);
- SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]);
- SetFakeShortCut(EDelete, VK_DELETE, []);
- SetFakeShortCutText(VZoomIn, SmkcCtrl + 'Num +'); { These zoom shortcuts are handled by Scintilla and only support the active memo, unlike the menu items which work on all memos }
- SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -');
- SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /');
- { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the
- editor's autocompletion list }
- SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
- { Use fake Ctrl+F4 shortcut for VCloseCurrentTab2 because VCloseCurrentTab
- already has the real one }
- SetFakeShortCut(VCloseCurrentTab2, VK_F4, [ssCtrl]);
- { Use fake Ctrl+C and Ctrl+A shortcuts for OutputListPopupMenu's items so they
- don't conflict with the editor which also uses fake shortcuts for these }
- SetFakeShortCut(POutputListCopy, Ord('C'), [ssCtrl]);
- SetFakeShortCut(POutputListSelectAll, Ord('A'), [ssCtrl]);
- { Set real shortcut on TOptions which can't be set at design time }
- TOptions.ShortCut := ShortCut(VK_OEM_COMMA, [ssCtrl]);
- PopupMenu := TMainFormPopupMenu.Create(Self, EMenu);
- FMemosStyler := TInnoSetupStyler.Create(Self);
- FMemosStyler.ISPPInstalled := ISPPInstalled;
- FTheme := TTheme.Create;
- InitFormThemeInit(FTheme);
- MemosTabSet.Theme := FTheme;
- OutputTabSet.Theme := FTheme;
- ToolBarPanel.ParentBackground := False;
- UpdatePanel.ParentBackground := False;
- UpdatePanelDonateImage.Hint := RemoveAccelChar(HDonate.Caption);
- UpdateImages;
- FMemos := TList<TIDEScintEdit>.Create;
- FMainMemo := InitializeMainMemo(TIDEScintFileEdit.Create(Self), PopupMenu);
- FMemos.Add(FMainMemo);
- FPreprocessorOutputMemo := InitializeNonFileMemo(TIDEScintEdit.Create(Self), PopupMenu);
- FMemos.Add(FPreprocessorOutputMemo);
- for I := FMemos.Count to MaxMemos-1 do
- FMemos.Add(InitializeFileMemo(TIDEScintFileEdit.Create(Self), PopupMenu));
- FFileMemos := TList<TIDEScintFileEdit>.Create;
- for Memo in FMemos do
- if Memo is TIDEScintFileEdit then
- FFileMemos.Add(TIDEScintFileEdit(Memo));
- FHiddenFiles := TStringList.Create(dupError, True, True);
- FActiveMemo := FMainMemo;
- FActiveMemo.Visible := True;
- FErrorMemo := FMainMemo;
- FStepMemo := FMainMemo;
- UpdateMarginsAndSquigglyAndCaretWidths;
- FMemosStyler.Theme := FTheme;
- MemosTabSet.PopupMenu := TMainFormPopupMenu.Create(Self, MemosTabSetPopupMenu);
- FFirstTabSelectShortCut := ShortCut(Ord('1'), [ssCtrl]);
- FLastTabSelectShortCut := ShortCut(Ord('9'), [ssCtrl]);
- FNavStacks := TIDEScintEditNavStacks.Create;
- UpdateNavButtons;
- FCurrentNavItem.Invalidate;
- BackNavButton.Style := tbsDropDown;
- BackNavButton.DropdownMenu := TMainFormPopupMenu.Create(Self, NavPopupMenu);
- PopupMenu := TMainFormPopupMenu.Create(Self, OutputListPopupMenu);
- CompilerOutputList.PopupMenu := PopupMenu;
- DebugOutputList.PopupMenu := PopupMenu;
- DebugCallStackList.PopupMenu := PopupMenu;
- FindResultsList.PopupMenu := PopupMenu;
- UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- Application.HintShortPause := 0;
- Application.OnException := AppOnException;
- Application.OnActivate := AppOnActivate;
- Application.OnIdle := AppOnIdle;
- FMRUMainFilesList := TStringList.Create;
- for I := 0 to High(FMRUMainFilesMenuItems) do begin
- NewItem := TMenuItem.Create(Self);
- NewItem.OnClick := FMRUClick;
- FRecent.Insert(I, NewItem);
- FMRUMainFilesMenuItems[I] := NewItem;
- end;
- FMRUParametersList := TStringList.Create;
- FSignTools := TStringList.Create;
- FFindResults := TFindResults.Create;
- FIncludedFiles := TIncludedFiles.Create;
- UpdatePreprocMemos;
- FDebugTarget := dtSetup;
- UpdateTargetMenu;
- UpdateCaption;
- FMenuDarkBackgroundBrush := TBrush.Create;
- FMenuDarkHotOrSelectedBrush := TBrush.Create;
- LightToolbarVirtualImageList.AutoFill := True;
- ThemedMarkersAndACVirtualImageList.AutoFill := True;
- UpdateThemeData(True);
-
- FMenuBitmaps := TMenuBitmaps.Create;
- FMenuBitmapsSize.cx := 0;
- FMenuBitmapsSize.cy := 0;
- FKeyMappedMenus := TKeyMappedMenus.Create;
- FCallTipState.MaxCallTips := 1; { Just like SciTE 5.50 }
- FUpdatePanelMessages := TUpdatePanelMessages.Create;
- if CommandLineCompile then begin
- ReadSignTools(FSignTools);
- PostMessage(Handle, WM_StartCommandLineCompile, 0, 0)
- end else if CommandLineWizard then begin
- { Stop Delphi from showing the compiler form }
- Application.ShowMainForm := False;
- { Show wizard form later }
- PostMessage(Handle, WM_StartCommandLineWizard, 0, 0);
- end else begin
- ReadConfig; { Calls UpdateTheme }
- ReadSignTools(FSignTools);
- PostMessage(Handle, WM_StartNormally, 0, 0);
- end;
- end;
- destructor TMainForm.Destroy;
- procedure SaveConfig;
- var
- Ini: TConfigIniFile;
- WindowPlacement: TWindowPlacement;
- begin
- Ini := TConfigIniFile.Create;
- try
- { Theme state - can change without opening the options }
- Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick }
- { Menu check boxes state }
- Ini.WriteBool('Options', 'ShowToolbar', ToolbarPanel.Visible);
- Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible);
- Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile);
- { Window state }
- WindowPlacement.length := SizeOf(WindowPlacement);
- GetWindowPlacement(Handle, @WindowPlacement);
- Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
- Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top);
- Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right);
- Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom);
- { The GetWindowPlacement docs claim that "flags" is always zero.
- Fortunately, that's wrong. WPF_RESTORETOMAXIMIZED is set when the
- window is either currently maximized, or currently minimized from a
- previous maximized state. }
- Ini.WriteBool('State', 'WindowMaximized', WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0);
- Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height));
- { Zoom state }
- Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom }
- finally
- Ini.Free;
- end;
- end;
- begin
- UpdateThemeData(False);
- Application.OnActivate := nil;
- Application.OnIdle := nil;
- if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then
- SaveConfig;
- if FDevMode <> 0 then
- GlobalFree(FDevMode);
- if FDevNames <> 0 then
- GlobalFree(FDevNames);
- FUpdatePanelMessages.Free;
- FNavStacks.Free;
- FKeyMappedMenus.Free;
- FMenuBitmaps.Free;
- FMenuDarkBackgroundBrush.Free;
- FMenuDarkHotOrSelectedBrush.Free;
- FTheme.Free;
- DestroyDebugInfo;
- FIncludedFiles.Free;
- FFindResults.Free;
- FSignTools.Free;
- FMRUParametersList.Free;
- FMRUMainFilesList.Free;
- FFileMemos.Free;
- FHiddenFiles.Free;
- FMemos.Free;
- inherited;
- end;
- function TMainForm.GetBorderStyle: TFormBorderStyle;
- begin
- Result := inherited BorderStyle;
- end;
- procedure TMainForm.SetBorderStyle(Value: TFormBorderStyle);
- begin
- { Hack: To stop the Delphi IDE from adding Explicit* properties to the .dfm
- file every time the unit is saved, we set BorderStyle=bsNone on the form.
- At run-time, ignore that setting so that BorderStyle stays at the default
- value, bsSizeable.
- It would be simpler to change BorderStyle from bsNone to bsSizeable in the
- form's constructor, but it doesn't quite work: when a form's handle is
- created while BorderStyle=bsNone, Position=poDefault behaves like
- poDefaultPosOnly (see TCustomForm.CreateParams). }
- if Value <> bsNone then
- inherited BorderStyle := Value;
- end;
- class procedure TMainForm.AppOnException(Sender: TObject; E: Exception);
- begin
- AppMessageBox(PChar(AddPeriod(E.Message)), SCompilerFormCaption,
- MB_OK or MB_ICONSTOP);
- end;
- class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND);
- begin
- { As of Delphi 11.3, the default code in TApplication.GetActiveFormHandle
- (which runs after this handler) calls GetActiveWindow, and if that returns
- 0, it calls GetLastActivePopup(Application.Handle).
- The problem is that when the application isn't in the foreground,
- GetActiveWindow returns 0, and when MainFormOnTaskBar=True, the
- GetLastActivePopup call normally just returns Application.Handle (since
- there are no popups owned by the application window).
- So if the application calls Application.MessageBox while it isn't in the
- foreground, that message box will be owned by Application.Handle, not by
- the last-active window as it should be. That can lead to the message box
- falling behind the main form in z-order.
- To rectify that, when no window is active and MainFormOnTaskBar=True, we
- fall back to returning the handle of the main form's last active popup,
- which is the window that would be activated if the main form's taskbar
- button were clicked. (If Application.Handle is active, we treat that the
- same as no active window because Application.Handle shouldn't be the owner
- of any windows when MainFormOnTaskBar=True.)
- If there is no assigned main form or if MainFormOnTaskBar=False, then we
- fall back to the default handling. }
- if Application.MainFormOnTaskBar then begin
- AHandle := GetActiveWindow;
- if ((AHandle = 0) or (AHandle = Application.Handle)) and
- Assigned(Application.MainForm) and
- Application.MainForm.HandleAllocated then
- AHandle := GetLastActivePopup(Application.MainFormHandle);
- end;
- end;
- procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
- NewDPI: Integer);
- begin
- UpdateImages;
- UpdateMarginsAndAutoCompleteIcons;
- UpdateMarginsAndSquigglyAndCaretWidths;
- UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- UpdateStatusPanelHeight(StatusPanel.Height);
- end;
- procedure TMainForm.FormCloseQuery(Sender: TObject;
- var CanClose: Boolean);
- begin
- if IsWindowEnabled(Handle) then
- CanClose := ConfirmCloseFile(True)
- else
- { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message
- is received. Don't display message box if a modal dialog is already
- displayed. }
- CanClose := False;
- end;
- procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure AddControlToArray(const ControlToAdd: TWinControl; var Controls: TArray<TWinControl>;
- var NControls: Integer);
- begin
- Inc(NControls);
- SetLength(Controls, NControls);
- Controls[NControls-1] := ControlToAdd;
- end;
- begin
- var AShortCut := ShortCut(Key, Shift);
- if (AShortCut = VK_ESCAPE) and BStopCompile.Enabled then begin
- Key := 0; { Intentionally only done when BStopCompile is enabled to allow the memo to process it instead }
- BStopCompileClick(Self)
- end else if (AShortCut = FBackNavButtonShortCut) or
- ((FBackNavButtonShortCut2 <> 0) and (AShortCut = FBackNavButtonShortCut2)) then begin
- Key := 0;
- if BackNavButton.Enabled then
- BackNavButtonClick(Self);
- end else if (AShortCut = FForwardNavButtonShortCut) or
- ((FForwardNavButtonShortCut2 <> 0) and (AShortCut = FForwardNavButtonShortCut2)) then begin
- Key := 0;
- if ForwardNavButton.Enabled then
- ForwardNavButtonClick(Self);
- end else if (AShortCut >= FFirstTabSelectShortCut) and (AShortCut <= FLastTabSelectShortCut) then begin
- Key := 0;
- if MemosTabSet.Visible then begin
- var TabIndex := AShortCut - FFirstTabSelectShortCut;
- if TabIndex < 8 then begin
- if TabIndex < MemosTabSet.Tabs.Count then
- MemosTabSet.TabIndex := TabIndex;
- end else { Ctrl+9 = Select last tab }
- MemosTabSet.TabIndex := MemosTabSet.Tabs.Count-1;
- end;
- end else if AShortCut = FCompileShortCut2 then begin
- Key := 0;
- if BCompile.Enabled then
- BCompileClick(Self);
- end else if (Key = VK_F6) and not (ssAlt in Shift) then begin
- { Move focus between the active memo, the active bottom pane, and the active banner }
- Key := 0;
- { First get the list of controls to toggle between }
- var Controls: TArray<TWinControl> := [FActiveMemo];
- var NControls := Length(Controls);
- if StatusPanel.Visible then begin
- var ControlToAdd: TWinControl := nil;
- case OutputTabSet.TabIndex of
- tiCompilerOutput: ControlToAdd := CompilerOutputList;
- tiDebugOutput: ControlToAdd := DebugOutputList;
- tiDebugCallStack: ControlToAdd := DebugCallStackList;
- tiFindResults: ControlToAdd := FindResultsList;
- end;
- if ControlToAdd <> nil then
- AddControlToArray(ControlToAdd, Controls, NControls);
- end;
- if UpdatePanel.Visible and FUpdatePanelMessages[UpdateLinkLabel.Tag].HasLink then
- AddControlToArray(UpdateLinkLabel, Controls, NControls);
- { Now move focus to next }
- if NControls > 1 then begin
- for var I := 0 to NControls-1 do begin
- if ActiveControl = Controls[I] then begin
- if I = NControls-1 then
- ActiveControl := Controls[0]
- else
- ActiveControl := Controls[I+1];
- Exit;
- end;
- end;
- end;
- { Didn't move }
- if ActiveControl <> FActiveMemo then
- ActiveControl := FActiveMemo;
- end;
- end;
- procedure TMainForm.MemoKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure SimplifySelection(const AMemo: TIDEScintEdit);
- begin
- { The built in Esc (SCI_CANCEL) simply drops all additional selections
- and does not empty the main selection, It doesn't matter if Esc is
- pressed once or twice. Implement our own behaviour, same as VSCode.
- Also see https://github.com/microsoft/vscode/issues/118835. }
- if AMemo.SelectionCount > 1 then
- AMemo.RemoveAdditionalSelections
- else if not AMemo.SelEmpty then
- AMemo.SetEmptySelection;
- AMemo.ScrollCaretIntoView;
- end;
- procedure AddCursor(const AMemo: TIDEScintEdit; const Up: Boolean);
- begin
- { Does not try to keep the main selection. }
- var Selections: TScintCaretAndAnchorList := nil;
- var VirtualSpaces: TScintCaretAndAnchorList := nil;
- try
- Selections := TScintCaretAndAnchorList.Create;
- VirtualSpaces := TScintCaretAndAnchorList.Create;
- { Get all the virtual spaces as well before we start doing modifications }
- AMemo.GetSelections(Selections, VirtualSpaces);
- for var I := 0 to Selections.Count-1 do begin
- var Selection := Selections[I];
- var LineCaret := AMemo.GetLineFromPosition(Selection.CaretPos);
- var LineAnchor := AMemo.GetLineFromPosition(Selection.AnchorPos);
- if LineCaret = LineAnchor then begin
- { Add selection with same caret and anchor offsets one line up or down. }
- var OtherLine := LineCaret + IfThen(Up, -1, 1);;
- if (OtherLine < 0) or (OtherLine >= AMemo.Lines.Count) then
- Continue { Already at the top or bottom, can't add }
- else begin
- var LineStartPos := AMemo.GetPositionFromLine(LineCaret);
- var CaretCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.CaretPos) + VirtualSpaces[I].CaretPos;
- var AnchorCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.AnchorPos) + VirtualSpaces[I].AnchorPos;
- var OtherLineStart := AMemo.GetPositionFromLine(OtherLine);
- var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine));
- var NewCaretCharacterCount := CaretCharacterCount;
- var NewCaretVirtualSpace := 0;
- var NewAnchorCharacterCount := AnchorCharacterCount;
- var NewAnchorVirtualSpace := 0;
- if NewCaretCharacterCount > MaxCharacterCount then begin
- NewCaretVirtualSpace := NewCaretCharacterCount - MaxCharacterCount;
- NewCaretCharacterCount := MaxCharacterCount;
- end;
- if NewAnchorCharacterCount > MaxCharacterCount then begin
- NewAnchorVirtualSpace := NewAnchorCharacterCount - MaxCharacterCount;
- NewAnchorCharacterCount := MaxCharacterCount;
- end;
- var NewSelection: TScintCaretAndAnchor;
- NewSelection.CaretPos := AMemo.GetPositionRelative(OtherLineStart, NewCaretCharacterCount);
- NewSelection.AnchorPos := AMemo.GetPositionRelative(OtherLineStart, NewAnchorCharacterCount);
- { AddSelection trims selections except for the main selection so
- we need to check that ourselves unfortunately. Not doing a check
- gives a problem when you AddCursor two times starting with an
- empty single selection. The result will be 4 cursors, with 2 of
- them in the same place. The check below fixes this but not
- other cases when there's only partial overlap and Scintilla still
- behaves weird. The check also doesn't handle virtual space which
- is why we ultimately don't set virtual space: it leads to duplicate
- selections. }
- var MainSelection := AMemo.Selection;
- if not NewSelection.Range.Within(AMemo.Selection) then begin
- AMemo.AddSelection(NewSelection.CaretPos, NewSelection.AnchorPos);
- { if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then begin
- var MainSel := AMemo.MainSelection;
- AMemo.SelectionCaretVirtualSpace[MainSel] := NewCaretVirtualSpace;
- AMemo.SelectionAnchorVirtualSpace[MainSel] := NewAnchorVirtualSpace;
- end; }
- end;
- end;
- end else begin
- { Extend multiline selection up or down. This is not the same as
- LineExtendUp/Down because those can shrink instead of extend. }
- var CaretBeforeAnchor := Selection.CaretPos < Selection.AnchorPos;
- var Down := not Up;
- var LineStartOrEnd, StartOrEndPos, VirtualSpace: Integer;
- { Does it start (when going up) or end (when going down) at the caret or the anchor? }
- if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin
- LineStartOrEnd := LineCaret;
- StartOrEndPos := Selection.CaretPos;
- VirtualSpace := VirtualSpaces[I].CaretPos;
- end else begin
- LineStartOrEnd := LineAnchor;
- StartOrEndPos := Selection.AnchorPos;
- VirtualSpace := VirtualSpaces[I].AnchorPos;
- end;
- var NewStartOrEndPos: Integer;
- var NewVirtualSpace := 0;
- { Go up or down one line or to the start or end of the document }
- if (Up and (LineStartOrEnd > 0)) or (Down and (LineStartOrEnd < AMemo.Lines.Count-1)) then begin
- var CharacterCount := AMemo.GetCharacterCount(AMemo.GetPositionFromLine(LineStartOrEnd), StartOrEndPos) + VirtualSpace;
- var OtherLine := LineStartOrEnd + IfThen(Up, -1, 1);
- var OtherLineStart := AMemo.GetPositionFromLine(OtherLine);
- var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine));
- var NewCharacterCount := CharacterCount;
- if NewCharacterCount > MaxCharacterCount then begin
- NewVirtualSpace := NewCharacterCount - MaxCharacterCount;
- NewCharacterCount := MaxCharacterCount;
- end;
- NewStartOrEndPos := AMemo.GetPositionRelative(OtherLineStart, NewCharacterCount);
- end else
- NewStartOrEndPos := IfThen(Up, 0, AMemo.GetPositionFromLine(AMemo.Lines.Count));
- { Move the caret or the anchor up or down to extend the selection }
- if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin
- AMemo.SelectionCaretPosition[I] := NewStartOrEndPos;
- if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then
- AMemo.SelectionCaretVirtualSpace[I] := NewVirtualSpace;
- end else begin
- AMemo.SelectionAnchorPosition[I] := NewStartOrEndPos;
- if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then
- AMemo.SelectionAnchorVirtualSpace[I] := NewVirtualSpace;
- end;
- end;
- end;
- finally
- VirtualSpaces.Free;
- Selections.Free;
- end;
- end;
- procedure AddCursorsToLineEnds(const AMemo: TIDEScintEdit);
- begin
- { Does not try to keep the main selection. Otherwise behaves the same as
- observed in Visual Studio Code, see comments. }
- var Selections: TScintCaretAndAnchorList := nil;
- var VirtualSpaces: TScintCaretAndAnchorList := nil;
- try
- Selections := TScintCaretAndAnchorList.Create;
- VirtualSpaces := TScintCaretAndAnchorList.Create;
- AMemo.GetSelections(Selections, VirtualSpaces);
- { First remove all empty selections }
- for var I := Selections.Count-1 downto 0 do begin
- var Selection := Selections[I];
- var VirtualSpace := VirtualSpaces[I];
- if (Selection.CaretPos + VirtualSpace.CaretPos) =
- (Selection.AnchorPos + VirtualSpace.AnchorPos) then begin
- Selections.Delete(I);
- VirtualSpaces.Delete(I);
- end;
- end;
- { If all selections were empty do nothing }
- if Selections.Count = 0 then
- Exit;
- { Handle non empty selections }
- for var I := Selections.Count-1 downto 0 do begin
- var Selection := Selections[I];
- var Line1 := AMemo.GetLineFromPosition(Selection.CaretPos);
- var Line2 := AMemo.GetLineFromPosition(Selection.AnchorPos);
- var SelSingleLine := Line1 = Line2;
- if SelSingleLine then begin
- { Single line selections are updated into empty selection at end of selection }
- var VirtualSpace := VirtualSpaces[I];
- if Selection.CaretPos + VirtualSpace.CaretPos > Selection.AnchorPos + VirtualSpace.AnchorPos then begin
- Selection.AnchorPos := Selection.CaretPos;
- VirtualSpace.AnchorPos := VirtualSpace.CaretPos;
- end else begin
- Selection.CaretPos := Selection.AnchorPos;
- VirtualSpace.CaretPos := VirtualSpace.AnchorPos;
- end;
- Selections[I] := Selection;
- VirtualSpaces[I] := VirtualSpace;
- end else begin
- { Multiline selections are replaced by empty selections at each end of line }
- if Line1 > Line2 then begin
- var TmpLine := Line1;
- Line1 := Line2;
- Line2 := TmpLine;
- end;
- { Ignore last line if the selection doesn't really select anything on that line }
- if Selection.Range.EndPos = AMemo.GetPositionFromLine(Line2) then
- Dec(Line2);
- for var Line := Line1 to Line2 do begin
- Selection.CaretPos := AMemo.GetLineEndPosition(Line);
- Selection.AnchorPos := Selection.CaretPos;
- Selections.Add(Selection);
- VirtualSpaces.Add(TScintCaretAndAnchor.Create(0, 0));
- end;
- Selections.Delete(I);
- VirtualSpaces.Delete(I);
- end;
- end;
- { Send updated selections to memo }
- for var I := 0 to Selections.Count-1 do begin
- var Selection := Selections[I];
- var VirtualSpace := VirtualSpaces[I];
- if I = 0 then
- AMemo.SetSingleSelection(Selection.CaretPos, Selection.AnchorPos)
- else
- AMemo.AddSelection(Selection.CaretPos, Selection.AnchorPos);
- AMemo.SelectionCaretVirtualSpace[I] := VirtualSpaces[I].CaretPos;
- AMemo.SelectionAnchorVirtualSpace[I] := VirtualSpaces[I].AnchorPos;
- end;
- finally
- VirtualSpaces.Free;
- Selections.Free;
- end;
- end;
- begin
- if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then begin
- var Memo := Sender as TIDEScintEdit;
- { Make sure we don't break the special rectangular select shortcuts }
- if Shift * [ssShift, ssAlt, ssCtrl] <> Memo.GetRectExtendShiftState(True) then begin
- if Memo.SelectionMode in [ssmRectangular, ssmThinRectangular] then begin
- { Allow left/right/etc. navigation with rectangular selection, see
- https://sourceforge.net/p/scintilla/feature-requests/1275/ and
- https://sourceforge.net/p/scintilla/bugs/2412/#cb37
- Notepad++ calls this "Enable Column Selection to Multi-editing" which
- is on by default and in VSCode and VS it's also on by default. }
- Memo.SelectionMode := ssmStream;
- end;
- end;
- { Key is not cleared to allow Scintilla to do the actual handling }
- end;
- if Key = VK_F1 then begin
- Key := 0;
- var HelpFile := GetHelpFile;
- if Assigned(HtmlHelp) then begin
- HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0);
- var S := FActiveMemo.WordAtCaret;
- if S <> '' then begin
- var KLink: THH_AKLINK;
- FillChar(KLink, SizeOf(KLink), 0);
- KLink.cbStruct := SizeOf(KLink);
- KLink.pszKeywords := PChar(S);
- KLink.fIndexOnFail := True;
- HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD(@KLink));
- end;
- end;
- end else if ((Key = Ord('V')) or (Key = VK_INSERT)) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
- if FActiveMemo.CanPaste then
- if MultipleSelectionPasteFromClipboard(FActiveMemo) then
- Key := 0;
- end else if (Key = VK_SPACE) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssShift, ssCtrl]) then begin
- Key := 0;
- { Based on SciTE 5.50's SciTEBase::MenuCommand IDM_SHOWCALLTIP }
- if FActiveMemo.CallTipActive then begin
- FCallTipState.CurrentCallTip := IfThen(FCallTipState.CurrentCallTip + 1 = FCallTipState.MaxCallTips, 0, FCallTipState.CurrentCallTip + 1);
- UpdateCallTipFunctionDefinition;
- end else begin
- FCallTipState.BraceCount := 1; { Missing in SciTE, see https://sourceforge.net/p/scintilla/bugs/2446/ }
- InitiateCallTip(#0);
- end;
- end else begin
- var AShortCut := ShortCut(Key, Shift);
- { Check if the memo keymap wants us to handle the shortcut but first check
- the menu keymap didn't already claim the same shortcut. Other shortcuts
- (which are always same and not set by the menu keymap) are assumed to
- never conflict. }
- if not FKeyMappedMenus.ContainsKey(AShortCut) then begin
- var ComplexCommand := FActiveMemo.GetComplexCommand(AShortCut);
- if ComplexCommand <> ccNone then begin
- if Key <> VK_ESCAPE then { Allow Scintilla to see Esc }
- Key := 0;
- case ComplexCommand of
- ccSelectNextOccurrence:
- ESelectNextOccurrenceClick(Self);
- ccSelectAllOccurrences:
- ESelectAllOccurrencesClick(Self);
- ccSelectAllFindMatches:
- ESelectAllFindMatchesClick(Self);
- ccFoldLine:
- EFoldOrUnfoldLineClick(EFoldLine);
- ccUnfoldLine:
- EFoldOrUnfoldLineClick(EUnfoldLine);
- ccSimplifySelection:
- SimplifySelection(FActiveMemo);
- ccToggleLinesComment:
- EToggleLinesCommentClick(Self); //GetCompexCommand already checked ReadOnly for us
- ccAddCursorUp, ccAddCursorDown:
- AddCursor(FActiveMemo, ComplexCommand = ccAddCursorUp);
- ccBraceMatch:
- EBraceMatchClick(Self);
- ccAddCursorsToLineEnds:
- AddCursorsToLineEnds(FActiveMemo);
- else
- raise Exception.Create('Unknown ComplexCommand');
- end;
- end;
- end;
- end;
- end;
- procedure TMainForm.MemoKeyPress(Sender: TObject; var Key: Char);
- begin
- if ((Key = #9) or (Key = ' ')) and (GetKeyState(VK_CONTROL) < 0) then begin
- { About #9, as Wikipedia explains: "The most known and common tab is a
- horizontal tabulation <..> and may be referred to as Ctrl+I." Ctrl+I is
- (just like in Visual Studio Code) our alternative code completion character
- because Ctrl+Space is used by the Chinese IME and Alt+Right is used for the
- forward button. So that's why we handle #9 here. Doesn't mean Ctrl+Tab
- doesn't work: it doesnt trigger KeyPress, even if it wasn't a menu
- shortcut for Next Tab (which it is). }
- InitiateAutoComplete(#0);
- Key := #0;
- end else if (Key <= #31) or (Key = #127) then begin
- { Prevent "control characters" from being entered in text. Don't need to be
- concerned about #9 or #10 or #13 etc here. Based on Notepad++'s WM_CHAR
- handling in ScintillaEditView.cpp.
- Also don't need to be concerned about shortcuts like Ctrl+Shift+- which
- equals #31. }
- Key := #0
- end;
- end;
- procedure TMainForm.FormResize(Sender: TObject);
- begin
- { Make sure the status panel's height is decreased if necessary in response
- to the form's height decreasing }
- if StatusPanel.Visible then
- UpdateStatusPanelHeight(StatusPanel.Height);
- { Violently resizing the form leaves UpdatePanelDonateImage and UpdatePanelPaintBox artifacts
- under and over UpdateLinkLabel. Invalidating it prevents this. }
- UpdateLinkLabel.Invalidate;
- end;
- procedure TMainForm.WndProc(var Message: TMessage);
- begin
- { Without this, the status bar's owner drawn panels sometimes get corrupted and show
- menu items instead. See:
- http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 }
- with Message do
- case Msg of
- WM_DRAWITEM:
- with PDrawItemStruct(Message.LParam)^ do
- if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
- CtlType := ODT_STATIC;
- end;
- inherited
- end;
- function TMainForm.IsShortCut(var Message: TWMKey): Boolean;
- begin
- { Key messages are forwarded by the VCL to the main form for ShortCut
- processing. In Delphi 5+, however, this happens even when a TFindDialog
- is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form.
- Work around this by always returning False when not Active. }
- if Active then
- Result := inherited IsShortCut(Message)
- else
- Result := False;
- end;
- procedure TMainForm.UpdateCaption;
- var
- NewCaption: String;
- begin
- if FMainMemo.Filename = '' then
- NewCaption := GetFileTitle(FMainMemo.Filename)
- else begin
- if FOptions.FullPathInTitleBar then
- NewCaption := FMainMemo.Filename
- else
- NewCaption := GetDisplayFilename(FMainMemo.Filename);
- end;
- NewCaption := NewCaption + ' - ' + SCompilerFormCaption + ' ' +
- String(FCompilerVersion.Version);
- if FCompiling then
- NewCaption := NewCaption + ' [Compiling]'
- else if FDebugging then begin
- if not FPaused then
- NewCaption := NewCaption + ' [Running]'
- else
- NewCaption := NewCaption + ' [Paused]';
- end;
- Caption := NewCaption;
- if not CommandLineWizard then
- Application.Title := NewCaption;
- end;
- procedure TMainForm.UpdateNewMainFileButtons;
- begin
- if FOptions.UseWizard then begin
- FNewMainFile.Caption := '&New...';
- FNewMainFile.OnClick := FNewMainFileUserWizardClick;
- NewMainFileButton.OnClick := FNewMainFileUserWizardClick;
- end else begin
- FNewMainFile.Caption := '&New';
- FNewMainFile.OnClick := FNewMainFileClick;
- NewMainFileButton.OnClick := FNewMainFileClick;
- end;
- end;
- procedure TMainForm.NewMainFile;
- var
- Memo: TIDEScintFileEdit;
- begin
- HideError;
- FUninstExe := '';
- if FDebugTarget <> dtSetup then begin
- FDebugTarget := dtSetup;
- UpdateTargetMenu;
- end;
- FHiddenFiles.Clear;
- InvalidateStatusPanel(spHiddenFilesCount);
- for Memo in FFileMemos do
- if Memo.Used then
- Memo.BreakPoints.Clear;
- DestroyDebugInfo;
- FMainMemo.Filename := '';
- UpdateCaption;
- FMainMemo.SaveEncoding := seUTF8WithoutBOM;
- FMainMemo.Lines.Clear;
- FModifiedAnySinceLastCompile := True;
- FPreprocessorOutput := '';
- FIncludedFiles.Clear;
- UpdatePreprocMemos;
- FMainMemo.ClearUndo;
- FNavStacks.Clear;
- UpdateNavButtons;
- FCurrentNavItem.Invalidate;
- end;
- { Breakpoints are preserved on a per-file basis }
- procedure TMainForm.LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
- begin
- if AMemo.BreakPoints.Count <> 0 then
- raise Exception.Create('AMemo.BreakPoints.Count <> 0'); { NewMainFile or OpenFile should have cleared these }
- try
- var HadSkippedBreakPoint := False;
- var Strings := TStringList.Create;
- try
- LoadBreakPointLines(AMemo.FileName, Strings);
- for var LineAsString in Strings do begin
- var Line := LineAsString.ToInteger;
- if Line < AMemo.Lines.Count then
- AMemo.BreakPoints.Add(Line)
- else
- HadSkippedBreakPoint := True;
- end;
- finally
- Strings.Free;
- end;
- for var Line in AMemo.BreakPoints do
- UpdateLineMarkers(AMemo, Line);
- { If there were breakpoints beyond the end of file get rid of them so they
- don't magically reappear on a reload of an externally edited and grown
- file }
- if HadSkippedBreakPoint then
- BuildAndSaveBreakPointLines(AMemo);
- except
- { Ignore any exceptions }
- end;
- end;
- procedure TMainForm.BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
- begin
- try
- if AMemo.FileName <> '' then begin
- var Strings := TStringList.Create;
- try
- for var Line in AMemo.BreakPoints do
- Strings.Add(Line.ToString);
- SaveBreakPointLines(AMemo.FileName, Strings);
- finally
- Strings.Free;
- end;
- end;
- except
- { Handle exceptions locally; failure to save the breakpoint lines list should not be
- a fatal error }
- Application.HandleException(Self);
- end;
- end;
- { Known included and hidden files are preserved on a per-main-file basis }
- procedure TMainForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos;
- begin
- if FIncludedFiles.Count <> 0 then
- raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have cleared these }
- try
- if AFilename <> '' then begin
- var Strings := TStringList.Create;
- try
- LoadKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
- if Strings.Count > 0 then begin
- try
- for var Filename in Strings do begin
- var IncludedFile := TIncludedFile.Create;
- IncludedFile.Filename := Filename;
- IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex;
- IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
- @IncludedFile.LastWriteTime);
- FIncludedFiles.Add(IncludedFile);
- end;
- finally
- UpdatePreprocMemos;
- end;
- end;
- finally
- Strings.Free;
- end;
- end;
- except
- { Ignore any exceptions }
- end;
- end;
- procedure TMainForm.BuildAndSaveKnownIncludedAndHiddenFiles;
- begin
- try
- if FMainMemo.FileName <> '' then begin
- var Strings := TStringList.Create;
- try
- for var IncludedFile in FIncludedFiles do
- Strings.Add(IncludedFile.Filename);
- SaveKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
- finally
- Strings.Free;
- end;
- end;
- except
- { Handle exceptions locally; failure to save the includes list should not be
- a fatal error }
- Application.HandleException(Self);
- end;
- end;
- procedure TMainForm.NewMainFileUsingWizard;
- var
- WizardForm: TWizardForm;
- SaveEnabled: Boolean;
- begin
- WizardForm := TWizardForm.Create(Application);
- try
- SaveEnabled := Enabled;
- if CommandLineWizard then begin
- WizardForm.WizardName := CommandLineWizardName;
- { Must disable MainForm even though it isn't shown, otherwise
- menu keyboard shortcuts (such as Ctrl+O) still work }
- Enabled := False;
- end;
- try
- if WizardForm.ShowModal <> mrOk then
- Exit;
- finally
- Enabled := SaveEnabled;
- end;
- if CommandLineWizard then begin
- SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUTF8WithoutBOM);
- end else begin
- NewMainFile;
- FMainMemo.Lines.Text := WizardForm.ResultScript;
- FMainMemo.ClearUndo;
- if WizardForm.Result = wrComplete then begin
- FMainMemo.ForceModifiedState;
- if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
- BCompileClick(Self);
- end;
- end;
- finally
- WizardForm.Free;
- end;
- end;
- procedure TMainForm.OpenFile(AMemo: TIDEScintFileEdit; AFilename: String;
- const MainMemoAddToRecentDocs: Boolean);
- function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding;
- var
- Buf: array[0..2] of Byte;
- begin
- Result := seAuto;
- var StreamSize := Stream.Size;
- var CappedSize: Integer;
- if StreamSize > High(Integer) then
- CappedSize := High(Integer)
- else
- CappedSize := Integer(StreamSize);
- if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and
- (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
- Result := seUTF8WithBOM
- else begin
- Stream.Seek(0, soFromBeginning);
- var S: AnsiString;
- SetLength(S, CappedSize);
- SetLength(S, Stream.Read(S[1], CappedSize));
- if DetectUTF8Encoding(S) in [etUSASCII, etUTF8] then
- Result := seUTF8WithoutBOM;
- end;
- end;
- function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding;
- begin
- if SaveEncoding in [seUTF8WithBOM, seUTF8WithoutBOM] then
- Result := TEncoding.UTF8
- else
- Result := nil;
- end;
- var
- Stream: TFileStream;
- begin
- AMemo.OpeningFile := True;
- try
- AFilename := PathExpand(AFilename);
- var NameChange := PathCompare(AMemo.Filename, AFilename) <> 0;
- Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
- try
- if AMemo = FMainMemo then
- NewMainFile
- else begin
- AMemo.BreakPoints.Clear;
- if DestroyLineState(AMemo) then
- UpdateAllMemoLineMarkers(AMemo);
- if NameChange then { Also see below the other case which needs to be done after load }
- RemoveMemoFromNav(AMemo);
- end;
- GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime);
- AMemo.SaveEncoding := GetStreamSaveEncoding(Stream);
- Stream.Seek(0, soFromBeginning);
- AMemo.Lines.LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding));
- if (AMemo <> FMainMemo) and not NameChange then
- RemoveMemoBadLinesFromNav(AMemo);
- finally
- Stream.Free;
- end;
- AMemo.ClearUndo;
- if AMemo = FMainMemo then begin
- AMemo.Filename := AFilename;
- UpdateCaption;
- ModifyMRUMainFilesList(AFilename, True);
- if MainMemoAddToRecentDocs then
- AddFileToRecentDocs(AFilename);
- LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename);
- InvalidateStatusPanel(spHiddenFilesCount);
- end;
- LoadBreakPointLinesAndUpdateLineMarkers(AMemo);
- finally
- AMemo.OpeningFile := False;
- end;
- end;
- procedure TMainForm.OpenMRUMainFile(const AFilename: String);
- { Same as OpenFile, but offers to remove the file from the MRU list if it
- cannot be opened }
- begin
- try
- OpenFile(FMainMemo, AFilename, True);
- except
- Application.HandleException(Self);
- if MsgBoxFmt('There was an error opening the file. Remove it from the list?',
- [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin
- ModifyMRUMainFilesList(AFilename, False);
- DeleteBreakPointLines(AFilename);
- DeleteKnownIncludedAndHiddenFiles(AFilename);
- end;
- end;
- end;
- function TMainForm.SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
- procedure SaveMemoTo(const FN: String);
- var
- TempFN, BackupFN: String;
- Buf: array[0..4095] of Char;
- begin
- { Save to a temporary file; don't overwrite existing files in place. This
- way, if the system crashes or the disk runs out of space during the save,
- the existing file will still be intact. }
- if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then
- raise Exception.CreateFmt('Error creating file (code %d). Could not save file',
- [GetLastError]);
- TempFN := Buf;
- try
- SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding);
- { Back up existing file if needed }
- if FOptions.MakeBackups and NewFileExists(FN) then begin
- BackupFN := PathChangeExt(FN, '.~is');
- DeleteFile(BackupFN);
- if not RenameFile(FN, BackupFN) then
- raise Exception.Create('Error creating backup file. Could not save file');
- end;
- { Delete existing file }
- if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then
- raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file',
- [GetLastError]);
- except
- DeleteFile(TempFN);
- raise;
- end;
- { Rename temporary file.
- Note: This is outside the try..except because we already deleted the
- existing file, and don't want the temp file also deleted in the unlikely
- event that the rename fails. }
- if not RenameFile(TempFN, FN) then
- raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file',
- [GetLastError]);
- GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime);
- end;
- var
- FN: String;
- begin
- Result := False;
- var OldName := AMemo.Filename;
- if SaveAs or (AMemo.Filename = '') then begin
- if AMemo <> FMainMemo then
- raise Exception.Create('Internal error: AMemo <> FMainMemo');
- FN := AMemo.Filename;
- if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit;
- FN := PathExpand(FN);
- SaveMemoTo(FN);
- AMemo.Filename := FN;
- UpdateCaption;
- end else
- SaveMemoTo(AMemo.Filename);
- AMemo.SetSavePoint;
- if not FOptions.UndoAfterSave then
- AMemo.ClearUndo(False);
- Result := True;
- if AMemo = FMainMemo then begin
- ModifyMRUMainFilesList(AMemo.Filename, True);
- if PathCompare(AMemo.Filename, OldName) <> 0 then begin
- if OldName <> '' then begin
- DeleteBreakPointLines(OldName);
- DeleteKnownIncludedAndHiddenFiles(OldName);
- end;
- BuildAndSaveBreakPointLines(AMemo);
- BuildAndSaveKnownIncludedAndHiddenFiles;
- end;
- end;
- end;
- function TMainForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
- function PromptToSaveMemo(const AMemo: TIDEScintFileEdit): Boolean;
- var
- FileTitle: String;
- begin
- Result := True;
- if AMemo.Modified then begin
- FileTitle := GetFileTitle(AMemo.Filename);
- case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
- 'Do you want to save the changes?', SCompilerFormCaption, mbError,
- MB_YESNOCANCEL) of
- IDYES: Result := SaveFile(AMemo, False);
- IDNO: ;
- else
- Result := False;
- end;
- end;
- end;
- var
- Memo: TIDEScintFileEdit;
- begin
- if FCompiling then begin
- MsgBox('Please stop the compile process before performing this command.',
- SCompilerFormCaption, mbError, MB_OK);
- Result := False;
- Exit;
- end;
- if FDebugging and not AskToDetachDebugger then begin
- Result := False;
- Exit;
- end;
- Result := True;
- if PromptToSave then begin
- for Memo in FFileMemos do begin
- if Memo.Used then begin
- Result := PromptToSaveMemo(Memo);
- if not Result then
- Exit;
- end;
- end;
- end;
- end;
- procedure TMainForm.ClearMRUMainFilesList;
- begin
- try
- ClearMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew');
- except
- { Ignore any exceptions. }
- end;
- end;
- procedure TMainForm.ReadMRUMainFilesList;
- begin
- try
- ReadMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History');
- except
- { Ignore any exceptions. }
- end;
- end;
- procedure TMainForm.ModifyMRUMainFilesList(const AFilename: String;
- const AddNewItem: Boolean);
- begin
- { Load most recent items first, just in case they've changed }
- try
- ReadMRUMainFilesList;
- except
- { Ignore any exceptions. }
- end;
- try
- ModifyMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History', AFileName, AddNewItem, @PathCompare);
- except
- { Handle exceptions locally; failure to save the MRU list should not be
- a fatal error. }
- Application.HandleException(Self);
- end;
- end;
- procedure TMainForm.ReadMRUParametersList;
- begin
- try
- ReadMRUList(FMRUParametersList, 'ParametersHistory', 'History');
- except
- { Ignore any exceptions. }
- end;
- end;
- procedure TMainForm.ModifyMRUParametersList(const AParameter: String;
- const AddNewItem: Boolean);
- begin
- { Load most recent items first, just in case they've changed }
- try
- ReadMRUParametersList;
- except
- { Ignore any exceptions. }
- end;
- try
- ModifyMRUList(FMRUParametersList, 'ParametersHistory', 'History', AParameter, AddNewItem, @CompareText);
- except
- { Handle exceptions locally; failure to save the MRU list should not be
- a fatal error. }
- Application.HandleException(Self);
- end;
- end;
- procedure TMainForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
- begin
- AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
- CompilerOutputList.Update;
- end;
- procedure TMainForm.DebugLogMessage(const S: String);
- begin
- AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
- DebugOutputList.Update;
- end;
- procedure TMainForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
- begin
- DebugCallStackList.Clear;
- AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1);
- DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
- DebugCallStackList.Update;
- end;
- type
- PAppData = ^TAppData;
- TAppData = record
- Form: TMainForm;
- Filename: String;
- Lines: TStringList;
- CurLineNumber: Integer;
- CurLine: String;
- OutputExe: String;
- DebugInfo: Pointer;
- ErrorMsg: String;
- ErrorFilename: String;
- ErrorLine: Integer;
- Aborted: Boolean;
- end;
- function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
- AppData: Longint): Integer; stdcall;
- procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles);
- var
- IncludedFile: TIncludedFile;
- I: Integer;
- begin
- IncludedFiles.Clear;
- if P = nil then
- Exit;
- I := 0;
- while P^ <> #0 do begin
- if not IsISPPBuiltins(P) then begin
- IncludedFile := TIncludedFile.Create;
- IncludedFile.Filename := GetCleanFileNameOfFile(P);
- IncludedFile.CompilerFileIndex := I;
- IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
- @IncludedFile.LastWriteTime);
- IncludedFiles.Add(IncludedFile);
- end;
- Inc(P, StrLen(P) + 1);
- Inc(I);
- end;
- end;
- procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList);
- var
- HiddenFileIncluded: array of Boolean;
- begin
- if HiddenFiles.Count > 0 then begin
- { Clean previously hidden files which are no longer included }
- if IncludedFiles.Count > 0 then begin
- SetLength(HiddenFileIncluded, HiddenFiles.Count);
- for var I := 0 to HiddenFiles.Count-1 do
- HiddenFileIncluded[I] := False;
- for var I := 0 to IncludedFiles.Count-1 do begin
- var IncludedFile := IncludedFiles[I];
- var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename);
- if HiddenFileIndex <> -1 then
- HiddenFileIncluded[HiddenFileIndex] := True;
- end;
- for var I := HiddenFiles.Count-1 downto 0 do
- if not HiddenFileIncluded[I] then
- HiddenFiles.Delete(I);
- end else
- HiddenFiles.Clear;
- end;
- end;
- begin
- Result := iscrSuccess;
- with PAppData(AppData)^ do
- case Code of
- iscbReadScript:
- begin
- if Data.Reset then
- CurLineNumber := 0;
- if CurLineNumber < Lines.Count then begin
- CurLine := Lines[CurLineNumber];
- Data.LineRead := PChar(CurLine);
- Inc(CurLineNumber);
- end;
- end;
- iscbNotifyStatus:
- if Data.Warning then
- Form.StatusMessage(smkWarning, Data.StatusMsg)
- else
- Form.StatusMessage(smkNormal, Data.StatusMsg);
- iscbNotifyIdle:
- begin
- Form.UpdateCompileStatusPanels(Data.CompressProgress,
- Data.CompressProgressMax, Data.SecondsRemaining,
- Data.BytesCompressedPerSecond);
- { We have to use HandleMessage instead of ProcessMessages so that
- Application.Idle is called. Otherwise, Flat TSpeedButton's don't
- react to the mouse being moved over them.
- Unfortunately, HandleMessage by default calls WaitMessage. To avoid
- this we have an Application.OnIdle handler which sets Done to False
- while compiling is in progress - see AppOnIdle.
- The GetQueueStatus check below is just an optimization; calling
- HandleMessage when there are no messages to process wastes CPU. }
- if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
- Form.FBecameIdle := False;
- repeat
- Application.HandleMessage;
- { AppOnIdle sets FBecameIdle to True when it's called, which
- indicates HandleMessage didn't find any message to process }
- until Form.FBecameIdle;
- end;
- if Form.FCompileWantAbort then
- Result := iscrRequestAbort;
- end;
- iscbNotifyPreproc:
- begin
- Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript);
- DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles); { Also stores last write time }
- CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles);
- Form.InvalidateStatusPanel(spHiddenFilesCount);
- Form.BuildAndSaveKnownIncludedAndHiddenFiles;
- end;
- iscbNotifySuccess:
- begin
- OutputExe := Data.OutputExeFilename;
- if Form.FCompilerVersion.BinVersion >= $3000001 then begin
- DebugInfo := AllocMem(Data.DebugInfoSize);
- Move(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize);
- end else
- DebugInfo := nil;
- end;
- iscbNotifyError:
- begin
- if Assigned(Data.ErrorMsg) then
- ErrorMsg := Data.ErrorMsg
- else
- Aborted := True;
- ErrorFilename := Data.ErrorFilename;
- ErrorLine := Data.ErrorLine;
- end;
- end;
- end;
- procedure TMainForm.CompileFile(AFilename: String; const ReadFromFile: Boolean);
- function GetMemoFromErrorFilename(const ErrorFilename: String): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- if ErrorFilename = '' then
- Result := FMainMemo
- else begin
- if FOptions.OpenIncludedFiles then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin
- Result := Memo;
- Exit;
- end;
- end;
- end;
- Result := nil;
- end;
- end;
- var
- SourcePath, S, Options: String;
- Params: TCompileScriptParamsEx;
- AppData: TAppData;
- StartTime, ElapsedTime, ElapsedSeconds: DWORD;
- I: Integer;
- Memo: TIDEScintFileEdit;
- OldActiveMemo: TIDEScintEdit;
- begin
- if FCompiling then begin
- { Shouldn't get here, but just in case... }
- MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
- Abort;
- end;
- if not ReadFromFile then begin
- if FOptions.OpenIncludedFiles then begin
- { Included files must always be saved since they're not read from the editor by the compiler }
- for Memo in FFileMemos do begin
- if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin
- if FOptions.Autosave then begin
- if not SaveFile(Memo, False) then
- Abort;
- end else begin
- case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 +
- 'Save the changes and continue?', SCompilerFormCaption, mbError,
- MB_YESNO) of
- IDYES:
- if not SaveFile(Memo, False) then
- Abort;
- else
- Abort;
- end;
- end;
- end;
- end;
- end;
- { Save main file if requested }
- if FOptions.Autosave and FMainMemo.Modified then begin
- if not SaveFile(FMainMemo, False) then
- Abort;
- end else if FMainMemo.Filename = '' then begin
- case MsgBox('Would you like to save the script before compiling?' +
- SNewLine2 + 'If you answer No, the compiled installation will be ' +
- 'placed under your My Documents folder by default.',
- SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of
- IDYES:
- if not SaveFile(FMainMemo, False) then
- Abort;
- IDNO: ;
- else
- Abort;
- end;
- end;
- AFilename := FMainMemo.Filename;
- end; {else: Command line compile, AFilename already set. }
- DestroyDebugInfo;
- OldActiveMemo := FActiveMemo;
- AppData.Lines := TStringList.Create;
- try
- FBuildAnimationFrame := 0;
- FProgress := 0;
- FProgressMax := 0;
- FTaskbarProgressValue := 0;
- FActiveMemo.CancelAutoCompleteAndCallTip;
- FActiveMemo.Cursor := crAppStart;
- FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor }
- CompilerOutputList.Cursor := crAppStart;
- for Memo in FFileMemos do
- Memo.ReadOnly := True;
- UpdateEditModePanel;
- HideError;
- CompilerOutputList.Clear;
- SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugOutputList.Clear;
- SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- OutputTabSet.TabIndex := tiCompilerOutput;
- SetStatusPanelVisible(True);
- SourcePath := GetSourcePath(AFilename);
- FillChar(Params, SizeOf(Params), 0);
- Params.Size := SizeOf(Params);
- Params.CompilerPath := nil;
- Params.SourcePath := PChar(SourcePath);
- Params.CallbackProc := CompilerCallbackProc;
- Pointer(Params.AppData) := @AppData;
- Options := '';
- for I := 0 to FSignTools.Count-1 do
- Options := Options + AddSignToolParam(FSignTools[I]);
- Params.Options := PChar(Options);
- AppData.Form := Self;
- AppData.CurLineNumber := 0;
- AppData.Aborted := False;
- I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo);
- if I <> -1 then begin
- if not ReadFromFile then begin
- MoveCaretAndActivateMemo(FMainMemo, I, False);
- SetErrorLine(FMainMemo, I);
- end;
- raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]);
- end;
- StartTime := GetTickCount;
- StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
- StatusMessage(smkStartEnd, '');
- FCompiling := True;
- FCompileWantAbort := False;
- UpdateRunMenu;
- UpdateCaption;
- SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
- AppData.Filename := AFilename;
- {$IFNDEF STATICCOMPILER}
- if ISDllCompileScript(Params) <> isceNoError then begin
- {$ELSE}
- if ISCompileScript(Params, False) <> isceNoError then begin
- {$ENDIF}
- StatusMessage(smkError, SCompilerStatusErrorAborted);
- if not ReadFromFile and (AppData.ErrorLine > 0) then begin
- Memo := GetMemoFromErrorFilename(AppData.ErrorFilename);
- if Memo <> nil then begin
- { Move the caret to the line number the error occurred on }
- MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False);
- SetErrorLine(Memo, AppData.ErrorLine - 1);
- end;
- end;
- if not AppData.Aborted then begin
- S := '';
- if AppData.ErrorFilename <> '' then
- S := 'File: ' + AppData.ErrorFilename + SNewLine2;
- if AppData.ErrorLine > 0 then
- S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
- S := S + AppData.ErrorMsg;
- SetAppTaskbarProgressState(tpsError);
- MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
- end;
- Abort;
- end;
- ElapsedTime := GetTickCount - StartTime;
- ElapsedSeconds := ElapsedTime div 1000;
- StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
- Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
- ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
- finally
- AppData.Lines.Free;
- FCompiling := False;
- SetLowPriority(False, FSavePriorityClass);
- OldActiveMemo.Cursor := crDefault;
- OldActiveMemo.SetCursorID(SC_CURSORNORMAL);
- CompilerOutputList.Cursor := crDefault;
- for Memo in FFileMemos do
- Memo.ReadOnly := False;
- UpdateEditModePanel;
- UpdateRunMenu;
- UpdateCaption;
- UpdatePreprocMemos;
- if AppData.DebugInfo <> nil then begin
- ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }
- FreeMem(AppData.DebugInfo);
- end;
- InvalidateStatusPanel(spCompileIcon);
- InvalidateStatusPanel(spCompileProgress);
- SetAppTaskbarProgressState(tpsNoProgress);
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- FCompiledExe := AppData.OutputExe;
- FModifiedAnySinceLastCompile := False;
- FModifiedAnySinceLastCompileAndGo := False;
- end;
- procedure TMainForm.SyncEditorOptions;
- const
- SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE);
- WhiteSpaceStyles: array[Boolean] of Integer = (SCWS_INVISIBLE, SCWS_VISIBLEALWAYS);
- var
- Memo: TIDEScintEdit;
- begin
- for Memo in FMemos do begin
- Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting;
- Memo.Call(SCI_INDICSETSTYLE, minSquiggly, SquigglyStyles[FOptions.UnderlineErrors]);
- Memo.Call(SCI_SETVIEWWS, WhiteSpaceStyles[FOptions.ShowWhiteSpace], 0);
- if FOptions.CursorPastEOL then
- Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible, svsNoWrapLineStart]
- else
- Memo.VirtualSpaceOptions := [];
- Memo.FillSelectionToEdge := FOptions.CursorPastEOL;
- Memo.TabWidth := FOptions.TabWidth;
- Memo.UseTabCharacter := FOptions.UseTabCharacter;
- Memo.KeyMappingType := FOptions.MemoKeyMappingType;
- if Memo = FMainMemo then begin
- SetFakeShortCut(ESelectNextOccurrence, FMainMemo.GetComplexCommandShortCut(ccSelectNextOccurrence));
- SetFakeShortCut(ESelectAllOccurrences, FMainMemo.GetComplexCommandShortCut(ccSelectAllOccurrences));
- SetFakeShortCut(ESelectAllFindMatches, FMainMemo.GetComplexCommandShortCut(ccSelectAllFindMatches));
- SetFakeShortCut(EFoldLine, FMainMemo.GetComplexCommandShortCut(ccFoldLine));
- SetFakeShortCut(EUnfoldLine, FMainMemo.GetComplexCommandShortCut(ccUnfoldLine));
- SetFakeShortCut(EToggleLinesComment, FMainMemo.GetComplexCommandShortCut(ccToggleLinesComment));
- SetFakeShortCut(EBraceMatch, FMainMemo.GetComplexCommandShortCut(ccBraceMatch));
- end;
- Memo.UseFolding := FOptions.UseFolding;
- Memo.WordWrap := FOptions.WordWrap;
- if FOptions.IndentationGuides then
- Memo.IndentationGuides := sigLookBoth
- else
- Memo.IndentationGuides := sigNone;
- Memo.LineNumbers := FOptions.GutterLineNumbers;
- end;
- end;
- procedure TMainForm.FMenuClick(Sender: TObject);
- var
- I: Integer;
- begin
- FSaveMainFileAs.Enabled := FActiveMemo = FMainMemo;
- FSaveEncoding.Enabled := FSave.Enabled; { FSave.Enabled is kept up-to-date by UpdateSaveMenuItemAndButton }
- FSaveEncodingAuto.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seAuto);
- FSaveEncodingUTF8WithBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithBOM);
- FSaveEncodingUTF8WithoutBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithoutBOM);
- FSaveAll.Visible := FOptions.OpenIncludedFiles;
- ReadMRUMainFilesList;
- FRecent.Visible := FMRUMainFilesList.Count <> 0;
- for I := 0 to High(FMRUMainFilesMenuItems) do
- with FMRUMainFilesMenuItems[I] do begin
- if I < FMRUMainFilesList.Count then begin
- Visible := True;
- Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(FMRUMainFilesList[I]);
- end
- else
- Visible := False;
- end;
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.FNewMainFileClick(Sender: TObject);
- begin
- if ConfirmCloseFile(True) then
- NewMainFile;
- end;
- procedure TMainForm.FNewMainFileUserWizardClick(Sender: TObject);
- begin
- if ConfirmCloseFile(True) then
- NewMainFileUsingWizard;
- end;
- procedure TMainForm.ShowOpenMainFileDialog(const Examples: Boolean);
- var
- InitialDir, FileName: String;
- begin
- if Examples then begin
- InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples';
- Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss';
- end
- else begin
- InitialDir := PathExtractDir(FMainMemo.Filename);
- Filename := '';
- end;
- if ConfirmCloseFile(True) then
- if NewGetOpenFileName('', FileName, InitialDir, SCompilerOpenFilter, 'iss', Handle) then
- OpenFile(FMainMemo, Filename, False);
- end;
- procedure TMainForm.FOpenMainFileClick(Sender: TObject);
- begin
- ShowOpenMainFileDialog(False);
- end;
- procedure TMainForm.FSaveClick(Sender: TObject);
- begin
- SaveFile((FActiveMemo as TIDEScintFileEdit), Sender = FSaveMainFileAs);
- end;
- procedure TMainForm.FSaveEncodingItemClick(Sender: TObject);
- begin
- var Memo := (FActiveMemo as TIDEScintFileEdit);
- var OldSaveEncoding := Memo.SaveEncoding;
- if Sender = FSaveEncodingUTF8WithBOM then
- Memo.SaveEncoding := seUTF8WithBOM
- else if Sender = FSaveEncodingUTF8WithoutBOM then
- Memo.SaveEncoding := seUTF8WithoutBOM
- else
- Memo.SaveEncoding := seAuto;
- if Memo.SaveEncoding <> OldSaveEncoding then
- Memo.ForceModifiedState;
- end;
- procedure TMainForm.FSaveAllClick(Sender: TObject);
- var
- Memo: TIDEScintFileEdit;
- begin
- for Memo in FFileMemos do
- if Memo.Used and Memo.Modified then
- SaveFile(Memo, False);
- end;
- procedure TMainForm.FPrintClick(Sender: TObject);
- procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme;
- var OldStyler: TScintCustomStyler; var OldTheme: TTheme);
- begin
- { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or
- somehow convince Scintilla to use different print styles but don't know of a good way to do
- either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. }
- PrintStyler := TInnoSetupStyler.Create(nil);
- PrintTheme := TTheme.Create;
- PrintStyler.ISPPInstalled := ISPPInstalled;
- PrintStyler.Theme := PrintTheme;
- if not FTheme.Dark then
- PrintTheme.Typ := FTheme.Typ
- else
- PrintTheme.Typ := ttModernLight;
- OldStyler := FActiveMemo.Styler;
- OldTheme := FActiveMemo.Theme;
- FActiveMemo.Styler := PrintStyler;
- FActiveMemo.Theme := PrintTheme;
- FActiveMemo.UpdateThemeColorsAndStyleAttributes;
- end;
- procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme;
- const OldStyler: TScintCustomStyler; const OldTheme: TTheme);
- begin
- if (OldStyler <> nil) or (OldTheme <> nil) then begin
- if OldStyler <> nil then
- FActiveMemo.Styler := OldStyler;
- if OldTheme <> nil then
- FActiveMemo.Theme := OldTheme;
- FActiveMemo.UpdateThemeColorsAndStyleAttributes;
- end;
- if PrintTheme <> FTheme then
- PrintTheme.Free;
- PrintStyler.Free;
- end;
- var
- PrintStyler: TInnoSetupStyler;
- OldStyler: TScintCustomStyler;
- PrintTheme, OldTheme: TTheme;
- PrintMemo: TIDEScintEdit;
- HeaderMemo: TIDEScintFileEdit;
- FileTitle, S: String;
- pdlg: TPrintDlg;
- hdc: Windows.HDC;
- rectMargins, rectPhysMargins, rectSetup, rcw: TRect;
- ptPage, ptDpi: TPoint;
- headerLineHeight, footerLineHeight: Integer;
- fontHeader, fontFooter: HFONT;
- tm: TTextMetric;
- di: TDocInfo;
- lengthDoc, lengthDocMax, lengthPrinted: Integer;
- frPrint: TScintRangeToFormat;
- pageNum: Integer;
- printPage: Boolean;
- ta: UINT;
- sHeader, sFooter: String;
- pen, penOld: HPEN;
- begin
- if FActiveMemo is TIDEScintFileEdit then
- HeaderMemo := TIDEScintFileEdit(FActiveMemo)
- else
- HeaderMemo := FMainMemo;
- sHeader := HeaderMemo.Filename;
- FileTitle := GetFileTitle(HeaderMemo.Filename);
- if HeaderMemo <> FActiveMemo then begin
- S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)];
- sHeader := Format('%s %s', [sHeader, S]);
- FileTitle := Format('%s %s', [FileTitle, S]);
- end;
- sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]);
- { Based on SciTE 5.50's SciTEWin::Print }
-
- ZeroMemory(@pdlg, SizeOf(pdlg));
- pdlg.lStructSize := SizeOf(pdlg);
- pdlg.hwndOwner := Handle;
- pdlg.hInstance := hInstance;
- pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC;
- pdlg.nFromPage := 1;
- pdlg.nToPage := 1;
- pdlg.nMinPage := 1;
- pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known.
- pdlg.nCopies := 1;
- pdlg.hDC := 0;
- pdlg.hDevMode := FDevMode;
- pdlg.hDevNames := FDevNames;
- // See if a range has been selected
- var rangeSelection := FActiveMemo.Selection;
- if rangeSelection.StartPos = rangeSelection.EndPos then
- pdlg.Flags := pdlg.Flags or PD_NOSELECTION
- else
- pdlg.Flags := pdlg.Flags or PD_SELECTION;
- if not PrintDlg(pdlg) then
- Exit;
- PrintStyler := nil;
- PrintTheme := nil;
- OldStyler := nil;
- OldTheme := nil;
- try
- if FTheme.Dark then
- SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme)
- else
- PrintTheme := FTheme;
- FDevMode := pdlg.hDevMode;
- FDevNames := pdlg.hDevNames;
- hdc := pdlg.hDC;
- // Get printer resolution
- ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction
- ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction
- // Start by getting the physical page size (in device units).
- ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units
- ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units
- // Get the dimensions of the unprintable
- // part of the page (in device units).
- rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX);
- rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY);
- // To get the right and lower unprintable area,
- // we take the entire width and height of the paper and
- // subtract everything else.
- rectPhysMargins.right := ptPage.x // total paper width
- - GetDeviceCaps(hdc, HORZRES) // printable width
- - rectPhysMargins.left; // left unprintable margin
- rectPhysMargins.bottom := ptPage.y // total paper height
- - GetDeviceCaps(hdc, VERTRES) // printable height
- - rectPhysMargins.top; // right unprintable margin
- // At this point, rectPhysMargins contains the widths of the
- // unprintable regions on all four sides of the page in device units.
- (*
- // Take in account the page setup given by the user (if one value is not null)
- if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 ||
- pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) {
- GUI::Rectangle rectSetup;
- // Convert the hundredths of millimeters (HiMetric) or
- // thousandths of inches (HiEnglish) margin values
- // from the Page Setup dialog to device units.
- // (There are 2540 hundredths of a mm in an inch.)
- TCHAR localeInfo[3];
- GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3);
- if (localeInfo[0] == '0') { // Metric system. '1' is US System *)
- rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540);
- rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540);
- rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540);
- rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540);
- (* } else {
- rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000);
- rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000);
- rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000);
- rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000);
- } *)
- // Don't reduce margins below the minimum printable area
- rectMargins.left := Max(rectPhysMargins.left, rectSetup.left);
- rectMargins.top := Max(rectPhysMargins.top, rectSetup.top);
- rectMargins.right := Max(rectPhysMargins.right, rectSetup.right);
- rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom);
- (*
- } else {
- rectMargins := rectPhysMargins;
- }
- *)
- // rectMargins now contains the values used to shrink the printable
- // area of the page.
- // Convert device coordinates into logical coordinates
- DPtoLP(hdc, rectMargins, 2);
- DPtoLP(hdc, rectPhysMargins, 2);
- // Convert page size to logical units and we're done!
- DPtoLP(hdc, ptPage, 1);
- headerLineHeight := MulDiv(9, ptDpi.y, 72);
- fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
- SelectObject(hdc, fontHeader);
- GetTextMetrics(hdc, &tm);
- headerLineHeight := tm.tmHeight + tm.tmExternalLeading;
- footerLineHeight := MulDiv(9, ptDpi.y, 72);
- fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
- SelectObject(hdc, fontFooter);
- GetTextMetrics(hdc, &tm);
- footerLineHeight := tm.tmHeight + tm.tmExternalLeading;
- ZeroMemory(@di, SizeOf(di));
- di.cbSize := SizeOf(di);
- di.lpszDocName := PChar(FileTitle);
- di.lpszOutput := nil;
- di.lpszDatatype := nil;
- di.fwType := 0;
- if StartDoc(hdc, &di) < 0 then begin
- DeleteDC(hdc);
- DeleteObject(fontHeader);
- DeleteObject(fontFooter);
- MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK);
- Exit;
- end;
- lengthDocMax := FActiveMemo.GetRawTextLength;
- // PD_SELECTION -> requested to print selection.
- lengthDoc := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.EndPos, lengthDocMax);
- lengthPrinted := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.StartPos, 0);
- // We must subtract the physical margins from the printable area
- frPrint.hdc := hdc;
- frPrint.hdcTarget := hdc;
- frPrint.rc.left := rectMargins.left - rectPhysMargins.left;
- frPrint.rc.top := rectMargins.top - rectPhysMargins.top;
- frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left;
- frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top;
- frPrint.rcPage.left := 0;
- frPrint.rcPage.top := 0;
- frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1;
- frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1;
- frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2;
- frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2);
- // Print each page
- pageNum := 1;
- while lengthPrinted < lengthDoc do begin
- printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or
- ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage));
- sFooter := Format('- %d -', [pageNum]);
- if printPage then begin
- StartPage(hdc);
- SetTextColor(hdc, PrintTheme.Colors[tcFore]);
- SetBkColor(hdc, PrintTheme.Colors[tcBack]);
- SelectObject(hdc, fontHeader);
- ta := SetTextAlign(hdc, TA_BOTTOM);
- rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2,
- frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2);
- rcw.bottom := rcw.top + headerLineHeight;
- ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2,
- ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil);
- SetTextAlign(hdc, ta);
- pen := CreatePen(0, 1, GetTextColor(hdc));
- penOld := SelectObject(hdc, pen);
- MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil);
- LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4);
- SelectObject(hdc, penOld);
- DeleteObject(pen);
- end;
- frPrint.chrg.StartPos := lengthPrinted;
- frPrint.chrg.EndPos := lengthDoc;
- lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint);
- if printPage then begin
- SetTextColor(hdc, PrintTheme.Colors[tcFore]);
- SetBkColor(hdc, PrintTheme.Colors[tcBack]);
- SelectObject(hdc, fontFooter);
- ta := SetTextAlign(hdc, TA_TOP);
- rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2,
- frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2);
- ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2,
- ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil);
- SetTextAlign(hdc, ta);
- pen := CreatePen(0, 1, GetTextColor(hdc));
- penOld := SelectObject(hdc, pen);
- MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil);
- LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4);
- SelectObject(hdc, penOld);
- DeleteObject(pen);
- EndPage(hdc);
- end;
- Inc(pageNum);
- if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then
- Break;
- end;
- FActiveMemo.FormatRange(False, nil);
- EndDoc(hdc);
- DeleteDC(hdc);
- DeleteObject(fontHeader);
- DeleteObject(fontFooter);
- finally
- DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
- end;
- end;
- procedure TMainForm.FClearRecentClick(Sender: TObject);
- begin
- if MsgBox('Are you sure you want to clear the list of recently opened files?',
- SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
- ClearMRUMainFilesList;
- end;
- procedure TMainForm.FMRUClick(Sender: TObject);
- var
- I: Integer;
- begin
- if ConfirmCloseFile(True) then
- for I := 0 to High(FMRUMainFilesMenuItems) do
- if FMRUMainFilesMenuItems[I] = Sender then begin
- OpenMRUMainFile(FMRUMainFilesList[I]);
- Break;
- end;
- end;
- procedure TMainForm.FExitClick(Sender: TObject);
- begin
- Close;
- end;
- procedure TMainForm.EMenuClick(Sender: TObject);
- var
- MemoHasFocus, MemoIsReadOnly: Boolean;
- begin
- MemoHasFocus := FActiveMemo.Focused;
- MemoIsReadOnly := FActiveMemo.ReadOnly;
- EUndo.Enabled := MemoHasFocus and FActiveMemo.CanUndo;
- ERedo.Enabled := MemoHasFocus and FActiveMemo.CanRedo;
- ECut.Enabled := MemoHasFocus and not MemoIsReadOnly and not FActiveMemo.SelEmpty;
- ECopy.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty;
- EPaste.Enabled := MemoHasFocus and FActiveMemo.CanPaste;
- EDelete.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty;
- ESelectAll.Enabled := MemoHasFocus;
- ESelectNextOccurrence.Enabled := MemoHasFocus;
- ESelectAllOccurrences.Enabled := MemoHasFocus;
- ESelectAllFindMatches.Enabled := MemoHasFocus and (FLastFindText <> '');
- EFind.Enabled := MemoHasFocus;
- EFindNext.Enabled := MemoHasFocus;
- EFindPrevious.Enabled := MemoHasFocus;
- EReplace.Enabled := MemoHasFocus and not MemoIsReadOnly;
- EFindRegEx.Checked := FOptions.FindRegEx;
- EFoldLine.Visible := FOptions.UseFolding;
- EFoldLine.Enabled := MemoHasFocus;
- EUnfoldLine.Visible := EFoldLine.Visible;
- EUnfoldLine.Enabled := EFoldLine.Enabled;
- EGoto.Enabled := MemoHasFocus;
- EToggleLinesComment.Enabled := not MemoIsReadOnly;
- EBraceMatch.Enabled := MemoHasFocus;
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.EUndoClick(Sender: TObject);
- begin
- FActiveMemo.Undo;
- end;
- procedure TMainForm.ERedoClick(Sender: TObject);
- begin
- FActiveMemo.Redo;
- end;
- procedure TMainForm.ECutClick(Sender: TObject);
- begin
- FActiveMemo.CutToClipboard;
- end;
- procedure TMainForm.ECopyClick(Sender: TObject);
- begin
- FActiveMemo.CopyToClipboard;
- end;
- function TMainForm.MultipleSelectionPasteFromClipboard(const AMemo: TIDEScintEdit): Boolean;
- begin
- { Scintilla doesn't yet properly support multiple selection paste. Handle it
- here, just like VS and VSCode do: if there's multiple selections and the paste
- text has the same amount of lines then paste 1 line per selection. Do this even
- if the paste text is marked as rectangular. Otherwise (so no match between
- the selection count and the line count) paste all lines into each selection.
- For the latter we don't need handling here: this is Scintilla's default
- behaviour if SC_MULTIPASTE_EACH is on. }
- Result := False;
- var SelectionCount := AMemo.SelectionCount;
- if SelectionCount > 1 then begin
- var PasteLines := Clipboard.AsText.Replace(#13#10, #13).Split([#13, #10]);
- if SelectionCount = Length(PasteLines) then begin
- AMemo.BeginUndoAction;
- try
- for var I := 0 to SelectionCount-1 do begin
- var StartPos := AMemo.SelectionStartPosition[I]; { Can't use AMemo.GetSelections because each paste can update other selections }
- var EndPos := AMemo.SelectionEndPosition[I];
- AMemo.ReplaceTextRange(StartPos, EndPos, PasteLines[I], srmMinimal);
- { Update the selection to an empty selection at the end of the inserted
- text, just like ReplaceMainSelText }
- var Pos := AMemo.Target.EndPos; { ReplaceTextRange updates the target }
- AMemo.SelectionCaretPosition[I] := Pos;
- AMemo.SelectionAnchorPosition[I] := Pos;
- end;
- { Be like SCI_PASTE }
- AMemo.ChooseCaretX;
- AMemo.ScrollCaretIntoView;
- finally
- AMemo.EndUndoAction;
- end;
- Result := True;
- end;
- end;
- end;
- procedure TMainForm.EPasteClick(Sender: TObject);
- begin
- if not MultipleSelectionPasteFromClipboard(FActiveMemo) then
- FActiveMemo.PasteFromClipboard;
- end;
- procedure TMainForm.EDeleteClick(Sender: TObject);
- begin
- FActiveMemo.ClearSelection;
- end;
- procedure TMainForm.ESelectAllClick(Sender: TObject);
- begin
- FActiveMemo.SelectAll;
- end;
- procedure TMainForm.ESelectAllOccurrencesClick(Sender: TObject);
- begin
- { Might be called even if ESelectAllOccurrences.Enabled would be False in EMenuClick }
- if FActiveMemo.SelEmpty then begin
- { If the selection is empty then SelectAllOccurrences will actually just select
- the word at caret which is not what we want, so preselect this word ourselves }
- var Range := FActiveMemo.WordAtCaretRange;
- if Range.StartPos <> Range.EndPos then
- FActiveMemo.SetSingleSelection(Range.EndPos, Range.StartPos);
- end;
- FActiveMemo.SelectAllOccurrences([sfoMatchCase]);
- end;
- procedure TMainForm.ESelectNextOccurrenceClick(Sender: TObject);
- begin
- { Might be called even if ESelectNextOccurrence.Enabled would be False in EMenuClick }
- FActiveMemo.SelectNextOccurrence([sfoMatchCase]);
- end;
- procedure TMainForm.EToggleLinesCommentClick(Sender: TObject);
- begin
- var AMemo := FActiveMemo;
- { Based on SciTE 5.50's SciTEBase::StartBlockComment - only toggles comments
- for the main selection }
- var Selection := AMemo.Selection;
- var CaretPosition := AMemo.CaretPosition;
- // checking if caret is located in _beginning_ of selected block
- var MoveCaret := CaretPosition < Selection.EndPos;
- var SelStartLine := AMemo.GetLineFromPosition(Selection.StartPos);
- var SelEndLine := AMemo.GetLineFromPosition(Selection.EndPos);
- var Lines := SelEndLine - SelStartLine;
- var FirstSelLineStart := AMemo.GetPositionFromLine(SelStartLine);
- // "caret return" is part of the last selected line
- if (Lines > 0) and (Selection.EndPos = AMemo.GetPositionFromLine(SelEndLine)) then
- Dec(SelEndLine);
- { We rely on the styler to identify [Code] section lines, but we
- may be searching into areas that haven't been styled yet }
- AMemo.StyleNeeded(Selection.EndPos);
- AMemo.BeginUndoAction;
- try
- var LastLongCommentLength := 0;
- for var I := SelStartLine to SelEndLine do begin
- var LineIndent := AMemo.GetLineIndentPosition(I);
- var LineEnd := AMemo.GetLineEndPosition(I);
- var LineBuf := AMemo.GetTextRange(LineIndent, LineEnd);
- // empty lines are not commented
- if LineBuf = '' then
- Continue;
- var Comment: String;
- if LineBuf.StartsWith('//') or
- (FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[I]) = scCode) then
- Comment := '//'
- else
- Comment := ';';
- var LongComment := Comment + ' ';
- LastLongCommentLength := Length(LongComment);
- if LineBuf.StartsWith(Comment) then begin
- var CommentLength := Length(Comment);
- if LineBuf.StartsWith(LongComment) then begin
- // Removing comment with space after it.
- CommentLength := Length(LongComment);
- end;
- AMemo.Selection := TScintRange.Create(LineIndent, LineIndent + CommentLength);
- AMemo.SelText := '';
- if I = SelStartLine then // is this the first selected line?
- Dec(Selection.StartPos, CommentLength);
- Dec(Selection.EndPos, CommentLength); // every iteration
- Continue;
- end;
- if I = SelStartLine then // is this the first selected line?
- Inc(Selection.StartPos, Length(LongComment));
- Inc(Selection.EndPos, Length(LongComment)); // every iteration
- AMemo.Call(SCI_INSERTTEXT, LineIndent, AMemo.ConvertStringToRawString(LongComment));
- end;
- // after uncommenting selection may promote itself to the lines
- // before the first initially selected line;
- // another problem - if only comment symbol was selected;
- if Selection.StartPos < FirstSelLineStart then begin
- if Selection.StartPos >= Selection.EndPos - (LastLongCommentLength - 1) then
- Selection.EndPos := FirstSelLineStart;
- Selection.StartPos := FirstSelLineStart;
- end;
- if MoveCaret then begin
- // moving caret to the beginning of selected block
- AMemo.CaretPosition := Selection.EndPos;
- AMemo.CaretPositionWithSelectFromAnchor := Selection.StartPos;
- end else
- AMemo.Selection := Selection;
- finally
- AMemo.EndUndoAction;
- end;
- end;
- procedure TMainForm.EBraceMatchClick(Sender: TObject);
- begin
- var AMemo := FActiveMemo;
- var Selections: TScintCaretAndAnchorList := nil;
- var VirtualSpaces: TScintCaretAndAnchorList := nil;
- try
- Selections := TScintCaretAndAnchorList.Create;
- VirtualSpaces := TScintCaretAndAnchorList.Create;
- AMemo.GetSelections(Selections, VirtualSpaces);
- for var I := 0 to Selections.Count-1 do begin
- if VirtualSpaces[I].CaretPos = 0 then begin
- var Pos := Selections[I].CaretPos;
- var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
- if MatchPos = -1 then begin
- Pos := AMemo.GetPositionBefore(Pos);
- MatchPos := AMemo.GetPositionOfMatchingBrace(Pos)
- end;
- if MatchPos <> -1 then begin
- AMemo.SelectionCaretPosition[I] := MatchPos;
- AMemo.SelectionAnchorPosition[I] := MatchPos;
- if I = 0 then
- AMemo.ScrollCaretIntoView;
- end;
- end;
- end;
- finally
- VirtualSpaces.Free;
- Selections.Free;
- end;
- end;
- procedure TMainForm.ESelectAllFindMatchesClick(Sender: TObject);
- begin
- { Might be called even if ESelectAllFindMatches.Enabled would be False in EMenuClick }
- if FLastFindText <> '' then begin
- var StartPos := 0;
- var EndPos := FActiveMemo.RawTextLength;
- var FoundRange: TScintRange;
- var ClosestSelection := -1;
- var ClosestSelectionDistance := 0; { Silence compiler }
- var CaretPos := FActiveMemo.CaretPosition;
- while (StartPos < EndPos) and
- FActiveMemo.FindText(StartPos, EndPos, FLastFindText,
- FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), FoundRange) do begin
- if StartPos = 0 then
- FActiveMemo.SetSingleSelection(FoundRange.EndPos, FoundRange.StartPos)
- else
- FActiveMemo.AddSelection(FoundRange.EndPos, FoundRange.StartPos);
- var Distance := Abs(CaretPos-FoundRange.EndPos);
- if (ClosestSelection = -1) or (Distance < ClosestSelectionDistance) then begin
- ClosestSelection := FActiveMemo.SelectionCount-1;
- ClosestSelectionDistance := Distance;
- end;
- StartPos := FoundRange.EndPos;
- end;
- if ClosestSelection <> -1 then begin
- FActiveMemo.MainSelection := ClosestSelection;
- FActiveMemo.ScrollCaretIntoView;
- end;
- end;
- end;
- procedure TMainForm.VMenuClick(Sender: TObject);
- begin
- VZoomIn.Enabled := (FActiveMemo.Zoom < 20);
- VZoomOut.Enabled := (FActiveMemo.Zoom > -10);
- VZoomReset.Enabled := (FActiveMemo.Zoom <> 0);
- VToolbar.Checked := ToolbarPanel.Visible;
- VStatusBar.Checked := StatusBar.Visible;
- VNextTab.Enabled := MemosTabSet.Visible and (MemosTabSet.Tabs.Count > 1);
- VPreviousTab.Enabled := VNextTab.Enabled;
- VCloseCurrentTab.Enabled := MemosTabSet.Visible and (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
- VReopenTab.Visible := MemosTabSet.Visible and (FHiddenFiles.Count > 0);
- if VReopenTab.Visible then
- UpdateReopenTabMenu(VReopenTab);
- VReopenTabs.Visible := VReopenTab.Visible;
- VHide.Checked := not StatusPanel.Visible;
- VCompilerOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiCompilerOutput);
- VDebugOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugOutput);
- VDebugCallStack.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugCallStack);
- VFindResults.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiFindResults);
- VWordWrap.Checked := FOptions.WordWrap;
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.VNextTabClick(Sender: TObject);
- var
- NewTabIndex: Integer;
- begin
- NewTabIndex := MemosTabSet.TabIndex+1;
- if NewTabIndex >= MemosTabSet.Tabs.Count then
- NewTabIndex := 0;
- MemosTabSet.TabIndex := NewTabIndex;
- end;
- procedure TMainForm.VPreviousTabClick(Sender: TObject);
- var
- NewTabIndex: Integer;
- begin
- NewTabIndex := MemosTabSet.TabIndex-1;
- if NewTabIndex < 0 then
- NewTabIndex := MemosTabSet.Tabs.Count-1;
- MemosTabSet.TabIndex := NewTabIndex;
- end;
- procedure TMainForm.CloseTab(const TabIndex: Integer);
- begin
- var Memo := TabIndexToMemo(TabIndex, MemosTabSet.Tabs.Count-1);
- var MemoWasActiveMemo := Memo = FActiveMemo;
- MemosTabSet.Tabs.Delete(TabIndex); { This will not change MemosTabset.TabIndex }
- MemosTabSet.Hints.Delete(TabIndex);
- MemosTabSet.CloseButtons.Delete(TabIndex);
- FHiddenFiles.Add((Memo as TIDEScintFileEdit).Filename);
- InvalidateStatusPanel(spHiddenFilesCount);
- BuildAndSaveKnownIncludedAndHiddenFiles;
- { Because MemosTabSet.Tabs and FHiddenFiles have both been updated now,
- hereafter setting TabIndex will not select the memo we're closing
- even if it's not hidden yet because TabIndexToMemo as called by
- MemosTabSetClick will skip it }
- if MemoWasActiveMemo then begin
- { Select next tab, except when we're already at the end. Avoiding flicker by
- doing this before hiding old active memo. We do this in a dirty way by
- clicking two tabs while making sure TabSetClick doesn't see the first
- 'fake' one. }
- FIgnoreTabSetClick := True;
- try
- VNextTabClick(Self);
- finally
- FIgnoreTabSetClick := False;
- end;
- VPreviousTabClick(Self);
- Memo.CancelAutoCompleteAndCallTip;
- Memo.Visible := False;
- end else if TabIndex < MemosTabset.TabIndex then
- MemosTabSet.TabIndex := MemosTabset.TabIndex-1; { Reselect old selected tab }
- end;
- procedure TMainForm.VCloseCurrentTabClick(Sender: TObject);
- begin
- CloseTab(MemosTabSet.TabIndex);
- end;
- procedure TMainForm.ReopenTabOrTabs(const HiddenFileIndex: Integer;
- const Activate: Boolean);
- begin
- var ReopenFilename: String;
- if HiddenFileIndex >= 0 then begin
- ReopenFilename := FHiddenFiles[HiddenFileIndex];
- FHiddenFiles.Delete(HiddenFileIndex);
- end else begin
- ReopenFilename := FHiddenFiles[0];
- FHiddenFiles.Clear;
- end;
- InvalidateStatusPanel(spHiddenFilesCount);
- UpdatePreprocMemos;
- BuildAndSaveKnownIncludedAndHiddenFiles;
- { Activate the memo if requested }
- if Activate then begin
- for var Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin
- MemosTabSet.TabIndex := MemoToTabIndex(memo);
- Break;
- end;
- end
- end;
- end;
- procedure TMainForm.ReopenTabClick(Sender: TObject);
- begin
- ReopenTabOrTabs((Sender as TMenuItem).Tag, True);
- end;
- procedure TMainForm.VReopenTabsClick(Sender: TObject);
- begin
- ReopenTabOrTabs(-1, True);
- end;
- procedure TMainForm.VZoomInClick(Sender: TObject);
- begin
- FActiveMemo.ZoomIn; { MemoZoom will zoom the other memos }
- end;
- procedure TMainForm.VZoomOutClick(Sender: TObject);
- begin
- FActiveMemo.ZoomOut;
- end;
- procedure TMainForm.VZoomResetClick(Sender: TObject);
- begin
- FActiveMemo.Zoom := 0;
- end;
- procedure TMainForm.VToolbarClick(Sender: TObject);
- begin
- ToolbarPanel.Visible := not ToolbarPanel.Visible;
- end;
- procedure TMainForm.VStatusBarClick(Sender: TObject);
- begin
- StatusBar.Visible := not StatusBar.Visible;
- end;
- procedure TMainForm.VWordWrapClick(Sender: TObject);
- begin
- FOptions.WordWrap := not FOptions.WordWrap;
- SyncEditorOptions;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap);
- finally
- Ini.Free;
- end;
- end;
- procedure TMainForm.SetStatusPanelVisible(const AVisible: Boolean);
- var
- CaretWasInView: Boolean;
- begin
- if StatusPanel.Visible <> AVisible then begin
- CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition);
- if AVisible then begin
- { Ensure the status panel height isn't out of range before showing }
- UpdateStatusPanelHeight(StatusPanel.Height);
- SplitPanel.Top := ClientHeight;
- StatusPanel.Top := ClientHeight;
- end
- else begin
- if StatusPanel.ContainsControl(ActiveControl) then
- ActiveControl := FActiveMemo;
- end;
- SplitPanel.Visible := AVisible;
- StatusPanel.Visible := AVisible;
- if AVisible and CaretWasInView then begin
- { If the caret was in view, make sure it still is }
- FActiveMemo.ScrollCaretIntoView;
- end;
- end;
- end;
- procedure TMainForm.VHideClick(Sender: TObject);
- begin
- SetStatusPanelVisible(False);
- end;
- procedure TMainForm.VCompilerOutputClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiCompilerOutput;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VDebugOutputClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiDebugOutput;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VDebugCallStackClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiDebugCallStack;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VFindResultsClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiFindResults;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.BMenuClick(Sender: TObject);
- begin
- BLowPriority.Checked := FOptions.LowPriorityDuringCompile;
- BOpenOutputFolder.Enabled := (FCompiledExe <> '');
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.BCompileClick(Sender: TObject);
- begin
- CompileFile('', False);
- end;
- procedure TMainForm.BStopCompileClick(Sender: TObject);
- begin
- SetAppTaskbarProgressState(tpsPaused);
- try
- if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption,
- mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
- FCompileWantAbort := True;
- finally
- SetAppTaskbarProgressState(tpsNormal);
- end;
- end;
- procedure TMainForm.BLowPriorityClick(Sender: TObject);
- begin
- FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile;
- { If a compile is already in progress, change the priority now }
- if FCompiling then
- SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
- end;
- procedure TMainForm.BOpenOutputFolderClick(Sender: TObject);
- begin
- LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe',
- Format('/select,"%s"', [FCompiledExe]));
- end;
- procedure TMainForm.HShortcutsDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformshortcuts.htm')));
- end;
- procedure TMainForm.HRegExDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformregex.htm')));
- end;
- procedure TMainForm.HDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0);
- end;
- procedure TMainForm.HExamplesClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples');
- end;
- procedure TMainForm.HFaqClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url');
- end;
- procedure TMainForm.HWhatsNewClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + {$IFDEF DEBUG} '..\..\' + {$ENDIF} 'whatsnew.htm');
- end;
- procedure TMainForm.HWebsiteClick(Sender: TObject);
- begin
- LaunchFileOrURL('https://jrsoftware.org/isinfo.php');
- end;
- procedure TMainForm.HMailingListClick(Sender: TObject);
- begin
- OpenMailingListSite;
- end;
- procedure TMainForm.HISPPDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_isppoverview.htm')));
- end;
- procedure TMainForm.HDonateClick(Sender: TObject);
- begin
- OpenDonateSite;
- end;
- procedure TMainForm.HAboutClick(Sender: TObject);
- var
- S: String;
- begin
- { Removing the About box or modifying any existing text inside it is a
- violation of the Inno Setup license agreement; see LICENSE.TXT.
- However, adding additional lines to the About box is permitted, as long as
- they are placed below the original copyright notice. }
- S := FCompilerVersion.Title + ' Compiler version ' +
- String(FCompilerVersion.Version) + SNewLine;
- if FCompilerVersion.Title <> 'Inno Setup' then
- S := S + (SNewLine + 'Based on Inno Setup' + SNewLine);
- S := S + ('Copyright (C) 1997-2025 Jordan Russell' + SNewLine +
- 'Portions Copyright (C) 2000-2025 Martijn Laan' + SNewLine +
- 'All rights reserved.' + SNewLine2 +
- 'Inno Setup home page:' + SNewLine +
- 'https://www.innosetup.com/' + SNewLine2 +
- 'RemObjects Pascal Script home page:' + SNewLine +
- 'https://www.remobjects.com/ps' + SNewLine2 +
- 'Refer to LICENSE.TXT for conditions of distribution and use.');
- MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK);
- end;
- procedure TMainForm.WMStartCommandLineCompile(var Message: TMessage);
- var
- Code: Integer;
- begin
- UpdateStatusPanelHeight(ClientHeight);
- Code := 0;
- try
- try
- CompileFile(CommandLineFilename, True);
- except
- Code := 2;
- Application.HandleException(Self);
- end;
- finally
- Halt(Code);
- end;
- end;
- procedure TMainForm.WMStartCommandLineWizard(var Message: TMessage);
- var
- Code: Integer;
- begin
- Code := 0;
- try
- try
- NewMainFileUsingWizard;
- except
- Code := 2;
- Application.HandleException(Self);
- end;
- finally
- Halt(Code);
- end;
- end;
- procedure TMainForm.WMStartNormally(var Message: TMessage);
- procedure ShowStartupForm;
- var
- StartupForm: TStartupForm;
- Ini: TConfigIniFile;
- begin
- ReadMRUMainFilesList;
- StartupForm := TStartupForm.Create(Application);
- try
- StartupForm.MRUFilesList := FMRUMainFilesList;
- StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm;
- if StartupForm.ShowModal = mrOK then begin
- if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin
- FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked;
- Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
- finally
- Ini.Free;
- end;
- end;
- case StartupForm.Result of
- srEmpty:
- FNewMainFileClick(Self);
- srWizard:
- FNewMainFileUserWizardClick(Self);
- srOpenFile:
- if ConfirmCloseFile(True) then
- OpenMRUMainFile(StartupForm.ResultMainFileName);
- srOpenDialog:
- ShowOpenMainFileDialog(False);
- srOpenDialogExamples:
- ShowOpenMainFileDialog(True);
- end;
- end;
- finally
- StartupForm.Free;
- end;
- end;
- begin
- if CommandLineFilename = '' then begin
- if FOptions.ShowStartupForm then
- ShowStartupForm;
- end else
- OpenFile(FMainMemo, CommandLineFilename, False);
- end;
- procedure TMainForm.WMSysColorChange(var Message: TMessage);
- begin
- inherited;
- for var Memo in FMemos do
- Memo.SysColorChange(Message);
- end;
- procedure TMainForm.UpdateReopenTabMenu(const Menu: TMenuItem);
- begin
- Menu.Clear;
- for var I := 0 to FHiddenFiles.Count-1 do begin
- var MenuItem := TMenuItem.Create(Menu);
- MenuItem.Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(PathExtractName(FHiddenFiles[I]));
- MenuItem.Tag := I;
- MenuItem.OnClick := ReopenTabClick;
- Menu.Add(MenuItem);
- end;
- end;
- procedure TMainForm.MemosTabSetPopupMenuClick(Sender: TObject);
- begin
- { Main and preprocessor memos can't be hidden }
- VCloseCurrentTab2.Enabled := (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
- VReopenTab2.Visible := FHiddenFiles.Count > 0;
- if VReopenTab2.Visible then
- UpdateReopenTabMenu(VReopenTab2);
- VReopenTabs2.Visible := VReopenTab2.Visible;
- ApplyMenuBitmaps(Sender as TMenuItem)
- end;
- procedure TMainForm.MemosTabSetClick(Sender: TObject);
- begin
- if FIgnoreTabSetClick then
- Exit;
- var NewActiveMemo := TabIndexToMemo(MemosTabSet.TabIndex, MemosTabSet.Tabs.Count-1);
- if NewActiveMemo <> FActiveMemo then begin
- { Avoiding flicker by showing new before hiding old }
- NewActiveMemo.Visible := True;
- var OldActiveMemo := FActiveMemo;
- FActiveMemo := NewActiveMemo;
- ActiveControl := NewActiveMemo;
- OldActiveMemo.CancelAutoCompleteAndCallTip;
- OldActiveMemo.Visible := False;
- UpdateSaveMenuItemAndButton;
- UpdateRunMenu;
- UpdateCaretPosPanelAndBackNavStack;
- UpdateEditModePanel;
- UpdateModifiedPanel;
- end;
- end;
- procedure TMainForm.MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
- begin
- CloseTab(Index);
- end;
- procedure TMainForm.InitializeFindText(Dlg: TFindDialog);
- var
- S: String;
- begin
- S := FActiveMemo.MainSelText;
- if (S <> '') and (Pos(#13, S) = 0) and (Pos(#10, S) = 0) then
- Dlg.FindText := S
- else
- Dlg.FindText := FLastFindText;
- end;
- const
- OldFindReplaceWndProcProp = 'OldFindReplaceWndProc';
- function FindReplaceWndProc(Wnd: HWND; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
- function CallDefWndProc: LRESULT;
- begin
- Result := CallWindowProc(Pointer(GetProp(Wnd, OldFindReplaceWndProcProp)), Wnd,
- Msg, WParam, LParam);
- end;
- begin
- case Msg of
- WM_MENUCHAR:
- if LoWord(wParam) = VK_RETURN then begin
- var hwndCtl := GetDlgItem(Wnd, idOk);
- if (hWndCtl <> 0) and IsWindowEnabled(hWndCtl) then
- PostMessage(Wnd, WM_COMMAND, MakeWParam(idOk, BN_CLICKED), Windows.LPARAM(hWndCtl));
- end;
- WM_NCDESTROY:
- begin
- Result := CallDefWndProc;
- RemoveProp(Wnd, OldFindReplaceWndProcProp);
- Exit;
- end;
- end;
- Result := CallDefWndProc;
- end;
- procedure ExecuteFindDialogAllowingAltEnter(const FindDialog: TFindDialog);
- begin
- var DoHook := FindDialog.Handle = 0;
- FindDialog.Execute;
- if DoHook then begin
- SetProp(FindDialog.Handle, OldFindReplaceWndProcProp, GetWindowLong(FindDialog.Handle, GWL_WNDPROC));
- SetWindowLong(FindDialog.Handle, GWL_WNDPROC, IntPtr(@FindReplaceWndProc));
- end;
- end;
- procedure TMainForm.EFindClick(Sender: TObject);
- begin
- ReplaceDialog.CloseDialog;
- if FindDialog.Handle = 0 then
- InitializeFindText(FindDialog);
- if (Sender = EFind) or (Sender = EFindNext) then
- FindDialog.Options := FindDialog.Options + [frDown]
- else
- FindDialog.Options := FindDialog.Options - [frDown];
- ExecuteFindDialogAllowingAltEnter(FindDialog);
- end;
- procedure TMainForm.EFindInFilesClick(Sender: TObject);
- begin
- InitializeFindText(FindInFilesDialog);
- FindInFilesDialog.Execute;
- end;
- procedure TMainForm.EFindNextOrPreviousClick(Sender: TObject);
- begin
- if FLastFindText = '' then
- EFindClick(Sender)
- else begin
- if Sender = EFindNext then
- FLastFindOptions := FLastFindOptions + [frDown]
- else
- FLastFindOptions := FLastFindOptions - [frDown];
- FLastFindRegEx := FOptions.FindRegEx;
- if not TestLastFindOptions then
- Exit;
- FindNext(False);
- end;
- end;
- procedure TMainForm.FindNext(const ReverseDirection: Boolean);
- var
- StartPos, EndPos: Integer;
- Range: TScintRange;
- begin
- var Down := frDown in FLastFindOptions;
- if ReverseDirection then
- Down := not Down;
- if Down then begin
- StartPos := FActiveMemo.Selection.EndPos;
- EndPos := FActiveMemo.RawTextLength;
- end
- else begin
- StartPos := FActiveMemo.Selection.StartPos;
- EndPos := 0;
- end;
- if FActiveMemo.FindText(StartPos, EndPos, FLastFindText,
- FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) then
- FActiveMemo.SelectAndEnsureVisible(Range)
- else
- MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
- mbInformation, MB_OK);
- end;
- function TMainForm.StoreAndTestLastFindOptions(Sender: TObject): Boolean;
- begin
- { TReplaceDialog is a subclass of TFindDialog must check for TReplaceDialog first }
- if Sender is TReplaceDialog then begin
- with Sender as TReplaceDialog do begin
- FLastFindOptions := Options;
- FLastFindText := FindText;
- end;
- end else begin
- with Sender as TFindDialog do begin
- FLastFindOptions := Options;
- FLastFindText := FindText;
- end;
- end;
- FLastFindRegEx := FOptions.FindRegEx;
- Result := TestLastFindOptions;
- end;
- function TMainForm.TestLastFindOptions;
- begin
- if FLastFindRegEx then begin
- Result := FActiveMemo.TestRegularExpression(FLastFindText);
- if not Result then
- MsgBoxFmt('Invalid regular expression "%s"', [FLastFindText], SCompilerFormCaption,
- mbError, MB_OK);
- end else
- Result := True;
- end;
- procedure TMainForm.FindDialogFind(Sender: TObject);
- begin
- { This event handler is shared between FindDialog & ReplaceDialog }
- if not StoreAndTestLastFindOptions(Sender) then
- Exit;
- if GetKeyState(VK_MENU) < 0 then begin
- { Alt+Enter was used to close the dialog }
- (Sender as TFindDialog).CloseDialog;
- ESelectAllFindMatchesClick(Self); { Uses the copy made above }
- end else
- FindNext(GetKeyState(VK_SHIFT) < 0);
- end;
- procedure TMainForm.FindInFilesDialogFind(Sender: TObject);
- begin
- if not StoreAndTestLastFindOptions(Sender) then
- Exit;
- FindResultsList.Clear;
- SendMessage(FindResultsList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- FFindResults.Clear;
- var Hits := 0;
- var Files := 0;
- for var Memo in FFileMemos do begin
- if Memo.Used then begin
- var StartPos := 0;
- var EndPos := Memo.RawTextLength;
- var FileHits := 0;
- var Range: TScintRange;
- while (StartPos < EndPos) and
- Memo.FindText(StartPos, EndPos, FLastFindText,
- FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin
- { Also see UpdateFindResult }
- var Line := Memo.GetLineFromPosition(Range.StartPos);
- var Prefix := Format(' Line %d: ', [Line+1]);
- var FindResult := TFindResult.Create;
- FindResult.Filename := Memo.Filename;
- FindResult.Line := Line;
- FindResult.LineStartPos := Memo.GetPositionFromLine(Line);
- FindResult.Range := Range;
- FindResult.PrefixStringLength := Length(Prefix);
- FFindResults.Add(FindResult);
- FindResultsList.Items.AddObject(Prefix + Memo.Lines[Line], FindResult);
- Inc(FileHits);
- StartPos := Range.EndPos;
- end;
- Inc(Files);
- if FileHits > 0 then begin
- Inc(Hits, FileHits);
- FindResultsList.Items.Insert(FindResultsList.Count-FileHits, Format('%s (%d hits):', [Memo.Filename, FileHits]));
- end;
- end;
- end;
- FindResultsList.Items.Insert(0, Format('Find "%s" (%d hits in %d files)', [FindInFilesDialog.FindText, Hits, Files]));
- FindInFilesDialog.CloseDialog;
- OutputTabSet.TabIndex := tiFindResults;
- SetStatusPanelVisible(True);
- end;
- function TMainForm.FindSetupDirectiveValue(const DirectiveName,
- DefaultValue: String): String;
- begin
- Result := DefaultValue;
- var Memo := FMainMemo; { This function only searches the main file }
- var StartPos := 0;
- var EndPos := Memo.RawTextLength;
- var Range: TScintRange;
- { We rely on the styler to identify [Setup] section lines, but we
- may be searching into areas that haven't been styled yet }
- Memo.StyleNeeded(EndPos);
- while (StartPos < EndPos) and
- Memo.FindText(StartPos, EndPos, DirectiveName, [sfoWholeWord], Range) do begin
- var Line := Memo.GetLineFromPosition(Range.StartPos);
- if FMemosStyler.GetSectionFromLineState(Memo.Lines.State[Line]) = scSetup then begin
- var LineValue := Memo.Lines[Line].Trim; { LineValue can't be empty }
- if LineValue[1] <> ';' then begin
- var LineParts := LineValue.Split(['=']);
- if (Length(LineParts) = 2) and SameText(LineParts[0].Trim, DirectiveName) then begin
- Result := LineParts[1].Trim;
- { If Result is surrounded in quotes, remove them, just like TSetupCompiler.SeparateDirective }
- if (Length(Result) >= 2) and
- (Result[1] = '"') and (Result[Length(Result)] = '"') then
- Result := Copy(Result, 2, Length(Result)-2);
- Exit; { Compiler doesn't allow a directive to be specified twice so we can exit now }
- end;
- end;
- end;
- StartPos := Range.EndPos;
- end;
- end;
- function TMainForm.FindSetupDirectiveValue(const DirectiveName: String;
- DefaultValue: Boolean): Boolean;
- begin
- var Value := FindSetupDirectiveValue(DirectiveName, IfThen(DefaultValue, '1', '0'));
- if not TryStrToBoolean(Value, Result) then
- Result := DefaultValue;
- end;
- procedure TMainForm.EReplaceClick(Sender: TObject);
- begin
- FindDialog.CloseDialog;
- if ReplaceDialog.Handle = 0 then begin
- InitializeFindText(ReplaceDialog);
- ReplaceDialog.ReplaceText := FLastReplaceText;
- end;
- ExecuteFindDialogAllowingAltEnter(ReplaceDialog);
- end;
- procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
- begin
- if not StoreAndTestLastFindOptions(Sender) then
- Exit;
- FLastReplaceText := ReplaceDialog.ReplaceText;
- var ReplaceMode := RegExToReplaceMode(FLastFindRegEx);
- if frReplaceAll in FLastFindOptions then begin
- var ReplaceCount := 0;
- FActiveMemo.BeginUndoAction;
- try
- var Pos := 0;
- var Range: TScintRange;
- while FActiveMemo.FindText(Pos, FActiveMemo.RawTextLength, FLastFindText,
- FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin
- var NewRange := FActiveMemo.ReplaceTextRange(Range.StartPos, Range.EndPos, FLastReplaceText, ReplaceMode);
- Pos := NewRange.EndPos;
- Inc(ReplaceCount);
- end;
- finally
- FActiveMemo.EndUndoAction;
- end;
- if ReplaceCount = 0 then
- MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
- mbInformation, MB_OK)
- else
- MsgBoxFmt('%d occurrence(s) replaced.', [ReplaceCount], SCompilerFormCaption,
- mbInformation, MB_OK);
- end
- else begin
- if FActiveMemo.MainSelTextEquals(FLastFindText, FindOptionsToSearchOptions(frMatchCase in FLastFindOptions, FLastFindRegEx)) then begin
- { Note: the MainSelTextEquals above performs a search so the replacement
- below is safe even if the user just enabled regex }
- FActiveMemo.ReplaceMainSelText(FLastReplaceText, ReplaceMode);
- end;
- FindNext(GetKeyState(VK_SHIFT) < 0);
- end;
- end;
- procedure TMainForm.EFindRegExClick(Sender: TObject);
- begin
- { If EFindRegEx uses Alt+R as the shortcut just like VSCode then also handle it like VSCode:
- when the memo does not have the focus open the Run menu (also Alt+R) instead }
- if not FActiveMemo.Focused and (EFindRegEx.ShortCut = ShortCut(Ord('R'), [ssAlt])) then
- SendMessage(Handle, WM_SYSCOMMAND, SC_KEYMENU, Ord('r'))
- else begin
- FOptions.FindRegEx := not FOptions.FindRegEx;
- UpdateFindRegExUI;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'FindRegEx', FOptions.FindRegEx);
- finally
- Ini.Free;
- end;
- end;
- end;
- procedure TMainForm.EFoldOrUnfoldLineClick(Sender: TObject);
- begin
- FActiveMemo.FoldLine(FActiveMemo.CaretLine, Sender = EFoldLine);
- end;
- procedure TMainForm.UpdateStatusPanelHeight(H: Integer);
- var
- MinHeight, MaxHeight: Integer;
- begin
- MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height;
- MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height;
- if H > MaxHeight then H := MaxHeight;
- if H < MinHeight then H := MinHeight;
- StatusPanel.Height := H;
- end;
- procedure TMainForm.UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
- procedure FindTextAndAddRanges(const AMemo: TIDEScintEdit;
- const TextToFind: TScintRawString; const Options: TScintFindOptions;
- const Selections, IndicatorRanges: TScintRangeList);
- begin
- if TScintEdit.RawStringIsBlank(TextToFind) then
- Exit;
- var StartPos := 0;
- var EndPos := AMemo.RawTextLength;
- var FoundRange: TScintRange;
- while (StartPos < EndPos) and
- AMemo.FindRawText(StartPos, EndPos, TextToFind, Options, FoundRange) do begin
- StartPos := FoundRange.EndPos;
- { Don't add indicators on lines which have a line marker }
- var Line := AMemo.GetLineFromPosition(FoundRange.StartPos);
- var Markers := AMemo.GetMarkers(Line);
- if Markers * [mlmError, mlmBreakpointBad, mlmStep] <> [] then
- Continue;
- { Add indicator while making sure it does not overlap any regular selection
- styling for either the main selection or any additional selection. Does
- not account for an indicator overlapping more than 1 selection. }
- var OverlappingSelection: TScintRange;
- if Selections.Overlaps(FoundRange, OverlappingSelection) then begin
- if FoundRange.StartPos < OverlappingSelection.StartPos then
- IndicatorRanges.Add(TScintRange.Create(FoundRange.StartPos, OverlappingSelection.StartPos));
- if FoundRange.EndPos > OverlappingSelection.EndPos then
- IndicatorRanges.Add(TScintRange.Create(OverlappingSelection.EndPos, FoundRange.EndPos));
- end else
- IndicatorRanges.Add(FoundRange);
- end;
- end;
- function HighlightAtCursorAllowed(const Word: TScintRawString): Boolean;
- begin
- const Section = FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]);
- Result := FMemosStyler.HighlightAtCursorAllowed(Section, FActiveMemo.ConvertRawStringToString(Word));
- end;
- begin
- { Add occurrence indicators for the word at cursor if there's any and the
- main selection is within this word. On top of those add occurrence indicators
- for the main selected text if there's any. Don't do anything if the main
- selection is not single line. All of these things are just like VSCode. }
- var MainSelection: TScintRange;
- var MainSelNotEmpty := AMemo.SelNotEmpty(MainSelection);
- var MainSelSingleLine := AMemo.GetLineFromPosition(MainSelection.StartPos) =
- AMemo.GetLineFromPosition(MainSelection.EndPos);
- var IndicatorRanges: TScintRangeList := nil;
- var Selections: TScintRangeList := nil;
- try
- IndicatorRanges := TScintRangeList.Create;
- Selections := TScintRangeList.Create;
- if FOptions.HighlightWordAtCursorOccurrences and (AMemo.CaretVirtualSpace = 0) and MainSelSingleLine then begin
- var Word := AMemo.WordAtCaretRange;
- if (Word.StartPos <> Word.EndPos) and MainSelection.Within(Word) then begin
- var TextToIndicate := AMemo.GetRawTextRange(Word.StartPos, Word.EndPos);
- if HighlightAtCursorAllowed(TextToIndicate) then begin
- AMemo.GetSelections(Selections); { Gets any additional selections as well }
- FindTextAndAddRanges(AMemo, TextToIndicate, [sfoMatchCase, sfoWholeWord], Selections, IndicatorRanges);
- end;
- end;
- end;
- AMemo.UpdateIndicators(IndicatorRanges, minWordAtCursorOccurrence);
- IndicatorRanges.Clear;
- if FOptions.HighlightSelTextOccurrences and MainSelNotEmpty and MainSelSingleLine then begin
- var TextToIndicate := AMemo.RawMainSelText;
- if Selections.Count = 0 then { If 0 then we didn't already call GetSelections above}
- AMemo.GetSelections(Selections);
- FindTextAndAddRanges(AMemo, TextToIndicate, [], Selections, IndicatorRanges);
- end;
- AMemo.UpdateIndicators(IndicatorRanges, minSelTextOccurrence);
- finally
- Selections.Free;
- IndicatorRanges.Free;
- end;
- end;
- procedure TMainForm.UpdateImages;
- { Should be called at startup and after DPI changes }
- begin
- var WH := MulDiv(16, CurrentPPI, 96);
- var Images := ImagesModule.LightToolBarImageCollection;
- var Image := Images.GetSourceImage(Images.GetIndexByName('heart-filled'), WH, WH);
- UpdatePanelDonateImage.Picture.Graphic:= Image;
- end;
- procedure TMainForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- { Should be called at startup and after DPI changes }
- begin
- CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
- CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1;
- DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
- FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
- DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1;
- DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
- DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1;
- FindResultsList.Canvas.Font.Assign(FindResultsList.Font);
- FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1;
- end;
- type
- TBitmapWithBits = class
- Handle: HBITMAP;
- pvBits: Pointer;
- destructor Destroy; override;
- end;
- destructor TBitmapWithBits.Destroy;
- begin
- if Handle <> 0 then
- DeleteObject(Handle);
- inherited;
- end;
- procedure TMainForm.UpdateMarginsAndAutoCompleteIcons;
- { Should be called at startup and after theme and DPI changes }
- type
- TMarkerOrACBitmaps = TObjectDictionary<Integer, TBitmapWithBits>;
- procedure SwapRedBlue(const pvBits: PByte; Width, Height: Integer);
- begin
- var pvPixel := pvBits;
- var pvMax := pvBits + 4*Width*Height;
- while pvPixel < pvMax do begin
- var Tmp := PByte(pvPixel)^;
- PByte(pvPixel)^ := PByte(pvPixel + 2)^;
- PByte(pvPixel + 2)^ := Tmp;
- Inc(pvPixel, 4);
- end;
- end;
- procedure AddMarkerOrACBitmap(const MarkerOrACBitmaps: TMarkerOrACBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
- const MarkerNumberOrACType: Integer; const BkBrush: TBrush; const ImageList: TVirtualImageList; const ImageName: String);
- begin
- { Prepare a bitmap and select it }
- var pvBits: Pointer;
- var Bitmap := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
- var OldBitmap := SelectObject(DC, Bitmap);
- { Fill the entire bitmap to avoid any alpha so we don't have to worry about
- whether will be premultiplied or not (it was in tests) when Scintilla wants
- it without premultiplication }
- var Width := BitmapInfo.bmiHeader.biWidth;
- var Height := Abs(BitmapInfo.bmiHeader.biHeight);
- var Rect := TRect.Create(0, 0, Width, Height);
- FillRect(DC, Rect, BkBrush.Handle);
- { Draw the image - the result will be in pvBits }
- if ImageList_Draw(ImageList.Handle, ImageList.GetIndexByName(ImageName), DC, 0, 0, ILD_TRANSPARENT) then begin
- SwapRedBlue(pvBits, Width, Height); { Change pvBits from BGRA to RGBA like Scintilla wants }
- var Bitmap2 := TBitmapWithBits.Create;
- Bitmap2.Handle := Bitmap;
- Bitmap2.pvBits := pvBits;
- MarkerOrACBitmaps.Add(MarkerNumberOrACType, Bitmap2);
- end else begin
- SelectObject(DC, OldBitmap);
- DeleteObject(Bitmap);
- end;
- end;
- type
- TMarkerNumberOrACType = TPair<Integer, String>;
- function NNT(const MarkerNumberOrACType: Integer; const Name: String): TMarkerNumberOrACType;
- begin
- Result := TMarkerNumberOrACType.Create(MarkerNumberOrACType, Name); { This is a record so no need to free }
- end;
- begin
- var ImageList := ThemedMarkersAndACVirtualImageList;
- var DC := CreateCompatibleDC(0);
- if DC <> 0 then begin
- try
- var MarkerBitmaps: TMarkerOrACBitmaps := nil;
- var MarkerBkBrush: TBrush := nil;
- var AutoCompleteBitmaps: TMarkerOrACBitmaps := nil;
- var AutoCompleteBkBrush: TBrush := nil;
- try
- var BitmapInfo := CreateBitmapInfo(ImageList.Width, -ImageList.Height, 32); { This is a record so no need to free }
- MarkerBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
- MarkerBkBrush := TBrush.Create;
- MarkerBkBrush.Color := FTheme.Colors[tcMarginBack];
- var NamedMarkers := [
- NNT(mmiHasEntry, 'markers\debug-stop-filled'),
- NNT(mmiEntryProcessed, 'markers\debug-stop-filled_2'),
- NNT(mmiBreakpoint, 'markers\debug-breakpoint-filled'),
- NNT(mmiBreakpointBad, 'markers\debug-breakpoint-filled-cancel-2'),
- NNT(mmiBreakpointGood, 'markers\debug-breakpoint-filled-ok-2'),
- NNT(mmiStep, 'markers\symbol-arrow-right'),
- NNT(mmiBreakpointStep, 'markers\debug-breakpoint-filled-ok2-symbol-arrow-right'),
- NNT(SC_MARKNUM_FOLDER, 'markers\symbol-add'),
- NNT(SC_MARKNUM_FOLDEROPEN, 'markers\symbol-remove')];
- for var NamedMarker in NamedMarkers do
- AddMarkerOrAcBitmap(MarkerBitmaps, DC, BitmapInfo, NamedMarker.Key, MarkerBkBrush, ImageList, NamedMarker.Value);
- AutoCompleteBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
- AutoCompleteBkBrush := TBrush.Create;
- AutoCompleteBkBrush.Color := FTheme.Colors[tcIntelliBack];
- var NamedTypes := [
- NNT(awtSection, 'ac\structure-filled'),
- NNT(awtParameter, 'ac\xml-filled'),
- NNT(awtDirective, 'ac\xml-filled'),
- NNT(awtFlag, 'ac\values'),
- NNT(awtPreprocessorDirective, 'ac\symbol-hashtag'),
- NNT(awtConstant, 'ac\constant-filled_2'),
- NNT(awtScriptFunction, 'ac\method-filled'),
- NNT(awtScriptType, 'ac\types'),
- NNT(awtScriptVariable, 'ac\variables'),
- NNT(awtScriptConstant, 'ac\constant-filled'),
- NNT(awtScriptInterface, 'ac\interface-filled'),
- NNT(awtScriptProperty, 'ac\properties-filled'),
- NNT(awtScriptEvent, 'ac\event-filled'),
- NNT(awtScriptKeyword, 'ac\list'),
- NNT(awtScriptEnumValue, 'ac\constant-filled')];
- for var NamedType in NamedTypes do
- AddMarkerOrAcBitmap(AutoCompleteBitmaps, DC, BitmapInfo, NamedType.Key, AutoCompleteBkBrush, ImageList, NamedType.Value);
- for var Memo in FMemos do begin
- Memo.Call(SCI_RGBAIMAGESETWIDTH, ImageList.Width, 0);
- Memo.Call(SCI_RGBAIMAGESETHEIGHT, ImageList.Height, 0);
- for var MarkerBitmap in MarkerBitmaps do
- Memo.Call(SCI_MARKERDEFINERGBAIMAGE, MarkerBitmap.Key, LPARAM(MarkerBitmap.Value.pvBits));
- for var AutoCompleteBitmap in AutoCompleteBitmaps do
- Memo.Call(SCI_REGISTERRGBAIMAGE, AutoCompleteBitmap.Key, LPARAM(AutoCompleteBitmap.Value.pvBits));
- end;
- finally
- AutoCompleteBkBrush.Free;
- AutoCompleteBitmaps.Free;
- MarkerBkBrush.Free;
- MarkerBitmaps.Free;
- end;
- finally
- DeleteDC(DC);
- end;
- end;
- end;
- procedure TMainForm.UpdateMarginsAndSquigglyAndCaretWidths;
- { Update the width of our two margins. Note: the width of the line numbers
- margin is fully handled by TScintEdit. Should be called at startup and after
- DPI change. }
- begin
- var IconMarkersWidth := ToCurrentPPI(18); { 3 pixel margin on both sides of the icon }
- var BaseChangeHistoryWidth := ToCurrentPPI(6); { 6 = 2 pixel bar with 2 pixel margin on both sides because: "SC_MARK_BAR ... takes ... 1/3 of the margin width" }
- var FolderMarkersWidth := ToCurrentPPI(14); { 1 pixel margin on boths side of the icon }
- var LeftBlankMarginWidth := ToCurrentPPI(2); { 2 pixel margin between gutter and the main text }
- var SquigglyWidth := ToCurrentPPI(100); { 100 = 1 pixel }
- var CaretWidth := ToCurrentPPI(2);
- var WhiteSpaceSize := CaretWidth;
- for var Memo in FMemos do
- Memo.UpdateWidthsAndSizes(IconMarkersWidth, BaseChangeHistoryWidth, FolderMarkersWidth,
- LeftBlankMarginWidth, 0, SquigglyWidth, CaretWidth, WhiteSpaceSize);
- end;
- procedure TMainForm.SplitPanelMouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
- begin
- if (ssLeft in Shift) and StatusPanel.Visible then begin
- UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y -
- SplitPanel.ClientToScreen(Point(0, Y)).Y +
- BodyPanel.ClientHeight - (SplitPanel.Height div 2));
- end;
- end;
- procedure TMainForm.SimpleMenuClick(Sender: TObject);
- begin
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.TMenuClick(Sender: TObject);
- var
- MemoIsReadOnly: Boolean;
- begin
- MemoIsReadOnly := FActiveMemo.ReadOnly;
- TGenerateGUID.Enabled := not MemoIsReadOnly;
- TMsgBoxDesigner.Enabled := not MemoIsReadOnly;
- TFilesDesigner.Enabled := not MemoIsReadOnly;
- TRegistryDesigner.Enabled := not MemoIsReadOnly;
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- procedure TMainForm.TAddRemoveProgramsClick(Sender: TObject);
- begin
- StartAddRemovePrograms;
- end;
- procedure TMainForm.TGenerateGUIDClick(Sender: TObject);
- begin
- if MsgBox('The generated GUID will be inserted into the editor at the cursor position. Continue?',
- SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
- FActiveMemo.MainSelText := GenerateGuid;
- end;
- procedure TMainForm.TMsgBoxDesignerClick(Sender: TObject);
- begin
- if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scCode) and
- (MsgBox('The generated Pascal script will be inserted into the editor at the cursor position, but the cursor is not in the [Code] section. Continue anyway?',
- SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDNO) then
- Exit;
- var MsgBoxForm := TMsgBoxDesignerForm.Create(Application);
- try
- if MsgBoxForm.ShowModal = mrOk then
- FActiveMemo.MainSelText := MsgBoxForm.GetText(FOptions.TabWidth, FOptions.UseTabCharacter);
- finally
- MsgBoxForm.Free;
- end;
- end;
- procedure TMainForm.TRegistryDesignerClick(Sender: TObject);
- begin
- var RegistryDesignerForm := TRegistryDesignerForm.Create(Application);
- try
- var PrivilegesRequired := FindSetupDirectiveValue('PrivilegesRequired', 'admin');
- var PrivilegesRequiredOverridesAllowed := FindSetupDirectiveValue('PrivilegesRequiredOverridesAllowed', '');
- if PrivilegesRequiredOverridesAllowed = '' then begin
- if SameText(PrivilegesRequired, 'admin') then
- RegistryDesignerForm.PrivilegesRequired := prAdmin
- else
- RegistryDesignerForm.PrivilegesRequired := prLowest
- end else
- RegistryDesignerForm.PrivilegesRequired := prDynamic;
- if RegistryDesignerForm.ShowModal = mrOk then
- begin
- FActiveMemo.CaretColumn := 0;
- var Text := RegistryDesignerForm.Text;
- if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scRegistry then
- Text := '[Registry]' + SNewLine + Text;
- FActiveMemo.MainSelText := Text;
- end;
- finally
- RegistryDesignerForm.Free;
- end;
- end;
- procedure TMainForm.TFilesDesignerClick(Sender: TObject);
- begin
- var FilesDesignerForm := TFilesDesignerForm.Create(Application);
- try
- FilesDesignerForm.CreateAppDir := FindSetupDirectiveValue('CreateAppDir', True);
- if FilesDesignerForm.ShowModal = mrOk then begin
- FActiveMemo.CaretColumn := 0;
- var Text := FilesDesignerForm.Text;
- if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scFiles then
- Text := '[Files]' + SNewLine + Text;
- FActiveMemo.MainSelText := Text;
- end;
- finally
- FilesDesignerForm.Free;
- end;
- end;
- procedure TMainForm.TSignToolsClick(Sender: TObject);
- var
- SignToolsForm: TSignToolsForm;
- Ini: TConfigIniFile;
- I: Integer;
- begin
- SignToolsForm := TSignToolsForm.Create(Application);
- try
- SignToolsForm.SignTools := FSignTools;
- if SignToolsForm.ShowModal <> mrOK then
- Exit;
- FSignTools.Assign(SignToolsForm.SignTools);
- { Save new options }
- Ini := TConfigIniFile.Create;
- try
- Ini.EraseSection('SignTools');
- for I := 0 to FSignTools.Count-1 do
- Ini.WriteString('SignTools', 'SignTool' + IntToStr(I), FSignTools[I]);
- finally
- Ini.Free;
- end;
- finally
- SignToolsForm.Free;
- end;
- end;
- procedure TMainForm.TOptionsClick(Sender: TObject);
- var
- OptionsForm: TOptionsForm;
- Ini: TConfigIniFile;
- Memo: TIDEScintEdit;
- begin
- OptionsForm := TOptionsForm.Create(Application);
- try
- OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
- OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
- OptionsForm.AutosaveCheck.Checked := FOptions.Autosave;
- OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
- OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
- OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
- OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
- OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser;
- OptionsForm.AutoAutoCompleteCheck.Checked := FOptions.AutoAutoComplete;
- OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
- OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput;
- OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors;
- OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
- OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
- OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter;
- OptionsForm.ShowWhiteSpaceCheck.Checked := FOptions.ShowWhiteSpace;
- OptionsForm.UseFoldingCheck.Checked := FOptions.UseFolding;
- OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent;
- OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides;
- OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers;
- OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput;
- OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles;
- OptionsForm.KeyMappingComboBox.ItemIndex := Ord(FOptions.KeyMappingType);
- OptionsForm.MemoKeyMappingComboBox.ItemIndex := Ord(FOptions.MemoKeyMappingType);
- OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType);
- OptionsForm.FontPanel.Font.Assign(FMainMemo.Font);
- OptionsForm.FontPanel.ParentBackground := False;
- OptionsForm.FontPanel.Color := FMainMemo.Color;
- OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked := FOptions.HighlightWordAtCursorOccurrences;
- OptionsForm.HighlightSelTextOccurrencesCheck.Checked := FOptions.HighlightSelTextOccurrences;
- if OptionsForm.ShowModal <> mrOK then
- Exit;
- FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
- FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
- FOptions.Autosave := OptionsForm.AutosaveCheck.Checked;
- FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
- FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
- FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
- FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
- FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked;
- FOptions.AutoAutoComplete := OptionsForm.AutoAutoCompleteCheck.Checked;
- FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
- FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked;
- FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked;
- FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
- FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
- FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked;
- FOptions.ShowWhiteSpace := OptionsForm.ShowWhiteSpaceCheck.Checked;
- FOptions.UseFolding := OptionsForm.UseFoldingCheck.Checked;
- FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked;
- FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked;
- FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked;
- FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked;
- FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked;
- FOptions.KeyMappingType := TKeyMappingType(OptionsForm.KeyMappingComboBox.ItemIndex);
- FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(OptionsForm.MemoKeyMappingComboBox.ItemIndex);
- FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex);
- FOptions.HighlightWordAtCursorOccurrences := OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked;
- FOptions.HighlightSelTextOccurrences := OptionsForm.HighlightSelTextOccurrencesCheck.Checked;
- UpdateCaption;
- UpdatePreprocMemos;
- InvalidateStatusPanel(spHiddenFilesCount);
- for Memo in FMemos do begin
- { Move caret to start of line to ensure it doesn't end up in the middle
- of a double-byte character if the code page changes from SBCS to DBCS }
- Memo.CaretLine := Memo.CaretLine;
- Memo.Font.Assign(OptionsForm.FontPanel.Font);
- end;
- SyncEditorOptions;
- UpdateMarginsAndSquigglyAndCaretWidths;
- UpdateNewMainFileButtons;
- UpdateOccurrenceIndicators(FActiveMemo);
- UpdateKeyMapping;
- UpdateTheme;
- { Save new options }
- Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
- Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
- Ini.WriteBool('Options', 'Autosave', FOptions.Autosave);
- Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
- Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
- Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
- Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
- Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser);
- Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoAutoComplete);
- Ini.WriteBool('Options', 'AutoCallTips', FOptions.AutoCallTips);
- Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
- Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput);
- Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors);
- Ini.WriteBool('Options', 'HighlightWordAtCursorOccurrences', FOptions.HighlightWordAtCursorOccurrences);
- Ini.WriteBool('Options', 'HighlightSelTextOccurrences', FOptions.HighlightSelTextOccurrences);
- Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
- Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
- Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter);
- Ini.WriteBool('Options', 'ShowWhiteSpace', FOptions.ShowWhiteSpace);
- Ini.WriteBool('Options', 'UseFolding', FOptions.UseFolding);
- Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent);
- Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides);
- Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers);
- Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput);
- Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles);
- Ini.WriteInteger('Options', 'KeyMappingType', Ord(FOptions.KeyMappingType));
- Ini.WriteInteger('Options', 'MemoKeyMappingType', Ord(FOptions.MemoKeyMappingType));
- Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy }
- Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name);
- Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
- Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
- finally
- Ini.Free;
- end;
- finally
- OptionsForm.Free;
- end;
- end;
- { Also see TabIndexToMemoIndex }
- function TMainForm.MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
- begin
- if AMemo = FMainMemo then
- Result := 0 { First tab displays the main memo }
- else if AMemo = FPreprocessorOutputMemo then begin
- if not FPreprocessorOutputMemo.Used then
- raise Exception.Create('not FPreprocessorOutputMemo.Used');
- Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo }
- end else begin
- Result := FFileMemos.IndexOf(AMemo as TIDEScintFileEdit); { Other tabs display include files which start second tab }
- { Filter memos explicitly hidden by the user }
- for var MemoIndex := Result-1 downto 0 do
- if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then
- Dec(Result);
- end;
- end;
- { Also see MemoToTabIndex }
- function TMainForm.TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
- begin
- if ATabIndex = 0 then
- Result := FMemos[0] { First tab displays the main memo which is FMemos[0] }
- else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then
- Result := FMemos[1] { Last tab displays the preprocessor output memo which is FMemos[1] }
- else begin
- { Only count memos not explicitly hidden by the user }
- var TabIndex := 0;
- for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
- if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin
- Inc(TabIndex);
- if TabIndex = ATabIndex then begin
- Result := FMemos[MemoIndex + 1]; { Other tabs display include files which start at second tab but at FMemos[2] }
- Exit;
- end;
- end;
- end;
- raise Exception.Create('TabIndexToMemo failed');
- end;
- end;
- procedure TMainForm.MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
- const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean;
- const PositionVirtualSpace: Integer);
- var
- Pos: Integer;
- begin
- { Reopen tab if needed }
- if AMemo is TIDEScintFileEdit then begin
- var FileName := (AMemo as TIDEScintFileEdit).Filename;
- var HiddenFileIndex := FHiddenFiles.IndexOf(Filename);
- if HiddenFileIndex <> -1 then begin
- ReopenTabOrTabs(HiddenFileIndex, False);
- { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which
- sets up all the memos. Currently it will keep same memo for the reopened file but in case it no
- longer does at some point: look it up again }
- AMemo := nil;
- for var Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, Filename) = 0) then begin
- AMemo := Memo;
- Break;
- end;
- end;
- if AMemo = nil then
- raise Exception.Create('AMemo MIA');
- end;
- end;
- { Move caret }
- if IsPosition then
- Pos := LineNumberOrPosition
- else if AlwaysResetColumnEvenIfOnRequestedLineAlready or (AMemo.CaretLine <> LineNumberOrPosition) then
- Pos := AMemo.GetPositionFromLine(LineNumberOrPosition)
- else
- Pos := AMemo.CaretPosition; { Not actually moving caret - it's already were we want it}
- { If the line is in a contracted section, expand it }
- AMemo.EnsureLineVisible(AMemo.GetLineFromPosition(Pos));
- { If the line isn't in view, scroll so that it's in the center }
- if not AMemo.IsPositionInViewVertically(Pos) then
- AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(AMemo.GetLineFromPosition(Pos)) -
- (AMemo.LinesInWindow div 2);
- AMemo.CaretPosition := Pos;
- if IsPosition then
- AMemo.CaretVirtualSpace := PositionVirtualSpace;
- { Activate memo }
- MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo }
- end;
- procedure TMainForm.SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
- var
- OldLine: Integer;
- begin
- if AMemo <> FErrorMemo then begin
- SetErrorLine(FErrorMemo, -1);
- FErrorMemo := AMemo;
- end;
- if FErrorMemo.ErrorLine <> ALine then begin
- OldLine := FErrorMemo.ErrorLine;
- FErrorMemo.ErrorLine := ALine;
- if OldLine >= 0 then
- UpdateLineMarkers(FErrorMemo, OldLine);
- if FErrorMemo.ErrorLine >= 0 then begin
- FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition;
- UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine);
- end;
- end;
- end;
- procedure TMainForm.SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
- var
- OldLine: Integer;
- begin
- if AMemo <> FStepMemo then begin
- SetStepLine(FStepMemo, -1);
- FStepMemo := AMemo;
- end;
- if FStepMemo.StepLine <> ALine then begin
- OldLine := FStepMemo.StepLine;
- FStepMemo.StepLine := ALine;
- if OldLine >= 0 then
- UpdateLineMarkers(FStepMemo, OldLine);
- if FStepMemo.StepLine >= 0 then
- UpdateLineMarkers(FStepMemo, FStepMemo.StepLine);
- end;
- end;
- procedure TMainForm.HideError;
- begin
- SetErrorLine(FErrorMemo, -1);
- if not FCompiling then
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- procedure TMainForm.RemoveMemoFromNav(const AMemo: TIDEScintEdit);
- begin
- if FNavStacks.RemoveMemo(AMemo) then
- UpdateNavButtons;
- if FCurrentNavItem.Memo = AMemo then
- FCurrentNavItem.Invalidate;
- end;
- procedure TMainForm.RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit);
- begin
- if FNavStacks.RemoveMemoBadLines(AMemo) then
- UpdateNavButtons;
- { We do NOT update FCurrentNav here so it might point to a line that's
- deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
- end;
- procedure TMainForm.UpdateNavButtons;
- begin
- ForwardNavButton.Enabled := FNavStacks.Forward.Count > 0;
- BackNavButton.Enabled := (FNavStacks.Back.Count > 0) or
- ForwardNavButton.Enabled; { for the dropdown }
- end;
- procedure TMainForm.BackNavButtonClick(Sender: TObject);
- begin
- { Delphi does not support BTNS_WHOLEDROPDOWN so we can't be like VS which
- can have a disabled back nav button with an enabled dropdown. To avoid
- always showing two dropdowns we keep the back button enabled when we need
- the dropdown. So we need to check for this. }
- if FNavStacks.Back.Count = 0 then begin
- Beep;
- Exit;
- end;
- FNavStacks.Forward.Add(FCurrentNavItem);
- var NewNavItem := FNavStacks.Back.ExtractAt(FNavStacks.Back.Count-1);
- UpdateNavButtons;
- FCurrentNavItem := NewNavItem; { Must be done *before* moving }
- MoveCaretAndActivateMemo(NewNavItem.Memo,
- NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace);
- end;
- procedure TMainForm.ForwardNavButtonClick(Sender: TObject);
- begin
- FNavStacks.Back.Add(FCurrentNavItem);
- var NewNavItem := FNavStacks.Forward.ExtractAt(FNavStacks.Forward.Count-1);
- UpdateNavButtons;
- FCurrentNavItem := NewNavItem; { Must be done *before* moving }
- MoveCaretAndActivateMemo(NewNavItem.Memo,
- NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace);
- end;
- procedure TMainForm.WMAppCommand(var Message: TMessage);
- begin
- var Command := GET_APPCOMMAND_LPARAM(Message.LParam);
- if Command = APPCOMMAND_BROWSER_BACKWARD then begin
- if BackNavButton.Enabled then
- BackNavButton.Click;
- Message.Result := 1;
- end else if Command = APPCOMMAND_BROWSER_FORWARD then begin
- if ForwardNavButton.Enabled then
- ForwardNavButton.Click;
- Message.Result := 1;
- end;
- end;
- procedure TMainForm.NavItemClick(Sender: TObject);
- begin
- var MenuItem := Sender as TMenuItem;
- var Clicks := Abs(MenuItem.Tag);
- if Clicks > 0 then begin
- var ButtonToClick: TToolButton;
- if MenuItem.Tag > 0 then
- ButtonToClick := ForwardNavButton
- else
- ButtonToClick := BackNavButton;
- while Clicks > 0 do begin
- if not ButtonToClick.Enabled then
- raise Exception.Create('not ButtonToClick.Enabled');
- ButtonToClick.Click;
- Dec(Clicks);
- end;
- end;
- end;
- procedure TMainForm.NavPopupMenuClick(Sender: TObject);
- procedure AddNavItemToMenu(const NavItem: TIDEScintEditNavItem; const Checked: Boolean;
- const ClicksNeeded: Integer; const Menu: TMenuItem);
- begin
- if NavItem.Line >= NavItem.Memo.Lines.Count then
- raise Exception.Create('NavItem.Line >= NavItem.Memo.Lines.Count');
- var LineInfo := NavItem.Memo.Lines[NavItem.Line];
- if LineInfo.Trim = '' then
- LineInfo := Format('Line %d', [NavItem.Line+1]);
- var Caption: String;
- if MemosTabSet.Visible then
- Caption := Format('%s: %s', [MemosTabSet.Tabs[MemoToTabIndex(NavItem.Memo)], LineInfo])
- else
- Caption := LineInfo;
- var MenuItem := TMenuItem.Create(Menu);
- MenuItem.Caption := DoubleAmp(Caption);
- MenuItem.Checked := Checked;
- MenuItem.RadioItem := True;
- MenuItem.Tag := ClicksNeeded;
- MenuItem.OnClick := NavItemClick;
- Menu.Add(MenuItem);
- end;
- begin
- var Menu := Sender as TMenuItem;
- Menu.Clear;
- { Setup dropdown. The result should end up being just like Visual Studio 2022
- which means from top to bottom:
- - Furthest (=oldest) forward item
- - ...
- - Closest (=next) forward item
- - Current position in the active memo, checked
- - Closest (=next) back item
- - ...
- - Furthest (=oldest) back item
- The Tag parameter should be set to the amount of clicks needed to get to
- the item, positive for forward and negative for back }
- for var I := 0 to FNavStacks.Forward.Count-1 do
- AddNavItemToMenu(FNavStacks.Forward[I], False, FNavStacks.Forward.Count-I, Menu);
- AddNavItemToMenu(FCurrentNavItem, True, 0, Menu);
- for var I := FNavStacks.Back.Count-1 downto 0 do
- AddNavItemToMenu(FNavStacks.Back[I], False, -(FNavStacks.Back.Count-I), Menu);
- end;
- procedure TMainForm.UpdateCaretPosPanelAndBackNavStack;
- begin
- { Update panel }
- var Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1,
- FActiveMemo.CaretColumnExpandedForTabs + 1]);
- if FOptions.ShowCaretPosition then begin
- const CaretPos = FActiveMemo.CaretPosition;
- const Style = FActiveMemo.GetStyleAtPosition(CaretPos);
- Text := Format('%s@%d+%d:%s', [Copy(GetEnumName(TypeInfo(TInnoSetupStylerStyle), Style), 3, MaxInt),
- CaretPos, FActiveMemo.CaretVirtualSpace, Text]);
- end;
- StatusBar.Panels[spCaretPos].Text := Text;
- { Update NavStacks.Back if needed and remember new position }
- var NewNavItem := TIDEScintEditNavItem.Create(FActiveMemo); { This is a record so no need to free }
- if FCurrentNavItem.Valid and FNavStacks.AddNewBackForJump(FCurrentNavItem, NewNavItem) then
- UpdateNavButtons;
- FCurrentNavItem := NewNavItem;
- end;
- procedure TMainForm.UpdateEditModePanel;
- const
- InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
- begin
- if FActiveMemo.ReadOnly then
- StatusBar.Panels[spEditMode].Text := 'Read only'
- else
- StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode];
- end;
- procedure TMainForm.UpdateFindRegExUI;
- const
- FindRegExText: array[Boolean] of String = ('', '.*');
- begin
- StatusBar.Panels[spFindRegEx].Text := FindRegExText[FOptions.FindRegEx];
- if FOptions.FindRegEx then begin
- FindDialog.Options := FindDialog.Options + [frHideWholeWord];
- ReplaceDialog.Options := ReplaceDialog.Options + [frHideWholeWord];
- end else begin
- FindDialog.Options := FindDialog.Options - [frHideWholeWord];
- ReplaceDialog.Options := ReplaceDialog.Options - [frHideWholeWord];
- end;
- end;
- procedure TMainForm.UpdateMemosTabSetVisibility;
- begin
- MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used;
- if not MemosTabSet.Visible then
- MemosTabSet.TabIndex := 0; { For next time }
- end;
- procedure TMainForm.UpdateModifiedPanel;
- begin
- if FActiveMemo.Modified then
- StatusBar.Panels[spModified].Text := 'Modified'
- else
- StatusBar.Panels[spModified].Text := '';
- end;
- procedure TMainForm.UpdatePreprocMemos;
- procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList;
- const NewCloseButtons: TBoolList);
- begin
- if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and
- (FMainMemo.Lines.Text.TrimRight <> FPreprocessorOutput) then begin
- NewTabs.Add('Preprocessor Output');
- NewHints.Add('');
- NewCloseButtons.Add(False);
- FPreprocessorOutputMemo.ReadOnly := False;
- try
- FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput;
- FPreprocessorOutputMemo.ClearUndo;
- finally
- FPreprocessorOutputMemo.ReadOnly := True;
- end;
- FPreprocessorOutputMemo.Used := True;
- end else begin
- if FPreprocessorOutputMemo.Used then
- RemoveMemoFromNav(FPreprocessorOutputMemo);
- FPreprocessorOutputMemo.Used := False;
- FPreprocessorOutputMemo.Visible := False;
- end;
- end;
- procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList;
- const NewCloseButtons: TBoolList);
- var
- IncludedFile: TIncludedFile;
- I: Integer;
- begin
- if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin
- var NextMemoIndex := FirstIncludedFilesMemoIndex;
- var NextTabIndex := 1; { First tab displays the main memo }
- for IncludedFile in FIncludedFiles do begin
- IncludedFile.Memo := FFileMemos[NextMemoIndex];
- try
- if not IncludedFile.Memo.Used or
- ((PathCompare(IncludedFile.Memo.Filename, IncludedFile.Filename) <> 0) or
- not IncludedFile.HasLastWriteTime or
- (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0)) then begin
- IncludedFile.Memo.Filename := IncludedFile.Filename;
- IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
- OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime }
- IncludedFile.Memo.Used := True;
- end else begin
- { The memo assigned to the included file already has that file loaded
- and is up-to-date so no call to OpenFile is needed. However, it could be
- that CompilerFileIndex is not set yet. This happens if the initial
- load was from the history loaded by LoadKnownIncludedAndHiddenFiles
- and is followed by the user doing a compile. }
- if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then
- IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
- end;
- if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin
- NewTabs.Insert(NextTabIndex, GetDisplayFilename(IncludedFile.Filename));
- NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename));
- NewCloseButtons.Insert(NextTabIndex, True);
- Inc(NextTabIndex);
- end;
- Inc(NextMemoIndex);
- if NextMemoIndex = FFileMemos.Count then
- Break; { We're out of memos :( }
- except on E: Exception do
- begin
- StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message);
- IncludedFile.Memo := nil;
- end;
- end;
- end;
- { Hide any remaining memos }
- for I := NextMemoIndex to FFileMemos.Count-1 do begin
- FFileMemos[I].BreakPoints.Clear;
- if FFileMemos[I].Used then
- RemoveMemoFromNav(FFileMemos[I]);
- FFileMemos[I].Used := False;
- FFileMemos[I].Visible := False;
- end;
- end else begin
- for I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
- FFileMemos[I].BreakPoints.Clear;
- if FFileMemos[I].Used then
- RemoveMemoFromNav(FFileMemos[I]);
- FFileMemos[I].Used := False;
- FFileMemos[I].Visible := False;
- end;
- for IncludedFile in FIncludedFiles do
- IncludedFile.Memo := nil;
- end;
- end;
- var
- NewTabs, NewHints: TStringList;
- NewCloseButtons: TBoolList;
- I, SaveTabIndex: Integer;
- SaveTabName: String;
- begin
- NewTabs := nil;
- NewHints := nil;
- NewCloseButtons := nil;
- try
- NewTabs := TStringList.Create;
- NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' }
- NewHints := TStringList.Create;
- NewHints.Add(GetFileTitle(FMainMemo.Filename));
- NewCloseButtons := TBoolList.Create;
- NewCloseButtons.Add(False);
- UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons);
- UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons);
- { Set new tabs, try keep same file open }
- SaveTabIndex := MemosTabSet.TabIndex;
- SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex];
- MemosTabSet.Tabs := NewTabs;
- MemosTabSet.Hints := NewHints;
- MemosTabSet.CloseButtons := NewCloseButtons;
- I := MemosTabSet.Tabs.IndexOf(SaveTabName);
- if I <> -1 then
- MemosTabSet.TabIndex := I;
- if MemosTabSet.TabIndex = SaveTabIndex then begin
- { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make
- sure the right memo is visible - so trigger it ourselves }
- MemosTabSetClick(MemosTabSet);
- end;
- finally
- NewCloseButtons.Free;
- NewHints.Free;
- NewTabs.Free;
- end;
- UpdateMemosTabSetVisibility;
- UpdateBevel1Visibility;
- end;
- procedure TMainForm.MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
- procedure UpdatePendingSquiggly(const AMemo: TIDEScintEdit);
- var
- Pos: Integer;
- Value: Boolean;
- begin
- { Check for the inPendingSquiggly indicator on either side of the caret }
- Pos := AMemo.CaretPosition;
- Value := False;
- if AMemo.CaretVirtualSpace = 0 then begin
- Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos);
- if not Value and (Pos > 0) then
- Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos-1);
- end;
- if FOnPendingSquiggly <> Value then begin
- FOnPendingSquiggly := Value;
- { If caret has left a pending squiggly, force restyle of the line }
- if not Value then begin
- { Stop reporting the caret position to the styler (until the next
- Change event) so the token doesn't re-enter pending-squiggly state
- if the caret comes back and something restyles the line }
- AMemo.ReportCaretPositionToStyler := False;
- AMemo.RestyleLine(AMemo.GetLineFromPosition(FPendingSquigglyCaretPos));
- end;
- end;
- FPendingSquigglyCaretPos := Pos;
- end;
- procedure UpdateBraceHighlighting(const AMemo: TIDEScintEdit);
- const
- OpeningBraces: TSysCharSet = ['(', '[', '{', '<'];
- ClosingBraces: TSysCharSet = [')', ']', '}', '>'];
- function HighlightPos(const AMemo: TIDEScintEdit; const CaretPos: Integer;
- const Before: Boolean; const Braces: TSysCharSet): Boolean;
- begin
- var Pos := CaretPos;
- if Before then begin
- if Pos > 0 then
- Pos := AMemo.GetPositionBefore(Pos)
- else
- Exit(False);
- end;
- var C := AMemo.GetByteAtPosition(Pos);
- Result := C in Braces;
- if Result then begin
- var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
- if MatchPos >= 0 then
- AMemo.SetBraceHighlighting(Pos, MatchPos)
- else begin
- { Found an unmatched brace: highlight it as bad unless it's an opening
- brace and the caret is at the end of the line }
- var CaretLineEndPos := AMemo.GetLineEndPosition(AMemo.CaretLine);
- if (C in ClosingBraces) or (CaretPos <> CaretLineEndPos) then
- AMemo.SetBraceBadHighlighting(Pos)
- else
- AMemo.SetBraceHighlighting(-1, -1);
- end;
- end;
- end;
- begin
- var Highlighted := False;
- var Section := FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[AMemo.CaretLine]);
- if (Section <> scNone) and (AMemo.CaretVirtualSpace = 0) then begin
- var Pos := AMemo.CaretPosition;
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, OpeningBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, ClosingBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, ClosingBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, OpeningBraces);
- end;
- if not Highlighted then
- AMemo.SetBraceHighlighting(-1, -1);
- end;
- begin
- if Updated * [suContent, suSelection] = [] then
- Exit;
- var Memo := Sender as TIDEScintEdit;
- if (Memo = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then
- HideError;
- if Memo = FActiveMemo then begin
- UpdateCaretPosPanelAndBackNavStack;
- UpdateEditModePanel;
- end;
- UpdatePendingSquiggly(Memo);
- UpdateBraceHighlighting(Memo);
- UpdateOccurrenceIndicators(Memo);
- end;
- procedure TMainForm.MemoModifiedChange(Sender: TObject);
- begin
- if Sender = FActiveMemo then
- UpdateModifiedPanel;
- end;
- procedure TMainForm.MemoCallTipArrowClick(Sender: TObject;
- const Up: Boolean);
- begin
- { Based on SciTE 5.50's SciTEBase::Notify SA::Notification::CallTipClick }
- if Up and (FCallTipState.CurrentCallTip > 0) then begin
- Dec(FCallTipState.CurrentCallTip);
- UpdateCallTipFunctionDefinition;
- end else if not Up and (FCallTipState.CurrentCallTip + 1 < FCallTipState.MaxCallTips) then begin
- Inc(FCallTipState.CurrentCallTip);
- UpdateCallTipFunctionDefinition;
- end;
- end;
- procedure TMainForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
- procedure MemoLinesInsertedOrDeleted(Memo: TIDEScintFileEdit);
- var
- FirstAffectedLine, Line, LinePos: Integer;
- begin
- Line := Memo.GetLineFromPosition(Info.StartPos);
- LinePos := Memo.GetPositionFromLine(Line);
- FirstAffectedLine := Line;
- { If the deletion/insertion does not start on the first character of Line,
- then we consider the first deleted/inserted line to be the following
- line (Line+1). This way, if you press Del at the end of line 1, the dot
- on line 2 is removed, while line 1's dot stays intact. }
- if Info.StartPos > LinePos then
- Inc(Line);
- if Info.LinesDelta > 0 then
- MemoLinesInserted(Memo, Line, Info.LinesDelta)
- else
- MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine);
- end;
- var
- Memo: TIDEScintFileEdit;
- begin
- if not (Sender is TIDEScintFileEdit) then
- Exit;
- Memo := TIDEScintFileEdit(Sender);
- if Memo.OpeningFile then
- Exit;
- FModifiedAnySinceLastCompile := True;
- if FDebugging then
- FModifiedAnySinceLastCompileAndGo := True
- else begin
- { Modified while not debugging or opening a file; free the debug info and clear the dots }
- DestroyDebugInfo;
- end;
- if Info.LinesDelta <> 0 then
- MemoLinesInsertedOrDeleted(Memo);
- if Memo = FErrorMemo then begin
- { When the Delete key is pressed, the caret doesn't move, so reset
- FErrorCaretPosition to ensure that OnUpdateUI calls HideError }
- FErrorMemo.ErrorCaretPosition := -1;
- end;
- { The change should trigger restyling. Allow the styler to see the current
- caret position in case it wants to set a pending squiggly indicator. }
- Memo.ReportCaretPositionToStyler := True;
- end;
- function TMainForm.InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit;
- const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean;
- begin
- Result := (PositionBeforeWordStartPos < WordStartLinePos) or
- not FMemosStyler.IsCommentOrPascalStringStyle(AMemo.GetStyleAtPosition(PositionBeforeWordStartPos));
- end;
- procedure TMainForm.InitiateAutoComplete(const Key: AnsiChar);
- function OnlyWhiteSpaceBeforeWord(const Memo: TIDEScintEdit; const LinePos, WordStartPos: Integer): Boolean;
- var
- I: Integer;
- C: AnsiChar;
- begin
- { Only allow autocompletion if no non-whitespace characters exist before the current word on the line }
- I := WordStartPos;
- Result := False;
- while I > LinePos do begin
- I := FActiveMemo.GetPositionBefore(I);
- if I < LinePos then
- Exit; { shouldn't get here }
- C := FActiveMemo.GetByteAtPosition(I);
- if C > ' ' then
- Exit;
- end;
- Result := True;
- end;
- var
- CaretPos, Line, LinePos, WordStartPos, WordEndPos, CharsBefore,
- LangNamePos: Integer;
- Section: TInnoSetupStylerSection;
- IsParamSection: Boolean;
- WordList: AnsiString;
- FoundSemicolon, FoundFlagsOrType, FoundDot: Boolean;
- C: AnsiChar;
- begin
- if FActiveMemo.AutoCompleteActive or FActiveMemo.ReadOnly then
- Exit;
- if Key = #0 then begin
- { If a character is typed then Scintilla will handle selections but
- otherwise we should empty them and also make sure the caret is visible
- before we start autocompletion }
- FActiveMemo.SetEmptySelections;
- FActiveMemo.ScrollCaretIntoView;
- end;
- CaretPos := FActiveMemo.CaretPosition;
- Line := FActiveMemo.GetLineFromPosition(CaretPos);
- LinePos := FActiveMemo.GetPositionFromLine(Line);
- WordStartPos := FActiveMemo.GetWordStartPosition(CaretPos, True);
- WordEndPos := FActiveMemo.GetWordEndPosition(CaretPos, True);
- CharsBefore := CaretPos - WordStartPos;
- { Don't auto start autocompletion after a character is typed if there are any
- word characters adjacent to the character }
- if Key <> #0 then begin
- if CharsBefore > 1 then
- Exit;
- if WordEndPos > CaretPos then
- Exit;
- end;
- case FActiveMemo.GetByteAtPosition(WordStartPos) of
- '#':
- begin
- if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
- Exit;
- WordList := FMemosStyler.ISPPDirectivesWordList;
- FActiveMemo.SetAutoCompleteFillupChars(' ');
- end;
- '{':
- begin
- WordList := FMemosStyler.ConstantsWordList;
- FActiveMemo.SetAutoCompleteFillupChars('\:');
- end;
- '[':
- begin
- if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
- Exit;
- WordList := FMemosStyler.SectionsWordList;
- FActiveMemo.SetAutoCompleteFillupChars('');
- end;
- else
- begin
- Section := FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]);
- if Section = scCode then begin
- { Space can only initiate autocompletion after non whitespace }
- if (Key = ' ') and OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
- Exit;
- var PositionBeforeWordStartPos := FActiveMemo.GetPositionBefore(WordStartPos);
- if Key <> #0 then begin
- FActiveMemo.StyleNeeded(PositionBeforeWordStartPos); { Make sure the typed character has been styled }
- if not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo, LinePos, PositionBeforeWordStartPos) then
- Exit;
- end;
- WordList := '';
- { Autocomplete event functions if the current word on the line has
- exactly 1 space before it which has the word 'function' or
- 'procedure' before it which has only whitespace before it }
- if (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) <= ' ') then begin
- var FunctionWordEndPos := PositionBeforeWordStartPos;
- var FunctionWordStartPos := FActiveMemo.GetWordStartPosition(FunctionWordEndPos, True);
- if OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, FunctionWordStartPos) then begin
- var FunctionWord := FActiveMemo.GetTextRange(FunctionWordStartPos, FunctionWordEndPos);
- if SameText(FunctionWord, 'procedure') then
- WordList := FMemosStyler.EventFunctionsWordList[True]
- else if SameText(FunctionWord, 'function') then
- WordList := FMemosStyler.EventFunctionsWordList[False];
- if WordList <> '' then
- FActiveMemo.SetAutoCompleteFillupChars('');
- end;
- end;
- { If no event function was found then autocomplete script functions,
- types, etc if the current word has no dot before it }
- if WordList = '' then begin
- var ClassOrRecordMember := (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) = '.');
- WordList := FMemosStyler.ScriptWordList[ClassOrRecordMember];
- FActiveMemo.SetAutoCompleteFillupChars('');
- end;
- if WordList = '' then
- Exit;
- end else begin
- IsParamSection := FMemosStyler.IsParamSection(Section);
- { Autocomplete if the current word on the line has only whitespace
- before it, or else also: after the last ';' or after 'Flags:' or
- 'Type:' in parameterized sections }
- FoundSemicolon := False;
- FoundFlagsOrType := False;
- FoundDot := False;
- var I := WordStartPos;
- while I > LinePos do begin
- I := FActiveMemo.GetPositionBefore(I);
- if I < LinePos then
- Exit; { shouldn't get here }
- C := FActiveMemo.GetByteAtPosition(I);
- if IsParamSection and (C in [';', ':']) and
- FMemosStyler.IsSymbolStyle(FActiveMemo.GetStyleAtPosition(I)) then begin { Make sure it's an stSymbol ';' or ':' and not one inside a quoted string }
- FoundSemicolon := C = ';';
- if not FoundSemicolon then begin
- var ParameterWordEndPos := I;
- var ParameterWordStartPos := FActiveMemo.GetWordStartPosition(ParameterWordEndPos, True);
- var ParameterWord := FActiveMemo.GetTextRange(ParameterWordStartPos, ParameterWordEndPos);
- FoundFlagsOrType := SameText(ParameterWord, 'Flags') or
- ((Section in [scInstallDelete, scUninstallDelete]) and SameText(ParameterWord, 'Type'));
- end else
- FoundFlagsOrType := False;
- if FoundSemicolon or FoundFlagsOrType then
- Break;
- end;
- if (Section = scLangOptions) and (C = '.') and not FoundDot then begin
- { Verify that a word (language name) precedes the '.', then check for
- any non-whitespace characters before the word }
- LangNamePos := FActiveMemo.GetWordStartPosition(I, True);
- if LangNamePos >= I then
- Exit;
- I := LangNamePos;
- FoundDot := True;
- end else if C > ' ' then begin
- if IsParamSection and not (Section in [scInstallDelete, scUninstallDelete]) and
- (FMemosStyler.FlagsWordList[Section] <> '') then begin
- { Verify word before the current word (or before that when we get here again) is
- a valid flag and if so, continue looking before it instead of stopping }
- var FlagEndPos := FActiveMemo.GetWordEndPosition(I, True);
- var FlagStartPos := FActiveMemo.GetWordStartPosition(I, True);
- var FlagWord := FActiveMemo.GetTextRange(FlagStartPos, FlagEndPos);
- if FMemosStyler.SectionHasFlag(Section, FlagWord) then
- I := FlagStartPos
- else
- Exit;
- end else
- Exit;
- end;
- end;
- { Space can only initiate autocompletion after ';' or 'Flags:' or 'Type:' in parameterized sections }
- if (Key = ' ') and not (FoundSemicolon or FoundFlagsOrType) then
- Exit;
- if FoundFlagsOrType then begin
- WordList := FMemosStyler.FlagsWordList[Section];
- if WordList = '' then
- Exit;
- FActiveMemo.SetAutoCompleteFillupChars(' ');
- end else begin
- WordList := FMemosStyler.KeywordsWordList[Section];
- if WordList = '' then { CustomMessages }
- Exit;
- if IsParamSection then
- FActiveMemo.SetAutoCompleteFillupChars(':')
- else
- FActiveMemo.SetAutoCompleteFillupChars('=');
- end;
- end;
- end;
- end;
- FActiveMemo.ShowAutoComplete(CharsBefore, WordList);
- end;
- procedure TMainForm.UpdateCallTipFunctionDefinition(const Pos: Integer { = -1 });
- begin
- { Based on SciTE 5.50's SciTEBase::FillFunctionDefinition }
-
- if Pos > 0 then
- FCallTipState.LastPosCallTip := Pos;
- // Should get current api definition
- var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(FCallTipState.ClassOrRecordMember, FCallTipState.CurrentCallTipWord, FCallTipState.CurrentCallTip, FCallTipState.MaxCallTips);
- if ((FCallTipState.MaxCallTips = 1) and FunctionDefinition.HasParams) or //if there's a single definition then only show if it has a parameter
- (FCallTipState.MaxCallTips > 1) then begin //if there's multiple then show always just like MemoHintShow, so even the one without parameters if it exists
- FCallTipState.FunctionDefinition := FunctionDefinition.ScriptFuncWithoutHeader;
- if FCallTipState.MaxCallTips > 1 then
- FCallTipState.FunctionDefinition := AnsiString(Format(#1'%d of %d'#2'%s', [FCallTipState.CurrentCallTip+1, FCallTipState.MaxCallTips, FCallTipState.FunctionDefinition]));
- FActiveMemo.ShowCallTip(FCallTipState.LastPosCallTip - Length(FCallTipState.CurrentCallTipWord), FCallTipState.FunctionDefinition);
- ContinueCallTip;
- end;
- end;
- procedure TMainForm.InitiateCallTip(const Key: AnsiChar);
- begin
- var Pos := FActiveMemo.CaretPosition;
- if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.GetLineFromPosition(Pos)]) <> scCode) or
- ((Key <> #0) and not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo,
- FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos)),
- FActiveMemo.GetPositionBefore(Pos))) then
- Exit;
- { Based on SciTE 5.50's SciTEBase::StartAutoComplete }
- FCallTipState.CurrentCallTip := 0;
- FCallTipState.CurrentCallTipWord := '';
- var Line := FActiveMemo.CaretLineText;
- var Current := FActiveMemo.CaretPositionInLine;
- var CallTipWordCharacters := FActiveMemo.WordCharsAsSet;
- {$ZEROBASEDSTRINGS ON}
- repeat
- var Braces := 0;
- while ((Current > 0) and ((Braces <> 0) or not (Line[Current-1] = '('))) do begin
- if Line[Current-1] = '(' then
- Dec(Braces)
- else if Line[Current-1] = ')' then
- Inc(Braces);
- Dec(Current);
- Dec(Pos);
- end;
- if Current > 0 then begin
- Dec(Current);
- Dec(Pos);
- end else
- Break;
- while (Current > 0) and (Line[Current-1] <= ' ') do begin
- Dec(Current);
- Dec(Pos);
- end
- until not ((Current > 0) and not CharInSet(Line[Current-1], CallTipWordCharacters));
- {$ZEROBASEDSTRINGS OFF}
- if Current <= 0 then
- Exit;
- FCallTipState.StartCallTipWord := Current - 1;
- {$ZEROBASEDSTRINGS ON}
- while (FCallTipState.StartCallTipWord > 0) and CharInSet(Line[FCallTipState.StartCallTipWord-1], CallTipWordCharacters) do
- Dec(FCallTipState.StartCallTipWord);
- FCallTipState.ClassOrRecordMember := (FCallTipState.StartCallTipWord > 0) and (Line[FCallTipState.StartCallTipWord-1] = '.');
- {$ZEROBASEDSTRINGS OFF}
- SetLength(Line, Current);
- FCallTipState.CurrentCallTipWord := Line.Substring(FCallTipState.StartCallTipWord); { Substring is zero-based }
- FCallTipState.FunctionDefinition := '';
- UpdateCallTipFunctionDefinition(Pos);
- end;
- procedure TMainForm.ContinueCallTip;
- begin
- { Based on SciTE 5.50's SciTEBase::ContinueCallTip }
- var Line := FActiveMemo.CaretLineText;
- var Current := FActiveMemo.CaretPositionInLine;
- var Braces := 0;
- var Commas := 0;
- for var I := FCallTipState.StartCallTipWord to Current-1 do begin
- {$ZEROBASEDSTRINGS ON}
- if CharInSet(Line[I], ['(', '[']) then
- Inc(Braces)
- else if CharInSet(Line[I], [')', ']']) and (Braces > 0) then
- Dec(Braces)
- else if (Braces = 1) and (Line[I] = ',') then
- Inc(Commas);
- {$ZEROBASEDSTRINGS OFF}
- end;
- {$ZEROBASEDSTRINGS ON}
- var StartHighlight := 0;
- var FunctionDefinition := FCallTipState.FunctionDefinition;
- var FunctionDefinitionLength := Length(FunctionDefinition);
- while (StartHighlight < FunctionDefinitionLength) and not (FunctionDefinition[StartHighlight] = '(') do
- Inc(StartHighlight);
- if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] = '(') then
- Inc(StartHighlight);
- while (StartHighlight < FunctionDefinitionLength) and (Commas > 0) do begin
- if FunctionDefinition[StartHighlight] in [',', ';'] then
- Dec(Commas);
- // If it reached the end of the argument list it means that the user typed in more
- // arguments than the ones listed in the calltip
- if FunctionDefinition[StartHighlight] = ')' then
- Commas := 0
- else
- Inc(StartHighlight);
- end;
- if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] in [',', ';']) then
- Inc(StartHighlight);
- var EndHighlight := StartHighlight;
- while (EndHighlight < FunctionDefinitionLength) and not (FunctionDefinition[EndHighlight] in [',', ';']) and not (FunctionDefinition[EndHighlight] = ')') do
- Inc(EndHighlight);
- {$ZEROBASEDSTRINGS OFF}
- FActiveMemo.SetCallTipHighlight(StartHighlight, EndHighlight);
- end;
- procedure TMainForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar);
- function LineIsBlank(const Line: Integer): Boolean;
- begin
- var S := FActiveMemo.Lines.RawLines[Line];
- Result := TScintEdit.RawStringIsBlank(S);
- end;
- var
- NewLine, PreviousLine, NewIndent, PreviousIndent: Integer;
- begin
- if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin
- { Add to the new line any (remaining) indentation from the previous line }
- NewLine := FActiveMemo.CaretLine;
- PreviousLine := NewLine-1;
- if PreviousLine >= 0 then begin
- NewIndent := FActiveMemo.GetLineIndentation(NewLine);
- { If no indentation was moved from the previous line to the new line
- (i.e., there are no spaces/tabs directly to the right of the new
- caret position), and the previous line is completely empty (0 length),
- then use the indentation from the last line containing non-space
- characters. }
- if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin
- Dec(PreviousLine);
- while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do
- Dec(PreviousLine);
- end;
- if PreviousLine >= 0 then begin
- PreviousIndent := FActiveMemo.GetLineIndentation(PreviousLine);
- FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent);
- FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine,
- PreviousIndent);
- end;
- end;
- end;
-
- { Based on SciTE 5.50's SciTEBase::CharAdded but with an altered interaction
- between calltips and autocomplete }
- var DoAutoComplete := False;
- if FActiveMemo.CallTipActive then begin
- if Ch = ')' then begin
- Dec(FCallTipState.BraceCount);
- if FCallTipState.BraceCount < 1 then
- FActiveMemo.CancelCallTip
- else if FOptions.AutoCallTips then
- InitiateCallTip(Ch);
- end else if Ch = '(' then begin
- Inc(FCallTipState.BraceCount);
- if FOptions.AutoCallTips then
- InitiateCallTip(Ch);
- end else
- ContinueCallTip;
- end else if FActiveMemo.AutoCompleteActive then begin
- if Ch = '(' then begin
- Inc(FCallTipState.BraceCount);
- if FOptions.AutoCallTips then begin
- InitiateCallTip(Ch);
- if not FActiveMemo.CallTipActive then begin
- { Normally the calltip activation means any active autocompletion gets
- cancelled by Scintilla but if the current word has no call tip then
- we should make sure ourselves that the added brace still cancels
- the currently active autocompletion }
- DoAutoComplete := True;
- end;
- end;
- end else if Ch = ')' then
- Dec(FCallTipState.BraceCount)
- else
- DoAutoComplete := True;
- end else if Ch = '(' then begin
- FCallTipState.BraceCount := 1;
- if FOptions.AutoCallTips then
- InitiateCallTip(Ch);
- end else
- DoAutoComplete := True;
- if DoAutoComplete then begin
- case Ch of
- 'A'..'Z', 'a'..'z', '_', '#', '{', '[', '<', '0'..'9':
- if not FActiveMemo.AutoCompleteActive and FOptions.AutoAutoComplete and not (Ch in ['0'..'9']) then
- InitiateAutoComplete(Ch);
- else
- var RestartAutoComplete := (Ch in [' ', '.']) and
- (FOptions.AutoAutoComplete or FActiveMemo.AutoCompleteActive);
- FActiveMemo.CancelAutoComplete;
- if RestartAutoComplete then
- InitiateAutoComplete(Ch);
- end;
- end;
- end;
- procedure TMainForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
- function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer; out DebugEntry: PVariableDebugEntry): Boolean;
- var
- I: Integer;
- begin
- { FVariableDebugEntries uses 1-based line and column numbers }
- Inc(Line);
- Inc(Col);
- Result := False;
- for I := 0 to FVariableDebugEntriesCount-1 do begin
- if (FVariableDebugEntries[I].FileIndex = FileIndex) and
- (FVariableDebugEntries[I].LineNumber = Line) and
- (FVariableDebugEntries[I].Col = Col) then begin
- DebugEntry := @FVariableDebugEntries[I];
- Result := True;
- Break;
- end;
- end;
- end;
- function GetCodeColumnFromPosition(const Pos: Integer): Integer;
- var
- LinePos: Integer;
- S: TScintRawString;
- U: String;
- begin
- { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
- passed to the compiler. This can lead to column number discrepancies
- between Scintilla and ROPS. This code simulates the conversion to try to
- find out where ROPS thinks a Pos resides. }
- LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
- S := FActiveMemo.GetRawTextRange(LinePos, Pos);
- U := FActiveMemo.ConvertRawStringToString(S);
- Result := Length(U);
- end;
- function FindVarOrFuncRange(const Pos: Integer): TScintRange;
- begin
- { Note: The GetPositionAfter is needed so that when the mouse is over a '.'
- between two words, it won't match the word to the left of the '.' }
- FActiveMemo.SetDefaultWordChars;
- Result.StartPos := FActiveMemo.GetWordStartPosition(FActiveMemo.GetPositionAfter(Pos), True);
- Result.EndPos := FActiveMemo.GetWordEndPosition(Pos, True);
- end;
- function FindConstRange(const Pos: Integer): TScintRange;
- var
- BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer;
- C: AnsiChar;
- begin
- Result.StartPos := 0;
- Result.EndPos := 0;
- BraceLevel := 0;
- ConstStartPos := -1;
- Line := FActiveMemo.GetLineFromPosition(Pos);
- LineEndPos := FActiveMemo.GetLineEndPosition(Line);
- I := FActiveMemo.GetPositionFromLine(Line);
- while I < LineEndPos do begin
- if (I > Pos) and (BraceLevel = 0) then
- Break;
- C := FActiveMemo.GetByteAtPosition(I);
- if C = '{' then begin
- if FActiveMemo.GetByteAtPosition(I + 1) = '{' then
- Inc(I)
- else begin
- if BraceLevel = 0 then
- ConstStartPos := I;
- Inc(BraceLevel);
- end;
- end
- else if (C = '}') and (BraceLevel > 0) then begin
- Dec(BraceLevel);
- if (BraceLevel = 0) and (ConstStartPos <> -1) then begin
- if (Pos >= ConstStartPos) and (Pos <= I) then begin
- Result.StartPos := ConstStartPos;
- Result.EndPos := I + 1;
- Exit;
- end;
- ConstStartPos := -1;
- end;
- end;
- I := FActiveMemo.GetPositionAfter(I);
- end;
- end;
- procedure UpdateInfo(var Info: TScintHintInfo; const HintStr: String; const Range: TScintRange; const Memo: TIDEScintEdit);
- begin
- Info.HintStr := HintStr;
- Info.CursorRect.TopLeft := Memo.GetPointFromPosition(Range.StartPos);
- Info.CursorRect.BottomRight := Memo.GetPointFromPosition(Range.EndPos);
- Info.CursorRect.Bottom := Info.CursorRect.Top + Memo.LineHeight;
- Info.HideTimeout := High(Integer); { infinite }
- end;
- begin
- var Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True);
- if Pos < 0 then
- Exit;
- var Line := FActiveMemo.GetLineFromPosition(Pos);
- { Check if cursor is over a [Code] variable or function }
- if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode then begin
- var VarOrFuncRange := FindVarOrFuncRange(Pos);
- if VarOrFuncRange.EndPos > VarOrFuncRange.StartPos then begin
- var HintStr := '';
- var DebugEntry: PVariableDebugEntry;
- if (FActiveMemo is TIDEScintFileEdit) and (FDebugClientWnd <> 0) and
- GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TIDEScintFileEdit).CompilerFileIndex,
- Line, GetCodeColumnFromPosition(VarOrFuncRange.StartPos), DebugEntry) then begin
- var Output: String;
- case EvaluateVariableEntry(DebugEntry, Output) of
- 1: HintStr := Output;
- 2: HintStr := Output;
- else
- HintStr := 'Unknown error';
- end;
- end else begin
- var ClassMember := False;
- var Name := FActiveMemo.GetTextRange(VarOrFuncRange.StartPos, VarOrFuncRange.EndPos);
- var Index := 0;
- var Count: Integer;
- var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
- if Count = 0 then begin
- ClassMember := not ClassMember;
- FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
- end;
- while Index < Count do begin
- if Index <> 0 then
- FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index);
- if HintStr <> '' then
- HintStr := HintStr + #13;
- if FunctionDefinition.WasFunction then
- HintStr := HintStr + 'function '
- else
- HintStr := HintStr + 'procedure ';
- HintStr := HintStr + String(FunctionDefinition.ScriptFuncWithoutHeader);
- Inc(Index);
- end;
- end;
- if HintStr <> '' then begin
- UpdateInfo(Info, HintStr, VarOrFuncRange, FActiveMemo);
- Exit;
- end;
- end;
- end;
- if FDebugClientWnd <> 0 then begin
- { Check if cursor is over a constant }
- var ConstRange := FindConstRange(Pos);
- if ConstRange.EndPos > ConstRange.StartPos then begin
- var HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos);
- var Output: String;
- case EvaluateConstant(Info.HintStr, Output) of
- 1: HintStr := HintStr + ' = "' + Output + '"';
- 2: HintStr := HintStr + ' = Exception: ' + Output;
- else
- HintStr := HintStr + ' = Unknown error';
- end;
- UpdateInfo(Info, HintStr, ConstRange, FActiveMemo);
- end;
- end;
- end;
- procedure TMainForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer;
- AFiles: TStrings);
- begin
- if (AFiles.Count > 0) and ConfirmCloseFile(True) then
- OpenFile(FMainMemo, AFiles[0], True);
- end;
- procedure TMainForm.MemoZoom(Sender: TObject);
- begin
- if not FSynchingZoom then begin
- FSynchingZoom := True;
- try
- for var Memo in FMemos do
- if Memo <> Sender then
- Memo.Zoom := (Sender as TScintEdit).Zoom;
- finally
- FSynchingZoom := False;
- end;
- end;
- end;
- procedure TMainForm.StatusBarResize(Sender: TObject);
- begin
- { Without this, on Windows XP with themes, the status bar's size grip gets
- corrupted as the form is resized }
- if StatusBar.HandleAllocated then
- InvalidateRect(StatusBar.Handle, nil, True);
- end;
- procedure TMainForm.WMDebuggerQueryVersion(var Message: TMessage);
- begin
- Message.Result := FCompilerVersion.BinVersion;
- end;
- procedure TMainForm.WMDebuggerHello(var Message: TMessage);
- var
- PID: DWORD;
- WantCodeText: Boolean;
- begin
- FDebugClientWnd := HWND(Message.WParam);
- { Save debug client process handle }
- if FDebugClientProcessHandle <> 0 then begin
- { Shouldn't get here, but just in case, don't leak a handle }
- CloseHandle(FDebugClientProcessHandle);
- FDebugClientProcessHandle := 0;
- end;
- PID := 0;
- if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then
- FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,
- False, PID);
- WantCodeText := Bool(Message.LParam);
- if WantCodeText then
- SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText);
- SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo);
- UpdateRunMenu;
- end;
- procedure TMainForm.WMDebuggerGoodbye(var Message: TMessage);
- begin
- ReplyMessage(0);
- DebuggingStopped(True);
- end;
- procedure TMainForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry);
- function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- Result := nil;
- if FOptions.OpenIncludedFiles then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin
- Result := Memo;
- Exit;
- end;
- end;
- end else if FMainMemo.CompilerFileIndex = FileIndex then
- Result := FMainMemo;
- end;
- var
- I: Integer;
- begin
- for I := 0 to FDebugEntriesCount-1 do begin
- if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin
- Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex);
- DebugEntry := @FDebugEntries[I];
- Exit;
- end;
- end;
- Memo := nil;
- DebugEntry := nil;
- end;
- procedure TMainForm.BringToForeground;
- { Brings our top window to the foreground. Called when pausing while
- debugging. }
- var
- TopWindow: HWND;
- begin
- TopWindow := GetThreadTopWindow;
- if TopWindow <> 0 then begin
- { First ask the debug client to call SetForegroundWindow() on our window.
- If we don't do this then Windows (98/2000+) will prevent our window from
- becoming activated if the debug client is currently in the foreground. }
- SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow,
- WPARAM(TopWindow), 0);
- { Now call SetForegroundWindow() ourself. Why? When a remote thread calls
- SetForegroundWindow(), the request is queued; the window doesn't actually
- become active until the next time the window's thread checks the message
- queue. This call causes the window to become active immediately. }
- SetForegroundWindow(TopWindow);
- end;
- end;
- procedure TMainForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
- var
- Memo: TIDEScintFileEdit;
- DebugEntry: PDebugEntry;
- LineNumber: Integer;
- begin
- GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
- if (Memo = nil) or (DebugEntry = nil) then
- Exit;
- LineNumber := DebugEntry.LineNumber;
- if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number }
- Exit;
- if (LineNumber < Memo.LineStateCount) and
- (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin
- Memo.LineState[LineNumber] := lnEntryProcessed;
- UpdateLineMarkers(Memo, LineNumber);
- end;
- if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then
- FStepMode := smStepInto { Pause on next line }
- else if (FStepMode = smStepInto) or
- ((FStepMode = smStepOver) and not Intermediate) or
- ((FStepMode = smRunToCursor) and
- (FRunToCursorPoint.Kind = Integer(Message.WParam)) and
- (FRunToCursorPoint.Index = Message.LParam)) or
- (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin
- MoveCaretAndActivateMemo(Memo, LineNumber, True);
- HideError;
- SetStepLine(Memo, LineNumber);
- BringToForeground;
- { Tell Setup to pause }
- Message.Result := 1;
- FPaused := True;
- FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine);
- UpdateRunMenu;
- UpdateCaption;
- end;
- end;
- procedure TMainForm.WMDebuggerStepped(var Message: TMessage);
- begin
- DebuggerStepped(Message, False);
- end;
- procedure TMainForm.WMDebuggerSteppedIntermediate(var Message: TMessage);
- begin
- DebuggerStepped(Message, True);
- end;
- procedure TMainForm.WMDPIChanged(var Message: TMessage);
- begin
- inherited;
- for var Memo in FMemos do
- Memo.DPIChanged(Message);
- end;
- procedure TMainForm.WMDebuggerException(var Message: TMessage);
- var
- Memo: TIDEScintFileEdit;
- DebugEntry: PDebugEntry;
- LineNumber: Integer;
- S: String;
- begin
- if FOptions.PauseOnDebuggerExceptions then begin
- GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
- if DebugEntry <> nil then
- LineNumber := DebugEntry.LineNumber
- else
- LineNumber := -1;
- if (Memo <> nil) and (LineNumber >= 0) then begin
- MoveCaretAndActivateMemo(Memo, LineNumber, True);
- SetStepLine(Memo, -1);
- SetErrorLine(Memo, LineNumber);
- end;
- BringToForeground;
- { Tell Setup to pause }
- Message.Result := 1;
- FPaused := True;
- FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine));
- UpdateRunMenu;
- UpdateCaption;
- ReplyMessage(Message.Result); { so that Setup enters a paused state now }
- if LineNumber >= 0 then begin
- S := Format('Line %d:' + SNewLine + '%s', [LineNumber + 1, AddPeriod(FDebuggerException)]);
- if (Memo <> nil) and (Memo.Filename <> '') then
- S := Memo.Filename + SNewLine2 + S;
- MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok)
- end else
- MsgBox(AddPeriod(FDebuggerException), 'Runtime Error', mbCriticalError, mb_Ok);
- end;
- end;
- procedure TMainForm.WMDebuggerSetForegroundWindow(var Message: TMessage);
- begin
- SetForegroundWindow(HWND(Message.WParam));
- end;
- procedure TMainForm.WMDebuggerCallStackCount(var Message: TMessage);
- begin
- FCallStackCount := Message.WParam;
- end;
- procedure TMainForm.WMCopyData(var Message: TWMCopyData);
- var
- S: String;
- begin
- case Message.CopyDataStruct.dwData of
- CD_Debugger_ReplyW: begin
- FReplyString := '';
- SetString(FReplyString, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_ExceptionW: begin
- SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_UninstExeW: begin
- SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div sizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_LogMessageW: begin
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- DebugLogMessage(S);
- Message.Result := 1;
- end;
- CD_Debugger_TempDirW: begin
- { Paranoia: Store it in a local variable first. That way, if there's
- a problem reading the string FTempDir will be left unmodified.
- Gotta be extra careful when storing a path we'll be deleting. }
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- { Extreme paranoia: If there are any embedded nulls, discard it. }
- if Pos(#0, S) <> 0 then
- S := '';
- FTempDir := S;
- Message.Result := 1;
- end;
- CD_Debugger_CallStackW: begin
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- DebugShowCallStack(S, FCallStackCount);
- end;
- end;
- end;
- function TMainForm.DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
- begin
- if Assigned(AMemo.LineState) then begin
- AMemo.LineStateCapacity := 0;
- AMemo.LineStateCount := 0;
- FreeMem(AMemo.LineState);
- AMemo.LineState := nil;
- Result := True;
- end else
- Result := False;
- end;
- procedure TMainForm.DestroyDebugInfo;
- var
- HadDebugInfo: Boolean;
- Memo: TIDEScintFileEdit;
- begin
- HadDebugInfo := False;
- for Memo in FFileMemos do
- if DestroyLineState(Memo) then
- HadDebugInfo := True;
- FDebugEntriesCount := 0;
- FreeMem(FDebugEntries);
- FDebugEntries := nil;
- FVariableDebugEntriesCount := 0;
- FreeMem(FVariableDebugEntries);
- FVariableDebugEntries := nil;
- FCompiledCodeText := '';
- FCompiledCodeDebugInfo := '';
- { Clear all dots and reset breakpoint icons (unless exiting; no point) }
- if HadDebugInfo and not(csDestroying in ComponentState) then
- UpdateAllMemosLineMarkers;
- end;
- var
- PrevCompilerFileIndex: Integer;
- PrevMemo: TIDEScintFileEdit;
- procedure TMainForm.ParseDebugInfo(DebugInfo: Pointer);
- function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- if (PrevCompilerFileIndex <> CompilerFileIndex) then begin
- PrevMemo := nil;
- for Memo in FFileMemos do begin
- if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin
- PrevMemo := Memo;
- Break;
- end;
- end;
- PrevCompilerFileIndex := CompilerFileIndex;
- end;
- Result := PrevMemo;
- end;
- { This creates and fills the DebugEntries and Memo LineState arrays }
- var
- Header: PDebugInfoHeader;
- Memo: TIDEScintFileEdit;
- Size: Cardinal;
- I: Integer;
- begin
- DestroyDebugInfo;
- Header := DebugInfo;
- if (Header.ID <> DebugInfoHeaderID) or
- (Header.Version <> DebugInfoHeaderVersion) then
- raise Exception.Create('Unrecognized debug info format');
- try
- for Memo in FFileMemos do begin
- if Memo.Used then begin
- I := Memo.Lines.Count;
- Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount));
- Memo.LineStateCapacity := I + LineStateGrowAmount;
- Memo.LineStateCount := I;
- end;
- end;
- Inc(Cardinal(DebugInfo), SizeOf(Header^));
- FDebugEntriesCount := Header.DebugEntryCount;
- Size := FDebugEntriesCount * SizeOf(TDebugEntry);
- GetMem(FDebugEntries, Size);
- Move(DebugInfo^, FDebugEntries^, Size);
- for I := 0 to FDebugEntriesCount-1 do
- Dec(FDebugEntries[I].LineNumber);
- Inc(Cardinal(DebugInfo), Size);
- FVariableDebugEntriesCount := Header.VariableDebugEntryCount;
- Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry);
- GetMem(FVariableDebugEntries, Size);
- Move(DebugInfo^, FVariableDebugEntries^, Size);
- Inc(Cardinal(DebugInfo), Size);
- SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength);
- Inc(Cardinal(DebugInfo), Header.CompiledCodeTextLength);
- SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength);
- PrevCompilerFileIndex := UnknownCompilerFileIndex;
- for I := 0 to FDebugEntriesCount-1 do begin
- if FDebugEntries[I].LineNumber >= 0 then begin
- Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex);
- if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin
- if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then
- Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry;
- end;
- end;
- end;
- UpdateAllMemosLineMarkers;
- except
- DestroyDebugInfo;
- raise;
- end;
- end;
- procedure TMainForm.ResetAllMemosLineState;
- { Changes green dots back to grey dots }
- var
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- for Memo in FFileMemos do begin
- if Memo.Used and Assigned(Memo.LineState) then begin
- for I := 0 to Memo.LineStateCount-1 do begin
- if Memo.LineState[I] = lnEntryProcessed then begin
- Memo.LineState[I] := lnHasEntry;
- UpdateLineMarkers(Memo, I);
- end;
- end;
- end;
- end;
- end;
- procedure TMainForm.CheckIfTerminated;
- var
- H: THandle;
- begin
- if FDebugging then begin
- { Check if the process hosting the debug client (e.g. Setup or the
- uninstaller second phase) has terminated. If the debug client hasn't
- connected yet, check the initial process (e.g. SetupLdr or the
- uninstaller first phase) instead. }
- if FDebugClientWnd <> 0 then
- H := FDebugClientProcessHandle
- else
- H := FProcessHandle;
- if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then
- DebuggingStopped(True);
- end;
- end;
- procedure TMainForm.DebuggingStopped(const WaitForTermination: Boolean);
- function GetExitCodeText: String;
- var
- ExitCode: DWORD;
- begin
- { Note: When debugging an uninstall, this will get the exit code off of
- the first phase process, since that's the exit code users will see when
- running the uninstaller outside the debugger. }
- case WaitForSingleObject(FProcessHandle, 0) of
- WAIT_OBJECT_0:
- begin
- if GetExitCodeProcess(FProcessHandle, ExitCode) then begin
- { If the high bit is set, the process was killed uncleanly (e.g.
- by a debugger). Show the exit code as hex in that case. }
- if ExitCode and $80000000 <> 0 then
- Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode])
- else
- Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]);
- end
- else
- Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)';
- end;
- WAIT_TIMEOUT:
- Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code';
- else
- Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)';
- end;
- end;
- var
- ExitCodeText: String;
- begin
- if WaitForTermination then begin
- { Give the initial process time to fully terminate so we can successfully
- get its exit code }
- WaitForSingleObject(FProcessHandle, 5000);
- end;
- FDebugging := False;
- FDebugClientWnd := 0;
- ExitCodeText := GetExitCodeText;
- if FDebugClientProcessHandle <> 0 then begin
- CloseHandle(FDebugClientProcessHandle);
- FDebugClientProcessHandle := 0;
- end;
- CloseHandle(FProcessHandle);
- FProcessHandle := 0;
- FTempDir := '';
- CheckIfRunningTimer.Enabled := False;
- HideError;
- SetStepLine(FStepMemo, -1);
- UpdateRunMenu;
- UpdateCaption;
- DebugLogMessage('*** ' + ExitCodeText);
- StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText;
- end;
- procedure TMainForm.DetachDebugger;
- begin
- CheckIfTerminated;
- if not FDebugging then Exit;
- SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0);
- DebuggingStopped(False);
- end;
- function TMainForm.AskToDetachDebugger: Boolean;
- begin
- if FDebugClientWnd = 0 then begin
- MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.',
- SCompilerFormCaption, mbError, MB_OK);
- Result := False;
- end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?',
- SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin
- DetachDebugger;
- Result := True;
- end else
- Result := False;
- end;
- function TMainForm.AnyMemoHasBreakPoint: Boolean;
- begin
- { Also see RDeleteBreakPointsClick }
- for var Memo in FFileMemos do
- if Memo.Used and (Memo.BreakPoints.Count > 0) then
- Exit(True);
- Result := False;
- end;
- procedure TMainForm.RMenuClick(Sender: TObject);
- begin
- RDeleteBreakPoints.Enabled := AnyMemoHasBreakPoint;
- { See UpdateRunMenu for other menu items }
- ApplyMenuBitmaps(RMenu);
- end;
- procedure TMainForm.BreakPointsPopupMenuClick(Sender: TObject);
- begin
- RToggleBreakPoint2.Enabled := FActiveMemo is TIDEScintFileEdit;
- RDeleteBreakPoints2.Enabled := AnyMemoHasBreakPoint;
- { Also see UpdateRunMenu }
- ApplyMenuBitmaps(Sender as TMenuItem);
- end;
- { Should always be called when one of the Enabled states would change because
- other code depends on the states being correct always even if the user never
- clicks the Run menu. This is unlike the other menus. Note: also updates
- BCompile and BStopCompile from the Build menu. }
- procedure TMainForm.UpdateRunMenu;
- begin
- CheckIfTerminated;
- BCompile.Enabled := not FCompiling and not FDebugging;
- CompileButton.Enabled := BCompile.Enabled;
- BStopCompile.Enabled := FCompiling;
- StopCompileButton.Enabled := BStopCompile.Enabled;
- RRun.Enabled := not FCompiling and (not FDebugging or FPaused);
- RunButton.Enabled := RRun.Enabled;
- RPause.Enabled := FDebugging and not FPaused;
- PauseButton.Enabled := RPause.Enabled;
- RRunToCursor.Enabled := RRun.Enabled and (FActiveMemo is TIDEScintFileEdit);
- RStepInto.Enabled := RRun.Enabled;
- RStepOver.Enabled := RRun.Enabled;
- RStepOut.Enabled := FPaused;
- RToggleBreakPoint.Enabled := FActiveMemo is TIDEScintFileEdit;
- RTerminate.Enabled := FDebugging and (FDebugClientWnd <> 0);
- TerminateButton.Enabled := RTerminate.Enabled;
- REvaluate.Enabled := FDebugging and (FDebugClientWnd <> 0);
- { See RMenuClick for other menu items and also see BreakPointsPopupMenuClick }
- end;
- procedure TMainForm.UpdateSaveMenuItemAndButton;
- begin
- FSave.Enabled := FActiveMemo is TIDEScintFileEdit;
- SaveButton.Enabled := FSave.Enabled;
- end;
- procedure TMainForm.UpdateTargetMenu;
- begin
- if FDebugTarget = dtSetup then begin
- RTargetSetup.Checked := True;
- TargetSetupButton.Down := True;
- end else begin
- RTargetUninstall.Checked := True;
- TargetUninstallButton.Down := True;
- end;
- end;
- procedure TMainForm.UpdateKeyMapping;
- type
- TKeyMappedMenu = TPair<TMenuItem, TPair<TShortcut, TToolButton>>;
- function KMM(const MenuItem: TMenuItem; const DelphiKey: Word; const DelphiShift: TShiftState;
- const VisualStudioKey: Word; const VisualStudioShift: TShiftState;
- const ToolButton: TToolButton = nil): TKeyMappedMenu;
- begin
- var AShortCut: TShortCut;
- case FOptions.KeyMappingType of
- kmtDelphi: AShortCut := ShortCut(DelphiKey, DelphiShift);
- kmtVisualStudio: AShortCut := ShortCut(VisualStudioKey, VisualStudioShift);
- else
- raise Exception.Create('Unknown FOptions.KeyMappingType');
- end;
- Result := TKeyMappedMenu.Create(MenuItem, TPair<TShortcut, TToolButton>.Create(AShortcut, ToolButton)); { These are records so no need to free }
- end;
- begin
- var KeyMappedMenus := [
- KMM(EFindRegEx, Ord('R'), [ssCtrl, ssAlt], Ord('R'), [ssAlt]),
- KMM(BCompile, VK_F9, [ssCtrl], Ord('B'), [ssCtrl], CompileButton), { Also FCompileShortCut2 below }
- KMM(RRun, VK_F9, [], VK_F5, [], RunButton),
- KMM(RRunToCursor, VK_F4, [], VK_F10, [ssCtrl]),
- KMM(RStepInto, VK_F7, [], VK_F11, []),
- KMM(RStepOver, VK_F8, [], VK_F10, []),
- KMM(RStepOut, VK_F8, [ssShift], VK_F11, [ssShift]),
- KMM(RToggleBreakPoint, VK_F5, [], VK_F9, []),
- KMM(RDeleteBreakPoints, VK_F5, [ssShift, ssCtrl], VK_F9, [ssShift, ssCtrl]),
- KMM(RTerminate, VK_F2, [ssCtrl], VK_F5, [ssShift], TerminateButton),
- KMM(REvaluate, VK_F7, [ssCtrl], VK_F9, [ssShift])];
- FKeyMappedMenus.Clear;
- for var KeyMappedMenu in KeyMappedMenus do begin
- var ShortCut := KeyMappedMenu.Value.Key;
- var ToolButton := KeyMappedMenu.Value.Value;
- KeyMappedMenu.Key.ShortCut := ShortCut;
- if ToolButton <> nil then begin
- var MenuItem := KeyMappedMenu.Key;
- ToolButton.Hint := Format('%s (%s)', [RemoveAccelChar(MenuItem.Caption), NewShortCutToText(ShortCut)]);
- end;
- FKeyMappedMenus.Add(ShortCut, ToolButton);
- end;
- { Set fake shortcuts on any duplicates of the above in popup menus }
- SetFakeShortCut(RToggleBreakPoint2, RToggleBreakPoint.ShortCut);
- SetFakeShortCut(RDeleteBreakPoints2, RDeleteBreakPoints.ShortCut);
- { Handle two special cases:
- -The Nav buttons have no corresponding menu item and also no ShortCut property
- so they need special handling
- -Visual Studio and Delphi have separate Compile and Build shortcuts and the
- Compile shortcut is displayed by the menu and is set above but we want to
- allow the Build shortcuts as well for our single Build/Compile command }
- FBackNavButtonShortCut := ShortCut(VK_LEFT, [ssAlt]);
- FForwardNavButtonShortCut := ShortCut(VK_RIGHT, [ssAlt]);
- case FOptions.KeyMappingType of
- kmtDelphi:
- begin
- FBackNavButtonShortCut2 := 0;
- FForwardNavButtonShortCut2 := 0;
- FCompileShortCut2 := ShortCut(VK_F9, [ssShift]);
- end;
- kmtVisualStudio:
- begin
- FBackNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl]);
- FForwardNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl, ssShift]);
- FCompileShortCut2 := ShortCut(VK_F7, []);
- end;
- else
- raise Exception.Create('Unknown FOptions.KeyMappingType');
- end;
- BackNavButton.Hint := Format('Back (%s)', [NewShortCutToText(FBackNavButtonShortCut)]);
- FKeyMappedMenus.Add(FBackNavButtonShortCut, nil);
- ForwardNavButton.Hint := Format('Forward (%s)', [NewShortCutToText(FForwardNavButtonShortCut)]);
- FKeyMappedMenus.Add(FForwardNavButtonShortCut, nil);
- end;
- procedure TMainForm.UpdateTheme;
- procedure SetListBoxWindowTheme(const ListBox: TListBox);
- begin
- ListBox.Font.Color := FTheme.Colors[tcFore];
- ListBox.Color := FTheme.Colors[tcBack];
- ListBox.Invalidate;
- SetControlWindowTheme(ListBox, FTheme.Dark);
- end;
- begin
- FTheme.Typ := FOptions.ThemeType;
- SetHelpFileDark(FTheme.Dark);
- { For MainForm the active style only impacts message boxes and tooltips: FMemos, ToolbarPanel,
- UpdatePanel, SplitPanel and the 4 ListBoxes all ignore it because their StyleName property is set
- to 'Windows' always, either by the .dfm or by code. Additionally, for scrollbars and StatusBar,
- MainForm's StyleElements is empty. Menus ignore it because shMenus is removed from
- TStyleManager.SystemHooks at startup. }
- if FTheme.Dark then
- TStyleManager.TrySetStyle('Dark')
- else
- TStyleManager.TrySetStyle('Windows');
- { For some reason only MainForm needs this: with StyleName set to an empty string, dialog boxes
- it opens, such as MsgBox, look broken }
- StyleName := TStyleManager.ActiveStyle.Name;
- InitFormTheme(Self);
- ToolbarPanel.Color := FTheme.Colors[tcToolBack];
- for var Memo in FMemos do begin
- Memo.UpdateThemeColorsAndStyleAttributes;
- SetControlWindowTheme(Memo, FTheme.Dark);
- end;
- SetListBoxWindowTheme(CompilerOutputList);
- SetListBoxWindowTheme(DebugOutputList);
- SetListBoxWindowTheme(DebugCallStackList);
- SetListBoxWindowTheme(FindResultsList);
- if FTheme.Dark then begin
- ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.DarkToolBarImageCollection;
- ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.DarkMarkersAndACImageCollection;
- FBuildImageList := ImagesModule.DarkBuildImageList;
- end else begin
- ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.LightToolBarImageCollection;
- ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.LightMarkersAndACImageCollection;
- FBuildImageList := ImagesModule.LightBuildImageList;
- end;
- UpdateThemeData(True);
- UpdateBevel1Visibility;
- UpdateMarginsAndAutoCompleteIcons;
- SplitPanel.ParentBackground := False;
- SplitPanel.Color := FTheme.Colors[tcSplitterBack];
- FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
- FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
- DrawMenuBar(Handle);
- { SetPreferredAppMode doesn't work without FlushMenuThemes here: it would have
- to be called before the form is created to have an effect without
- FlushMenuThemes. So don't call SetPreferredAppMode if FlushMenuThemes is
- missing. }
- if Assigned(SetPreferredAppMode) and Assigned(FlushMenuThemes) then begin
- FMenuImageList := ThemedToolbarVirtualImageList;
- if FTheme.Dark then
- SetPreferredAppMode(PAM_FORCEDARK)
- else
- SetPreferredAppMode(PAM_FORCELIGHT);
- FlushMenuThemes;
- end else
- FMenuImageList := LightToolbarVirtualImageList;
- end;
- procedure TMainForm.UpdateThemeData(const Open: Boolean);
- procedure CloseThemeDataIfNeeded(var ThemeData: HTHEME);
- begin
- if ThemeData <> 0 then begin
- CloseThemeData(ThemeData);
- ThemeData := 0;
- end;
- end;
- begin
- CloseThemeDataIfNeeded(FProgressThemeData);
- CloseThemeDataIfNeeded(FMenuThemeData);
- CloseThemeDataIfNeeded(FToolbarThemeData);
- CloseThemeDataIfNeeded(FStatusBarThemeData);
- if Open and UseThemes then begin
- FProgressThemeData := OpenThemeData(Handle, 'Progress');
- FMenuThemeData := OpenThemeData(Handle, 'Menu');
- if FTheme.Dark then
- FToolbarThemeData := OpenThemeData(Handle, 'DarkMode::Toolbar');
- if FToolbarThemeData = 0 then
- FToolbarThemeData := OpenThemeData(Handle, 'Toolbar');
- FStatusBarThemeData := OpenThemeData(Handle, 'Status');
- end;
- end;
- procedure TMainForm.UpdateUpdatePanel;
- begin
- UpdatePanel.Visible := FUpdatePanelMessages.Count > 0;
- if UpdatePanel.Visible then begin
- var MessageToShowIndex := FUpdatePanelMessages.Count-1;
- UpdateLinkLabel.Tag := MessageToShowIndex;
- UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
- if not FHighContrastActive then
- UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
- end;
- UpdateBevel1Visibility;
- end;
- procedure TMainForm.UpdateMenuBitmapsIfNeeded;
- procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
- const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageIndex: Integer); overload;
- begin
- var pvBits: Pointer;
- var Bitmap := CreateDIBSection(DC, bitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
- var OldBitmap := SelectObject(DC, Bitmap);
- if ImageList_Draw(ImageList.Handle, ImageIndex, DC, 0, 0, ILD_TRANSPARENT) then
- MenuBitmaps.Add(MenuItem, Bitmap)
- else begin
- SelectObject(DC, OldBitmap);
- DeleteObject(Bitmap);
- end;
- end;
- procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
- const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageName: String); overload;
- begin
- AddMenuBitmap(MenuBitmaps, DC, BitmapInfo, MenuItem, ImageList, ImageList.GetIndexByName(ImageName));
- end;
- type
- TButtonedMenu = TPair<TMenuItem, TToolButton>;
- TNamedMenu = TPair<TMenuItem, String>;
- function BM(const MenuItem: TMenuItem; const ToolButton: TToolButton): TButtonedMenu;
- begin
- Result := TButtonedMenu.Create(MenuItem, ToolButton); { This is a record so no need to free }
- end;
- function NM(const MenuItem: TMenuItem; const Name: String): TNamedMenu;
- begin
- Result := TNamedMenu.Create(MenuItem, Name); { This is a record so no need to free }
- end;
- begin
- { This will create bitmaps for the current DPI using ImageList_Draw.
- These draw perfectly even on Windows 7. Other techniques don't work because
- they loose transparency or only look good on Windows 8 and later. Or they do
- work but cause lots more VCL code to be run than just our simple CreateDIB+Draw
- combo.
- ApplyBitmaps will apply them to menu items using SetMenuItemInfo. The menu item
- does not copy the bitmap so they should still be alive after ApplyBitmaps is done.
- Depends on FMenuImageList to pick the best size icons for the current DPI
- from the collection. }
- var ImageList := FMenuImageList;
- var NewSize: TSize;
- NewSize.cx := ImageList.Width;
- NewSize.cy := ImageList.Height;
- if (NewSize.cx <> FMenuBitmapsSize.cx) or (NewSize.cy <> FMenuBitmapsSize.cy) or
- (ImageList.ImageCollection <> FMenuBitmapsSourceImageCollection) then begin
- { Cleanup previous }
- for var Bitmap in FMenuBitmaps.Values do
- DeleteObject(Bitmap);
- FMenuBitmaps.Clear;
- { Create }
- var DC := CreateCompatibleDC(0);
- if DC <> 0 then begin
- try
- var BitmapInfo := CreateBitmapInfo(NewSize.cx, NewSize.cy, 32);
- var ButtonedMenus := [
- BM(FNewMainFile, NewMainFileButton),
- BM(FOpenMainFile, OpenMainFileButton),
- BM(FSave, SaveButton),
- BM(BCompile, CompileButton),
- BM(BStopCompile, StopCompileButton),
- BM(RRun, RunButton),
- BM(RPause, PauseButton),
- BM(RTerminate, TerminateButton),
- BM(HDoc, HelpButton)];
- for var ButtonedMenu in ButtonedMenus do
- AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, ButtonedMenu.Key, ImageList, ButtonedMenu.Value.ImageIndex);
- var NamedMenus := [
- NM(FClearRecent, 'eraser'),
- NM(FSaveMainFileAs, 'save-as-filled'),
- NM(FSaveAll, 'save-all-filled'),
- NM(FPrint, 'printer'),
- NM(EUndo, 'command-undo-1'),
- NM(ERedo, 'command-redo-1'),
- NM(ECut, 'clipboard-cut'),
- NM(ECopy, 'clipboard-copy'),
- NM(POutputListCopy, 'clipboard-copy'),
- NM(EPaste, 'clipboard-paste'),
- NM(EDelete, 'symbol-cancel'),
- NM(ESelectAll, 'select-all'),
- NM(POutputListSelectAll, 'select-all'),
- NM(EFind, 'find'),
- NM(EFindInFiles, 'folder-open-filled-find'),
- //NM(EFindNext, 'unused\find-arrow-right-2'),
- //NM(EFindPrevious, 'unused\find-arrow-left-2'),
- NM(EReplace, 'replace'),
- NM(EFoldLine, 'symbol-remove'),
- NM(EUnfoldLine, 'symbol-add'),
- NM(VZoomIn, 'zoom-in'),
- NM(VZoomOut, 'zoom-out'),
- NM(VNextTab, 'control-tab-filled-arrow-right-2'),
- NM(VPreviousTab, 'control-tab-filled-arrow-left-2'),
- //NM(VCloseCurrentTab, 'unused\control-tab-filled-cancel-2'),
- NM(VReopenTabs, 'control-tab-filled-redo-1'),
- NM(VReopenTabs2, 'control-tab-filled-redo-1'),
- NM(BOpenOutputFolder, 'folder-open-filled'),
- NM(RParameters, 'control-edit'),
- NM(RRunToCursor, 'debug-start-filled-arrow-right-2'),
- NM(RStepInto, 'debug-step-into'),
- NM(RStepOver, 'debug-step-over'),
- NM(RStepOut, 'debug-step-out'),
- NM(RToggleBreakPoint, 'debug-breakpoint-filled'),
- NM(RToggleBreakPoint2, 'debug-breakpoint-filled'),
- NM(RDeleteBreakPoints, 'debug-breakpoints-filled-eraser'),
- NM(RDeleteBreakPoints2, 'debug-breakpoints-filled-eraser'),
- NM(REvaluate, 'variables'),
- NM(TAddRemovePrograms, 'application'),
- NM(TGenerateGUID, 'tag-script-filled'),
- NM(TFilesDesigner, 'documents-script-filled'),
- NM(TRegistryDesigner, 'control-tree-script-filled'),
- NM(TMsgBoxDesigner, 'comment-text-script-filled'),
- NM(TSignTools, 'key-filled'),
- NM(TOptions, 'gear-filled'),
- NM(HDonate, 'heart-filled'),
- NM(HMailingList, 'alert-filled'),
- NM(HWhatsNew, 'announcement'),
- NM(HWebsite, 'home'),
- NM(HAbout, 'button-info')];
- for var NamedMenu in NamedMenus do
- AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, NamedMenu.Key, ImageList, NamedMenu.Value);
- finally
- DeleteDC(DC);
- end;
- end;
- FMenuBitmapsSize := NewSize;
- FMenuBitmapsSourceImageCollection := FMenuImageList.ImageCollection;
- end;
- end;
- procedure TMainForm.ApplyMenuBitmaps(const ParentMenuItem: TMenuItem);
- begin
- UpdateMenuBitmapsIfNeeded;
- { Setting MainMenu1.ImageList or a menu item's .Bitmap to make a menu item
- show a bitmap is not OK: it causes the entire menu to become owner drawn
- which makes it looks different from native menus and additionally the trick
- SetFakeShortCut uses doesn't work with owner drawn menus.
- Instead UpdateMenuBitmapsIfNeeded has prepared images which can be applied
- to native menu items using SetMenuItemInfo and MIIM_BITMAP - which is what we
- do below.
- A problem with this is that Delphi's TMenu likes to constantly recreate the
- underlying native menu items, for example when updating the caption. Sometimes
- it will even destroy and repopulate an entire menu because of a simple change
- like setting the caption of a single item!
- This means the result of our SetMenuItemInfo call (which Delphi doesn't know
- about) will quickly become lost when Delphi recreates the menu item.
- Fixing this in the OnChange event is not possible, this is event is more
- than useless.
- The solution is shown by TMenu.DispatchPopup: in reaction to WM_INITMENUPOPUP
- it calls our Click events right before the menu is shown, giving us the
- opportunity to call SetMenuItemInfo for the menu's items.
- This works unless Delphi decides to destroy and repopulate the menu after
- calling Click. Most amazingly it can do that indeed: it does this if the DPI
- changed since the last popup or if a automatic hotkey change or line reduction
- happens due to the menu's AutoHotkeys or AutoLineReduction properties. To make
- things even worse: for the Run menu it does this each and every time it is
- opened: this menu currently has a 'Step Out' item which has no shortcut but
- also all its letters are taken by another item already. This confuses the
- AutoHotkeys code, making it destroy and repopulate the entire menu over and
- over because it erroneously thinks a hotkey changed.
- To avoid this MainMenu1.AutoHotkeys was set to maManual since we have always
- managed the hotkeys ourselves anyway and .AutoLineReduction was also set to
- maManual and we now manage that ourselves as well.
- This just leave an issue with the icons not appearing on the first popup after
- a DPI change and this seems like a minor issue only.
-
- For TPopupMenu: calling ApplyMenuBitmaps(PopupMenu.Items) does work but makes
- the popup only show icons without text. This seems to be a limitiation of menus
- created by CreatePopupMenu instead of CreateMenu. This is why our popups with
- icons are all menu items popped using TMainFormPopupMenu. These menu items
- are hidden in the main menu and temporarily shown on popup. Popping an always
- hidden menu item (or a visible one as a child of a hidden parent) doesnt work. }
- var mmi: TMenuItemInfo;
- mmi.cbSize := SizeOf(mmi);
- mmi.fMask := MIIM_BITMAP;
- for var I := 0 to ParentMenuItem.Count-1 do begin
- var MenuItem := ParentMenuItem.Items[I];
- if MenuItem.Visible then begin
- if FMenuBitmaps.TryGetValue(MenuItem, mmi.hbmpItem) then
- SetMenuItemInfo(ParentMenuItem.Handle, MenuItem.Command, False, mmi);
- if MenuItem.Count > 0 then
- ApplyMenuBitmaps(MenuItem);
- end;
- end;
- end;
- procedure TMainForm.StartProcess;
- var
- RunFilename, RunParameters, WorkingDir: String;
- Info: TShellExecuteInfo;
- SaveFocusWindow: HWND;
- WindowList: Pointer;
- ShellExecuteResult: BOOL;
- ErrorCode: DWORD;
- begin
- if FDebugTarget = dtUninstall then begin
- if FUninstExe = '' then
- raise Exception.Create(SCompilerNeedUninstExe);
- RunFilename := FUninstExe;
- end else begin
- if FCompiledExe = '' then
- raise Exception.Create(SCompilerNeedCompiledExe);
- RunFilename := FCompiledExe;
- end;
- RunParameters := Format('/DEBUGWND=$%x ', [Handle]) + FRunParameters;
- ResetAllMemosLineState;
- DebugOutputList.Clear;
- SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
- OutputTabSet.TabIndex := tiDebugOutput;
- SetStatusPanelVisible(True);
- FillChar(Info, SizeOf(Info), 0);
- Info.cbSize := SizeOf(Info);
- Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
- SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS;
- Info.Wnd := Handle;
- if FOptions.RunAsDifferentUser then
- Info.lpVerb := 'runas'
- else
- Info.lpVerb := 'open';
- Info.lpFile := PChar(RunFilename);
- Info.lpParameters := PChar(RunParameters);
- WorkingDir := PathExtractDir(RunFilename);
- Info.lpDirectory := PChar(WorkingDir);
- Info.nShow := SW_SHOWNORMAL;
- { When the RunAsDifferentUser option is enabled, it's this process that
- waits on the UAC dialog, not Setup(Ldr), so we need to disable windows to
- prevent the user from clicking other things before the UAC dialog is
- dismissed (which is definitely a possibility if the "Switch to the secure
- desktop when prompting for elevation" setting is disabled in Group
- Policy). }
- SaveFocusWindow := GetFocus;
- WindowList := DisableTaskWindows(Handle);
- try
- { Also temporarily remove the focus since a disabled window's children can
- still receive keystrokes. This is needed if Windows doesn't switch to
- the secure desktop immediately and instead shows a flashing taskbar
- button that the user must click (which happened on Windows Vista; I'm
- unable to reproduce it on Windows 11). }
- Windows.SetFocus(0);
- ShellExecuteResult := ShellExecuteEx(@Info);
- ErrorCode := GetLastError;
- finally
- EnableTaskWindows(WindowList);
- Windows.SetFocus(SaveFocusWindow);
- end;
- if not ShellExecuteResult then begin
- { Don't display error message if user clicked Cancel at UAC dialog }
- if ErrorCode = ERROR_CANCELLED then
- Abort;
- raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename,
- ErrorCode, Win32ErrorString(ErrorCode)]);
- end;
- FDebugging := True;
- FPaused := False;
- FProcessHandle := Info.hProcess;
- CheckIfRunningTimer.Enabled := True;
- UpdateRunMenu;
- UpdateCaption;
- DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started');
- end;
- procedure TMainForm.CompileIfNecessary;
- function UnopenedIncludedFileModifiedSinceLastCompile: Boolean;
- var
- IncludedFile: TIncludedFile;
- NewTime: TFileTime;
- begin
- Result := False;
- for IncludedFile in FIncludedFiles do begin
- if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and
- GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and
- (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin
- Result := True;
- Exit;
- end;
- end;
- end;
- begin
- CheckIfTerminated;
- { Display warning if the user modified the script while running - does not support unopened included files }
- if FDebugging and FModifiedAnySinceLastCompileAndGo then begin
- if MsgBox('The changes you made will not take effect until you ' +
- 're-compile.' + SNewLine2 + 'Continue running anyway?',
- SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then
- Abort;
- FModifiedAnySinceLastCompileAndGo := False;
- { The process may have terminated while the message box was up; check,
- and if it has, we want to recompile below }
- CheckIfTerminated;
- end;
- if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then
- CompileFile('', False);
- end;
- procedure TMainForm.Go(AStepMode: TStepMode);
- begin
- CompileIfNecessary;
- FStepMode := AStepMode;
- HideError;
- SetStepLine(FStepMemo, -1);
- if FDebugging then begin
- if FPaused then begin
- FPaused := False;
- UpdateRunMenu;
- UpdateCaption;
- if DebugCallStackList.Items.Count > 0 then begin
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Update;
- end;
- { Tell it to continue }
- SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
- Ord(AStepMode = smStepOver), 0);
- end;
- end
- else
- StartProcess;
- end;
- function TMainForm.EvaluateConstant(const S: String;
- out Output: String): Integer;
- begin
- { This is about evaluating constants like 'app' and not [Code] variables }
- FReplyString := '';
- Result := SendCopyDataMessageStr(FDebugClientWnd, Handle,
- CD_DebugClient_EvaluateConstantW, S);
- if Result > 0 then
- Output := FReplyString;
- end;
- function TMainForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
- out Output: String): Integer;
- begin
- FReplyString := '';
- Result := SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry,
- DebugEntry, SizeOf(DebugEntry^));
- if Result > 0 then
- Output := FReplyString;
- end;
- procedure TMainForm.RRunClick(Sender: TObject);
- begin
- Go(smRun);
- end;
- procedure TMainForm.RParametersClick(Sender: TObject);
- begin
- ReadMRUParametersList;
- InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] +
- ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList);
- if FRunParameters <> '' then
- ModifyMRUParametersList(FRunParameters, True);
- end;
- procedure TMainForm.RPauseClick(Sender: TObject);
- begin
- if FDebugging and not FPaused then begin
- if FStepMode <> smStepInto then begin
- FStepMode := smStepInto;
- UpdateCaption;
- end
- else
- MsgBox('A pause is already pending.', SCompilerFormCaption, mbError,
- MB_OK);
- end;
- end;
- procedure TMainForm.RRunToCursorClick(Sender: TObject);
- function GetDebugEntryFromMemoAndLineNumber(Memo: TIDEScintFileEdit; LineNumber: Integer;
- var DebugEntry: TDebugEntry): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- for I := 0 to FDebugEntriesCount-1 do begin
- if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
- (FDebugEntries[I].LineNumber = LineNumber) then begin
- DebugEntry := FDebugEntries[I];
- Result := True;
- Break;
- end;
- end;
- end;
- begin
- CompileIfNecessary;
- if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TIDEScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin
- MsgBox('No code was generated for the current line.', SCompilerFormCaption,
- mbError, MB_OK);
- Exit;
- end;
- Go(smRunToCursor);
- end;
- procedure TMainForm.RStepIntoClick(Sender: TObject);
- begin
- Go(smStepInto);
- end;
- procedure TMainForm.RStepOutClick(Sender: TObject);
- begin
- if FPausedAtCodeLine then
- Go(smStepOut)
- else
- Go(smStepInto);
- end;
- procedure TMainForm.RStepOverClick(Sender: TObject);
- begin
- Go(smStepOver);
- end;
- procedure TMainForm.RTerminateClick(Sender: TObject);
- var
- S, Dir: String;
- begin
- S := 'This will unconditionally terminate the running ' +
- DebugTargetStrings[FDebugTarget] + ' process. Continue?';
- if FDebugTarget = dtSetup then
- S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' +
- 'is currently in the installation phase, any changes made to the ' +
- 'system thus far will not be undone, nor will uninstall data be written.';
- if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then
- Exit;
- CheckIfTerminated;
- if FDebugging then begin
- DebugLogMessage('*** Terminating process');
- Win32Check(TerminateProcess(FDebugClientProcessHandle, 6));
- if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and
- (FTempDir <> '') then begin
- Dir := FTempDir;
- FTempDir := '';
- DebugLogMessage('*** Removing left-over temporary directory: ' + Dir);
- { Sleep for a bit to allow files to be unlocked by Windows,
- otherwise it fails intermittently (with Hyper-Threading, at least) }
- Sleep(50);
- if not DeleteDirTree(Dir) and DirExists(Dir) then
- DebugLogMessage('*** Failed to remove temporary directory');
- end;
- DebuggingStopped(True);
- end;
- end;
- procedure TMainForm.REvaluateClick(Sender: TObject);
- var
- Output: String;
- begin
- if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):',
- FLastEvaluateConstantText) then begin
- case EvaluateConstant(FLastEvaluateConstantText, Output) of
- 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK);
- 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK);
- else
- MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK);
- end;
- end;
- end;
- procedure TMainForm.CheckIfRunningTimerTimer(Sender: TObject);
- begin
- { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye
- message. But in case we don't get that, use a timer to periodically check
- if the process is no longer running. }
- CheckIfTerminated;
- end;
- procedure TMainForm.POutputListCopyClick(Sender: TObject);
- var
- ListBox: TListBox;
- Text: String;
- I: Integer;
- begin
- if CompilerOutputList.Visible then
- ListBox := CompilerOutputList
- else if DebugOutputList.Visible then
- ListBox := DebugOutputList
- else if DebugCallStackList.Visible then
- ListBox := DebugCallStackList
- else
- ListBox := FindResultsList;
- Text := '';
- if ListBox.SelCount > 0 then begin
- for I := 0 to ListBox.Items.Count-1 do begin
- if ListBox.Selected[I] then begin
- if Text <> '' then
- Text := Text + SNewLine;
- Text := Text + ListBox.Items[I];
- end;
- end;
- end;
- Clipboard.AsText := Text;
- end;
- procedure TMainForm.POutputListSelectAllClick(Sender: TObject);
- var
- ListBox: TListBox;
- I: Integer;
- begin
- if CompilerOutputList.Visible then
- ListBox := CompilerOutputList
- else if DebugOutputList.Visible then
- ListBox := DebugOutputList
- else if DebugCallStackList.Visible then
- ListBox := DebugCallStackList
- else
- ListBox := FindResultsList;
- ListBox.Items.BeginUpdate;
- try
- for I := 0 to ListBox.Items.Count-1 do
- ListBox.Selected[I] := True;
- finally
- ListBox.Items.EndUpdate;
- end;
- end;
- procedure TMainForm.OutputListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if Shift = [ssCtrl] then begin
- if Key = Ord('C') then
- POutputListCopyClick(Sender)
- else if Key = Ord('A') then
- POutputListSelectAllClick(Sender);
- end;
- end;
- procedure TMainForm.AppOnIdle(Sender: TObject; var Done: Boolean);
- begin
- { For an explanation of this, see the comment where HandleMessage is called }
- if FCompiling then
- Done := False;
- FBecameIdle := True;
- end;
- procedure TMainForm.EGotoClick(Sender: TObject);
- var
- S: String;
- L: Integer;
- begin
- S := IntToStr(FActiveMemo.CaretLine + 1);
- if InputQuery('Go to Line', 'Line number:', S) then begin
- L := StrToIntDef(S, Low(L));
- if L <> Low(L) then
- FActiveMemo.CaretLine := L - 1;
- end;
- end;
- procedure TMainForm.StatusBarClick(Sender: TObject);
- begin
- if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
- var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
- var X := StatusBar.ScreenToClient(Point).X;
- var W := 0;
- for var I := 0 to StatusBar.Panels.Count-1 do begin
- Inc(W, StatusBar.Panels[I].Width);
- if X < W then begin
- if I = spHiddenFilesCount then
- (MemosTabSet.PopupMenu as TMainFormPopupMenu).Popup(Point.X, Point.Y);
- Break;
- end else if I = spHiddenFilesCount then
- Break;
- end;
- end;
- end;
- procedure TMainForm.StatusBarCanvasDrawPanel(Canvas: TCanvas;
- Panel: TStatusPanel; const Rect: TRect);
- const
- TP_DROPDOWNBUTTONGLYPH = 7;
- TS_NORMAL = 1;
- begin
- case Panel.Index of
- spHiddenFilesCount:
- if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
- var RText := Rect;
- if FToolbarThemeData <> 0 then begin
- Dec(RText.Right, RText.Bottom - RText.Top);
- var RGlyph := Rect;
- RGlyph.Left := RText.Right; { RGlyph is now a square }
- DrawThemeBackground(FToolbarThemeData, Canvas.Handle, TP_DROPDOWNBUTTONGLYPH, TS_NORMAL, RGlyph, nil);
- end;
- var Color: TColor := FTheme.Colors[tcFore];
- const LStyle = TStyleManager.ActiveStyle;
- if LStyle <> nil then begin
- const Details = LStyle.GetElementDetails(tsPane);
- LStyle.GetElementColor(Details, ecTextColor, Color);
- end;
- Canvas.Font.Color := Color;
- var S := Format('Tabs closed: %d', [FHiddenFiles.Count]);
- Canvas.TextRect(RText, S, [tfCenter]);
- end;
- spCompileIcon:
- if FCompiling then begin
- var BuildImageList := FBuildImageList;
- ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, Canvas.Handle,
- Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2,
- Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL);
- end;
- spCompileProgress:
- if FCompiling and (FProgressMax > 0) then begin
- var R := Rect;
- InflateRect(R, -2, -2);
- var LStyle := StyleServices(Self);
- if not LStyle.Enabled or LStyle.IsSystemStyle then
- LStyle := nil;
- if LStyle <> nil then begin
- { See Vcl.ComCtrl's TProgressBarStyleHook.Paint, .PaintFrame, and .PaintBar }
- var Details: TThemedElementDetails;
- Details.Element := teProgress;
- if LStyle.HasTransparentParts(Details) then
- LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False, @R);
- Details := LStyle.GetElementDetails(tpBar);
- LStyle.DrawElement(Canvas.Handle, Details, R);
- InflateRect(R, -1, -1);
- const W = R.Width;
- const Pos = Round(W * (FProgress / FProgressMax));
- var FillR := R;
- FillR.Right := FillR.Left + Pos;
- Details := LStyle.GetElementDetails(tpChunk);
- LStyle.DrawElement(Canvas.Handle, Details, FillR);
- end else if FProgressThemeData = 0 then begin
- { Border }
- Canvas.Pen.Color := clBtnShadow;
- Canvas.Brush.Style := bsClear;
- Canvas.Rectangle(R);
- InflateRect(R, -1, -1);
- { Filled part }
- var SaveRight := R.Right;
- R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
- FProgressMax);
- Canvas.Brush.Color := clHighlight;
- Canvas.FillRect(R);
- { Unfilled part }
- R.Left := R.Right;
- R.Right := SaveRight;
- Canvas.Brush.Color := clBtnFace;
- Canvas.FillRect(R);
- end else begin
- DrawThemeBackground(FProgressThemeData, Canvas.Handle,
- PP_BAR, 0, R, nil);
- { PP_FILL drawing on Windows 11 (and probably 10) is bugged: when
- the width of the green bar is less than ~25 pixels, the bar is
- drawn over the left border. The same thing happens with
- TProgressBar, so I don't think the API is being used incorrectly.
- Work around the bug by passing a clipping rectangle that excludes
- the left edge when running on Windows 10/11 only. (I don't know if
- earlier versions need it, or if later versions will fix it.) }
- var CR := R;
- if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then
- Inc(CR.Left); { does this need to be DPI-scaled? }
- R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
- FProgressMax);
- DrawThemeBackground(FProgressThemeData, Canvas.Handle,
- PP_FILL, PBFS_NORMAL, R, @CR);
- end;
- end;
- end;
- end;
- procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar;
- Panel: TStatusPanel; const Rect: TRect);
- begin
- StatusBarCanvasDrawPanel(StatusBar.Canvas, Panel, Rect);
- end;
- procedure TMainForm.InvalidateStatusPanel(const Index: Integer);
- var
- R: TRect;
- begin
- { For some reason, the VCL doesn't offer a method for this... }
- if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin
- InflateRect(R, -1, -1);
- InvalidateRect(StatusBar.Handle, @R, True);
- end;
- end;
- procedure TMainForm.UpdateCompileStatusPanels(const AProgress,
- AProgressMax: Cardinal; const ASecondsRemaining: Integer;
- const ABytesCompressedPerSecond: Cardinal);
- begin
- var CurTick := GetTickCount;
- var LastTick := FLastAnimationTick;
- FLastAnimationTick := CurTick;
- { Icon and text panels - updated every 500ms }
- if CurTick div 500 <> LastTick div 500 then begin
- InvalidateStatusPanel(spCompileIcon);
- FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4;
- if ASecondsRemaining >= 0 then
- StatusBar.Panels[spExtraStatus].Text := Format(
- ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
- [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
- (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
- ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
- else
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- { Progress panel and taskbar progress bar - updated every 100ms }
- if (CurTick div 100 <> LastTick div 100) and
- ((FProgress <> AProgress) or (FProgressMax <> AProgressMax)) then begin
- FProgress := AProgress;
- FProgressMax := AProgressMax;
- InvalidateStatusPanel(spCompileProgress);
- { The taskbar progress updates are slow (on Windows 11). Limiting the
- range to 64 instead of 1024 improved compression KB/sec by about 4%
- (9000 to 9400) when the rate limit above is disabled. }
- var NewValue: Cardinal := 1; { must be at least 1 for progress bar to show }
- if AProgressMax > 0 then begin
- { Not using MulDiv here to avoid rounding up }
- NewValue := (AProgress * 64) div AProgressMax;
- if NewValue = 0 then
- NewValue := 1;
- end;
- { Don't call the function if the value hasn't changed, just in case there's
- a performance penalty. (There doesn't appear to be on Windows 11.) }
- if FTaskbarProgressValue <> NewValue then begin
- FTaskbarProgressValue := NewValue;
- SetAppTaskbarProgressValue(NewValue, 64);
- end;
- end;
- end;
- procedure TMainForm.WMSettingChange(var Message: TMessage);
- begin
- inherited;
- if (FTheme.Typ <> ttClassic) and IsWindows10 and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin
- FOptions.ThemeType := GetDefaultThemeType;
- UpdateTheme;
- end;
- for var Memo in FMemos do
- Memo.SettingChange(Message);
- end;
- procedure TMainForm.WMThemeChanged(var Message: TMessage);
- begin
- { Don't Run to Cursor into this function, it will interrupt up the theme change }
- UpdateThemeData(True);
- inherited;
- end;
- procedure TMainForm.WMUAHDrawMenu(var Message: TMessage);
- begin
- if FTheme.Dark then begin
- var MenuBarInfo: TMenuBarInfo;
- MenuBarInfo.cbSize := SizeOf(MenuBarInfo);
- GetMenuBarInfo(Handle, Integer(OBJID_MENU), 0, MenuBarInfo);
- var WindowRect: TRect;
- GetWindowRect(Handle, WindowRect);
- var Rect := MenuBarInfo.rcBar;
- OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top);
- var UAHMenu := PUAHMenu(Message.lParam);
- FillRect(UAHMenu.hdc, Rect, FMenuDarkBackgroundBrush.Handle);
- end else
- inherited;
- end;
- procedure TMainForm.WMUAHDrawMenuItem(var Message: TMessage);
- const
- ODS_NOACCEL = $100;
- DTT_TEXTCOLOR = 1;
- MENU_BARITEM = 8;
- MBI_NORMAL = 1;
- var
- Buffer: array of Char;
- begin
- if FTheme.Dark then begin
- var UAHDrawMenuItem := PUAHDrawMenuItem(Message.lParam);
- var MenuItemInfo: TMenuItemInfo;
- MenuItemInfo.cbSize := SizeOf(MenuItemInfo);
- MenuItemInfo.fMask := MIIM_STRING;
- MenuItemInfo.dwTypeData := nil;
- GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo);
- Inc(MenuItemInfo.cch);
- SetLength(Buffer, MenuItemInfo.cch);
- MenuItemInfo.dwTypeData := @Buffer[0];
- GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo);
- var dwFlags: DWORD := DT_CENTER or DT_SINGLELINE or DT_VCENTER;
- if (UAHDrawMenuItem.dis.itemState and ODS_NOACCEL) <> 0 then
- dwFlags := dwFlags or DT_HIDEPREFIX;
- var Inactive := (UAHDrawMenuItem.dis.itemState and ODS_INACTIVE) <> 0;
- var TextColor: TThemeColor;
- if Inactive then
- TextColor := tcMarginFore
- else
- TextColor := tcFore;
- var opts: TDTTOpts;
- opts.dwSize := SizeOf(opts);
- opts.dwFlags := DTT_TEXTCOLOR;
- opts.crText := FTheme.Colors[TextColor];
- var Brush: HBrush;
- { ODS_HOTLIGHT can be set when the menu is inactive so we check Inactive as well. }
- if not Inactive and ((UAHDrawMenuItem.dis.itemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0) then
- Brush := FMenuDarkHotOrSelectedBrush.Handle
- else
- Brush := FMenuDarkBackgroundBrush.Handle;
- FillRect(UAHDrawMenuItem.um.hdc, UAHDrawMenuItem.dis.rcItem, Brush);
- DrawThemeTextEx(FMenuThemeData, UAHDrawMenuItem.um.hdc, MENU_BARITEM, MBI_NORMAL, MenuItemInfo.dwTypeData, MenuItemInfo.cch, dwFlags, @UAHDrawMenuItem.dis.rcItem, opts);
- end else
- inherited;
- end;
- { Should be removed if the main menu ever gets removed }
- procedure TMainForm.UAHDrawMenuBottomLine;
- begin
- if not (csDestroying in ComponentState) and (FTheme <> nil) and FTheme.Dark then begin
- var ClientRect: TRect;
- Windows.GetClientRect(Handle, ClientRect);
- MapWindowPoints(Handle, 0, ClientRect, 2);
- var WindowRect: TRect;
- GetWindowRect(Handle, WindowRect);
- var Rect := ClientRect;
- OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top);
- Rect.Bottom := Rect.Top;
- Dec(Rect.Top);
- var DC := GetWindowDC(Handle);
- FillRect(DC, Rect, FMenuDarkBackgroundBrush.Handle);
- ReleaseDC(Handle, DC);
- end;
- end;
- procedure TMainForm.WMNCActivate(var Message: TMessage);
- begin
- inherited;
- UAHDrawMenuBottomLine;
- end;
- procedure TMainForm.WMNCPaint(var Message: TMessage);
- begin
- inherited;
- UAHDrawMenuBottomLine;
- end;
- procedure TMainForm.RTargetClick(Sender: TObject);
- var
- NewTarget: TDebugTarget;
- begin
- if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then
- NewTarget := dtSetup
- else
- NewTarget := dtUninstall;
- if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then
- FDebugTarget := NewTarget;
- { Update always even if the user decided not to switch so the states are restored }
- UpdateTargetMenu;
- end;
- procedure TMainForm.AppOnActivate(Sender: TObject);
- const
- ReloadMessages: array[Boolean] of String = (
- 'The %s file has been modified outside of the source editor.' + SNewLine2 +
- 'Do you want to reload the file?',
- 'The %s file has been modified outside of the source editor. Changes have ' +
- 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' +
- 'reload the file and lose the changes made in the source editor?');
- var
- Memo: TIDEScintFileEdit;
- NewTime: TFileTime;
- Changed: Boolean;
- begin
- for Memo in FFileMemos do begin
- if (Memo.Filename = '') or not Memo.Used then
- Continue;
- { See if the file has been modified outside the editor }
- Changed := False;
- if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin
- if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin
- Memo.FileLastWriteTime := NewTime;
- Changed := True;
- end;
- end;
- { If it has been, offer to reload it }
- if Changed then begin
- if IsWindowEnabled(Handle) then begin
- if MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]),
- SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
- if ConfirmCloseFile(False) then begin
- OpenFile(Memo, Memo.Filename, False);
- if Memo = FMainMemo then
- Break; { Reloading the main script will also reload all include files }
- end;
- end
- else begin
- { When a modal dialog is up, don't offer to reload the file. Probably
- not a good idea since the dialog might be manipulating the file. }
- MsgBox('The ' + Memo.Filename + ' file has been modified outside ' +
- 'of the source editor. You might want to reload it.',
- SCompilerFormCaption, mbInformation, MB_OK);
- end;
- end;
- end;
- end;
- procedure TMainForm.CompilerOutputListDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState);
- const
- ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed);
- var
- Canvas: TCanvas;
- S: String;
- StatusMessageKind: TStatusMessageKind;
- begin
- Canvas := CompilerOutputList.Canvas;
- S := CompilerOutputList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin
- StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]);
- Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]];
- end;
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- procedure TMainForm.DebugOutputListDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S: String;
- begin
- Canvas := DebugOutputList.Canvas;
- S := DebugOutputList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if (S <> '') and (S[1] = #9) then
- Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
- else begin
- if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
- { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
- Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
- Canvas.Font.Style := [fsBold];
- Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
- end else
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- end;
- procedure TMainForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S: String;
- begin
- Canvas := DebugCallStackList.Canvas;
- S := DebugCallStackList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- procedure TMainForm.FindResultsListDblClick(Sender: TObject);
- var
- FindResult: TFindResult;
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- I := FindResultsList.ItemIndex;
- if I <> -1 then begin
- FindResult := FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, FindResult.Filename) = 0) then begin
- MoveCaretAndActivateMemo(Memo, FindResult.Line, True);
- Memo.SelectAndEnsureVisible(FindResult.Range);
- ActiveControl := Memo;
- Exit;
- end;
- end;
- MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK);
- end;
- end;
- end;
- procedure TMainForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S, S2: String;
- FindResult: TFindResult;
- StartI, EndI: Integer;
- SaveColor: TColor;
- begin
- Canvas := FindResultsList.Canvas;
- S := FindResultsList.Items[Index];
- FindResult := FindResultsList.Items.Objects[Index] as TFindResult;
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if FindResult = nil then begin
- Canvas.Font.Style := [fsBold];
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end else if not (odSelected in State) then begin
- StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
- EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
- if StartI > 1 then begin
- Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1));
- Rect.Left := Canvas.PenPos.X;
- end;
- SaveColor := Canvas.Brush.Color;
- if FTheme.Dark then
- Canvas.Brush.Color := FTheme.Colors[tcRed]
- else
- Canvas.Brush.Color := FTheme.Colors[tcSelBack];
- S2 := Copy(S, StartI, EndI-StartI);
- Rect.Right := Rect.Left + Canvas.TextWidth(S2);
- Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text }
- if EndI <= Length(S) then begin
- Canvas.Brush.Color := SaveColor;
- S2 := Copy(S, EndI, MaxInt);
- Rect.Left := Rect.Right;
- Rect.Right := Rect.Left + Canvas.TextWidth(S2);
- Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2);
- end;
- end else
- Canvas.TextOut(Rect.Left, Rect.Top, S)
- end;
- procedure TMainForm.OutputTabSetClick(Sender: TObject);
- begin
- case OutputTabSet.TabIndex of
- tiCompilerOutput:
- begin
- CompilerOutputList.BringToFront;
- CompilerOutputList.Visible := True;
- DebugOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiDebugOutput:
- begin
- DebugOutputList.BringToFront;
- DebugOutputList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiDebugCallStack:
- begin
- DebugCallStackList.BringToFront;
- DebugCallStackList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugOutputList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiFindResults:
- begin
- FindResultsList.BringToFront;
- FindResultsList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- end;
- end;
- end;
- procedure TMainForm.ToggleBreakPoint(Line: Integer);
- var
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- Memo := FActiveMemo as TIDEScintFileEdit;
- I := Memo.BreakPoints.IndexOf(Line);
- if I = -1 then
- Memo.BreakPoints.Add(Line)
- else
- Memo.BreakPoints.Delete(I);
- UpdateLineMarkers(Memo, Line);
- BuildAndSaveBreakPointLines(Memo);
- end;
- procedure TMainForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- begin
- if (MarginNumber = 1) and RToggleBreakPoint.Enabled then
- ToggleBreakPoint(Line);
- end;
- procedure TMainForm.MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- begin
- if MarginNumber = 1 then begin
- var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
- var PopupMenu := TMainFormPopupMenu.Create(Self, BreakPointsPopupMenu);
- try
- PopupMenu.Popup(Point.X, Point.Y);
- finally
- PopupMenu.Free;
- end;
- end;
- end;
- procedure TMainForm.RToggleBreakPointClick(Sender: TObject);
- begin
- ToggleBreakPoint(FActiveMemo.CaretLine);
- end;
- procedure TMainForm.RDeleteBreakPointsClick(Sender: TObject);
- begin
- { Also see AnyMemoHasBreakPoint }
- for var Memo in FFileMemos do begin
- if Memo.Used and (Memo.BreakPoints.Count > 0) then begin
- for var I := Memo.BreakPoints.Count-1 downto 0 do begin
- var Line := Memo.BreakPoints[I];
- Memo.BreakPoints.Delete(I);
- UpdateLineMarkers(Memo, Line);
- end;
- BuildAndSaveBreakPointLines(Memo);
- end;
- end;
- end;
- procedure TMainForm.UpdateFindResult(const FindResult: TFindResult; const ItemIndex: Integer;
- const NewLine, NewLineStartPos: Integer);
- begin
- { Also see FindInFilesDialogFind }
- const OldPrefix = Format(' Line %d: ', [FindResult.Line+1]);
- FindResult.Line := NewLine;
- const NewPrefix = Format(' Line %d: ', [FindResult.Line+1]);
- FindResultsList.Items[ItemIndex] := NewPrefix + Copy(FindResultsList.Items[ItemIndex], Length(OldPrefix)+1, MaxInt);
- FindResult.PrefixStringLength := Length(NewPrefix);
- const PosChange = NewLineStartPos - FindResult.LineStartPos;
- FindResult.LineStartPos := NewLineStartPos;
- FindResult.Range.StartPos := FindResult.Range.StartPos + PosChange;
- FindResult.Range.EndPos := FindResult.Range.EndPos + PosChange;
- end;
- procedure TMainForm.MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
- begin
- for var I := 0 to FDebugEntriesCount-1 do
- if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
- (FDebugEntries[I].LineNumber >= FirstLine) then
- Inc(FDebugEntries[I].LineNumber, Count);
- for var I := FindResultsList.Items.Count-1 downto 0 do begin
- const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and
- (FindResult.Line >= FirstLine) then begin
- const NewLine = FindResult.Line + Count;
- UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
- end;
- end;
- end;
- if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin
- { Grow FStateLine if necessary }
- var GrowAmount := (Memo.LineStateCount + Count) - Memo.LineStateCapacity;
- if GrowAmount > 0 then begin
- if GrowAmount < LineStateGrowAmount then
- GrowAmount := LineStateGrowAmount;
- ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + GrowAmount));
- Inc(Memo.LineStateCapacity, GrowAmount);
- end;
- { Shift existing line states and clear the new ones }
- for var I := Memo.LineStateCount-1 downto FirstLine do
- Memo.LineState[I + Count] := Memo.LineState[I];
- for var I := FirstLine to FirstLine + Count - 1 do
- Memo.LineState[I] := lnUnknown;
- Inc(Memo.LineStateCount, Count);
- end;
- if Memo.StepLine >= FirstLine then
- Inc(Memo.StepLine, Count);
- if Memo.ErrorLine >= FirstLine then
- Inc(Memo.ErrorLine, Count);
- var BreakPointsChanged := False;
- for var I := 0 to Memo.BreakPoints.Count-1 do begin
- const Line = Memo.BreakPoints[I];
- if Line >= FirstLine then begin
- Memo.BreakPoints[I] := Line + Count;
- BreakPointsChanged := True;
- end;
- end;
- if BreakPointsChanged then
- BuildAndSaveBreakPointLines(Memo);
- FNavStacks.LinesInserted(Memo, FirstLine, Count);
- end;
- procedure TMainForm.MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count,
- FirstAffectedLine: Integer);
- begin
- for var I := 0 to FDebugEntriesCount-1 do begin
- const DebugEntry: PDebugEntry = @FDebugEntries[I];
- if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and
- (DebugEntry.LineNumber >= FirstLine) then begin
- if DebugEntry.LineNumber < FirstLine + Count then
- DebugEntry.LineNumber := -1
- else
- Dec(DebugEntry.LineNumber, Count);
- end;
- end;
- for var I := FindResultsList.Items.Count-1 downto 0 do begin
- const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and
- (FindResult.Line >= FirstLine) then begin
- if FindResult.Line < FirstLine + Count then
- FindResultsList.Items.Delete(I)
- else begin
- const NewLine = FindResult.Line - Count;
- UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
- end;
- end;
- end;
- end;
- if Assigned(Memo.LineState) then begin
- { Shift existing line states }
- if FirstLine < Memo.LineStateCount - Count then begin
- for var I := FirstLine to Memo.LineStateCount - Count - 1 do
- Memo.LineState[I] := Memo.LineState[I + Count];
- Dec(Memo.LineStateCount, Count);
- end
- else begin
- { There's nothing to shift because the last line(s) were deleted, or
- line(s) past FLineStateCount }
- if Memo.LineStateCount > FirstLine then
- Memo.LineStateCount := FirstLine;
- end;
- end;
- if Memo.StepLine >= FirstLine then begin
- if Memo.StepLine < FirstLine + Count then
- Memo.StepLine := -1
- else
- Dec(Memo.StepLine, Count);
- end;
- if Memo.ErrorLine >= FirstLine then begin
- if Memo.ErrorLine < FirstLine + Count then
- Memo.ErrorLine := -1
- else
- Dec(Memo.ErrorLine, Count);
- end;
- var BreakPointsChanged := False;
- for var I := Memo.BreakPoints.Count-1 downto 0 do begin
- const Line = Memo.BreakPoints[I];
- if Line >= FirstLine then begin
- if Line < FirstLine + Count then begin
- Memo.BreakPoints.Delete(I);
- BreakPointsChanged := True;
- end else begin
- Memo.BreakPoints[I] := Line - Count;
- BreakPointsChanged := True;
- end;
- end;
- end;
- if BreakPointsChanged then
- BuildAndSaveBreakPointLines(Memo);
- if FNavStacks.LinesDeleted(Memo, FirstLine, Count) then
- UpdateNavButtons;
- { We do NOT update FCurrentNavItem here so it might point to a line that's
- deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
- { When lines are deleted, Scintilla insists on moving all of the deleted
- lines' markers to the line on which the deletion started
- (FirstAffectedLine). This is bad for us as e.g. it can result in the line
- having two conflicting markers (or two of the same marker). There's no
- way to stop it from doing that, or to easily tell which markers came from
- which lines, so we simply delete and re-create all markers on the line. }
- UpdateLineMarkers(Memo, FirstAffectedLine);
- end;
- procedure TMainForm.UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
- var
- NewMarker: Integer;
- begin
- if Line >= AMemo.Lines.Count then
- Exit;
- var StepLine := AMemo.StepLine = Line;
- NewMarker := -1;
- if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin
- if AMemo.LineState = nil then
- NewMarker := mmiBreakpoint
- else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then
- NewMarker := IfThen(StepLine, mmiBreakpointStep, mmiBreakpointGood)
- else
- NewMarker := mmiBreakpointBad;
- end else if StepLine then
- NewMarker := mmiStep
- else begin
- if Line < AMemo.LineStateCount then begin
- case AMemo.LineState[Line] of
- lnHasEntry: NewMarker := mmiHasEntry;
- lnEntryProcessed: NewMarker := mmiEntryProcessed;
- end;
- end;
- end;
- { Delete all markers on the line. To flush out any possible duplicates,
- even the markers we'll be adding next are deleted. }
- if AMemo.GetMarkers(Line) <> [] then
- AMemo.DeleteAllMarkersOnLine(Line);
- if NewMarker <> -1 then
- AMemo.AddMarker(Line, NewMarker);
- if StepLine then
- AMemo.AddMarker(Line, mlmStep)
- else if AMemo.ErrorLine = Line then
- AMemo.AddMarker(Line, mlmError)
- else if NewMarker = mmiBreakpointBad then
- AMemo.AddMarker(Line, mlmBreakpointBad);
- end;
- procedure TMainForm.UpdateLinkLabelLinkClick(Sender: TObject;
- const Link: string; LinkType: TSysLinkType);
- begin
- var Handled := True;
- if (LinkType = sltID) and (Link = 'hwhatsnew') then
- HWhatsNew.Click
- else if (LinkType = sltID) and (Link = 'toptions-vscode') then begin
- TOptionsForm.DropDownMemoKeyMappingComboBoxOnNextShow := True;
- TOptions.Click
- end else
- Handled := False;
- if Handled then
- UpdatePanelClosePaintBoxClick(Sender);
- end;
- procedure TMainForm.UpdatePanelClosePaintBoxClick(Sender: TObject);
- begin
- var MessageToHideIndex := UpdateLinkLabel.Tag;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteInteger('UpdatePanel', FUpdatePanelMessages[MessageToHideIndex].ConfigIdent, FUpdatePanelMessages[MessageToHideIndex].ConfigValue);
- finally
- Ini.Free;
- end;
- FUpdatePanelMessages.Delete(MessageToHideIndex);
- UpdateUpdatePanel;
- end;
- procedure TMainForm.UpdatePanelDonateImageClick(Sender: TObject);
- begin
- HDonate.Click;
- end;
- procedure TMainForm.UpdatePanelClosePaintBoxPaint(Sender: TObject);
- const
- MENU_SYSTEMCLOSE = 17;
- MSYSC_NORMAL = 1;
- begin
- var Canvas := UpdatePanelClosePaintBox.Canvas;
- var R := TRect.Create(0, 0, UpdatePanelClosePaintBox.Width, UpdatePanelClosePaintBox.Height);
- if FMenuThemeData <> 0 then begin
- var Offset := MulDiv(1, CurrentPPI, 96);
- Inc(R.Left, Offset);
- DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil);
- end else begin
- InflateRect(R, -MulDiv(6, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96));
- Canvas.Pen.Color := Canvas.Font.Color;
- Canvas.MoveTo(R.Left, R.Top);
- Canvas.LineTo(R.Right, R.Bottom);
- Canvas.MoveTo(R.Left, R.Bottom-1);
- Canvas.LineTo(R.Right, R.Top-1);
- end;
- end;
- procedure TMainForm.UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
- begin
- for var Line := 0 to AMemo.Lines.Count-1 do
- UpdateLineMarkers(AMemo, Line);
- end;
- procedure TMainForm.UpdateAllMemosLineMarkers;
- begin
- for var Memo in FFileMemos do
- if Memo.Used then
- UpdateAllMemoLineMarkers(Memo);
- end;
- procedure TMainForm.UpdateBevel1Visibility;
- begin
- { Bevel1 is the line between the toolbar and memos when there's nothing in
- between and the color of the toolbar and memo margins is the same }
- Bevel1.Visible := (ToolBarPanel.Color = FTheme.Colors[tcMarginBack]) and
- not UpdatePanel.Visible and not MemosTabSet.Visible;
- end;
- function TMainForm.ToCurrentPPI(const XY: Integer): Integer;
- begin
- Result := MulDiv(XY, CurrentPPI, 96);
- end;
- function TMainForm.FromCurrentPPI(const XY: Integer): Integer;
- begin
- Result := MulDiv(XY, 96, CurrentPPI);
- end;
- initialization
- Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle;
- InitThemeLibrary;
- InitHtmlHelpLibrary;
- { For ClearType support, try to make the default font Microsoft Sans Serif }
- if DefFontData.Name = 'MS Sans Serif' then
- DefFontData.Name := AnsiString(GetPreferredUIFont);
- CoInitialize(nil);
- finalization
- CoUninitialize();
- end.
|